diff src/cjrize.sml @ 453:787d4931fb07

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
line wrap: on
line diff
--- a/src/cjrize.sml	Sat Nov 01 17:19:12 2008 -0400
+++ b/src/cjrize.sml	Sat Nov 01 21:19:43 2008 -0400
@@ -39,6 +39,7 @@
     val find : t * (string * L.typ) list * (string * L'.typ) list -> t * int
 
     val declares : t -> (int * (string * L'.typ) list) list
+    val clearDeclares : t -> t
 end = struct
 
 structure FM = BinaryMapFn(struct
@@ -61,6 +62,8 @@
 
 fun declares (_, _, ds) = ds
 
+fun clearDeclares (n, m, _) = (n, m, [])
+
 end
 
 fun cifyTyp x =
@@ -520,23 +523,25 @@
         val (dsF, ds, ps, sm) = foldl (fn (d, (dsF, ds, ps, sm)) =>
                                           let
                                               val (dop, pop, sm) = cifyDecl (d, sm)
+
                                               val (dsF, ds) = case dop of
                                                                   NONE => (dsF, ds)
-                                                                | SOME (d as (L'.DDatatype (dk, x, n, _), loc)) =>
-                                                                  ((L'.DDatatypeForward (dk, x, n), loc) :: dsF,
-                                                                   d :: ds)
+                                                                | SOME (d as (L'.DDatatype _, loc)) =>
+                                                                  (d :: dsF, ds)
                                                                 | SOME d => (dsF, d :: ds)
+
+                                              val dsF = map (fn v => (L'.DStruct v, ErrorMsg.dummySpan)) (Sm.declares sm)
+                                                        @ dsF
+
                                               val ps = case pop of
                                                            NONE => ps
                                                          | SOME p => p :: ps
                                           in
-                                              (dsF, ds, ps, sm)
+                                              (dsF, ds, ps, Sm.clearDeclares sm)
                                           end)
                                       ([], [], [], Sm.empty) ds
     in
-        (List.revAppend (dsF,
-                         List.revAppend (map (fn v => (L'.DStruct v, ErrorMsg.dummySpan)) (Sm.declares sm),
-                                         rev ds)),
+        (List.revAppend (dsF, rev ds),
          ps)
     end