X-Git-Url: https://git.xandkar.net/?a=blobdiff_plain;f=compiler%2Fsrc%2Flib%2Ftiger%2Ftiger_env_type.ml;h=cef1ff19b5124180c09a5ffa19748d956aa1df02;hb=refs%2Fheads%2Fir-translation-wip;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..cef1ff1 100644
--- a/compiler/src/lib/tiger/tiger_env_type.ml
+++ b/compiler/src/lib/tiger/tiger_env_type.ml
@@ -1,12 +1,12 @@
 open Printf
 
-module List    = ListLabels
+module List = ListLabels
 
-module Map    = Tiger_map
-module Symbol = Tiger_symbol
+module Map = Tiger_map
+module Sym = Tiger_symbol
 
 type unique =
-  unit ref
+  Sym.t
 
 type t =
   | Unit
@@ -15,58 +15,66 @@ 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
+  | Name of Sym.t * t option ref
+and record_fields =
+  (Tiger_symbol.t * t) list
 
 type env =
-  (Symbol.t, t ) Map.t
+  (Sym.t, t ) Map.t
 
-let new_unique () =
-  ref ()
-
-let new_record fields =
+let new_record ~name ~fields =
   Record
     { fields
-    ; unique = new_unique ()
+    ; unique = Sym.unique_of_string (Sym.to_string name)
     }
 
-let new_array ty =
+let new_array ~name ~ty =
   Array
     { ty
-    ; unique = new_unique ()
+    ; unique = Sym.unique_of_string (Sym.to_string name)
     }
 
 let is_equal t1 t2 =
   match t1, t2 with
-  | Record {unique=u1; _},  Record {unique=u2; _} -> u1 == u2
-  | Array  {unique=u1; _},  Array  {unique=u2; _} -> u1 == u2
-  | t1                   , t2                     -> t1 =  t2
+  | Name   (s1, _)       ,  Name   (s2, _)        -> Sym.is_equal s1 s2
+  | Record {unique=s1; _},  Record {unique=s2; _} -> Sym.is_equal s1 s2
+  | Record _             ,  Nil                   -> true
+  | Nil                  ,  Record _              -> true
+  | Array  {unique=s1; _},  Array  {unique=s2; _} -> Sym.is_equal s1 s2
+  | 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,14 +85,38 @@ 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"
   | String             -> "string"
-  | Record {unique; _} -> sprintf "record(%d)" (Obj.magic unique)
-  | Array  {unique; _} -> sprintf "array(%d)"  (Obj.magic unique)
+  | Record {unique; _} -> sprintf "Record[%s]" (Sym.to_string unique)
+  | Array  {unique; _} -> sprintf "Array[%s]"  (Sym.to_string unique)
   | Int                -> "int"
-  | Name (name, _)     -> Symbol.to_string name
+  | Name (name, _)     -> Sym.to_string name
 
 let built_in =
   [ ("unit"   , Unit)
@@ -92,5 +124,5 @@ let built_in =
   ; ("int"    , Int)
   ; ("string" , String)
   ]
-  |> List.map ~f:(fun (k, v) -> (Symbol.of_string k, v))
+  |> List.map ~f:(fun (k, v) -> (Sym.of_string k, v))
   |> Map.of_list