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 : (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