Stefan pushed to branch master at Stefan / Typer
Commits: e905eb9e by Stefan Monnier at 2016-05-10T21:15:41-04:00 Get rid of ;;
- - - - -
23 changed files:
- src/REPL.ml - src/builtin.ml - src/debruijn.ml - src/debug.ml - src/debug_util.ml - src/elexp.ml - src/env.ml - src/eval.ml - src/fmt.ml - src/lexer.ml - src/lparse.ml - src/pexp.ml - src/sexp.ml - src/util.ml - tests/debruijn_test.ml - tests/env_test.ml - tests/eval_test.ml - tests/lexp_test.ml - tests/macro_test.ml - tests/pexp_test.ml - tests/sexp_test.ml - tests/utest_lib.ml - tests/utest_main.ml
Changes:
===================================== src/REPL.ml ===================================== --- a/src/REPL.ml +++ b/src/REPL.ml @@ -62,11 +62,9 @@ let print_input_line i = print_string " In["; ralign_print_int i 2; print_string "] >> " -;;
let ieval_error loc msg = - msg_error "IEVAL" loc msg; -;; + msg_error "IEVAL" loc msg
(* Read stdin for input. Returns only when the last char is ';' * We can use '%' to prevent parsing @@ -96,7 +94,6 @@ let rec read_input i = loop str (i + 1))) in
loop "" i -;;
(* Interactive mode is not usual typer It makes things easier to test out code *) @@ -119,21 +116,18 @@ let ipexp_parse (sxps: sexp list): (pdecl list * pexpr list) = (* Expression *) | _ -> _pxp_parse tl dacc ((pexp_parse sxp)::pacc) in _pxp_parse sxps [] [] -;;
let ilexp_parse pexps lctx = let pdecls, pexprs = pexps in let ldecls, lctx = lexp_p_decls pdecls lctx in let lexprs = lexp_parse_all pexprs lctx in (ldecls, lexprs), lctx -;;
let ieval lexps rctx = let (ldecls, lexprs) = lexps in let rctx = eval_decls ldecls rctx in let vals = eval_all lexprs rctx false in vals, rctx -;;
let _ieval f str lctx rctx = let pres = (f str) in @@ -145,7 +139,6 @@ let _ieval f str lctx rctx = let lxps, lctx = ilexp_parse pxps lctx in let v, rctx = ieval lxps rctx in v, lctx, rctx -;;
let ieval_string = _ieval prelex_string let ieval_file = _ieval prelex_file @@ -156,7 +149,7 @@ let _welcome_msg =
%quit (%q) : leave REPL %help (%h) : print help -";; +"
let _help_msg = " %quit (%q) : leave REPL @@ -165,7 +158,7 @@ let _help_msg = %calltrace (%ct): print call trace of last call %readfile : read a typer/ityper file %help (%h) : print help -";; +"
let readfiles files (i, lctx, rctx) prt = @@ -183,7 +176,7 @@ let readfiles files (i, lctx, rctx) prt = ieval_error dloc ("file "" ^ file ^ "" does not exist."); (i, lctx, rctx)) ) - (i, lctx, rctx) files;; + (i, lctx, rctx) files
(* Specials commands %[command-name] [args] *) @@ -217,7 +210,6 @@ let rec repl i clxp rctx = repl clxp rctx with e -> repl clxp rctx) -;;
let arg_files = ref []
@@ -227,7 +219,7 @@ let arg_defs = [ (*"-I", Arg.String (fun f -> searchpath := f::!searchpath), "Append a directory to the search path"*) -];; +]
let parse_args () = Arg.parse arg_defs (fun s -> arg_files:= s::!arg_files) "" @@ -249,8 +241,6 @@ let main () =
(* Initiate REPL. This will allow us to inspect interpreted code *) repl i lctx rctx -;;
-main () -;; +let _ = main ()
===================================== src/builtin.ml ===================================== --- a/src/builtin.ml +++ b/src/builtin.ml @@ -43,7 +43,6 @@ open Env (* get_rte_variable *) let builtin_error loc msg = msg_error "BUILT-IN" loc msg; raise (internal_error msg) -;;
(* Builtin types *) let dloc = dummy_location @@ -84,7 +83,6 @@ let _generic_binary_iop name f loc (args_val: value_type list) | _ -> value_print l; print_string " "; value_print r; builtin_error loc (name ^ " expects Integers as arguments") -;;
let iadd_impl = _generic_binary_iop "Integer::add" (fun a b -> a + b) let isub_impl = _generic_binary_iop "Integer::sub" (fun a b -> a - b)
===================================== src/debruijn.ml ===================================== --- a/src/debruijn.ml +++ b/src/debruijn.ml @@ -95,7 +95,7 @@ let make_lexp_context = (_make_senv_type, _make_myers, (0, 0))
let get_roffset ctx = let (_, _, (_, rof)) = ctx in rof
-let get_size ctx = let ((n, _), _, _) = ctx in n;; +let get_size ctx = let ((n, _), _, _) = ctx in n
(* return its current DeBruijn index *) let rec senv_lookup (name: string) (ctx: lexp_context): int = @@ -130,7 +130,6 @@ let _name_error loc estr str = if estr = str then () else debruijn_error loc ("DeBruijn index refers to wrong name. " ^ "Expected: "" ^ estr ^ "" got "" ^ str ^ """) -;;
let env_set_var_info ctx (def: vref) (v: lexp option) (t: lexp) = let ((dv_size, _), info_env, _) = ctx in @@ -145,7 +144,6 @@ let env_set_var_info ctx (def: vref) (v: lexp option) (t: lexp) = rf := (0, (loc, ename), v, t)) with Not_found -> debruijn_error loc "DeBruijn index out of bounds!" -;;
(* generic lookup *) let _env_lookup ctx (v: vref): env_elem =
===================================== src/debug.ml ===================================== --- a/src/debug.ml +++ b/src/debug.ml @@ -63,13 +63,11 @@ let rec debug_pretokens_print pretoken =
| Prestring(loc, str) -> print_info "Prestring: " loc; - print_string (""" ^ str ^ """); -;; + print_string (""" ^ str ^ """)
(* Print a List of Pretokens *) let rec debug_pretokens_print_all pretokens = List.iter (fun pt -> debug_pretokens_print pt; print_string "\n") pretokens -;;
(* Sexp Print *) let rec debug_sexp_print sexp = @@ -103,7 +101,6 @@ let rec debug_sexp_print sexp = List.iter (fun sexp -> sexp_print sexp; print_string " @ ") args; print_string " " -;;
(* Print a list of sexp *) let debug_sexp_print_all tokens = @@ -112,7 +109,6 @@ let debug_sexp_print_all tokens = debug_sexp_print pt; print_string "\n";) tokens -;;
(* Print a Pexp with debug info *) @@ -137,7 +133,6 @@ let debug_pexp_print ptop = | Pcons (_,_) -> print_info "Pcons " l ptop | Pcase (_, _, _) -> print_info "Pcase " l ptop (*| _ -> print_info "Not Impl " l ptop *) -;;
let debug_pexp_decls decls = List.iter (fun e -> @@ -162,7 +157,6 @@ let debug_pexp_print_all pexps = debug_pexp_print px; print_string "\n") pexps -;;
let debug_lexp_decls decls = let sep = " : " in
===================================== src/debug_util.ml ===================================== --- a/src/debug_util.ml +++ b/src/debug_util.ml @@ -56,26 +56,25 @@ open Env
-let dloc = dummy_location;; -let dummy_decl = Imm(String(dloc, "Dummy"));; +let dloc = dummy_location +let dummy_decl = Imm(String(dloc, "Dummy"))
-let discard v = ();; +let discard v = ()
(* Argument parsing *) -let arg_print_options = ref SMap.empty;; +let arg_print_options = ref SMap.empty let arg_files = ref [] let debug_arg = ref 0
let add_p_option name () = debug_arg := (!debug_arg) + 1; - arg_print_options := SMap.add name true (!arg_print_options);; + arg_print_options := SMap.add name true (!arg_print_options)
let get_p_option name = try let _ = SMap.find name (!arg_print_options) in true with Not_found -> false -;;
(* pretty ? (print with new lines and indents) @@ -173,7 +172,7 @@ let arg_defs = [ add_p_option "lctx" (); add_p_option "rctx" ();), " Print all debug info"); -];; +]
let parse_args () = Arg.parse arg_defs (fun s -> arg_files:= s::!arg_files) "" @@ -183,7 +182,6 @@ let make_default () = add_p_option "sexp" (); add_p_option "pexp" (); add_p_option "lexp" () -;;
let format_source () = @@ -212,7 +210,6 @@ let format_source () =
) else (List.iter (fun str -> print_string str; print_string "\n") result;) -;;
let main () = parse_args (); @@ -322,7 +319,5 @@ let main () = Not_found -> () ) ) -;;
-main () -;; +let _ = main ()
===================================== src/elexp.ml ===================================== --- a/src/elexp.ml +++ b/src/elexp.ml @@ -93,6 +93,7 @@ let rec erase_type (lxp: L.lexp): elexp = | L.Arrow _ -> Arrow | L.SortLevel _ -> SortLevel | L.Sort _ -> Sort + (* FIXME: This one is wrong: eliminate it with `unsusp`. *) | L.Susp _ -> Arrow (* Still useful to some extend *) | L.Inductive(l, label, _, _) -> Inductive(l, label)
===================================== src/env.ml ===================================== --- a/src/env.ml +++ b/src/env.ml @@ -45,7 +45,6 @@ let dloc = dummy_location let env_error loc msg = msg_error "ENV" loc msg; raise (internal_error msg) -;;
let str_idx idx = "[" ^ (string_of_int idx) ^ "]"
@@ -88,15 +87,14 @@ let value_location (vtp: value_type) = type env_cell = (string option * value_type) ref type runtime_env = (env_cell myers) * (int * int)
-let make_runtime_ctx = (nil, (0, 0));; +let make_runtime_ctx = (nil, (0, 0))
-let get_rte_size (ctx: runtime_env): int = let (l, _) = ctx in length l;; +let get_rte_size (ctx: runtime_env): int = let (l, _) = ctx in length l
let is_free_var idx ctx = let (l, (osize, _)) = ctx in let tsize = (get_rte_size ctx) - osize in if idx > tsize then true else false -;;
let get_rte_variable (name: string option) (idx: int) (ctx: runtime_env): value_type = let (l, _) = ctx in @@ -117,7 +115,6 @@ let get_rte_variable (name: string option) (idx: int) (ctx: runtime_env): value_ let n = match name with Some n -> n | None -> "" in env_error dloc ("Variable lookup failure. Var: "" ^ n ^ "" idx: " ^ (str_idx idx)) -;;
let rte_shift vref ctx = let (_, (osize, _)) = ctx in (* number of variable declared outside *) @@ -132,7 +129,7 @@ let rte_shift vref ctx = let add_rte_variable name (x: value_type) (ctx: runtime_env): runtime_env = let (l, b) = ctx in let lst = (cons (ref (name, x)) l) in - (lst, b);; + (lst, b)
let set_rte_variable idx name (lxp: value_type) ctx = let (l, _) = ctx in @@ -156,7 +153,6 @@ let local_ctx ctx = let (l, (_, _)) = ctx in let osize = length l in (l, (osize, 0)) -;;
let select_n (ctx: runtime_env) n: runtime_env = let (l, a) = ctx in @@ -180,8 +176,7 @@ let temp_ctx (ctx: runtime_env): runtime_env = print_string "temp ctx was useful\n"; *) (select_n ctx osize)) else - ctx -;; *) + ctx *)
(* Select the n first variable present in the env *) let nfirst_rte_var n ctx = @@ -191,7 +186,6 @@ let nfirst_rte_var n ctx = else List.rev acc in loop 0 [] -;;
let print_myers_list l print_fun = let n = (length l) - 1 in @@ -207,8 +201,7 @@ let print_myers_list l print_fun = print_string " | "; print_fun (nth (n - i) l); done; - print_string (make_sep '='); -;; + print_string (make_sep '=')
let print_rte_ctx (ctx: runtime_env) = let (l, b) = ctx in @@ -221,5 +214,4 @@ let print_rte_ctx (ctx: runtime_env) = | None -> print_string (make_line ' ' 12); print_string " | " in
value_print g; print_string "\n") -;;
===================================== src/eval.ml ===================================== --- a/src/eval.ml +++ b/src/eval.ml @@ -49,7 +49,6 @@ module ET = Elexp let eval_error loc msg = msg_error "EVAL" loc msg; raise (internal_error msg) -;;
let eval_fatal = msg_fatal "EVAL"
@@ -291,7 +290,6 @@ and print_eval_result i lxp =
and print_eval_trace () = print_trace " EVAL TRACE " 50 lexp_to_string lexp_print !_global_eval_trace -;;
let eval lxp ctx = _global_eval_trace := []; @@ -305,12 +303,11 @@ let debug_eval lxp ctx = print_rte_ctx (!_global_eval_ctx); print_eval_trace (); raise e) -;;
(* Eval a list of lexp *) let eval_all lxps rctx silent = let evalfun = if silent then eval else debug_eval in - List.map (fun g -> evalfun g rctx) lxps;; + List.map (fun g -> evalfun g rctx) lxps
(* build a rctx from a lctx *)
===================================== src/fmt.ml ===================================== --- a/src/fmt.ml +++ b/src/fmt.ml @@ -33,13 +33,12 @@ (* Compute the number of character needed to print an integer*) let str_size_int value = (int_of_float (log10 (float value))) + 1 -;;
(* print n char 'c' *) -let rec make_line c n = String.make n c;; +let rec make_line c n = String.make n c
(* Big numbers are replaced by #### *) -let cut_int (v:int) (start:int) (len:int): int = 0;; +let cut_int (v:int) (start:int) (len:int): int = 0
(* RALIGN * ----------------------- *) @@ -50,13 +49,12 @@ let ralign_generic get_size print_str print_elem cut_elem elem col = else begin print_str (make_line ' ' (col - n)); print_elem elem; end -;;
let ralign_print_string = - ralign_generic String.length print_string print_string String.sub;; + ralign_generic String.length print_string print_string String.sub
let ralign_print_int = - ralign_generic str_size_int print_string print_int cut_int;; + ralign_generic str_size_int print_string print_int cut_int
(* LALIGN @@ -68,13 +66,12 @@ let lalign_generic get_size print_str print_elem cut_elem elem col = else begin print_elem elem; print_str (make_line ' ' (col - n)); end -;;
let lalign_print_string = - lalign_generic String.length print_string print_string String.sub;; + lalign_generic String.length print_string print_string String.sub
let lalign_print_int = - lalign_generic str_size_int print_string print_int cut_int;; + lalign_generic str_size_int print_string print_int cut_int
(* CALIGN * ----------------------- *) @@ -89,13 +86,12 @@ let calign_generic get_size print_str print_elem cut_elem elem col = print_str (make_line ' ' sep_n); print_elem elem; print_str (make_line ' ' (sep_n + p)); end -;;
let calign_print_string = - calign_generic String.length print_string print_string String.sub;; + calign_generic String.length print_string print_string String.sub
let calign_print_int = - calign_generic str_size_int print_string print_int cut_int;; + calign_generic str_size_int print_string print_int cut_int
(* Table Printing helper *) let make_title title = @@ -105,7 +101,6 @@ let make_title title = let lsep = (make_line '=' sep_n) in let rsep = (make_line '=' (sep_n + p)) in (" " ^ lsep ^ title ^ rsep ^ "\n") -;;
let make_rheader (head: (((char* int) option * string) list)) = print_string " | "; @@ -119,9 +114,8 @@ let make_rheader (head: (((char* int) option * string) list)) = head;
print_string "\n" -;;
-let make_sep c = " " ^ (make_line c 76) ^ "\n";; +let make_sep c = " " ^ (make_line c 76) ^ "\n"
(* used to help visualize the call trace *) @@ -132,7 +126,6 @@ let _print_ct_tree i = | _ when (j mod 2) = 0 -> print_char '|'; loop (j + 1) | _ -> print_char ':'; loop (j + 1) in loop 0 -;;
(* iterate of first n of a list l and apply f *) let print_first n l f = @@ -143,7 +136,6 @@ let print_first n l f = if i < n then ((f i hd); loop (i + 1) tl;) else () in loop 0 l -;;
(* Colors *) let red = "\x1b[31m"
===================================== src/lexer.ml ===================================== --- a/src/lexer.ml +++ b/src/lexer.ml @@ -1,6 +1,6 @@ (* lexer.ml --- Second half of lexical analysis of Typer.
-Copyright (C) 2011-2012 Free Software Foundation, Inc. +Copyright (C) 2011-2012, 2016 Free Software Foundation, Inc.
Author: Stefan Monnier monnier@iro.umontreal.ca Keywords: languages, lisp, dependent types. @@ -118,19 +118,16 @@ let lex tenv (pts : pretoken list) : sexp list = | _ -> let (tok, pts, bpos, cpos) = nexttoken tenv pts bpos cpos in gettokens pts bpos cpos (tok :: acc) in gettokens pts 0 0 [] -;;
let _lex_str (str: string) tenv = let pretoks = prelex_string str in lex tenv pretoks -;;
let lex_str str = _lex_str str default_stt
let _sexp_parse_str (str: string) tenv grm limit = let toks = _lex_str str tenv in sexp_parse_all_to_list grm toks limit -;;
let sexp_parse_str str = _sexp_parse_str str default_stt default_grammar (Some ";")
===================================== src/lparse.ml ===================================== --- a/src/lparse.ml +++ b/src/lparse.ml @@ -783,7 +783,6 @@ let default_lctx () = let pxps = pexp_decls_all nods in let _, lctx = lexp_p_decls pxps lctx in lctx -;;
(* Make runtime context with built-in types *) let default_rctx () =
===================================== src/pexp.ml ===================================== --- a/src/pexp.ml +++ b/src/pexp.ml @@ -82,7 +82,6 @@ let rec pexp_pat_location e = match e with | Ppatany l -> l | Ppatvar (l,_) -> l | Ppatcons ((l, _), _) -> l -;;
(* In the following "pexp_p" the prefix for "parse a sexp, returning a pexp" * and "pexp_u" is the prefix for "unparse a pexp, returning a sexp". *) @@ -356,7 +355,6 @@ let pexp_print e = sexp_print (pexp_unparse e) (* Parse All Pexp as a list *) let pexp_parse_all (nodes: sexp list) = List.map pexp_parse nodes -;;
let pexp_decls_all (nodes: sexp list): ((pvar * pexp * bool) list) = let rec loop nodes acc = @@ -367,7 +365,6 @@ let pexp_decls_all (nodes: sexp list): ((pvar * pexp * bool) list) = let nacc = List.append acc r in loop tl nacc in loop nodes [] -;;
(* String Parsing * --------------------------------------------------------- *) @@ -377,22 +374,18 @@ let _pexp_expr_str (str: string) (tenv: bool array) (grm: grammar) (limit: string option) = let sxps = _sexp_parse_str str tenv grm limit in pexp_parse_all sxps -;;
(* specialized version *) let pexp_expr_str str = _pexp_expr_str str default_stt default_grammar (Some ";") -;;
let _pexp_decl_str (str: string) tenv grm limit = let sxps = _sexp_parse_str str tenv grm limit in pexp_decls_all sxps -;;
(* specialized version *) let pexp_decl_str str = _pexp_decl_str str default_stt default_grammar (Some ";") -;;
let pexp_to_string e = match e with @@ -407,6 +400,5 @@ let pexp_to_string e = | Pinductive ((_,_), _, _) -> "Pinductive" | Pcons ((_,_),_) -> "Pcons" | Pcase (_, _, _) -> "Pcase" -;;
===================================== src/sexp.ml ===================================== --- a/src/sexp.ml +++ b/src/sexp.ml @@ -1,6 +1,6 @@ (* sexp.ml --- The Lisp-style Sexp abstract syntax tree.
-Copyright (C) 2011-2015 Free Software Foundation, Inc. +Copyright (C) 2011-2016 Free Software Foundation, Inc.
Author: Stefan Monnier monnier@iro.umontreal.ca Keywords: languages, lisp, dependent types. @@ -231,8 +231,3 @@ let sexp_parse_all_to_list grm tokens limit = | _ -> let (sxp, rest) = sexp_parse_all grm tokens limit in sexp_parse_impl grm rest limit (sxp :: acc) in sexp_parse_impl grm tokens limit [] -;; - - - -
===================================== src/util.ml ===================================== --- a/src/util.ml +++ b/src/util.ml @@ -118,4 +118,4 @@ let str_split str sep = (if (Buffer.length buffer) > 0 then ret := (Buffer.contents buffer)::(!ret));
- List.rev (!ret));; \ No newline at end of file + List.rev (!ret))
===================================== tests/debruijn_test.ml ===================================== --- a/tests/debruijn_test.ml +++ b/tests/debruijn_test.ml @@ -71,10 +71,9 @@ let _ = (add_test "DEBRUIJN" "Set Variables" (fun () -> else success ()
-));; +))
(* run all tests *) -run_all () -;; +let _ = run_all ()
===================================== tests/env_test.ml ===================================== --- a/tests/env_test.ml +++ b/tests/env_test.ml @@ -72,10 +72,8 @@ let _ = (add_test "ENV" "Set Variables" (fun () -> else success ()
-));; - +))
(* run all tests *) -run_all () -;; +let _ = run_all ()
===================================== tests/eval_test.ml ===================================== --- a/tests/eval_test.ml +++ b/tests/eval_test.ml @@ -59,7 +59,7 @@ let _ = (add_test "EVAL" "Variable Cascade" (fun () -> match ret with | [Vint(r)] -> expect_equal_int r 10 | _ -> failure ()) -);; +)
(* Let @@ -82,7 +82,6 @@ let _ = (add_test "EVAL" "Let" (fun () -> | [Vint(r)] -> expect_equal_int r 30 | _ -> failure ()) ) -;;
(* Lambda @@ -105,7 +104,6 @@ let _ = (add_test "EVAL" "Lambda" (fun () -> | [Vint(r)] -> expect_equal_int r (4 * 4) | _ -> failure ()) ) -;;
let _ = (add_test "EVAL" "Nested Lambda" (fun () -> reset_eval_trace (); @@ -127,7 +125,6 @@ let _ = (add_test "EVAL" "Nested Lambda" (fun () -> | [Vint(r)] -> expect_equal_int r (4 * 4 * 4) | _ -> failure ()) ) -;;
(* This makes sure contexts are reinitialized between calls * i.e the context should not grow *) @@ -153,7 +150,7 @@ let _ = (add_test "EVAL" "Infinite Recursion failure" (fun () -> success () else failure ()) -));; +))
(* Cases + Inductive types * ------------------------ *) @@ -199,7 +196,7 @@ let _ = (add_test "EVAL" "Inductive::Case" (fun () -> else failure () | _ -> failure () -));; +))
(* Those wil be used multiple times *) let nat_decl = " @@ -212,13 +209,11 @@ let nat_decl = " to-num = lambda (x : Nat) -> case x | (succ y) => (1 + (to-num y)) | zero => 0;" -;;
let bool_decl = " Bool = inductive (dBool) (true) (false); false = inductive-cons Bool false; true = inductive-cons Bool true;" -;;
let _ = (add_test "EVAL" "Inductive::Recursive Call" (fun () -> reset_eval_trace (); @@ -246,7 +241,6 @@ let _ = (add_test "EVAL" "Inductive::Recursive Call" (fun () -> failure () | _ -> failure ()) ) -;;
let _ = (add_test "EVAL" "Inductive::Nat Plus" (fun () -> reset_eval_trace (); @@ -282,7 +276,7 @@ let _ = (add_test "EVAL" "Inductive::Nat Plus" (fun () -> else failure () | _ -> failure () -));; +))
let _ = (add_test "EVAL" "Mutually Recursive Definition" (fun () -> reset_eval_trace (); @@ -320,7 +314,7 @@ let _ = (add_test "EVAL" "Mutually Recursive Definition" (fun () -> else failure () | _ -> failure () -));; +))
let _ = (add_test "EVAL" "Partial Application" (fun () -> @@ -350,7 +344,7 @@ let _ = (add_test "EVAL" "Partial Application" (fun () -> else failure () | _ -> failure () -));; +))
let _ = (add_test "EVAL" "List" (fun () -> @@ -379,10 +373,9 @@ let _ = (add_test "EVAL" "List" (fun () -> else failure () | _ -> failure () -));; +))
(* run all tests *) -run_all () -;; +let _ = run_all ()
===================================== tests/lexp_test.ml ===================================== --- a/tests/lexp_test.ml +++ b/tests/lexp_test.ml @@ -50,7 +50,7 @@ let _ = (add_test "LEXP" "Built-in type Inference" (fun () -> success()
| _ -> failure () -));; +))
let _ = (add_test "LEXP" "lexp_print" (fun () ->
@@ -82,12 +82,11 @@ let _ = (add_test "LEXP" "lexp_print" (fun () -> let str2 = to_str ret2 in
if str1 = str2 then success () else failure () -));; +))
(* let set_to_list s = StringSet.fold (fun g a -> g::a) s [] -;;
let _ = (add_test "LEXP" "Free Variable" (fun () ->
@@ -115,8 +114,7 @@ let _ = (add_test "LEXP" "Free Variable" (fun () -> | _ -> failure ()) | _ -> failure ()
-));; *) +)) *)
(* run all tests *) -run_all () -;; +let _ = run_all ()
===================================== tests/macro_test.ml ===================================== --- a/tests/macro_test.ml +++ b/tests/macro_test.ml @@ -62,9 +62,8 @@ let _ = (add_test "MACROS" "macros base" (fun () -> match ret with | [Vint(r)] -> expect_equal_int r (3 * 3) | _ -> failure ()) -);; +)
(* run all tests *) -run_all () -;; \ No newline at end of file +let _ = run_all ()
===================================== tests/pexp_test.ml ===================================== --- a/tests/pexp_test.ml +++ b/tests/pexp_test.ml @@ -18,9 +18,6 @@ let _ = (add_test "PEXP" "Type Parsing" (fun () -> | _ -> failure ()) | _ -> failure ()) ) -;;
- -run_all () -;; \ No newline at end of file +let _ = run_all ()
===================================== tests/sexp_test.ml ===================================== --- a/tests/sexp_test.ml +++ b/tests/sexp_test.ml @@ -13,7 +13,7 @@ let _ = (add_test "SEXP" "lambda x -> x + x" (fun () -> Node(Symbol(_, "_+_"), [Symbol(_, "x"); Symbol(_, "x")])) -> success () | _ -> failure ()) | _ -> failure () -));; +))
let _ = (add_test "SEXP" "x * x * x" (fun () ->
@@ -33,8 +33,7 @@ let _ = (add_test "SEXP" "x * x * x" (fun () -> | _ -> failure ()) | _ -> failure ()
-));; +))
(* run all tests *) -run_all () -;; +let _ = run_all ()
===================================== tests/utest_lib.ml ===================================== --- a/tests/utest_lib.ml +++ b/tests/utest_lib.ml @@ -36,15 +36,14 @@ open Fmt
module StringMap = Map.Make (struct type t = string let compare = String.compare end) -;;
type test_fun = (unit -> int) type tests = (test_fun) StringMap.t type sections = ((tests) StringMap.t) * string list
-let success () = 0;; -let failure () = (-1);; +let success () = 0 +let failure () = (-1)
(* * SECTION NAME - TEST NAME - FUNCTION (() -> int) @@ -89,7 +88,7 @@ let arg_defs = [ Arg.String (fun g -> _global_fsection := String.uppercase g), " Set test filter"); ("--ftitle=", Arg.String (fun g -> _global_ftitle := String.uppercase g), " Set test filter"); -];; +]
let must_run_section str = if (String.length !_global_fsection) != 0 then( @@ -118,8 +117,7 @@ let ut_string2 = ut_string 2 let unexpected_throw sk tk e = ut_string2 (red ^ "[ FAIL] " ^ sk ^ " - " ^ tk ^ "\n"); ut_string2 "[ ] UNEXPECTED THROW:\n"; - ut_string2 "[ ] "; ut_string2 ((Printexc.to_string e) ^ "\n" ^ reset); -;; + ut_string2 "[ ] "; ut_string2 ((Printexc.to_string e) ^ "\n" ^ reset)
let _expect_equal_t to_string value expect = if value = expect then @@ -128,7 +126,6 @@ let _expect_equal_t to_string value expect = ut_string2 (red ^ "[ ] EXPECTED: " ^ (to_string expect)^ "\n"); ut_string2 ( "[ ] GOT: " ^ (to_string value) ^ "\n" ^ reset); failure ()) -;;
let expect_equal_int = _expect_equal_t string_of_int let expect_equal_float = _expect_equal_t string_of_float @@ -142,7 +139,6 @@ let add_section sname = Not_found -> _insertion_order := sname::(!_insertion_order); (StringMap.empty, ref []) -;;
(* USAGE *) (* @@ -172,7 +168,6 @@ let add_test sname tname tfun = _global_sections := StringMap.add sname (ntmap, lst) (!_global_sections);
_number_test := (!_number_test + 1) -;;
(* sk : Section Key * tmap: test_name -> tmap @@ -191,7 +186,6 @@ let for_all_tests sk tmap tk = with e -> _ret_code := failure (); unexpected_throw sk tk e) else () -;;
let for_all_sections sk = let tmap, tst = StringMap.find sk (!_global_sections) in @@ -202,7 +196,6 @@ let for_all_sections sk = List.iter (for_all_tests sk tmap) (!tst))
else () -;;
(* Run all *) let run_all () = @@ -215,4 +208,3 @@ let run_all () =
(* return success or failure *) exit !_ret_code -;;
===================================== tests/utest_main.ml ===================================== --- a/tests/utest_main.ml +++ b/tests/utest_main.ml @@ -33,7 +33,6 @@ open Fmt
let cut_name str = String.sub str 0 (String.length str - 12) -;;
let _global_verbose_lvl = ref 5 let _global_sample_dir = ref "./" @@ -56,7 +55,7 @@ let arg_defs = [ ("--ftitle=", Arg.String (fun g -> _global_ftitle := String.uppercase g; _global_filter := true), " Set test filter"); -];; +]
let verbose n = (n <= (!_global_verbose_lvl)) @@ -84,8 +83,7 @@ let print_file_name i n name pass = print_string name; print_string (make_line '.' line_size); if pass then print_string "..OK\n" else print_string "FAIL\n"; - print_string reset; -;; + print_string reset
let must_run str = if (!_global_filter) then( @@ -162,7 +160,6 @@ let main () = print_string " Test Ran : "; print_int !tests_n; print_string "\n Test Failed : "; print_int !failed_test; print_string "\n Test Passed : "; print_int (!tests_n - !failed_test); - print_endline "\n"; -;; + print_endline "\n"
-main (); +let _ = main ();
View it on GitLab: https://gitlab.com/monnier/typer/commit/e905eb9e83a9077b4c2bf59656f6c1a961a0...
Afficher les réponses par date