Mercurial > urweb

comparison src/mono_fm.sml @ 2253:d665925acff8

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Factor out [Monoize.Fm] to make it accessible to [Sqlcache].
author Ziv Scully <ziv@mit.edu>
date Mon, 21 Sep 2015 14:54:07 -0400
parents
children
comparison
equal deleted inserted replaced
2252:e843a04499d4 2253:d665925acff8
1 (* TODO: better name than "fm"? *)
2 structure MonoFm : MONO_FM = struct
3
4 open Mono
5
6 type vr = string * int * typ * exp * string
7
8 datatype foo_kind =
9 Attr
10 | Url
11
12 structure IM = IntBinaryMap
13
14 structure M = BinaryMapFn(struct
15 type ord_key = foo_kind
16 fun compare x =
17 case x of
18 (Attr, Attr) => EQUAL
19 | (Attr, _) => LESS
20 | (_, Attr) => GREATER
21
22 | (Url, Url) => EQUAL
23 end)
24
25 structure TM = BinaryMapFn(struct
26 type ord_key = typ
27 val compare = MonoUtil.Typ.compare
28 end)
29
30 type t = {
31 count : int,
32 map : int IM.map M.map,
33 listMap : int TM.map M.map,
34 decls : vr list
35 }
36
37 val nextPvar = ref 0
38
39 fun empty count = {
40 count = count,
41 map = M.empty,
42 listMap = M.empty,
43 decls = []
44 }
45
46 fun chooseNext count =
47 let
48 val n = !nextPvar
49 in
50 if count < n then
51 (count, count+1)
52 else
53 (nextPvar := n + 1;
54 (n, n+1))
55 end
56
57 fun enter ({count, map, listMap, ...} : t) = {count = count, map = map, listMap = listMap, decls = []}
58 fun freshName {count, map, listMap, decls} =
59 let
60 val (next, count) = chooseNext count
61 in
62 (next, {count = count , map = map, listMap = listMap, decls = decls})
63 end
64 fun decls ({decls, ...} : t) =
65 case decls of
66 [] => []
67 | _ => [(DValRec decls, ErrorMsg.dummySpan)]
68
69 fun lookup (t as {count, map, listMap, decls}) k n thunk =
70 let
71 val im = Option.getOpt (M.find (map, k), IM.empty)
72 in
73 case IM.find (im, n) of
74 NONE =>
75 let
76 val n' = count
77 val (d, {count, map, listMap, decls}) =
78 thunk count {count = count + 1,
79 map = M.insert (map, k, IM.insert (im, n, n')),
80 listMap = listMap,
81 decls = decls}
82 in
83 ({count = count,
84 map = map,
85 listMap = listMap,
86 decls = d :: decls}, n')
87 end
88 | SOME n' => (t, n')
89 end
90
91 fun lookupList (t as {count, map, listMap, decls}) k tp thunk =
92 let
93 val tm = Option.getOpt (M.find (listMap, k), TM.empty)
94 in
95 case TM.find (tm, tp) of
96 NONE =>
97 let
98 val n' = count
99 val (d, {count, map, listMap, decls}) =
100 thunk count {count = count + 1,
101 map = map,
102 listMap = M.insert (listMap, k, TM.insert (tm, tp, n')),
103 decls = decls}
104 in
105 ({count = count,
106 map = map,
107 listMap = listMap,
108 decls = d :: decls}, n')
109 end
110 | SOME n' => (t, n')
111 end
112
113 val postMonoize : t ref = ref (empty 0)
114
115 end