Home My Page Projects Code Snippets Project Openings SML/NJ
Summary Activity Forums Tracker Lists Tasks Docs Surveys News SCM Files

SCM Repository

[smlnj] Diff of /sml/trunk/src/cm/compile/generic.sml
ViewVC logotype

Diff of /sml/trunk/src/cm/compile/generic.sml

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 298, Thu May 27 09:42:28 1999 UTC revision 301, Fri May 28 09:43:39 1999 UTC
# Line 15  Line 15 
15          type benv = CT.benv          type benv = CT.benv
16          type env = CT.env          type env = CT.env
17    
18          val bnode : GP.params -> DG.bnode -> envdelta option          val bnode : GP.info -> DG.bnode -> envdelta option
19          val farbnode : GP.params -> DG.farbnode -> benv option          val farbnode : GP.info -> DG.farbnode -> benv option
20          val snode : GP.params -> DG.snode -> envdelta option          val snode : GP.info -> DG.snode -> envdelta option
21          val sbnode : GP.params -> DG.sbnode -> envdelta option          val sbnode : GP.info -> DG.sbnode -> envdelta option
22          val farsbnode : GP.params -> DG.farsbnode -> env option          val farsbnode : GP.info -> DG.farsbnode -> env option
23    
24      end = struct      end = struct
25    
# Line 27  Line 27 
27          type env = CT.env          type env = CT.env
28          type benv = CT.benv          type benv = CT.benv
29    
         fun prim (gp: GP.params) = CT.primitive (#primconf gp)  
   
30          fun foldlayer_k layer f = let          fun foldlayer_k layer f = let
31              fun loop r [] = r              fun loop r [] = r
32                | loop NONE (h :: t) = (ignore (f h); loop NONE t)                | loop NONE (h :: t) = (ignore (f h); loop NONE t)
# Line 51  Line 49 
49                  loop i l                  loop i l
50              end              end
51    
52          fun bnode (gp: GP.params) = let          fun bnode (gp: GP.info) n = let
53    
54              val (glob, loc) = let              val (glob, loc) = let
55                  val globf = farbnode gp                  val globf = farbnode gp
# Line 59  Line 57 
57                  fun k f = foldlayer_k CT.blayer f                  fun k f = foldlayer_k CT.blayer f
58                  fun s f = foldlayer_s CT.blayer f                  fun s f = foldlayer_s CT.blayer f
59              in              in
60                  if #keep_going gp then (k globf, k locf)                  if #keep_going (#param gp) then (k globf, k locf)
61                  else (s globf, s locf)                  else (s globf, s locf)
62              end              end
63    
64              fun bn (DG.PNODE p) = SOME (prim gp p)              fun bn (DG.PNODE p) = SOME (CT.primitive gp p)
65                | bn (DG.BNODE n) = let                | bn (DG.BNODE n) = let
66                      val { bininfo, localimports = li, globalimports = gi } = n                      val { bininfo, localimports = li, globalimports = gi } = n
67                      fun mkenv () = let                      fun mkenv () = loc (glob (SOME (CT.bpervasive gp)) gi) li
                         val pe = CT.bnofilter (prim gp Primitive.pervasive)  
                         val ge = glob (SOME pe) gi  
                     in  
                         loc ge li  
                     end  
68                  in                  in
69                      CT.dostable (bininfo, mkenv, gp)                      CT.dostable (bininfo, mkenv, gp)
70                  end                  end
71          in          in
72              bn              (* don't eta-reduce this -- it'll lead to an infinite loop! *)
73                bn n
74          end          end
75    
76          and farbnode gp (f, n) =          and farbnode gp (f, n) =
# Line 93  Line 87 
87                  fun k f = foldlayer_k CT.layer f                  fun k f = foldlayer_k CT.layer f
88                  fun s f = foldlayer_s CT.layer f                  fun s f = foldlayer_s CT.layer f
89              in              in
90                  if #keep_going gp then (k globf, k locf)                  if #keep_going (#param gp) then (k globf, k locf)
91                  else (s globf, s locf)                  else (s globf, s locf)
92              end              end
93    
94              val { smlinfo, localimports = li, globalimports = gi } = n              val { smlinfo, localimports = li, globalimports = gi } = n
95              val pe = CT.nofilter (prim gp Primitive.pervasive)              val desc = SmlInfo.fullSpec smlinfo
96              val ge = glob (SOME pe) gi              val pe = SOME (CT.pervasive gp)
97              val le = loc ge li              val ge = glob pe gi
98                val e = loc ge li
99          in          in
100              case le of              case e of
101                  NONE => NONE                  NONE => NONE
102                | SOME le => CT.dosml (smlinfo, le, gp)                | SOME e => CT.dosml (smlinfo, e, gp)
103          end          end
104    
105          and sbnode gp (DG.SB_BNODE b) = bnode gp b          and sbnode gp (DG.SB_BNODE b) = bnode gp b

Legend:
Removed from v.298  
changed lines
  Added in v.301

root@smlnj-gforge.cs.uchicago.edu
ViewVC Help
Powered by ViewVC 1.0.0