Mercurial > urweb

comparison src/reduce.sml @ 621:8998114760c1

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
"Hello world" compiles, after replacing type-level fold with map
author Adam Chlipala <adamc@hcoop.net>
date Sat, 21 Feb 2009 15:33:20 -0500
parents 56aaa1941dad
children 588b9d16b00a
comparison
equal deleted inserted replaced
620:d828b143e147 621:8998114760c1
101 in 101 in
102 case #1 c1 of 102 case #1 c1 of
103 CAbs (_, _, b) => 103 CAbs (_, _, b) =>
104 con (KnownC c2 :: deKnown env) b 104 con (KnownC c2 :: deKnown env) b
105 105
106 | CApp ((CApp ((CFold _, _), f), _), i) => 106 | CApp ((CMap (dom, ran), _), f) =>
107 (case #1 c2 of 107 (case #1 c2 of
108 CRecord (_, []) => i 108 CRecord (_, []) => (CRecord (ran, []), loc)
109 | CRecord (k, (x, c) :: rest) => 109 | CRecord (_, (x, c) :: rest) =>
110 con (deKnown env) 110 con (deKnown env)
111 (CApp ((CApp ((CApp (f, x), loc), c), loc), 111 (CConcat ((CRecord (ran, [(x, (CApp (f, c), loc))]), loc),
112 (CApp (c1, 112 (CApp (c1, (CRecord (dom, rest), loc)), loc)), loc)
113 (CRecord (k, rest), loc)), loc)), loc)
114 | _ => (CApp (c1, c2), loc)) 113 | _ => (CApp (c1, c2), loc))
115 114
116 | _ => (CApp (c1, c2), loc) 115 | _ => (CApp (c1, c2), loc)
117 end 116 end
118 | CAbs (x, k, b) => (CAbs (x, k, con (UnknownC :: env) b), loc) 117 | CAbs (x, k, b) => (CAbs (x, k, con (UnknownC :: env) b), loc)
128 case (#1 c1, #1 c2) of 127 case (#1 c1, #1 c2) of
129 (CRecord (k, xcs1), CRecord (_, xcs2)) => 128 (CRecord (k, xcs1), CRecord (_, xcs2)) =>
130 (CRecord (k, xcs1 @ xcs2), loc) 129 (CRecord (k, xcs1 @ xcs2), loc)
131 | _ => (CConcat (c1, c2), loc) 130 | _ => (CConcat (c1, c2), loc)
132 end 131 end
133 | CFold _ => all 132 | CMap _ => all
134 133
135 | CUnit => all 134 | CUnit => all
136 135
137 | CTuple cs => (CTuple (map (con env) cs), loc) 136 | CTuple cs => (CTuple (map (con env) cs), loc)
138 | CProj (c, n) => 137 | CProj (c, n) =>