X-Git-Url: https://git.xandkar.net/?a=blobdiff_plain;f=compiler%2Fsrc%2Flib%2Ftiger%2Ftiger_env_type.ml;h=a2e719f37d5d8e315a63e4ce715ba18596d10e69;hb=e6e82c0866db4eb08f956b2582e5c2ed5399e986;hp=041d4213a64fce5a8f370aeb6e4ccb2e5edf1835;hpb=c0bdf964d389a2b9465fad44aa1f1f849c72140f;p=tiger.ml.git diff --git a/compiler/src/lib/tiger/tiger_env_type.ml b/compiler/src/lib/tiger/tiger_env_type.ml index 041d421..a2e719f 100644 --- a/compiler/src/lib/tiger/tiger_env_type.ml +++ b/compiler/src/lib/tiger/tiger_env_type.ml @@ -15,13 +15,15 @@ type t = | String | Record of { unique : unique - ; fields : (Symbol.t * t) list + ; fields : record_fields } | Array of { unique : unique ; ty : t } | Name of Symbol.t * t option ref +and record_fields = + (Tiger_symbol.t * t) list type env = (Symbol.t, t ) Map.t @@ -43,30 +45,39 @@ let new_array ty = let is_equal t1 t2 = match t1, t2 with + | Name (s1, _) , Name (s2, _) -> Symbol.is_equal s1 s2 | Record {unique=u1; _}, Record {unique=u2; _} -> u1 == u2 + | Record _ , Nil -> true + | Nil , Record _ -> true | Array {unique=u1; _}, Array {unique=u2; _} -> u1 == u2 | t1 , t2 -> t1 = t2 (* The above pattern matching is "fragile" and I'm OK with it. * TODO: Can we ignore the warning locally? * *) -let is_record = function +let is_int t = + t = Int + +let is_string t = + t = String + +let is_array = function | Unit | Int | String | Name _ - | Array _ -> false - | Nil (* nil belongs to ANY record *) - | Record _ -> true + | Nil + | Record _ -> false + | Array _ -> true -let is_int = function +let is_record = function | Unit - | Nil + | Int | String | Name _ - | Record _ + | Nil | Array _ -> false - | Int -> true + | Record _ -> true let is_name = function | Unit @@ -77,6 +88,30 @@ let is_name = function | Array _ -> false | Name _ -> true +let if_record t ~f ~otherwise = + match t with + | Record {fields; _} -> + f fields + | Unit + | Int + | String + | Name _ + | Nil + | Array _ -> + otherwise () + +let if_array t ~f ~otherwise = + match t with + | Array {ty=t; _} -> + f t + | Unit + | Int + | String + | Name _ + | Nil + | Record _ -> + otherwise () + let to_string = function | Unit -> "unit" | Nil -> "nil"