From 0943408463f52f17d23896e1a8473de65a318078 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Georges=20Dup=C3=A9ron?= Date: Thu, 14 Mar 2019 20:42:41 +0100 Subject: [PATCH] SMap.t for records and sums --- AST2.ml | 23 ++++++++++++++++------- Typecheck2.ml | 29 ++++++++++++++++++++++++++--- Typecheck2.mli | 6 +++--- 3 files changed, 45 insertions(+), 13 deletions(-) diff --git a/AST2.ml b/AST2.ml index 231257b2a..b71c7f472 100644 --- a/AST2.ml +++ b/AST2.ml @@ -27,7 +27,7 @@ module O = struct | PSome of pattern | PCons of pattern * pattern | PNull - | PRecord of (field_name * pattern) list + | PRecord of (field_name * pattern) SMap.t type type_constructor = Option @@ -36,8 +36,8 @@ module O = struct | Map type type_expr_case = - Sum of (type_name * type_expr) list - | Record of (field_name * type_expr) list + Sum of (type_name * type_expr) SMap.t + | Record of (field_name * type_expr) SMap.t | TypeApp of type_constructor * (type_expr list) | Function of { arg: type_expr; ret: type_expr } | Ref of type_expr @@ -156,17 +156,26 @@ let s_type_constructor {value=name;region} : O.type_constructor = (* TODO: escape the name, prevent any \x1b and other weird characters from appearing in the output *) | _ -> failwith ("Unknown type constructor: " ^ name) +let named_list_to_map (l : (O.name_and_region * 'a) list) : (O.name_and_region * 'a) SMap.t = + List.fold_left + (fun m ((x,_) as p) -> + let {name;_} : O.name_and_region = x in + SMap.add name p m) + SMap.empty + l + let rec s_cartesian {value=sequence; region} : O.type_expr = let () = ignore (region) in s_nsepseq sequence |>map s_type_expr |> mapi (fun i p -> name_and_region_of_int i, p) + |> named_list_to_map |> (fun x -> (Record x : O.type_expr_case)) |> type_expr region and s_sum_type {value=sequence; region} : O.type_expr = let () = ignore (region) in - type_expr region (Sum (map s_variant (s_nsepseq sequence))) + type_expr region (Sum (map s_variant (s_nsepseq sequence) |> named_list_to_map)) and s_variant {value=(constr, kwd_of, cartesian); region} = let () = ignore (kwd_of,region) in @@ -174,7 +183,7 @@ and s_variant {value=(constr, kwd_of, cartesian); region} = and s_record_type {value=(kwd_record, field_decls, kwd_end); region} : O.type_expr = let () = ignore (kwd_record,region,kwd_end) in - type_expr region (Record (map s_field_decl (s_nsepseq field_decls)) : O.type_expr_case) + type_expr region (Record (map s_field_decl (s_nsepseq field_decls) |> named_list_to_map) : O.type_expr_case) and s_field_decl {value=(var, colon, type_expr); region} : O.type_name * O.type_expr = let () = ignore (colon,region) in @@ -234,7 +243,7 @@ let s_none {value=(l, (c_None, colon, type_expr), r); region} : O.expr = let parameters_to_tuple (parameters : (string * O.type_expr) list) : O.type_expr = (* TODO: use records with named fields to have named arguments. *) let parameter_tuple : O.type_expr_case = - Record (mapi (fun i (_name,ty) -> name_and_region_of_int i, ty) parameters) in + Record (mapi (fun i (_name,ty) -> name_and_region_of_int i, ty) parameters |> named_list_to_map) in O.{ type_expr = parameter_tuple; name = None; orig = Region.ghost } and parameters_to_decls singleparam (parameters : (string * O.type_expr) list) : O.decl list = @@ -354,7 +363,7 @@ and s_ptuple {value=(lpar, sequence, rpar); region} = s_nsepseq sequence |> map s_core_pattern |> mapi (fun i p -> name_and_region_of_int i, p) - |> fun x -> O.PRecord x + |> fun x -> O.PRecord (x |> named_list_to_map) and s_psome {value=(c_Some,{value=(l,psome,r);region=region2});region} : O.pattern = let () = ignore (c_Some,l,r,region2,region) in diff --git a/Typecheck2.ml b/Typecheck2.ml index 0c84ebe8f..d748a23e9 100644 --- a/Typecheck2.ml +++ b/Typecheck2.ml @@ -1,3 +1,5 @@ +[@@@warning "-27"] (* TODO *) +[@@@warning "-32"] (* TODO *) [@@@warning "-30"] module SMap = Map.Make(String) @@ -25,7 +27,7 @@ module O = struct | PSome of pattern | PCons of pattern * pattern | PNull - | PRecord of (field_name * pattern) list + | PRecord of (field_name * pattern) SMap.t type type_constructor = Option @@ -34,8 +36,8 @@ module O = struct | Map type type_expr_case = - Sum of (type_name * type_expr) list - | Record of (field_name * type_expr) list + Sum of (type_name * type_expr) SMap.t + | Record of (field_name * type_expr) SMap.t | TypeApp of type_constructor * (type_expr list) | Function of { arg: type_expr; ret: type_expr } | Ref of type_expr @@ -115,6 +117,27 @@ let fold_map f a l = let last_acc, last_l = List.fold_left f (a, []) l in last_acc, List.rev last_l +let a_type_constructor (tve : tve) : I.type_constructor -> O.type_constructor = function + Option -> failwith "TODO" +| List -> failwith "TODO" +| Set -> failwith "TODO" +| Map -> failwith "TODO" + +let a_type_expr_case (tve : tve) : I.type_expr_case -> O.type_expr_case = function + Sum l -> failwith "TODO" + | Record l -> failwith "TODO" + | TypeApp (tc, args) -> failwith "TODO" + | Function {arg;ret} -> failwith "TODO" + | Ref t -> failwith "TODO" + | String -> failwith "TODO" + | Int -> failwith "TODO" + | Unit -> failwith "TODO" + | Bool -> failwith "TODO" + + +let a_type_expr (tve : tve) ({type_expr;name;orig} : I.type_expr) : O.type_expr = + failwith "TODO" + let a_type (tve : tve) ({name;ty;orig} : I.type_decl) : tve * O.type_decl = failwith "TODO" diff --git a/Typecheck2.mli b/Typecheck2.mli index 0ae31d31b..26a1011c9 100644 --- a/Typecheck2.mli +++ b/Typecheck2.mli @@ -25,7 +25,7 @@ module O : sig | PSome of pattern | PCons of pattern * pattern | PNull - | PRecord of (field_name * pattern) list + | PRecord of (field_name * pattern) SMap.t type type_constructor = Option @@ -34,8 +34,8 @@ module O : sig | Map type type_expr_case = - Sum of (type_name * type_expr) list - | Record of (field_name * type_expr) list + Sum of (type_name * type_expr) SMap.t + | Record of (field_name * type_expr) SMap.t | TypeApp of type_constructor * (type_expr list) | Function of { arg: type_expr; ret: type_expr } | Ref of type_expr