Commit 844b8fb4 authored by Pietro Abate's avatar Pietro Abate
Browse files

WIP

parent ae8a69e8
open OUnit2
open Camlp4.PreCast
module BIN = struct
open Builtin_defs
(* Types *)
let stringn = Types.cons string
let namespaces =
Sequence.star (Types.times stringn stringn)
let types =
[
"Empty", Types.empty;
"Any", any;
"Int", int;
"Char", Types.char Chars.any;
"Byte", char_latin1;
"Atom", atom;
"Pair", Types.Product.any;
"Arrow", Types.Arrow.any;
"Record", Types.Record.any;
"String", string;
"Latin1", string_latin1;
"Bool", bool;
"Float", float;
"AnyXml", any_xml;
"Namespaces", namespaces;
"Caml_int", caml_int;
]
let env =
List.fold_left
(fun accu (n,t) ->
let n = (Ns.empty, Ident.U.mk n) in
Types.Print.register_global "" n t;
Typer.enter_type (Ident.ident n) t accu
)
Typer.empty_env
types
end
let run_test_typer msg expected totest =
let parse_expr s =
let astpat = Parser.expr (Stream.of_string s) in
fst (Typer.type_expr Typer.empty_env astpat)
let astexpr = Parser.expr (Stream.of_string s) in
Format.printf "aaa\n";
let texpr = fst (Typer.type_expr BIN.env astexpr) in
Format.printf "bbb\n";
Format.printf "Cduce Typed -> %a%!@." Printer.pp_typed texpr;
texpr
in
let parse_typed s =
try
let expr = Parse.ExprParser.of_string_no_file s in
let env, texpr = Compute.to_typed expr in
Format.printf "Expected Typed -> %a%!@." Printer.pp_typed texpr;
texpr
with
| Compute.Error -> exit 3
| Loc.Exc_located (loc, exn) ->
let l = Loc.start_line loc in
let cbegin = Loc.start_off loc - Loc.start_bol loc in
let cend = Loc.stop_off loc - Loc.start_bol loc in
Printf.eprintf "File %s, line %d, characters %d-%d:\n" (Loc.file_name loc) l
cbegin cend; raise exn
let l = Loc.start_line loc in
let cbegin = Loc.start_off loc - Loc.start_bol loc in
let cend = Loc.stop_off loc - Loc.start_bol loc in
Printf.eprintf "File %s, line %d, characters %d-%d:\n" (Loc.file_name loc) l
cbegin cend; raise exn
| e -> Printf.eprintf "Runtime error.\n"; raise e
in
fun _ -> assert_equal ~msg:msg ~printer:(fun x -> Printer.typed_to_string x) (parse_typed expected) (parse_expr totest)
fun _ ->
let expected = (parse_typed expected) in
let totest = (parse_expr totest) in
assert_equal ~msg:msg ~printer:(fun x -> Printer.typed_to_string x) expected totest
(* (message, typed expr - expected, cduce expr) *)
let tests_typer_list = [
"Test CDuce.typed.fun.const",
"fun f x : Int : Int -> 2",
......@@ -30,7 +79,7 @@ let tests_typer_list = [
]
let tests_typer = "CDuce type tests (Ast -> Typed)" >:::
List.map (fun (m,e,f) -> f >:: run_test_typer m e f) tests_typer_list
List.map (fun (msg,expected,cduce) -> msg >:: run_test_typer msg expected cduce) tests_typer_list
let _ =
run_test_tt_main (
......
......@@ -900,9 +900,12 @@ and type_check' loc env ed constr precise = match ed with
let su = type_check_branches loc env t1 a.fun_body t2 false in
let sigma = (* Tallying. su t2 *) [] in
(* p_j : t_j -> e^j_i sigma_{H_i} *)
()
(*
List.iter (fun br ->
br.br_body.exp_descr <- Subst(br.br_body,sigma)
) a.fun_body.br_branches
*)
) a.fun_iface;
(ed,t)
......@@ -1216,8 +1219,6 @@ let report_unused_branches () =
let clear_unused_branches () =
cur_branch := []
(* API *)
let type_expr env e =
......
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