compiler/src/lib/tiger/tiger_env_type.ml

   1 open Printf
   2
   3 module List = ListLabels
   4
   5 module Map = Tiger_map
   6 module Sym = Tiger_symbol
   7
   8 type unique =
   9   Sym.t
  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 Sym.t * t option ref
  25 and record_fields =
  26   (Tiger_symbol.t * t) list
  27
  28 type env =
  29   (Sym.t, t ) Map.t
  30
  31 let new_record ~name ~fields =
  32   Record
  33     { fields
  34     ; unique = Sym.unique_of_string (Sym.to_string name)
  35     }
  36
  37 let new_array ~name ~ty =
  38   Array
  39     { ty
  40     ; unique = Sym.unique_of_string (Sym.to_string name)
  41     }
  42
  43 let is_equal t1 t2 =
  44   match t1, t2 with
  45   | Name   (s1, _)       ,  Name   (s2, _)        -> Sym.is_equal s1 s2
  46   | Record {unique=s1; _},  Record {unique=s2; _} -> Sym.is_equal s1 s2
  47   | Record _             ,  Nil                   -> true
  48   | Nil                  ,  Record _              -> true
  49   | Array  {unique=s1; _},  Array  {unique=s2; _} -> Sym.is_equal s1 s2
  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 if_array t ~f ~otherwise =
 101   match t with
 102   | Array {ty=t; _} ->
 103       f t
 104   | Unit
 105   | Int
 106   | String
 107   | Name _
 108   | Nil
 109   | Record _ ->
 110       otherwise ()
 111
 112 let to_string = function
 113   | Unit               -> "unit"
 114   | Nil                -> "nil"
 115   | String             -> "string"
 116   | Record {unique; _} -> sprintf "Record[%s]" (Sym.to_string unique)
 117   | Array  {unique; _} -> sprintf "Array[%s]"  (Sym.to_string unique)
 118   | Int                -> "int"
 119   | Name (name, _)     -> Sym.to_string name
 120
 121 let built_in =
 122   [ ("unit"   , Unit)
 123   ; ("nil"    , Nil)
 124   ; ("int"    , Int)
 125   ; ("string" , String)
 126   ]
 127   |> List.map ~f:(fun (k, v) -> (Sym.of_string k, v))
 128   |> Map.of_list