[Git][monnier/typer][master] Get rid of ;;
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
participants (1)
-
Stefan