Commit 699bf667 authored by Kim Nguyễn's avatar Kim Nguyễn
Browse files

Merge branch 'master' of https://git.cduce.org/cduce

* 'master' of https://git.cduce.org/cduce:
  [MINOR] Remove dependence with Str module in parser
  Add syntactic sugar for if_then:
  Bugfix in parser: syntactic sugar if_then_else
parents 3a5b8d29 e2fc3b4a
......@@ -17,7 +17,7 @@ ifeq ($(NATIVE),true)
all: cduce_lib.cmxa
endif
PACKAGES = dynlink camlp4 ulex pcre num netstring str
PACKAGES = dynlink camlp4 ulex pcre num netstring
# Call make with VERBOSE=true to get a trace of commands
......
......@@ -112,7 +112,9 @@ let is_capture =
)
let if_then_else cond e1 e2 = Match (cond, [pat_true,e1; pat_false,e2])
let if_then_else cond e1 e2 =
Match (cond, [(mk (0,0) (Cst (Atom (ident "true")))),e1;
(mk (0,0) (Cst (Atom (ident "false")))),e2])
let logical_and e1 e2 = if_then_else e1 e2 cst_false
let logical_or e1 e2 = if_then_else e1 cst_true e2
......@@ -249,6 +251,8 @@ EXTEND Gram
exp _loc (Map (e,b))
| "xtransform"; e = SELF; "with"; b = branches ->
exp _loc (Xtrans (e,b))
| "if"; e = SELF; "then"; e1 = SELF ->
exp _loc (if_then_else e e1 cst_nil)
| "if"; e = SELF; "then"; e1 = SELF; "else"; e2 = SELF ->
exp _loc (if_then_else e e1 e2)
| "transform"; e = SELF; "with"; b = branches ->
......
......@@ -291,8 +291,13 @@ and token2 = lexer
| _ -> assert false) () lexbuf
| "(" [" \t"]* "'" ncname [" \t"]* ")" ->
let s = L.utf8_lexeme lexbuf in
let s = Str.global_replace (Str.regexp "[ \t]") "" s in
let s = String.sub s 2 (String.length s - 3) in
let idstart = String.index s '\'' + 1 in
let s = String.sub s idstart (String.length s - idstart) in
let len = String.length s in
let idend = min (min (try String.index s ' ' with _ -> len)
(try String.index s '\t' with _ -> len))
(try String.index s ')' with _ -> len) in
let s = String.sub s 0 idend in
return lexbuf (PTYPE s)
| "'" ncname ->
let s = L.utf8_lexeme lexbuf in
......@@ -351,8 +356,13 @@ and token2toplevel = lexer
| _ -> assert false) () lexbuf
| "(" [" \t"]* "'" ncname [" \t"]* ")" ->
let s = L.utf8_lexeme lexbuf in
let s = Str.global_replace (Str.regexp "[ \t]") "" s in
let s = String.sub s 2 (String.length s - 3) in
let idstart = String.index s '\'' + 1 in
let s = String.sub s idstart (String.length s - idstart) in
let len = String.length s in
let idend = min (min (try String.index s ' ' with _ -> len)
(try String.index s '\t' with _ -> len))
(try String.index s ')' with _ -> len) in
let s = String.sub s 0 idend in
return lexbuf (PTYPE s)
| "'" ncname ->
let s = L.utf8_lexeme lexbuf in
......
......@@ -185,7 +185,7 @@ let tests_eval = "CDuce runtime tests (Typed -> Lambda -> Value)" >:::
| x : (!Int) -> x).[2; 3]");
assert_equal ~msg:"Test CDuce.runtime.misc.is_int failed"
~printer:(fun x -> x)
"Abstraction([(Int,Bool),(Bool,Bool),(Any \\ (Bool | Int),Any \\ (Bool | Int))],Mono)"
"Abstraction([(Int,Bool),(Bool,Bool),(Any \\ ((Bool | Int)),Any \\ ((Bool | Int)))],Mono)"
(run_test_eval "fun ((Int -> Bool) & (Bool -> Bool) & ((!(Int|Bool)) -> (!(Int|Bool))))
| x : Int -> `true
| x : Bool -> `false
......@@ -409,10 +409,10 @@ let tests_eval = "CDuce runtime tests (Typed -> Lambda -> Value)" >:::
"union" >:: ( fun test_ctxt ->
assert_equal ~msg:"Test CDuce.runtime.union.identity failed"
~printer:(fun x -> x) "Abstraction([(Int | [ Char* ],Int | [ Char* ])],Mono)"
~printer:(fun x -> x) "Abstraction([((Int | [ Char* ]),(Int | [ Char* ]))],Mono)"
(run_test_eval "fun f x : (Int | String) : (Int | String) -> x");
assert_equal ~msg:"Test CDuce.runtime.union.match failed"
~printer:(fun x -> x) "Abstraction([(Int | [ Char* ],Int | [ Char* ])],Mono)"
~printer:(fun x -> x) "Abstraction([((Int | [ Char* ]),(Int | [ Char* ]))],Mono)"
(run_test_eval "fun f x : (Int | String) : (Int | String) ->
match x : (Int | String) with
| _ : Int -> 2
......
......@@ -15,7 +15,7 @@ let nb_tests = ref Int (0)
let run_test_suite (l : [(Latin1, 'a, 'a)*]) : [] = match l with
| [] -> []
| [(_, x, y) rest::(Latin1, 'a, 'a)*] -> nb_tests := !nb_tests + 1;
(if x = y then nb_success := !nb_success + 1 else []);
(if x = y then nb_success := !nb_success + 1);
run_test_suite rest
let run_test_suite_debug (l : [(Latin1, 'a, 'a)*]) : [] = match l with
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment