HCoop / hcoop / debian / mlton.git / blame
| Commit | Line | Data |
|---|---|---|
| 7f918cf1 CE |
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 |