Mercurial > urweb

comparison src/cjrize.sml @ 453:787d4931fb07

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Almost have that nested save function compiling
author Adam Chlipala <adamc@hcoop.net>
date Sat, 01 Nov 2008 21:19:43 -0400
parents 7abb28e9d51f
children bb27c7efcd90
comparison
equal deleted inserted replaced
452:222cbc1da232 453:787d4931fb07
37 37
38 val empty : t 38 val empty : t
39 val find : t * (string * L.typ) list * (string * L'.typ) list -> t * int 39 val find : t * (string * L.typ) list * (string * L'.typ) list -> t * int
40 40
41 val declares : t -> (int * (string * L'.typ) list) list 41 val declares : t -> (int * (string * L'.typ) list) list
42 val clearDeclares : t -> t
42 end = struct 43 end = struct
43 44
44 structure FM = BinaryMapFn(struct 45 structure FM = BinaryMapFn(struct
45 type ord_key = L.typ 46 type ord_key = L.typ
46 val compare = MonoUtil.Typ.compare 47 val compare = MonoUtil.Typ.compare
58 NONE => ((n+1, FM.insert (m, t, n), (n, xts') :: ds), n) 59 NONE => ((n+1, FM.insert (m, t, n), (n, xts') :: ds), n)
59 | SOME i => ((n, m, ds), i) 60 | SOME i => ((n, m, ds), i)
60 end 61 end
61 62
62 fun declares (_, _, ds) = ds 63 fun declares (_, _, ds) = ds
64
65 fun clearDeclares (n, m, _) = (n, m, [])
63 66
64 end 67 end
65 68
66 fun cifyTyp x = 69 fun cifyTyp x =
67 let 70 let
518 fun cjrize ds = 521 fun cjrize ds =
519 let 522 let
520 val (dsF, ds, ps, sm) = foldl (fn (d, (dsF, ds, ps, sm)) => 523 val (dsF, ds, ps, sm) = foldl (fn (d, (dsF, ds, ps, sm)) =>
521 let 524 let
522 val (dop, pop, sm) = cifyDecl (d, sm) 525 val (dop, pop, sm) = cifyDecl (d, sm)
526
523 val (dsF, ds) = case dop of 527 val (dsF, ds) = case dop of
524 NONE => (dsF, ds) 528 NONE => (dsF, ds)
525 | SOME (d as (L'.DDatatype (dk, x, n, _), loc)) => 529 | SOME (d as (L'.DDatatype _, loc)) =>
526 ((L'.DDatatypeForward (dk, x, n), loc) :: dsF, 530 (d :: dsF, ds)
527 d :: ds)
528 | SOME d => (dsF, d :: ds) 531 | SOME d => (dsF, d :: ds)
532
533 val dsF = map (fn v => (L'.DStruct v, ErrorMsg.dummySpan)) (Sm.declares sm)
534 @ dsF
535
529 val ps = case pop of 536 val ps = case pop of
530 NONE => ps 537 NONE => ps
531 | SOME p => p :: ps 538 | SOME p => p :: ps
532 in 539 in
533 (dsF, ds, ps, sm) 540 (dsF, ds, ps, Sm.clearDeclares sm)
534 end) 541 end)
535 ([], [], [], Sm.empty) ds 542 ([], [], [], Sm.empty) ds
536 in 543 in
537 (List.revAppend (dsF, 544 (List.revAppend (dsF, rev ds),
538 List.revAppend (map (fn v => (L'.DStruct v, ErrorMsg.dummySpan)) (Sm.declares sm),
539 rev ds)),
540 ps) 545 ps)
541 end 546 end
542 547
543 end 548 end