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/compiler/Semant/modules/evalent.sml
ViewVC logotype

Diff of /sml/trunk/src/compiler/Semant/modules/evalent.sml

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

revision 586, Thu Mar 30 05:08:07 2000 UTC revision 587, Thu Mar 30 09:01:52 2000 UTC
# Line 53  Line 53 
53               compInfo as {mkStamp,...}: EU.compInfo) =               compInfo as {mkStamp,...}: EU.compInfo) =
54        case tycExp        case tycExp
55         of CONSTtyc tycon => tycon         of CONSTtyc tycon => tycon
56          | FORMtyc (T.GENtyc {kind=T.DATATYPE{index=0, stamps, freetycs,          | FORMtyc (T.GENtyc { kind, arity, eq, path, ... }) =>
57                                                family, root=NONE},            (case kind of
58                                arity, eq, path, ...}) =>                 T.DATATYPE{index=0, stamps, freetycs, family, root=NONE} =>
59              let val viztyc = MU.transTycon entEnv              let val viztyc = MU.transTycon entEnv
60                  val nstamps = Vector.map (fn _ => mkStamp()) stamps                  val nstamps = Vector.map (fn _ => mkStamp()) stamps
61                  val nst = Vector.sub(nstamps,0)                  val nst = Vector.sub(nstamps,0)
62                  val nfreetycs = map viztyc freetycs                  val nfreetycs = map viztyc freetycs
63                  val _ = EPC.bindPath(epc,MI.TYCid(nst),entv)                     val _ = EPC.bindTycPath (epc, nst, entv)
64                   in
65               in T.GENtyc{stamp=nst, arity=arity, eq=eq,                     T.GENtyc{stamp=nst, arity=arity, eq=eq,
66                           kind=T.DATATYPE{index=0, stamps=nstamps, root=NONE,                              kind=T.DATATYPE{index=0, stamps=nstamps,
67                                           freetycs=nfreetycs, family=family},                                              root=NONE,
68                           path=IP.append(rpath,path)}                                              freetycs=nfreetycs,
69                                                family=family},
70                                path=IP.append(rpath,path), stub=NONE}
71              end              end
72          | FORMtyc (T.GENtyc {kind=T.DATATYPE{index=i, root=SOME rtev, ...},               | T.DATATYPE{index=i, root=SOME rtev, ...} =>
                              arity, eq, path, ...}) =>  
73              let val (nstamps, nfreetycs, nfamily) =              let val (nstamps, nfreetycs, nfamily) =
74                    case EE.lookTycEnt(entEnv, rtev)                    case EE.lookTycEnt(entEnv, rtev)
75                     of (T.GENtyc{kind=T.DATATYPE{stamps,freetycs,family,...},                          of T.GENtyc { kind = T.DATATYPE dt, ... } =>
76                                  ...}) =>                             (#stamps dt, #freetycs dt, #family dt)
77                          (stamps, freetycs, family)                           | _ => bug "unexpected case in evalTyc-FMGENtyc (2)"
                     | _ => bug "unexpected case in evalTyc-FMGENtyc"  
78                  val nst = Vector.sub(nstamps,i)                  val nst = Vector.sub(nstamps,i)
79                  val _ = EPC.bindPath(epc,MI.TYCid(nst),entv)                     val _ = EPC.bindTycPath (epc, nst, entv)
80                   in
81               in T.GENtyc{stamp=nst, arity=arity,                     T.GENtyc{stamp=nst, arity=arity,
82                           kind=T.DATATYPE{index=i, stamps=nstamps, root=NONE,                              kind=T.DATATYPE{index=i, stamps=nstamps,
83                                           freetycs=nfreetycs, family=nfamily},                                              root=NONE,
84                           path=IP.append(rpath,path), eq=eq}                                              freetycs=nfreetycs,
85                                                family=nfamily},
86                                path=IP.append(rpath,path),
87                                eq=eq, stub=NONE}
88              end              end
89                 | _ => bug "unexpected GENtyc in evalTyc")
90          | FORMtyc (T.DEFtyc{stamp,tyfun=T.TYFUN{arity, body},strict,path}) =>          | FORMtyc (T.DEFtyc{stamp,tyfun=T.TYFUN{arity, body},strict,path}) =>
91              let val nst = mkStamp()              let val nst = mkStamp()
92                  val _ = EPC.bindPath(epc,MI.TYCid(nst),entv)                (* tycId=stamp (this should perhaps be more abstract some day) *)
93               in T.DEFtyc{stamp = nst,                val _ = EPC.bindTycPath (epc, nst, entv)
94              in
95                  T.DEFtyc{stamp = nst,
96                           tyfun=T.TYFUN{arity=arity,                           tyfun=T.TYFUN{arity=arity,
97                                         body=MU.transType entEnv body},                                         body=MU.transType entEnv body},
98                           strict=strict, path=IP.append(rpath,path)}                           strict=strict, path=IP.append(rpath,path)}
# Line 110  Line 116 
116              let val epc = EPC.enterOpen(epc, entsv)              let val epc = EPC.enterOpen(epc, entsv)
117                  val stp = evalStp(stamp, depth, epc, entEnv, compInfo)                  val stp = evalStp(stamp, depth, epc, entEnv, compInfo)
118                  val env = evalDec(entDec, depth, epc, entEnv, rpath, compInfo)                  val env = evalDec(entDec, depth, epc, entEnv, rpath, compInfo)
119               in ({stamp = stp, entities = env,              in
120                    lambdaty = ref NONE, rpath = rpath}, entEnv)                  ({stamp = stp, entities=env, lambdaty=ref NONE,
121                      rpath = rpath, stub = NONE},
122                     entEnv)
123              end              end
124    
125          | APPLY (fctExp, strExp) =>          | APPLY (fctExp, strExp) =>
# Line 147  Line 155 
155                     we have to bind them to the epcontext.                     we have to bind them to the epcontext.
156                   *)                   *)
157                  val epc = EPC.enterOpen(epc, entsv)                  val epc = EPC.enterOpen(epc, entsv)
158                  fun h (T.GENtyc{stamp, ...}, ep) =                  fun h (T.GENtyc gt, ep) =
159                           EPC.bindLongPath(epc,MI.TYCid(stamp),ep)                      EPC.bindTycLongPath (epc, MI.tycId gt, ep)
160                    | h _ = ()                    | h _ = ()
161                  val _ = ListPair.app h (abstycs, tyceps)                  val _ = ListPair.app h (abstycs, tyceps)
162               in (rlzn, entEnv1)               in (rlzn, entEnv1)
# Line 182  Line 190 
190    
191          | LAMBDA{param, body} =>          | LAMBDA{param, body} =>
192              let val clos = CLOSURE{param=param, body=body, env=entEnv}              let val clos = CLOSURE{param=param, body=body, env=entEnv}
193               in ({stamp=mkStamp(), closure=clos, lambdaty=ref NONE,               in ({stamp = mkStamp (),
194                    tycpath=NONE, rpath=IP.IPATH[anonFctSym]}, entEnv)                    closure=clos, lambdaty=ref NONE,
195                      tycpath=NONE,
196                      rpath=IP.IPATH[anonFctSym],
197                      stub=NONE},
198                     entEnv)
199              end              end
200    
201          | LAMBDA_TP{param, body, sign as FSIG{paramsig, bodysig, ...}} =>          | LAMBDA_TP{param, body, sign as FSIG{paramsig, bodysig, ...}} =>
# Line 206  Line 218 
218                     in T.TP_FCT(paramTps, bodyTps)                     in T.TP_FCT(paramTps, bodyTps)
219                    end                    end
220    
221               in ({stamp=mkStamp(), closure=clos, lambdaty=ref NONE,               in ({stamp = mkStamp(),
222                   tycpath=SOME tps, rpath=IP.IPATH[anonFctSym]}, entEnv)                    closure=clos, lambdaty=ref NONE,
223                      tycpath=SOME tps, rpath=IP.IPATH[anonFctSym],
224                      stub = NONE},
225                     entEnv)
226              end              end
227    
228          | LETfct (entDec, fctExp) =>          | LETfct (entDec, fctExp) =>
# Line 220  Line 235 
235    
236          | _ => bug "unexpected cases in evalFct"          | _ => bug "unexpected cases in evalFct"
237    
238  and evalApp(fctRlzn as {closure=CLOSURE{param, body, env}, tycpath, ...} :  and evalApp(fctRlzn : Modules.fctEntity, argRlzn, depth, epc, rpath,
             Modules.fctEntity, argRlzn, depth, epc, rpath,  
239              compInfo as {mkStamp, ...} : EU.compInfo) =              compInfo as {mkStamp, ...} : EU.compInfo) =
240        let val nenv = EE.mark(mkStamp, EE.bind(param, STRent argRlzn, env))        let val {closure=CLOSURE{param, body, env}, tycpath, ...} = fctRlzn
241              val nenv = EE.mark(mkStamp, EE.bind(param, STRent argRlzn, env))
242            val  _ = debugmsg ("[Inside EvalAPP] ......")            val  _ = debugmsg ("[Inside EvalAPP] ......")
243         in case (body, tycpath)         in case (body, tycpath)
244             of (FORMstr(FSIG{paramsig, bodysig, ...}), SOME tp) =>             of (FORMstr(FSIG{paramsig, bodysig, ...}), SOME tp) =>
# Line 240  Line 255 
255                                     rpath=rpath, region=S.nullRegion,                                     rpath=rpath, region=S.nullRegion,
256                                     compInfo=compInfo}                                     compInfo=compInfo}
257    
258                     fun h (T.GENtyc{stamp, ...}, ep) =                     fun h (T.GENtyc gt, ep) =
259                             EPC.bindLongPath(epc,MI.TYCid(stamp),ep)                         EPC.bindTycLongPath (epc, MI.tycId gt, ep)
260                       | h _ = ()                       | h _ = ()
261                     val _ = ListPair.app h (abstycs, tyceps)                     val _ = ListPair.app h (abstycs, tyceps)
262                  in rlzn                  in rlzn
# Line 305  Line 320 
320  and evalStp (stpExp, depth, epc, entEnv,  and evalStp (stpExp, depth, epc, entEnv,
321               compInfo as {mkStamp,...}: EU.compInfo) =               compInfo as {mkStamp,...}: EU.compInfo) =
322        case stpExp        case stpExp
323         of CONST stamp     => stamp         of (* CONST stamp     => stamp
324          | NEW             => mkStamp()          | *) NEW             => mkStamp()
325          | GETSTAMP strExp =>          | GETSTAMP strExp => #stamp (#1 (evalStr(strExp, depth, epc, NONE,
326              let val (strEnt, _) =                                                   entEnv, IP.empty, compInfo)))
                   evalStr(strExp, depth, epc, NONE,  
                           entEnv, IP.empty, compInfo)  
              in #stamp(strEnt)  
             end  
327    
328  (*  (*
329  val evalApp = Stats.doPhase(Stats.makePhase "Compiler 044 x-evalApp") evalApp  val evalApp = Stats.doPhase(Stats.makePhase "Compiler 044 x-evalApp") evalApp
# Line 320  Line 331 
331    
332  end (* toplevel local *)  end (* toplevel local *)
333  end (* structure EvalEntity *)  end (* structure EvalEntity *)
   

Legend:
Removed from v.586  
changed lines
  Added in v.587

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