compiler/src/lib/tiger/tiger_env_type.ml

   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 : record_fields
  19       }
  20   | Array of
  21       { unique : unique
  22       ; ty     : t
  23       }
  24   | Name of Symbol.t * t option ref
  25 and record_fields =
  26   (Tiger_symbol.t * t) list
  27
  28 type env =
  29   (Symbol.t, t ) Map.t
  30
  31 let new_unique () =
  32   ref ()
  33
  34 let new_record fields =
  35   Record
  36     { fields
  37     ; unique = new_unique ()
  38     }
  39
  40 let new_array ty =
  41   Array
  42     { ty
  43     ; unique = new_unique ()
  44     }
  45
  46 let is_equal t1 t2 =
  47   match t1, t2 with
  48   | Record {unique=u1; _},  Record {unique=u2; _} -> u1 == u2
  49   | Array  {unique=u1; _},  Array  {unique=u2; _} -> u1 == u2
  50   | t1                   , t2                     -> t1 =  t2
  51   (* The above pattern matching is "fragile" and I'm OK with it.
  52    * TODO: Can we ignore the warning locally?
  53    * *)
  54
  55 let is_int t =
  56   t = Int
  57
  58 let is_string t =
  59   t = String
  60
  61 let is_array = function
  62   | Unit
  63   | Int
  64   | String
  65   | Name _
  66   | Nil
  67   | Record _ -> false
  68   | Array  _ -> true
  69
  70 let is_record = function
  71   | Unit
  72   | Int
  73   | String
  74   | Name _
  75   | Nil
  76   | Array  _ -> false
  77   | Record _ -> true
  78
  79 let is_name = function
  80   | Unit
  81   | Nil
  82   | String
  83   | Int
  84   | Record _
  85   | Array  _ -> false
  86   | Name _   -> true
  87
  88 let if_record t ~f ~otherwise =
  89   match t with
  90   | Record {fields; _} ->
  91       f fields
  92   | Unit
  93   | Int
  94   | String
  95   | Name _
  96   | Nil
  97   | Array  _ ->
  98       otherwise ()
  99
 100 let to_string = function
 101   | Unit               -> "unit"
 102   | Nil                -> "nil"
 103   | String             -> "string"
 104   | Record {unique; _} -> sprintf "record(%d)" (Obj.magic unique)
 105   | Array  {unique; _} -> sprintf "array(%d)"  (Obj.magic unique)
 106   | Int                -> "int"
 107   | Name (name, _)     -> Symbol.to_string name
 108
 109 let built_in =
 110   [ ("unit"   , Unit)
 111   ; ("nil"    , Nil)
 112   ; ("int"    , Int)
 113   ; ("string" , String)
 114   ]
 115   |> List.map ~f:(fun (k, v) -> (Symbol.of_string k, v))
 116   |> Map.of_list