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/branches/primop-branch-3/compiler/Elaborator/elaborate/elabmod.sml
ViewVC logotype

Diff of /sml/branches/primop-branch-3/compiler/Elaborator/elaborate/elabmod.sml

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

revision 3507, Fri Feb 26 15:55:08 2010 UTC revision 3508, Fri Feb 26 23:23:08 2010 UTC
# Line 161  Line 161 
161                   (case kind                   (case kind
162                     of T.DATATYPE{index=0,family,freetycs, stamps, root} =>                     of T.DATATYPE{index=0,family,freetycs, stamps, root} =>
163                        let val rootev = mkStamp()                        let val rootev = mkStamp()
164                            val rtevOp = SOME rootev                            val rootevOp = SOME rootev
165                            val nfreetycs = map viztc freetycs                            val newfreetycs = map viztc freetycs
166                            val nstamps = Vector.map (fn _ => mkStamp()) stamps                            val nstamps = Vector.map (fn _ => mkStamp()) stamps
167    
168                            fun newdt (dt as T.GENtyc {kind,arity,eq,path,...})=                            fun newdt (dt as T.GENtyc {kind,arity,eq,path,...})=
169                                (case kind                                (case kind
170                                   of T.DATATYPE{index=i,...} =>                                   of T.DATATYPE{index=i,...} =>
171                                      let val (ev, rtev) =                                      let val (ev, rtevOp) =
172                                              if i=0 then (rootev, NONE)                                              if i=0 then (rootev, NONE)
173                                              else (mkStamp(), rtevOp)                                              else (mkStamp(), rootevOp)
174    
175                                          val nkind =                                          val nkind =
176                                              T.DATATYPE{index=i, stamps=nstamps,                                              T.DATATYPE{index=i, stamps=nstamps,
177                                                         freetycs=nfreetycs,                                                         freetycs=newfreetycs,
178                                                         root=rtev,                                                         root=rtevOp,
179                                                         family=family}                                                         family=family}
180                                          (* the rtev field in DATATYPE indicates                                          (* the root field in DATATYPE indicates
181                                           * how to discover the new stamps when                                           * how to discover the new stamps when
182                                           * such datatypes get evalent-ed *)                                           * such datatypes get evalent-ed *)
183    
# Line 312  Line 312 
312                                        let val strExp =                                        let val strExp =
313                                                case epOp                                                case epOp
314                                                 of SOME ep => M.VARstr ep                                                 of SOME ep => M.VARstr ep
315                                                  | _ => M.CONSTstr rlzn                                                | _ => M.CONSTstr rlzn (* nonvolatile *)
316                                         in (M.STRdec(ev, strExp, sym))::entDecls                                         in (M.STRdec(ev, strExp, sym))::entDecls
317                                        end                                        end
318                                    | _ => entDecls                                    | _ => entDecls
# Line 341  Line 341 
341                                val ed =                                val ed =
342                                  case context                                  case context
343                                   of EU.INFCT _ =>                                   of EU.INFCT _ =>
344                                        (let val fctExp =                                      let val fctExp =
345                                               case epOp                                               case epOp
346                                                of SOME ep => M.VARfct ep                                                of SOME ep => M.VARfct ep
347                                                 | _ => M.CONSTfct rlzn                                                | _ => M.CONSTfct rlzn (* nonvolatile *)
348                                          in (M.FCTdec(x, fctExp))::entDecls                                          in (M.FCTdec(x, fctExp))::entDecls
349                                         end)                                      end
350                                    | _ => entDecl                                    | _ => entDecl
351                             in (ev, ee, ed)                             in (ev, ee, ed)
352                            end)                            end)
# Line 374  Line 374 
374                                val ed =                                val ed =
375                                  case context                                  case context
376                                   of EU.INFCT _ =>                                   of EU.INFCT _ =>
377                                        (let val tycExp =                                      let val tycExp =
378                                               case epOp                                               case epOp
379                                                of SOME ep => M.VARtyc ep                                                of SOME ep => M.VARtyc ep
380                                                 | NONE => M.CONSTtyc tyc                                                 | NONE => M.CONSTtyc tyc (* nonvolatile *)
381                                          in (M.TYCdec(ev, tycExp))::entDecls                                          in (M.TYCdec(ev, tycExp))::entDecls
382                                         end)                                      end
383                                    | _ => entDecl                                    | _ => entDecl
384                             in (ev, ee, ed)                             in (ev, ee, ed)
385                            end                            end
# Line 597  Line 597 
597                     val fctExp =                     val fctExp =
598                          case EPC.lookFctEntPath(epContext, MU.fctId fct)                          case EPC.lookFctEntPath(epContext, MU.fctId fct)
599                            of SOME ep => VARfct ep    (* volatile, use variable ref *)                            of SOME ep => VARfct ep    (* volatile, use variable ref *)
600                             | NONE => CONSTfct fctEnt (* nonvolatile, a constant *)                             | NONE => CONSTfct fctEnt (* a nonvolatile constant *)
601    
602                     val epc = case entVarOp (* from outer evalStr call *)                     val epc = case entVarOp (* from outer evalStr call *)
603                                 of NONE => epContext                                 of NONE => epContext
# Line 648  Line 648 
648                    of STR _ =>                    of STR _ =>
649                        ((* debugmsg "--elab[VarStr]: resExp/STR"; *)                        ((* debugmsg "--elab[VarStr]: resExp/STR"; *)
650                         case EPC.lookStrEntPath(epContext,MU.strId str)                         case EPC.lookStrEntPath(epContext,MU.strId str)
651                           of NONE => M.CONSTstr strRlzn                           of NONE => M.CONSTstr strRlzn (* nonvolatile constant *)
652                            | SOME ep => M.VARstr ep)                            | SOME ep => M.VARstr ep)
653                     | _ => M.CONSTstr M.bogusStrEntity (* error recovery *)                     | _ => M.CONSTstr M.bogusStrEntity (* error recovery *)
654    
# Line 1491  Line 1491 
1491                                   val tyc_id = MU.tycId tyc                                   val tyc_id = MU.tycId tyc
1492                                   val (ee_dec,ee_env) =                                   val (ee_dec,ee_env) =
1493                                       case context                                       case context
1494                                        of EU.INFCT _ => let                                        of EU.INFCT _ =>
1495                                               val texp =                                           let val texp =
1496                                                   case EPC.lookTycEntPath(epContext,tyc_id)                                                   case EPC.lookTycEntPath(epContext,tyc_id)
1497                                                    of NONE => M.CONSTtyc tyc                                                    of NONE =>
1498                                                         M.CONSTtyc tyc (* nonvolatile *)
1499                                                     | SOME entPath =>                                                     | SOME entPath =>
1500                                                       M.VARtyc entPath                                                       M.VARtyc entPath
1501                                           in (M.TYCdec(ev,texp),                                           in (M.TYCdec(ev,texp),

Legend:
Removed from v.3507  
changed lines
  Added in v.3508

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