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/elaborate/elabcore.sml
ViewVC logotype

Diff of /sml/trunk/src/compiler/Semant/elaborate/elabcore.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 122  Line 122 
122                             [], EE.empty, isFree, rpath, region, compInfo)                             [], EE.empty, isFree, rpath, region, compInfo)
123    
124        val (body,env2) =        val (body,env2) =
125          elabDec(body,Env.atop(env1,env),isFree,rpath,region,compInfo)          elabDec(body,SE.atop(env1,env),isFree,rpath,region,compInfo)
126    
127        (* datatycs will be changed to abstycs during type checking        (* datatycs will be changed to abstycs during type checking
128           by changing the eqprop field *)           by changing the eqprop field *)
129        fun bind (x, e) = Env.bind(TU.tycName x, B.TYCbind x, e)        fun bind (x, e) = SE.bind(TU.tycName x, B.TYCbind x, e)
130        val envt = foldl bind (foldl bind Env.empty datatycs) withtycs        val envt = foldl bind (foldl bind SE.empty datatycs) withtycs
131    
132     in (ABSTYPEdec{abstycs=datatycs,withtycs=withtycs,body=body},     in (ABSTYPEdec{abstycs=datatycs,withtycs=withtycs,body=body},
133         Env.atop(env2,envt))         SE.atop(env2,envt))
134    end (* function elabABSTYPEdec *)    end (* function elabABSTYPEdec *)
135    
136    
# Line 229  Line 229 
229                               rep=EXN(LVAR(mkv(SOME id))), sign=CNIL}                               rep=EXN(LVAR(mkv(SOME id))), sign=CNIL}
230                  in ([EBgen{exn=exn, etype=NONE,                  in ([EBgen{exn=exn, etype=NONE,
231                             ident=STRINGexp(S.name id)}],                             ident=STRINGexp(S.name id)}],
232                      Env.bind(id, B.CONbind exn, Env.empty),TS.empty)                      SE.bind(id, B.CONbind exn, SE.empty),TS.empty)
233                 end                 end
234             | EbGen{exn=id,etype=SOME typ} =>             | EbGen{exn=id,etype=SOME typ} =>
235                 let val (ty,vt) = ET.elabType(typ,env,error,region)                 let val (ty,vt) = ET.elabType(typ,env,error,region)
# Line 238  Line 238 
238                               rep=EXN(LVAR(mkv(SOME id))), sign=CNIL}                               rep=EXN(LVAR(mkv(SOME id))), sign=CNIL}
239                  in ([EBgen{exn=exn,etype=SOME ty,                  in ([EBgen{exn=exn,etype=SOME ty,
240                             ident=STRINGexp(S.name id)}],                             ident=STRINGexp(S.name id)}],
241                      Env.bind(id,B.CONbind exn, Env.empty),vt)                      SE.bind(id,B.CONbind exn, SE.empty),vt)
242                 end                 end
243             | EbDef{exn=id,edef=qid} =>             | EbDef{exn=id,edef=qid} =>
244                 let val edef as DATACON{const,typ,sign,...} =                 let val edef as DATACON{const,typ,sign,...} =
# Line 247  Line 247 
247                     val exn = DATACON{name=id, const=const, typ=typ, lazyp=false,                     val exn = DATACON{name=id, const=const, typ=typ, lazyp=false,
248                                       sign=sign, rep=nrep}                                       sign=sign, rep=nrep}
249                  in ([EBdef{exn=exn,edef=edef}],                  in ([EBdef{exn=exn,edef=edef}],
250                      Env.bind(id,B.CONbind exn,Env.empty),TS.empty)                      SE.bind(id,B.CONbind exn,SE.empty),TS.empty)
251                 end                 end
252             | MarkEb(eb,region) => elabEb region env eb             | MarkEb(eb,region) => elabEb region env eb
253    
# Line 256  Line 256 
256                foldl                foldl
257                  (fn (exc1,(ebs1,env1,vt1)) =>                  (fn (exc1,(ebs1,env1,vt1)) =>
258                     let val (eb2,env2,vt2) = elabEb region env exc1                     let val (eb2,env2,vt2) = elabEb region env exc1
259                      in (eb2@ebs1, Env.atop(env2,env1),                      in (eb2@ebs1, SE.atop(env2,env1),
260                          union(vt1,vt2,error region))                          union(vt1,vt2,error region))
261                     end)                     end)
262                   ([],Env.empty,TS.empty) excbinds                   ([],SE.empty,TS.empty) excbinds
263              fun getname(EBgen{exn=DATACON{name,...},...}) = name              fun getname(EBgen{exn=DATACON{name,...},...}) = name
264                | getname(EBdef{exn=DATACON{name,...},...}) = name                | getname(EBdef{exn=DATACON{name,...},...}) = name
265           in EU.checkUniq (error region, "duplicate exception declaration",           in EU.checkUniq (error region, "duplicate exception declaration",
# Line 387  Line 387 
387                      in IntStrMap.app (checkComplete (length pats)) tbl;                      in IntStrMap.app (checkComplete (length pats)) tbl;
388                         pats                         pats
389                     end (* freeOrVars *)                     end (* freeOrVars *)
390                 val (pat::pats) = freeOrVars ps                   | freeOrVars _ = bug "freeOrVars"
391                   val (pat, pats) =
392                       case freeOrVars ps of
393                           (h::t) => (h, t)
394                         | _ => bug "elabPat:no free or vars"
395                 fun foldOr (p, []) = p                 fun foldOr (p, []) = p
396                   | foldOr (p, p'::r) = ORpat(p, foldOr(p', r))                   | foldOr (p, p'::r) = ORpat(p, foldOr(p', r))
397              in (foldOr(pat, pats), tyv)              in (foldOr(pat, pats), tyv)
# Line 520  Line 524 
524             | LetExp {dec,expr} =>             | LetExp {dec,expr} =>
525                 let val (d1,e1,tv1,updt1) =                 let val (d1,e1,tv1,updt1) =
526                            elabDec'(dec,env,IP.IPATH[],region)                            elabDec'(dec,env,IP.IPATH[],region)
527                     val (e2,tv2,updt2) = elabExp(expr,Env.atop(e1,env),region)                     val (e2,tv2,updt2) = elabExp(expr,SE.atop(e1,env),region)
528                     fun updt tv = (updt1 tv;updt2 tv)                     fun updt tv = (updt1 tv;updt2 tv)
529                  in (LETexp(d1,e2), union(tv1,tv2,error region),updt)                  in (LETexp(d1,e2), union(tv1,tv2,error region),updt)
530                 end                 end
# Line 621  Line 625 
625      and elabRule(Rule{pat,exp},env,region)  =      and elabRule(Rule{pat,exp},env,region)  =
626          let val region' = case pat of MarkPat (p,reg) => reg | _ => region          let val region' = case pat of MarkPat (p,reg) => reg | _ => region
627              val (p,tv1) = elabPat(pat, env, region)              val (p,tv1) = elabPat(pat, env, region)
628              val env' = Env.atop(bindVARp ([p],error region'), env)              val env' = SE.atop(bindVARp ([p],error region'), env)
629              val (e,tv2,updt) = elabExp(exp,env',region)              val (e,tv2,updt) = elabExp(exp,env',region)
630           in (RULE(p,e),union(tv1,tv2,error region),updt)           in (RULE(p,e),union(tv1,tv2,error region),updt)
631          end          end
# Line 688  Line 692 
692             | OpenDec ds => elabOPENdec(ds,env,region)             | OpenDec ds => elabOPENdec(ds,env,region)
693             | FixDec (ds as {fixity,ops}) =>             | FixDec (ds as {fixity,ops}) =>
694                 let val env =                 let val env =
695                   foldr (fn (id,env) => Env.bind(id,B.FIXbind fixity,env))                   foldr (fn (id,env) => SE.bind(id,B.FIXbind fixity,env))
696                          Env.empty ops                          SE.empty ops
697                  in (FIXdec ds,env,TS.empty,no_updt)                  in (FIXdec ds,env,TS.empty,no_updt)
698                 end                 end
699             | OvldDec dec  => elabOVERLOADdec(dec,env,rpath,region)             | OvldDec dec  => elabOVERLOADdec(dec,env,rpath,region)
# Line 722  Line 726 
726              fun updt tv: unit = app (fn f => f tv) exps3              fun updt tv: unit = app (fn f => f tv) exps3
727              val ovldvar = OVLDvar{name=id,scheme=scheme,              val ovldvar = OVLDvar{name=id,scheme=scheme,
728                                    options=ref(map option exps1)}                                    options=ref(map option exps1)}
729           in (OVLDdec ovldvar, Env.bind(id,B.VALbind ovldvar,Env.empty),           in (OVLDdec ovldvar, SE.bind(id,B.VALbind ovldvar,SE.empty),
730               TS.empty, updt)               TS.empty, updt)
731          end          end
732    
# Line 731  Line 735 
735      and elabLOCALdec((ldecs1,ldecs2),env,rpath:IP.path,region) =      and elabLOCALdec((ldecs1,ldecs2),env,rpath:IP.path,region) =
736          let val (ld1,env1,tv1,updt1) = elabDec'(ldecs1,env,IP.IPATH[],region)          let val (ld1,env1,tv1,updt1) = elabDec'(ldecs1,env,IP.IPATH[],region)
737              val (ld2,env2,tv2,updt2) =              val (ld2,env2,tv2,updt2) =
738                    elabDec'(ldecs2,Env.atop(env1,env),rpath,region)                    elabDec'(ldecs2,SE.atop(env1,env),rpath,region)
739              fun updt tv = (updt1 tv;updt2 tv)              fun updt tv = (updt1 tv;updt2 tv)
740           in (LOCALdec(ld1,ld2), env2,union(tv1,tv2,error region),updt)           in (LOCALdec(ld1,ld2), env2,union(tv1,tv2,error region),updt)
741          end          end
# Line 892  Line 896 
896                    let val v = newVALvar var                    let val v = newVALvar var
897                        val nv = newVALvar var (* DBM: what is this for? *)                        val nv = newVALvar var (* DBM: what is this for? *)
898                     in (* checkBoundConstructor(env,var,error region); -- fix bug 1357 *)                     in (* checkBoundConstructor(env,var,error region); -- fix bug 1357 *)
899                        env' := Env.bind(var,B.VALbind v,!env');                        env' := SE.bind(var,B.VALbind v,!env');
900                        (v, p)                        (v, p)
901                    end                    end
902                | makevar _ (p as MarkRvb(rvb,region)) =                | makevar _ (p as MarkRvb(rvb,region)) =
903                    let val (v,_) = makevar region rvb in (v,p) end                    let val (v,_) = makevar region rvb in (v,p) end
904    
905              val rvbs' = map (makevar region) rvbs              val rvbs' = map (makevar region) rvbs
906              val env'' = Env.atop(!env', env)              val env'' = SE.atop(!env', env)
907              val (rvbs,tyvars,updts)=              val (rvbs,tyvars,updts)=
908                  foldl (fn((v,rvb1),(rvbs1,tvs1,updt1)) =>                  foldl (fn((v,rvb1),(rvbs1,tvs1,updt1)) =>
909                             let val (rvb2,tv2,updt2) =                             let val (rvb2,tv2,updt2) =
# Line 949  Line 953 
953    
954              fun elabFn((exp,lazyp),(fexps,tvs,updts)) =              fun elabFn((exp,lazyp),(fexps,tvs,updts)) =
955                  let val (p,tv1) = elabPat(argpat, env, region)                  let val (p,tv1) = elabPat(argpat, env, region)
956                      val env' = Env.atop(bindVARp ([p],error region), env)                      val env' = SE.atop(bindVARp ([p],error region), env)
957                      val (e,tv2,updt) = elabExp(exp,env',region)                      val (e,tv2,updt) = elabExp(exp,env',region)
958                  in (FNexp(completeMatch[RULE(p,if lazyp then e else delayExp e)],                  in (FNexp(completeMatch[RULE(p,if lazyp then e else delayExp e)],
959                            UNDEFty)::fexps,                            UNDEFty)::fexps,
# Line 992  Line 996 
996    
997              fun zip3(x::xs,y::ys,z::zs) = (x,y,z)::zip3(xs,ys,zs)              fun zip3(x::xs,y::ys,z::zs) = (x,y,z)::zip3(xs,ys,zs)
998                | zip3(nil,_,_) = nil                | zip3(nil,_,_) = nil
999                  | zip3 _ = bug "zip3"
1000    
1001              val (vbs,vars) =              val (vbs,vars) =
1002                  foldr forceStrict ([],[]) (zip3(lhsSyms,lhsVars,map #2 exps))                  foldr forceStrict ([],[]) (zip3(lhsSyms,lhsVars,map #2 exps))
# Line 1037  Line 1042 
1042                                 error region EM.COMPLAIN                                 error region EM.COMPLAIN
1043                                   ("infix operator \"" ^ S.name sym ^                                   ("infix operator \"" ^ S.name sym ^
1044                                    "\" used without \"op\" in fun dec")                                    "\" used without \"op\" in fun dec")
1045                                   EM.nullErrorBody;                                   EM.nullErrorBody
1046                                | _ => bug "ensureNonfix";
1047                            item)                            item)
1048    
1049                       fun getname(MarkPat(p,region),_) = getname(p,region)                       fun getname(MarkPat(p,region),_) = getname(p,region)
# Line 1061  Line 1067 
1067                         | parse' ((a as {region,...}) :: rest) =                         | parse' ((a as {region,...}) :: rest) =
1068                             (getname(ensureNonfix a, region),                             (getname(ensureNonfix a, region),
1069                              map ensureNonfix rest)                              map ensureNonfix rest)
1070                           | parse' [] = bug "parse':[]"
1071    
1072                       fun parse({item=MarkPat(p,_),region,fixity}::rest) =                       fun parse({item=MarkPat(p,_),region,fixity}::rest) =
1073                             parse({item=p,region=region,fixity=fixity}::rest)                             parse({item=p,region=region,fixity=fixity}::rest)
# Line 1078  Line 1085 
1085                                resultty=resultty,exp=exp}                                resultty=resultty,exp=exp}
1086                           end                           end
1087    
1088                       val clauses as {funsym=var,...}::_ =                       val (clauses, var) =
1089                           map parseClause clauses                           case map parseClause clauses of
1090                                 [] => bug "elabcore:no clauses"
1091                               | (l as ({funsym=var,...}::_)) => (l,var)
1092    
1093                       val _ = if List.exists (fn {funsym,...} =>                       val _ = if List.exists (fn {funsym,...} =>
1094                                          not(S.eq(var,funsym))) clauses                                          not(S.eq(var,funsym))) clauses
# Line 1141  Line 1150 
1150                                                       map VarExp outerargs)}                                                       map VarExp outerargs)}
1151                             in ((lv,innerclauses,region)::(v,[outerclause],region)                             in ((lv,innerclauses,region)::(v,[outerclause],region)
1152                                 ::lcl,                                 ::lcl,
1153                                 Env.bind(var,B.VALbind v,                                 SE.bind(var,B.VALbind v,
1154                                          Env.bind(lazyvar,B.VALbind lv, env')))                                          SE.bind(lazyvar,B.VALbind lv, env')))
1155                            end                            end
1156                       else ((v,clauses,region)::lcl,Env.bind(var,B.VALbind v,env'))                       else ((v,clauses,region)::lcl,SE.bind(var,B.VALbind v,env'))
1157                   end (* makevar *)                   end (* makevar *)
1158              val (fundecs,env') = foldl (makevar region) ([],Env.empty) fb              val (fundecs,env') = foldl (makevar region) ([],SE.empty) fb
1159              val env'' = Env.atop(env',env)              val env'' = SE.atop(env',env)
1160              fun elabClause(region,({kind,argpats,resultty,exp,funsym})) =              fun elabClause(region,({kind,argpats,resultty,exp,funsym})) =
1161                  let val (pats,tv1) = elabPatList(argpats, env, region)                  let val (pats,tv1) = elabPatList(argpats, env, region)
1162                      val nenv = Env.atop(bindVARp(pats,error region), env'')                      val nenv = SE.atop(bindVARp(pats,error region), env'')
1163                      val (exp,tv2,updt) = elabExp(exp, nenv,region)                      val (exp,tv2,updt) = elabExp(exp, nenv,region)
1164                      (* LAZY: wrap delay or force around rhs as appropriate*)                      (* LAZY: wrap delay or force around rhs as appropriate*)
1165                      val exp =                      val exp =
# Line 1208  Line 1217 
1217                foldl                foldl
1218                 (fn (decl2,(ds2,env2,tvs2,updt2)) =>                 (fn (decl2,(ds2,env2,tvs2,updt2)) =>
1219                    let val (d3,env3,tvs3,updt3) =                    let val (d3,env3,tvs3,updt3) =
1220                             elabDec'(decl2,Env.atop(env2,env),rpath,region)                             elabDec'(decl2,SE.atop(env2,env),rpath,region)
1221                     in (d3::ds2, Env.atop(env3,env2),                     in (d3::ds2, SE.atop(env3,env2),
1222                         union(tvs3,tvs2,error region), updt3::updt2)                         union(tvs3,tvs2,error region), updt3::updt2)
1223                    end)                    end)
1224                 ([],Env.empty,TS.empty,[]) ds                 ([],SE.empty,TS.empty,[]) ds
1225              fun updt tv : unit = app (fn f => f tv) updt1              fun updt tv : unit = app (fn f => f tv) updt1
1226           in (SEQdec(rev ds1),env1,tv1,updt)           in (SEQdec(rev ds1),env1,tv1,updt)
1227          end          end

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