Mercurial > urweb

comparison src/core_util.sml @ 626:230654093b51

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
demo/hello compiles with kind polymorphism
author Adam Chlipala <adamc@hcoop.net>
date Sun, 22 Feb 2009 17:17:01 -0500
parents 588b9d16b00a
children 70cbdcf5989b
comparison
equal deleted inserted replaced
625:47947d6e9750 626:230654093b51
56 | (KUnit, KUnit) => EQUAL 56 | (KUnit, KUnit) => EQUAL
57 | (KUnit, _) => LESS 57 | (KUnit, _) => LESS
58 | (_, KUnit) => GREATER 58 | (_, KUnit) => GREATER
59 59
60 | (KTuple ks1, KTuple ks2) => joinL compare (ks1, ks2) 60 | (KTuple ks1, KTuple ks2) => joinL compare (ks1, ks2)
61 61 | (KTuple _, _) => LESS
62 fun mapfold f = 62 | (_, KTuple _) => GREATER
63
64 | (KRel n1, KRel n2) => Int.compare (n1, n2)
65 | (KRel _, _) => LESS
66 | (_, KRel _) => GREATER
67
68 | (KFun (_, k1), KFun (_, k2)) => compare (k1, k2)
69
70 fun mapfoldB {kind = f, bind} =
63 let 71 let
64 fun mfk k acc = 72 fun mfk ctx k acc =
65 S.bindP (mfk' k acc, f) 73 S.bindP (mfk' ctx k acc, f ctx)
66 74
67 and mfk' (kAll as (k, loc)) = 75 and mfk' ctx (kAll as (k, loc)) =
68 case k of 76 case k of
69 KType => S.return2 kAll 77 KType => S.return2 kAll
70 78
71 | KArrow (k1, k2) => 79 | KArrow (k1, k2) =>
72 S.bind2 (mfk k1, 80 S.bind2 (mfk ctx k1,
73 fn k1' => 81 fn k1' =>
74 S.map2 (mfk k2, 82 S.map2 (mfk ctx k2,
75 fn k2' => 83 fn k2' =>
76 (KArrow (k1', k2'), loc))) 84 (KArrow (k1', k2'), loc)))
77 85
78 | KName => S.return2 kAll 86 | KName => S.return2 kAll
79 87
80 | KRecord k => 88 | KRecord k =>
81 S.map2 (mfk k, 89 S.map2 (mfk ctx k,
82 fn k' => 90 fn k' =>
83 (KRecord k', loc)) 91 (KRecord k', loc))
84 92
85 | KUnit => S.return2 kAll 93 | KUnit => S.return2 kAll
86 94
87 | KTuple ks => 95 | KTuple ks =>
88 S.map2 (ListUtil.mapfold mfk ks, 96 S.map2 (ListUtil.mapfold (mfk ctx) ks,
89 fn ks' => 97 fn ks' =>
90 (KTuple ks', loc)) 98 (KTuple ks', loc))
99
100 | KRel _ => S.return2 kAll
101 | KFun (x, k) =>
102 S.map2 (mfk (bind (ctx, x)) k,
103 fn k' =>
104 (KFun (x, k'), loc))
91 in 105 in
92 mfk 106 mfk
93 end 107 end
94 108
109 fun mapfold fk =
110 mapfoldB {kind = fn () => fk,
111 bind = fn ((), _) => ()} ()
112
95 fun map f k = 113 fun map f k =
96 case mapfold (fn k => fn () => S.Continue (f k, ())) k () of 114 case mapfold (fn k => fn () => S.Continue (f k, ())) k () of
97 S.Return () => raise Fail "Core_util.Kind.map" 115 S.Return () => raise Fail "CoreUtil.Kind.map"
98 | S.Continue (k, ()) => k 116 | S.Continue (k, ()) => k
117
118 fun mapB {kind, bind} ctx k =
119 case mapfoldB {kind = fn ctx => fn k => fn () => S.Continue (kind ctx k, ()),
120 bind = bind} ctx k () of
121 S.Continue (k, ()) => k
122 | S.Return _ => raise Fail "CoreUtil.Kind.mapB: Impossible"
99 123
100 fun exists f k = 124 fun exists f k =
101 case mapfold (fn k => fn () => 125 case mapfold (fn k => fn () =>
102 if f k then 126 if f k then
103 S.Return () 127 S.Return ()
192 | (CTuple _, _) => LESS 216 | (CTuple _, _) => LESS
193 | (_, CTuple _) => GREATER 217 | (_, CTuple _) => GREATER
194 218
195 | (CProj (c1, n1), CProj (c2, n2)) => join (Int.compare (n1, n2), 219 | (CProj (c1, n1), CProj (c2, n2)) => join (Int.compare (n1, n2),
196 fn () => compare (c1, c2)) 220 fn () => compare (c1, c2))
221 | (CProj _, _) => LESS
222 | (_, CProj _) => GREATER
223
224 | (CKAbs (_, c1), CKAbs (_, c2)) => compare (c1, c2)
225 | (CKAbs _, _) => LESS
226 | (_, CKAbs _) => GREATER
227
228 | (CKApp (c1, k1), CKApp (c2, k2)) =>
229 join (compare (c1, c2),
230 fn () => Kind.compare (k1, k2))
231 | (CKApp _, _) => LESS
232 | (_, CKApp _) => GREATER
233
234 | (TKFun (_, c1), TKFun (_, c2)) => compare (c1, c2)
197 235
198 datatype binder = 236 datatype binder =
199 Rel of string * kind 237 RelK of string
200 | Named of string * int * kind * con option 238 | RelC of string * kind
239 | NamedC of string * int * kind * con option
201 240
202 fun mapfoldB {kind = fk, con = fc, bind} = 241 fun mapfoldB {kind = fk, con = fc, bind} =
203 let 242 let
204 val mfk = Kind.mapfold fk 243 val mfk = Kind.mapfoldB {kind = fk, bind = fn (ctx, x) => bind (ctx, RelK x)}
205 244
206 fun mfc ctx c acc = 245 fun mfc ctx c acc =
207 S.bindP (mfc' ctx c acc, fc ctx) 246 S.bindP (mfc' ctx c acc, fc ctx)
208 247
209 and mfc' ctx (cAll as (c, loc)) = 248 and mfc' ctx (cAll as (c, loc)) =
213 fn c1' => 252 fn c1' =>
214 S.map2 (mfc ctx c2, 253 S.map2 (mfc ctx c2,
215 fn c2' => 254 fn c2' =>
216 (TFun (c1', c2'), loc))) 255 (TFun (c1', c2'), loc)))
217 | TCFun (x, k, c) => 256 | TCFun (x, k, c) =>
218 S.bind2 (mfk k, 257 S.bind2 (mfk ctx k,
219 fn k' => 258 fn k' =>
220 S.map2 (mfc (bind (ctx, Rel (x, k))) c, 259 S.map2 (mfc (bind (ctx, RelC (x, k))) c,
221 fn c' => 260 fn c' =>
222 (TCFun (x, k', c'), loc))) 261 (TCFun (x, k', c'), loc)))
223 | TRecord c => 262 | TRecord c =>
224 S.map2 (mfc ctx c, 263 S.map2 (mfc ctx c,
225 fn c' => 264 fn c' =>
233 fn c1' => 272 fn c1' =>
234 S.map2 (mfc ctx c2, 273 S.map2 (mfc ctx c2,
235 fn c2' => 274 fn c2' =>
236 (CApp (c1', c2'), loc))) 275 (CApp (c1', c2'), loc)))
237 | CAbs (x, k, c) => 276 | CAbs (x, k, c) =>
238 S.bind2 (mfk k, 277 S.bind2 (mfk ctx k,
239 fn k' => 278 fn k' =>
240 S.map2 (mfc (bind (ctx, Rel (x, k))) c, 279 S.map2 (mfc (bind (ctx, RelC (x, k))) c,
241 fn c' => 280 fn c' =>
242 (CAbs (x, k', c'), loc))) 281 (CAbs (x, k', c'), loc)))
243 282
244 | CName _ => S.return2 cAll 283 | CName _ => S.return2 cAll
245 284
246 | CRecord (k, xcs) => 285 | CRecord (k, xcs) =>
247 S.bind2 (mfk k, 286 S.bind2 (mfk ctx k,
248 fn k' => 287 fn k' =>
249 S.map2 (ListUtil.mapfold (fn (x, c) => 288 S.map2 (ListUtil.mapfold (fn (x, c) =>
250 S.bind2 (mfc ctx x, 289 S.bind2 (mfc ctx x,
251 fn x' => 290 fn x' =>
252 S.map2 (mfc ctx c, 291 S.map2 (mfc ctx c,
260 fn c1' => 299 fn c1' =>
261 S.map2 (mfc ctx c2, 300 S.map2 (mfc ctx c2,
262 fn c2' => 301 fn c2' =>
263 (CConcat (c1', c2'), loc))) 302 (CConcat (c1', c2'), loc)))
264 | CMap (k1, k2) => 303 | CMap (k1, k2) =>
265 S.bind2 (mfk k1, 304 S.bind2 (mfk ctx k1,
266 fn k1' => 305 fn k1' =>
267 S.map2 (mfk k2, 306 S.map2 (mfk ctx k2,
268 fn k2' => 307 fn k2' =>
269 (CMap (k1', k2'), loc))) 308 (CMap (k1', k2'), loc)))
270 309
271 | CUnit => S.return2 cAll 310 | CUnit => S.return2 cAll
272 311
277 316
278 | CProj (c, n) => 317 | CProj (c, n) =>
279 S.map2 (mfc ctx c, 318 S.map2 (mfc ctx c,
280 fn c' => 319 fn c' =>
281 (CProj (c', n), loc)) 320 (CProj (c', n), loc))
321
322 | CKAbs (x, c) =>
323 S.map2 (mfc (bind (ctx, RelK x)) c,
324 fn c' =>
325 (CKAbs (x, c'), loc))
326 | CKApp (c, k) =>
327 S.bind2 (mfc ctx c,
328 fn c' =>
329 S.map2 (mfk ctx k,
330 fn k' =>
331 (CKApp (c', k'), loc)))
332 | TKFun (x, c) =>
333 S.map2 (mfc (bind (ctx, RelK x)) c,
334 fn c' =>
335 (TKFun (x, c'), loc))
282 in 336 in
283 mfc 337 mfc
284 end 338 end
285 339
286 fun mapfold {kind = fk, con = fc} = 340 fun mapfold {kind = fk, con = fc} =
287 mapfoldB {kind = fk, 341 mapfoldB {kind = fn () => fk,
288 con = fn () => fc, 342 con = fn () => fc,
289 bind = fn ((), _) => ()} () 343 bind = fn ((), _) => ()} ()
290 344
291 fun map {kind, con} c = 345 fun map {kind, con} c =
292 case mapfold {kind = fn k => fn () => S.Continue (kind k, ()), 346 case mapfold {kind = fn k => fn () => S.Continue (kind k, ()),
293 con = fn c => fn () => S.Continue (con c, ())} c () of 347 con = fn c => fn () => S.Continue (con c, ())} c () of
294 S.Return () => raise Fail "Core_util.Con.map" 348 S.Return () => raise Fail "Core_util.Con.map"
295 | S.Continue (c, ()) => c 349 | S.Continue (c, ()) => c
296 350
297 fun mapB {kind, con, bind} ctx c = 351 fun mapB {kind, con, bind} ctx c =
298 case mapfoldB {kind = fn k => fn () => S.Continue (kind k, ()), 352 case mapfoldB {kind = fn ctx => fn k => fn () => S.Continue (kind ctx k, ()),
299 con = fn ctx => fn c => fn () => S.Continue (con ctx c, ()), 353 con = fn ctx => fn c => fn () => S.Continue (con ctx c, ()),
300 bind = bind} ctx c () of 354 bind = bind} ctx c () of
301 S.Continue (c, ()) => c 355 S.Continue (c, ()) => c
302 | S.Return _ => raise Fail "CoreUtil.Con.mapB: Impossible" 356 | S.Return _ => raise Fail "CoreUtil.Con.mapB: Impossible"
303 357
480 534
481 | (EServerCall (n1, es1, e1, _), EServerCall (n2, es2, e2, _)) => 535 | (EServerCall (n1, es1, e1, _), EServerCall (n2, es2, e2, _)) =>
482 join (Int.compare (n1, n2), 536 join (Int.compare (n1, n2),
483 fn () => join (joinL compare (es1, es2), 537 fn () => join (joinL compare (es1, es2),
484 fn () => compare (e1, e2))) 538 fn () => compare (e1, e2)))
539 | (EServerCall _, _) => LESS
540 | (_, EServerCall _) => GREATER
541
542 | (EKAbs (_, e1), EKAbs (_, e2)) => compare (e1, e2)
543 | (EKAbs _, _) => LESS
544 | (_, EKAbs _) => GREATER
545
546 | (EKApp (e1, k1), EKApp (e2, k2)) =>
547 join (compare (e1, e2),
548 fn () => Kind.compare (k1, k2))
485 549
486 datatype binder = 550 datatype binder =
487 RelC of string * kind 551 RelK of string
552 | RelC of string * kind
488 | NamedC of string * int * kind * con option 553 | NamedC of string * int * kind * con option
489 | RelE of string * con 554 | RelE of string * con
490 | NamedE of string * int * con * exp option * string 555 | NamedE of string * int * con * exp option * string
491 556
492 fun mapfoldB {kind = fk, con = fc, exp = fe, bind} = 557 fun mapfoldB {kind = fk, con = fc, exp = fe, bind} =
493 let 558 let
494 val mfk = Kind.mapfold fk 559 val mfk = Kind.mapfoldB {kind = fk, bind = fn (ctx, x) => bind (ctx, RelK x)}
495 560
496 fun bind' (ctx, b) = 561 fun bind' (ctx, b) =
497 let 562 let
498 val b' = case b of 563 val b' = case b of
499 Con.Rel x => RelC x 564 Con.RelK x => RelK x
500 | Con.Named x => NamedC x 565 | Con.RelC x => RelC x
566 | Con.NamedC x => NamedC x
501 in 567 in
502 bind (ctx, b') 568 bind (ctx, b')
503 end 569 end
504 val mfc = Con.mapfoldB {kind = fk, con = fc, bind = bind'} 570 val mfc = Con.mapfoldB {kind = fk, con = fc, bind = bind'}
505 571
546 fn e' => 612 fn e' =>
547 S.map2 (mfc ctx c, 613 S.map2 (mfc ctx c,
548 fn c' => 614 fn c' =>
549 (ECApp (e', c'), loc))) 615 (ECApp (e', c'), loc)))
550 | ECAbs (x, k, e) => 616 | ECAbs (x, k, e) =>
551 S.bind2 (mfk k, 617 S.bind2 (mfk ctx k,
552 fn k' => 618 fn k' =>
553 S.map2 (mfe (bind (ctx, RelC (x, k))) e, 619 S.map2 (mfe (bind (ctx, RelC (x, k))) e,
554 fn e' => 620 fn e' =>
555 (ECAbs (x, k', e'), loc))) 621 (ECAbs (x, k', e'), loc)))
556 622
658 S.bind2 (mfe ctx e, 724 S.bind2 (mfe ctx e,
659 fn e' => 725 fn e' =>
660 S.map2 (mfc ctx t, 726 S.map2 (mfc ctx t,
661 fn t' => 727 fn t' =>
662 (EServerCall (n, es', e', t'), loc)))) 728 (EServerCall (n, es', e', t'), loc))))
729
730 | EKAbs (x, e) =>
731 S.map2 (mfe (bind (ctx, RelK x)) e,
732 fn e' =>
733 (EKAbs (x, e'), loc))
734 | EKApp (e, k) =>
735 S.bind2 (mfe ctx e,
736 fn e' =>
737 S.map2 (mfk ctx k,
738 fn k' =>
739 (EKApp (e', k'), loc)))
663 740
664 and mfp ctx (pAll as (p, loc)) = 741 and mfp ctx (pAll as (p, loc)) =
665 case p of 742 case p of
666 PWild => S.return2 pAll 743 PWild => S.return2 pAll
667 | PVar (x, t) => 744 | PVar (x, t) =>
702 in 779 in
703 mfe 780 mfe
704 end 781 end
705 782
706 fun mapfold {kind = fk, con = fc, exp = fe} = 783 fun mapfold {kind = fk, con = fc, exp = fe} =
707 mapfoldB {kind = fk, 784 mapfoldB {kind = fn () => fk,
708 con = fn () => fc, 785 con = fn () => fc,
709 exp = fn () => fe, 786 exp = fn () => fe,
710 bind = fn ((), _) => ()} () 787 bind = fn ((), _) => ()} ()
711 788
712 fun mapB {kind, con, exp, bind} ctx e = 789 fun mapB {kind, con, exp, bind} ctx e =
713 case mapfoldB {kind = fn k => fn () => S.Continue (kind k, ()), 790 case mapfoldB {kind = fn ctx => fn k => fn () => S.Continue (kind ctx k, ()),
714 con = fn ctx => fn c => fn () => S.Continue (con ctx c, ()), 791 con = fn ctx => fn c => fn () => S.Continue (con ctx c, ()),
715 exp = fn ctx => fn e => fn () => S.Continue (exp ctx e, ()), 792 exp = fn ctx => fn e => fn () => S.Continue (exp ctx e, ()),
716 bind = bind} ctx e () of 793 bind = bind} ctx e () of
717 S.Continue (e, ()) => e 794 S.Continue (e, ()) => e
718 | S.Return _ => raise Fail "CoreUtil.Exp.mapB: Impossible" 795 | S.Return _ => raise Fail "CoreUtil.Exp.mapB: Impossible"
730 exp = fn e => fn s => S.Continue (e, exp (e, s))} e s of 807 exp = fn e => fn s => S.Continue (e, exp (e, s))} e s of
731 S.Continue (_, s) => s 808 S.Continue (_, s) => s
732 | S.Return _ => raise Fail "CoreUtil.Exp.fold: Impossible" 809 | S.Return _ => raise Fail "CoreUtil.Exp.fold: Impossible"
733 810
734 fun foldB {kind, con, exp, bind} ctx s e = 811 fun foldB {kind, con, exp, bind} ctx s e =
735 case mapfoldB {kind = fn k => fn s => S.Continue (k, kind (k, s)), 812 case mapfoldB {kind = fn ctx => fn k => fn s => S.Continue (k, kind (ctx, k, s)),
736 con = fn ctx => fn c => fn s => S.Continue (c, con (ctx, c, s)), 813 con = fn ctx => fn c => fn s => S.Continue (c, con (ctx, c, s)),
737 exp = fn ctx => fn e => fn s => S.Continue (e, exp (ctx, e, s)), 814 exp = fn ctx => fn e => fn s => S.Continue (e, exp (ctx, e, s)),
738 bind = bind} ctx e s of 815 bind = bind} ctx e s of
739 S.Continue (_, s) => s 816 S.Continue (_, s) => s
740 | S.Return _ => raise Fail "CoreUtil.Exp.foldB: Impossible" 817 | S.Return _ => raise Fail "CoreUtil.Exp.foldB: Impossible"
757 S.Continue (e, ())} k () of 834 S.Continue (e, ())} k () of
758 S.Return _ => true 835 S.Return _ => true
759 | S.Continue _ => false 836 | S.Continue _ => false
760 837
761 fun existsB {kind, con, exp, bind} ctx k = 838 fun existsB {kind, con, exp, bind} ctx k =
762 case mapfoldB {kind = fn k => fn () => 839 case mapfoldB {kind = fn ctx => fn k => fn () =>
763 if kind k then 840 if kind (ctx, k) then
764 S.Return () 841 S.Return ()
765 else 842 else
766 S.Continue (k, ()), 843 S.Continue (k, ()),
767 con = fn ctx => fn c => fn () => 844 con = fn ctx => fn c => fn () =>
768 if con (ctx, c) then 845 if con (ctx, c) then
769 S.Return () 846 S.Return ()
770 else 847 else
771 S.Continue (c, ()), 848 S.Continue (c, ()),
784 exp = fn e => fn s => S.Continue (exp (e, s))} e s of 861 exp = fn e => fn s => S.Continue (exp (e, s))} e s of
785 S.Continue v => v 862 S.Continue v => v
786 | S.Return _ => raise Fail "CoreUtil.Exp.foldMap: Impossible" 863 | S.Return _ => raise Fail "CoreUtil.Exp.foldMap: Impossible"
787 864
788 fun foldMapB {kind, con, exp, bind} ctx s e = 865 fun foldMapB {kind, con, exp, bind} ctx s e =
789 case mapfoldB {kind = fn k => fn s => S.Continue (kind (k, s)), 866 case mapfoldB {kind = fn ctx => fn k => fn s => S.Continue (kind (ctx, k, s)),
790 con = fn ctx => fn c => fn s => S.Continue (con (ctx, c, s)), 867 con = fn ctx => fn c => fn s => S.Continue (con (ctx, c, s)),
791 exp = fn ctx => fn e => fn s => S.Continue (exp (ctx, e, s)), 868 exp = fn ctx => fn e => fn s => S.Continue (exp (ctx, e, s)),
792 bind = bind} ctx e s of 869 bind = bind} ctx e s of
793 S.Continue v => v 870 S.Continue v => v
794 | S.Return _ => raise Fail "CoreUtil.Exp.foldMapB: Impossible" 871 | S.Return _ => raise Fail "CoreUtil.Exp.foldMapB: Impossible"
799 876
800 datatype binder = datatype Exp.binder 877 datatype binder = datatype Exp.binder
801 878
802 fun mapfoldB {kind = fk, con = fc, exp = fe, decl = fd, bind} = 879 fun mapfoldB {kind = fk, con = fc, exp = fe, decl = fd, bind} =
803 let 880 let
804 val mfk = Kind.mapfold fk 881 val mfk = Kind.mapfoldB {kind = fk, bind = fn (ctx, x) => bind (ctx, RelK x)}
805 882
806 fun bind' (ctx, b) = 883 fun bind' (ctx, b) =
807 let 884 let
808 val b' = case b of 885 val b' = case b of
809 Con.Rel x => RelC x 886 Con.RelK x => RelK x
810 | Con.Named x => NamedC x 887 | Con.RelC x => RelC x
888 | Con.NamedC x => NamedC x
811 in 889 in
812 bind (ctx, b') 890 bind (ctx, b')
813 end 891 end
814 val mfc = Con.mapfoldB {kind = fk, con = fc, bind = bind'} 892 val mfc = Con.mapfoldB {kind = fk, con = fc, bind = bind'}
815 893
819 S.bindP (mfd' ctx d acc, fd ctx) 897 S.bindP (mfd' ctx d acc, fd ctx)
820 898
821 and mfd' ctx (dAll as (d, loc)) = 899 and mfd' ctx (dAll as (d, loc)) =
822 case d of 900 case d of
823 DCon (x, n, k, c) => 901 DCon (x, n, k, c) =>
824 S.bind2 (mfk k, 902 S.bind2 (mfk ctx k,
825 fn k' => 903 fn k' =>
826 S.map2 (mfc ctx c, 904 S.map2 (mfc ctx c,
827 fn c' => 905 fn c' =>
828 (DCon (x, n, k', c'), loc))) 906 (DCon (x, n, k', c'), loc)))
829 | DDatatype (x, n, xs, xncs) => 907 | DDatatype (x, n, xs, xncs) =>
875 in 953 in
876 mfd 954 mfd
877 end 955 end
878 956
879 fun mapfold {kind = fk, con = fc, exp = fe, decl = fd} = 957 fun mapfold {kind = fk, con = fc, exp = fe, decl = fd} =
880 mapfoldB {kind = fk, 958 mapfoldB {kind = fn () => fk,
881 con = fn () => fc, 959 con = fn () => fc,
882 exp = fn () => fe, 960 exp = fn () => fe,
883 decl = fn () => fd, 961 decl = fn () => fd,
884 bind = fn ((), _) => ()} () 962 bind = fn ((), _) => ()} ()
885 963
898 decl = fn d => fn s => S.Continue (decl (d, s))} d s of 976 decl = fn d => fn s => S.Continue (decl (d, s))} d s of
899 S.Continue v => v 977 S.Continue v => v
900 | S.Return _ => raise Fail "CoreUtil.Decl.foldMap: Impossible" 978 | S.Return _ => raise Fail "CoreUtil.Decl.foldMap: Impossible"
901 979
902 fun foldMapB {kind, con, exp, decl, bind} ctx s d = 980 fun foldMapB {kind, con, exp, decl, bind} ctx s d =
903 case mapfoldB {kind = fn k => fn s => S.Continue (kind (k, s)), 981 case mapfoldB {kind = fn ctx => fn k => fn s => S.Continue (kind (ctx, k, s)),
904 con = fn ctx => fn c => fn s => S.Continue (con (ctx, c, s)), 982 con = fn ctx => fn c => fn s => S.Continue (con (ctx, c, s)),
905 exp = fn ctx => fn e => fn s => S.Continue (exp (ctx, e, s)), 983 exp = fn ctx => fn e => fn s => S.Continue (exp (ctx, e, s)),
906 decl = fn ctx => fn d => fn s => S.Continue (decl (ctx, d, s)), 984 decl = fn ctx => fn d => fn s => S.Continue (decl (ctx, d, s)),
907 bind = bind} ctx d s of 985 bind = bind} ctx d s of
908 S.Continue v => v 986 S.Continue v => v
1007 in 1085 in
1008 mff 1086 mff
1009 end 1087 end
1010 1088
1011 fun mapfold {kind = fk, con = fc, exp = fe, decl = fd} = 1089 fun mapfold {kind = fk, con = fc, exp = fe, decl = fd} =
1012 mapfoldB {kind = fk, 1090 mapfoldB {kind = fn () => fk,
1013 con = fn () => fc, 1091 con = fn () => fc,
1014 exp = fn () => fe, 1092 exp = fn () => fe,
1015 decl = fn () => fd, 1093 decl = fn () => fd,
1016 bind = fn ((), _) => ()} () 1094 bind = fn ((), _) => ()} ()
1017 1095
1018 fun mapB {kind, con, exp, decl, bind} ctx ds = 1096 fun mapB {kind, con, exp, decl, bind} ctx ds =
1019 case mapfoldB {kind = fn k => fn () => S.Continue (kind k, ()), 1097 case mapfoldB {kind = fn ctx => fn k => fn () => S.Continue (kind ctx k, ()),
1020 con = fn ctx => fn c => fn () => S.Continue (con ctx c, ()), 1098 con = fn ctx => fn c => fn () => S.Continue (con ctx c, ()),
1021 exp = fn ctx => fn e => fn () => S.Continue (exp ctx e, ()), 1099 exp = fn ctx => fn e => fn () => S.Continue (exp ctx e, ()),
1022 decl = fn ctx => fn d => fn () => S.Continue (decl ctx d, ()), 1100 decl = fn ctx => fn d => fn () => S.Continue (decl ctx d, ()),
1023 bind = bind} ctx ds () of 1101 bind = bind} ctx ds () of
1024 S.Continue (ds, ()) => ds 1102 S.Continue (ds, ()) => ds
1025 | S.Return _ => raise Fail "CoreUtil.File.mapB: Impossible" 1103 | S.Return _ => raise Fail "CoreUtil.File.mapB: Impossible"
1026 1104
1027 fun map {kind, con, exp, decl} ds = 1105 fun map {kind, con, exp, decl} ds =
1028 mapB {kind = kind, 1106 mapB {kind = fn () => kind,
1029 con = fn () => con, 1107 con = fn () => con,
1030 exp = fn () => exp, 1108 exp = fn () => exp,
1031 decl = fn () => decl, 1109 decl = fn () => decl,
1032 bind = fn _ => ()} () ds 1110 bind = fn _ => ()} () ds
1033 1111