compiler/src/lib/tiger/tiger_env.ml

   1 module Map   = Tiger_map
   2 module Sym   = Tiger_symbol
   3 module Translate = Tiger_translate
   4 module Type  = Tiger_env_type
   5 module Value = Tiger_env_value
   6
   7 type t =
   8   { typs : Type.env
   9   ; vals : Value.env
  10   ; loop : Sym.t option
  11   ; level : Translate.Level.t
  12   }
  13
  14 let base =
  15   { typs = Type.built_in
  16   ; vals = Value.built_in
  17   ; loop = None
  18   ; level = Translate.Level.init
  19   }
  20
  21 let get_typ {typs; _} k =
  22   Map.get typs ~k
  23
  24 let get_val {vals; _} k =
  25   Map.get vals ~k
  26
  27 let set_typ t k v =
  28   {t with typs = Map.set t.typs ~k ~v}
  29
  30 let set_val t k v =
  31   {t with vals = Map.set t.vals ~k ~v}
  32
  33 let loop_begin t =
  34   let loop = Sym.unique_of_string "loop" in
  35   let t = {t with loop = Some loop} in
  36   (loop, t)
  37
  38 let loop_end t given =
  39   match t.loop with
  40   | None ->
  41       assert false
  42   | Some current when (not (Sym.is_equal current given)) ->
  43       assert false
  44   | Some _ ->
  45       {t with loop = None}
  46
  47 let loop_current {loop; _} =
  48   loop
  49
  50 let level_set t level =
  51   {t with level}
  52
  53 let level_get {level; _} =
  54   level