Mercurial > urweb

comparison src/mono_util.sml @ 168:25b169416ea8

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Storing datatype constructors in type references past monoize
author Adam Chlipala <adamc@hcoop.net>
date Tue, 29 Jul 2008 15:43:17 -0400
parents 6847741e1f5f
children eb3f9913bf31
comparison
equal deleted inserted replaced
167:2be573fec9a6 168:25b169416ea8
55 val xts1 = sortFields xts1 55 val xts1 = sortFields xts1
56 val xts2 = sortFields xts2 56 val xts2 = sortFields xts2
57 in 57 in
58 joinL compareFields (xts1, xts2) 58 joinL compareFields (xts1, xts2)
59 end 59 end
60 | (TNamed n1, TNamed n2) => Int.compare (n1, n2) 60 | (TDatatype (n1, _), TDatatype (n2, _)) => Int.compare (n1, n2)
61 | (TFfi (m1, x1), TFfi (m2, x2)) => join (String.compare (m1, m2), fn () => String.compare (x1, x2)) 61 | (TFfi (m1, x1), TFfi (m2, x2)) => join (String.compare (m1, m2), fn () => String.compare (x1, x2))
62 62
63 | (TFun _, _) => LESS 63 | (TFun _, _) => LESS
64 | (_, TFun _) => GREATER 64 | (_, TFun _) => GREATER
65 65
66 | (TRecord _, _) => LESS 66 | (TRecord _, _) => LESS
67 | (_, TRecord _) => GREATER 67 | (_, TRecord _) => GREATER
68 68
69 | (TNamed _, _) => LESS 69 | (TDatatype _, _) => LESS
70 | (_, TNamed _) => GREATER 70 | (_, TDatatype _) => GREATER
71 71
72 and compareFields ((x1, t1), (x2, t2)) = 72 and compareFields ((x1, t1), (x2, t2)) =
73 join (String.compare (x1, x2), 73 join (String.compare (x1, x2),
74 fn () => compare (t1, t2)) 74 fn () => compare (t1, t2))
75 75
93 S.map2 (mft t, 93 S.map2 (mft t,
94 fn t' => 94 fn t' =>
95 (x, t'))) 95 (x, t')))
96 xts, 96 xts,
97 fn xts' => (TRecord xts', loc)) 97 fn xts' => (TRecord xts', loc))
98 | TNamed _ => S.return2 cAll 98 | TDatatype _ => S.return2 cAll
99 | TFfi _ => S.return2 cAll 99 | TFfi _ => S.return2 cAll
100 in 100 in
101 mft 101 mft
102 end 102 end
103 103
123 end 123 end
124 124
125 structure Exp = struct 125 structure Exp = struct
126 126
127 datatype binder = 127 datatype binder =
128 NamedT of string * int * typ option 128 Datatype of string * int * (string * int * typ option) list
129 | RelE of string * typ 129 | RelE of string * typ
130 | NamedE of string * int * typ * exp option * string 130 | NamedE of string * int * typ * exp option * string
131 131
132 fun mapfoldB {typ = fc, exp = fe, bind} = 132 fun mapfoldB {typ = fc, exp = fe, bind} =
133 let 133 let
322 let 322 let
323 val ctx' = 323 val ctx' =
324 case #1 d' of 324 case #1 d' of
325 DDatatype (x, n, xncs) => 325 DDatatype (x, n, xncs) =>
326 let 326 let
327 val ctx = bind (ctx, NamedT (x, n, NONE)) 327 val ctx = bind (ctx, Datatype (x, n, xncs))
328 val t = (TNamed n, #2 d') 328 val t = (TDatatype (n, xncs), #2 d')
329 in 329 in
330 foldl (fn ((x, n, to), ctx) => 330 foldl (fn ((x, n, to), ctx) =>
331 let 331 let
332 val t = case to of 332 val t = case to of
333 NONE => t 333 NONE => t