lib/mlton/env/mono-env.fun

   1 (* Copyright (C) 1999-2006, 2008 Henry Cejtin, Matthew Fluet, Suresh
   2  *    Jagannathan, and Stephen Weeks.
   3  *
   4  * MLton is released under a BSD-style license.
   5  * See the file MLton-LICENSE for details.
   6  *)
   7
   8 functor MakeMonoEnv(S: sig
   9                            structure Env: ENV
  10                            structure Range: T
  11                         end): MONO_ENV =
  12 struct
  13
  14 open S
  15 open Env
  16
  17 type t = Range.t t
  18
  19 val empty: t = empty()
  20
  21 val equals = equals Range.equals
  22
  23 val layout = layout Range.layout
  24
  25 end
  26
  27 (* THIS ISN'T HERE BECAUSE (no surprise) there is an NJ BUG
  28
  29 functor MonoEnv(S: MONO_ENV_STRUCTS): MONO_ENV =
  30    MakeMonoEnv(structure Env = Env(S)
  31                structure Range = S.Range)
  32 *)
  33
  34 functor MonoEnv(S: MONO_ENV_STRUCTS): MONO_ENV =
  35 BasicEnvToEnv
  36 (open S
  37
  38  datatype t = T of (Domain.t * Range.t) List.t
  39
  40  val fromList = T
  41
  42  fun toList(T l) = l
  43
  44  fun equalTo d (d', _) = Domain.equals(d, d')
  45
  46  fun extend(T drs, d, r) =
  47     T(List.cons((d, r), List.remove(drs, equalTo d)))
  48
  49  fun peek(T l, d) =
  50     case List.peek(l, equalTo d) of
  51        NONE => NONE
  52      | SOME (_, r) => SOME r
  53           )