From c0bdf964d389a2b9465fad44aa1f1f849c72140f Mon Sep 17 00:00:00 2001 From: Siraaj Khandkar Date: Thu, 13 Sep 2018 13:18:23 -0400 Subject: [PATCH] Define the environments (for types and values) --- compiler/src/lib/tiger/tiger_env.ml | 25 ++++++ compiler/src/lib/tiger/tiger_env.mli | 9 ++ compiler/src/lib/tiger/tiger_env_type.ml | 96 ++++++++++++++++++++++ compiler/src/lib/tiger/tiger_env_type.mli | 31 +++++++ compiler/src/lib/tiger/tiger_env_value.ml | 35 ++++++++ compiler/src/lib/tiger/tiger_env_value.mli | 12 +++ 6 files changed, 208 insertions(+) create mode 100644 compiler/src/lib/tiger/tiger_env.ml create mode 100644 compiler/src/lib/tiger/tiger_env.mli create mode 100644 compiler/src/lib/tiger/tiger_env_type.ml create mode 100644 compiler/src/lib/tiger/tiger_env_type.mli create mode 100644 compiler/src/lib/tiger/tiger_env_value.ml create mode 100644 compiler/src/lib/tiger/tiger_env_value.mli diff --git a/compiler/src/lib/tiger/tiger_env.ml b/compiler/src/lib/tiger/tiger_env.ml new file mode 100644 index 0000000..f698f89 --- /dev/null +++ b/compiler/src/lib/tiger/tiger_env.ml @@ -0,0 +1,25 @@ +module Map = Tiger_map +module Type = Tiger_env_type +module Value = Tiger_env_value + +type t = + { typs : Type.env + ; vals : Value.env + } + +let base = + { typs = Type.built_in + ; vals = Value.built_in + } + +let get_typ {typs; _} k = + Map.get typs ~k + +let get_val {vals; _} k = + Map.get vals ~k + +let set_typ t k v = + {t with typs = Map.set t.typs ~k ~v} + +let set_val t k v = + {t with vals = Map.set t.vals ~k ~v} diff --git a/compiler/src/lib/tiger/tiger_env.mli b/compiler/src/lib/tiger/tiger_env.mli new file mode 100644 index 0000000..91747e5 --- /dev/null +++ b/compiler/src/lib/tiger/tiger_env.mli @@ -0,0 +1,9 @@ +type t + +val base : t + +val get_typ : t -> Tiger_symbol.t -> Tiger_env_type.t option +val get_val : t -> Tiger_symbol.t -> Tiger_env_value.t option + +val set_typ : t -> Tiger_symbol.t -> Tiger_env_type.t -> t +val set_val : t -> Tiger_symbol.t -> Tiger_env_value.t -> t diff --git a/compiler/src/lib/tiger/tiger_env_type.ml b/compiler/src/lib/tiger/tiger_env_type.ml new file mode 100644 index 0000000..041d421 --- /dev/null +++ b/compiler/src/lib/tiger/tiger_env_type.ml @@ -0,0 +1,96 @@ +open Printf + +module List = ListLabels + +module Map = Tiger_map +module Symbol = Tiger_symbol + +type unique = + unit ref + +type t = + | Unit + | Nil + | Int + | String + | Record of + { unique : unique + ; fields : (Symbol.t * t) list + } + | Array of + { unique : unique + ; ty : t + } + | Name of Symbol.t * t option ref + +type env = + (Symbol.t, t ) Map.t + +let new_unique () = + ref () + +let new_record fields = + Record + { fields + ; unique = new_unique () + } + +let new_array ty = + Array + { ty + ; unique = new_unique () + } + +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 + (* The above pattern matching is "fragile" and I'm OK with it. + * TODO: Can we ignore the warning locally? + * *) + +let is_record = function + | Unit + | Int + | String + | Name _ + | Array _ -> false + | Nil (* nil belongs to ANY record *) + | Record _ -> true + +let is_int = function + | Unit + | Nil + | String + | Name _ + | Record _ + | Array _ -> false + | Int -> true + +let is_name = function + | Unit + | Nil + | String + | Int + | Record _ + | Array _ -> false + | Name _ -> true + +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) + | Int -> "int" + | Name (name, _) -> Symbol.to_string name + +let built_in = + [ ("unit" , Unit) + ; ("nil" , Nil) + ; ("int" , Int) + ; ("string" , String) + ] + |> List.map ~f:(fun (k, v) -> (Symbol.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 new file mode 100644 index 0000000..825750c --- /dev/null +++ b/compiler/src/lib/tiger/tiger_env_type.mli @@ -0,0 +1,31 @@ +type unique + +type t = + | Unit + | Nil + | Int + | String + | Record of + { unique : unique + ; fields : (Tiger_symbol.t * t) list + } + | Array of + { unique : unique + ; ty : t + } + | Name of Tiger_symbol.t * t option ref + +type env = + (Tiger_symbol.t, t ) Tiger_map.t + +val built_in : env + +val is_equal : t -> t -> bool +val is_record : t -> bool +val is_int : t -> bool +val is_name : t -> bool + +val new_record : (Tiger_symbol.t * t) list -> t +val new_array : t -> t + +val to_string : t -> string diff --git a/compiler/src/lib/tiger/tiger_env_value.ml b/compiler/src/lib/tiger/tiger_env_value.ml new file mode 100644 index 0000000..80f145e --- /dev/null +++ b/compiler/src/lib/tiger/tiger_env_value.ml @@ -0,0 +1,35 @@ +module List = ListLabels + +module Map = Tiger_map +module Symbol = Tiger_symbol +module Type = Tiger_env_type + +type t = + | Var of + {ty : Type.t} + | Fun of + { formals : Type.t list + ; result : Type.t + } + +type env = + (Symbol.t, t ) Map.t + +let built_in = + [ ("print" , [Type.String] , Type.Unit ) + ; ("flush" , [] , Type.Unit ) + ; ("getchar" , [] , Type.String ) + ; ("ord" , [Type.String] , Type.Int ) + ; ("chr" , [Type.Int] , Type.String ) + ; ("size" , [Type.String] , Type.Int ) + ; ("substring" , [Type.String; Type.Int; Type.Int] , Type.String ) + ; ("concat" , [Type.String; Type.String] , Type.String ) + ; ("not" , [Type.Int] , Type.Int ) + ; ("exit" , [Type.Int] , Type.Unit ) + ] + |> List.map ~f:(fun (name, formals, result) -> + let key = Symbol.of_string name in + let value = Fun {formals; result} in + (key, value) + ) + |> Map.of_list diff --git a/compiler/src/lib/tiger/tiger_env_value.mli b/compiler/src/lib/tiger/tiger_env_value.mli new file mode 100644 index 0000000..71209eb --- /dev/null +++ b/compiler/src/lib/tiger/tiger_env_value.mli @@ -0,0 +1,12 @@ +type t = + | Var of + {ty : Tiger_env_type.t} + | Fun of + { formals : Tiger_env_type.t list + ; result : Tiger_env_type.t + } + +type env = + (Tiger_symbol.t, t ) Tiger_map.t + +val built_in : env -- 2.20.1