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