lib/mlton/env/basic-env-to-env.fun

   1 (* Copyright (C) 1999-2006 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 BasicEnvToEnv(S: BASIC_MONO_ENV): MONO_ENV =
   9 struct
  10
  11 open S
  12
  13 val isEmpty = List.isEmpty o toList
  14
  15 fun layout e =
  16    let open Layout
  17    in seq[str "[",
  18           align(List.map(toList e, fn (d, r) =>
  19                          seq[Domain.layout d, str " -> ", Range.layout r])),
  20           str"]"]
  21    end
  22
  23 val size = List.length o toList
  24
  25 val empty = fromList []
  26
  27 fun domain e = List.revMap (toList e, #1)
  28
  29 fun single(d, r) = extend(empty, d, r)
  30
  31 fun new (ds, f) = fromList (List.map (ds, fn d => (d, f d)))
  32
  33 fun map (e, f) = fromList (List.map (toList e, fn (d, r) => (d, f r)))
  34
  35 fun mapi (e, f) = fromList (List.map(toList e, fn (d, r) => (d, f(d, r))))
  36
  37 fun env + env' =
  38    List.fold (toList env', env, fn ((d, r), env) => extend (env, d, r))
  39
  40 fun plus es = List.fold(es, empty, fn (e, accum) => accum + e)
  41
  42 val plus = Trace.trace("BasicEnvToEnv.plus", List.layout layout, layout) plus
  43
  44 fun remove(env, d) =
  45    fromList(List.remove(toList env, fn (d', _) => Domain.equals(d, d')))
  46
  47 fun lookup(env, d) = case peek(env, d) of
  48    SOME r => r
  49  | NONE => (Layout.output(Domain.layout d, Out.error) ;
  50             Out.newline Out.error ;
  51             Error.bug "BasicEnvToEnv.lookup")
  52
  53 fun restrict(env, ds) = new(ds, fn d => lookup(env, d))
  54
  55 fun multiExtend(env, ds, rs) =
  56    case (ds, rs) of
  57       ([], []) => env
  58     | (d :: ds, r :: rs) => multiExtend(extend(env, d, r), ds, rs)
  59     | _ => Error.bug "BasicEnvToEnv.multiExtend"
  60
  61 fun fold(e, b, f) = List.fold(toList e, b, fn ((_, r), b) => f(r, b))
  62 fun foldi(e, b, f) = List.fold(toList e, b, fn ((d, r), b) => f(d, r, b))
  63
  64 fun foreach(e, f) = List.foreach(toList e, f o #2)
  65 fun foreachi(e, f) = List.foreach(toList e, f)
  66
  67 fun foralli(e, f) = List.forall(toList e, f)
  68
  69 val equals =
  70    fn (e1, e2) =>
  71    size e1 = size e2
  72    andalso foralli(e1, fn (d, r) =>
  73                    case peek(e2, d) of
  74                       NONE => false
  75                     | SOME r' => Range.equals(r, r'))
  76
  77 end