The intent seem more apparent this way, plus we gain the ability to save the
human-readable type name (for error messages).
-module List = ListLabels
+module List = ListLabels
-module Map = Tiger_map
-module Symbol = Tiger_symbol
+module Map = Tiger_map
+module Sym = Tiger_symbol
{ unique : unique
; ty : 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 =
and record_fields =
(Tiger_symbol.t * t) list
type env =
-let new_unique () =
- ref ()
-
-let new_record fields =
+let new_record ~name ~fields =
- ; unique = new_unique ()
+ ; unique = Sym.unique_of_string (Sym.to_string name)
+let new_array ~name ~ty =
- ; unique = new_unique ()
+ ; unique = Sym.unique_of_string (Sym.to_string name)
}
let is_equal t1 t2 =
match t1, t2 with
}
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
| 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?
* *)
(* The above pattern matching is "fragile" and I'm OK with it.
* TODO: Can we ignore the warning locally?
* *)
| Unit -> "unit"
| Nil -> "nil"
| String -> "string"
| 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)
- | Name (name, _) -> Symbol.to_string name
+ | Name (name, _) -> Sym.to_string name
let built_in =
[ ("unit" , Unit)
let built_in =
[ ("unit" , Unit)
; ("int" , Int)
; ("string" , String)
]
; ("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))
+module Sym = Tiger_symbol
+
{ unique : unique
; ty : t
}
{ unique : unique
; ty : t
}
- | Name of Tiger_symbol.t * t option ref
+ | Name of Sym.t * t option ref
- (Tiger_symbol.t * t) list
- (Tiger_symbol.t, t ) Tiger_map.t
+ (Sym.t, t ) Tiger_map.t
val if_record : t -> f:(record_fields -> 'a) -> otherwise:(unit -> 'a) -> 'a
val if_array : t -> f:(t -> 'a) -> otherwise:(unit -> 'a) -> 'a
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
val to_string : t -> string
Env.set_typ env name (Type.Name (name, ref None))
)
in
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
| Type.Name (_, ty_opt_ref) ->
ty_opt_ref := Some ty
| Type.Unit
);
env_with_fun_heads_only
)
);
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
(match ty_exp with
| A.NameTy {symbol=sym; pos} ->
env_get_typ ~sym ~env ~pos
+ Type.new_record ~name:ty_name ~fields
| A.ArrayTy {symbol=sym; pos} ->
let element_ty = env_get_typ ~sym ~env ~pos in
| 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