| 1 | open Printf |
| 2 | |
| 3 | module List = ListLabels |
| 4 | |
| 5 | module Map = Tiger_map |
| 6 | module Symbol = Tiger_symbol |
| 7 | |
| 8 | type unique = |
| 9 | unit ref |
| 10 | |
| 11 | type t = |
| 12 | | Unit |
| 13 | | Nil |
| 14 | | Int |
| 15 | | String |
| 16 | | Record of |
| 17 | { unique : unique |
| 18 | ; fields : (Symbol.t * t) list |
| 19 | } |
| 20 | | Array of |
| 21 | { unique : unique |
| 22 | ; ty : t |
| 23 | } |
| 24 | | Name of Symbol.t * t option ref |
| 25 | |
| 26 | type env = |
| 27 | (Symbol.t, t ) Map.t |
| 28 | |
| 29 | let new_unique () = |
| 30 | ref () |
| 31 | |
| 32 | let new_record fields = |
| 33 | Record |
| 34 | { fields |
| 35 | ; unique = new_unique () |
| 36 | } |
| 37 | |
| 38 | let new_array ty = |
| 39 | Array |
| 40 | { ty |
| 41 | ; unique = new_unique () |
| 42 | } |
| 43 | |
| 44 | let is_equal t1 t2 = |
| 45 | match t1, t2 with |
| 46 | | Record {unique=u1; _}, Record {unique=u2; _} -> u1 == u2 |
| 47 | | Array {unique=u1; _}, Array {unique=u2; _} -> u1 == u2 |
| 48 | | t1 , t2 -> t1 = t2 |
| 49 | (* The above pattern matching is "fragile" and I'm OK with it. |
| 50 | * TODO: Can we ignore the warning locally? |
| 51 | * *) |
| 52 | |
| 53 | let is_record = function |
| 54 | | Unit |
| 55 | | Int |
| 56 | | String |
| 57 | | Name _ |
| 58 | | Array _ -> false |
| 59 | | Nil (* nil belongs to ANY record *) |
| 60 | | Record _ -> true |
| 61 | |
| 62 | let is_int = function |
| 63 | | Unit |
| 64 | | Nil |
| 65 | | String |
| 66 | | Name _ |
| 67 | | Record _ |
| 68 | | Array _ -> false |
| 69 | | Int -> true |
| 70 | |
| 71 | let is_name = function |
| 72 | | Unit |
| 73 | | Nil |
| 74 | | String |
| 75 | | Int |
| 76 | | Record _ |
| 77 | | Array _ -> false |
| 78 | | Name _ -> true |
| 79 | |
| 80 | let to_string = function |
| 81 | | Unit -> "unit" |
| 82 | | Nil -> "nil" |
| 83 | | String -> "string" |
| 84 | | Record {unique; _} -> sprintf "record(%d)" (Obj.magic unique) |
| 85 | | Array {unique; _} -> sprintf "array(%d)" (Obj.magic unique) |
| 86 | | Int -> "int" |
| 87 | | Name (name, _) -> Symbol.to_string name |
| 88 | |
| 89 | let built_in = |
| 90 | [ ("unit" , Unit) |
| 91 | ; ("nil" , Nil) |
| 92 | ; ("int" , Int) |
| 93 | ; ("string" , String) |
| 94 | ] |
| 95 | |> List.map ~f:(fun (k, v) -> (Symbol.of_string k, v)) |
| 96 | |> Map.of_list |