Switch Type.unique implementation from ref to Symbol

The intent seem more apparent this way, plus we gain the ability to save the
human-readable type name (for error messages).

diff --git a/compiler/src/lib/tiger/tiger_env_type.ml b/compiler/src/lib/tiger/tiger_env_type.ml
index a2e719f..cef1ff1 100644 (file)
--- 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
@@ -21,36 +21,33 @@ type t =
       { 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
-  | Name   (s1, _)       ,  Name   (s2, _)        -> Symbol.is_equal s1 s2
-  | Record {unique=u1; _},  Record {unique=u2; _} -> u1 == u2
+  | 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=u1; _},  Array  {unique=u2; _} -> u1 == u2
-  | t1                   , t2                     -> t1 =  t2
+  | 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?
    * *)
@@ -116,10 +113,10 @@ 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)
@@ -127,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

diff --git a/compiler/src/lib/tiger/tiger_env_type.mli b/compiler/src/lib/tiger/tiger_env_type.mli
index 2716e59..c8810a7 100644 (file)
--- a/compiler/src/lib/tiger/tiger_env_type.mli
+++ b/compiler/src/lib/tiger/tiger_env_type.mli
@@ -1,3 +1,5 @@
+module Sym = Tiger_symbol
+
 type unique
 
 type t =
@@ -13,12 +15,12 @@ type t =
       { unique : unique
       ; ty     : t
       }
-  | Name of Tiger_symbol.t * t option ref
+  | Name of Sym.t * t option ref
 and record_fields =
-  (Tiger_symbol.t * t) list
+  (Sym.t * t) list
 
 type env =
-  (Tiger_symbol.t, t ) Tiger_map.t
+  (Sym.t, t ) Tiger_map.t
 
 val built_in : env
 
@@ -33,7 +35,7 @@ val is_name   : t -> bool
 val if_record : t -> f:(record_fields -> 'a) -> otherwise:(unit -> 'a) -> 'a
 val if_array  : t -> f:(t -> 'a)             -> otherwise:(unit -> 'a) -> 'a
 
-val new_record : record_fields -> t
-val new_array  : t -> t
+val new_record : name:Sym.t -> fields:record_fields -> t
+val new_array  : name:Sym.t -> ty:t -> t
 
 val to_string : t -> string

diff --git a/compiler/src/lib/tiger/tiger_semant.ml b/compiler/src/lib/tiger/tiger_semant.ml
index 19e8c8b..a6e4af6 100644 (file)
--- a/compiler/src/lib/tiger/tiger_semant.ml
+++ b/compiler/src/lib/tiger/tiger_semant.ml
@@ -335,9 +335,9 @@ end = struct
               Env.set_typ env name (Type.Name (name, ref None))
           )
         in
-        List.iter typedecs ~f:(fun (A.TypeDec {name; ty=ty_exp; pos}) ->
-          let ty = transTy ~env ty_exp in
-          (match env_get_typ ~sym:name ~env ~pos with
+        List.iter typedecs ~f:(fun (A.TypeDec {name=ty_name; ty=ty_exp; pos}) ->
+          let ty = transTy ~env ~ty_name ~ty_exp in
+          (match env_get_typ ~sym:ty_name ~env ~pos with
           | Type.Name (_, ty_opt_ref) ->
               ty_opt_ref := Some ty
           | Type.Unit
@@ -382,7 +382,7 @@ end = struct
         );
         env_with_fun_heads_only
     )
-  and transTy ~(env : Env.t) (ty_exp : A.ty) : Type.t =
+  and transTy ~(env : Env.t) ~ty_name ~(ty_exp : A.ty) : Type.t =
     (match ty_exp with
     | A.NameTy {symbol=sym; pos} ->
         env_get_typ ~sym ~env ~pos
@@ -393,10 +393,10 @@ end = struct
             (name, ty)
           )
         in
-        Type.new_record fields
+        Type.new_record ~name:ty_name ~fields
     | A.ArrayTy {symbol=sym; pos} ->
         let element_ty = env_get_typ ~sym ~env ~pos in
-        Type.new_array element_ty
+        Type.new_array ~name:ty_name ~ty:element_ty
     )
 end