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   | Name   (s1, _)       ,  Name   (s2, _)        -> Symbol.is_equal s1 s2
  49   | Record {unique=u1; _},  Record {unique=u2; _} -> u1 == u2
  50   | Record _             ,  Nil                   -> true
  51   | Nil                  ,  Record _              -> true
  52   | Array  {unique=u1; _},  Array  {unique=u2; _} -> u1 == u2
  53   | t1                   , t2                     -> t1 =  t2
  54   (* The above pattern matching is "fragile" and I'm OK with it.
  55    * TODO: Can we ignore the warning locally?
  56    * *)
  57
  58 let is_int t =
  59   t = Int
  60
  61 let is_string t =
  62   t = String
  63
  64 let is_array = function
  65   | Unit
  66   | Int
  67   | String
  68   | Name _
  69   | Nil
  70   | Record _ -> false
  71   | Array  _ -> true
  72
  73 let is_record = function
  74   | Unit
  75   | Int
  76   | String
  77   | Name _
  78   | Nil
  79   | Array  _ -> false
  80   | Record _ -> true
  81
  82 let is_name = function
  83   | Unit
  84   | Nil
  85   | String
  86   | Int
  87   | Record _
  88   | Array  _ -> false
  89   | Name _   -> true
  90
  91 let if_record t ~f ~otherwise =
  92   match t with
  93   | Record {fields; _} ->
  94       f fields
  95   | Unit
  96   | Int
  97   | String
  98   | Name _
  99   | Nil
 100   | Array  _ ->
 101       otherwise ()
 102
 103 let if_array t ~f ~otherwise =
 104   match t with
 105   | Array {ty=t; _} ->
 106       f t
 107   | Unit
 108   | Int
 109   | String
 110   | Name _
 111   | Nil
 112   | Record _ ->
 113       otherwise ()
 114
 115 let to_string = function
 116   | Unit               -> "unit"
 117   | Nil                -> "nil"
 118   | String             -> "string"
 119   | Record {unique; _} -> sprintf "record(%d)" (Obj.magic unique)
 120   | Array  {unique; _} -> sprintf "array(%d)"  (Obj.magic unique)
 121   | Int                -> "int"
 122   | Name (name, _)     -> Symbol.to_string name
 123
 124 let built_in =
 125   [ ("unit"   , Unit)
 126   ; ("nil"    , Nil)
 127   ; ("int"    , Int)
 128   ; ("string" , String)
 129   ]
 130   |> List.map ~f:(fun (k, v) -> (Symbol.of_string k, v))
 131   |> Map.of_list