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

Diff of /sml/trunk/src/compiler/Elaborator/elaborate/elabcore.sml

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

revision 1644, Sat Oct 9 03:50:36 2004 UTC revision 1645, Mon Oct 11 21:37:17 2004 UTC
# Line 53  Line 53 
53      *)      *)
54  in  in
55    
56    fun cMARKexp (e, r) = if !ElabControl.markabsyn then MARKexp (e, r) else e
57    fun cMARKdec (d, r) = if !ElabControl.markabsyn then MARKdec (d, r) else d
58    
59  val say = Control_Print.say  val say = Control_Print.say
60  val debugging = ref false  val debugging = ref false
61  fun debugmsg (msg: string) = if !debugging then (say msg; say "\n") else ()  fun debugmsg (msg: string) = if !debugging then (say msg; say "\n") else ()
# Line 280  Line 283 
283    
284      (**** PATTERNS ****)      (**** PATTERNS ****)
285    
286      fun apply_pat (MarkPat(c,(l1,r1)),MarkPat(p,(l2,r2))) =      fun apply_pat (c as MarkPat(_,(l1,r1)),p as MarkPat(_,(l2,r2))) =
287            MarkPat(AppPat{constr=c, argument=p},(Int.min(l1,l2),Int.max(r1,r2)))            MarkPat(AppPat{constr=c, argument=p},(Int.min(l1,l2),Int.max(r1,r2)))
288        | apply_pat (c ,p) = AppPat{constr=c, argument=p}        | apply_pat (c ,p) = AppPat{constr=c, argument=p}
289    
290      fun tuple_pat (MarkPat(a,(l,_)),MarkPat(b,(_,r))) =      fun tuple_pat (a as MarkPat(_,(l,_)),b as MarkPat(_,(_,r))) =
291            MarkPat(TuplePat[a,b],(l,r))            MarkPat(TuplePat[a,b],(l,r))
292        | tuple_pat (a,b) = TuplePat[a,b]        | tuple_pat (a,b) = TuplePat[a,b]
293    
# Line 569  Line 572 
572                 end                 end
573             | MarkExp (exp,region) =>             | MarkExp (exp,region) =>
574                 let val (e,tyv,updt) = elabExp(exp,env,region)                 let val (e,tyv,updt) = elabExp(exp,env,region)
575                  in (if !ElabControl.markabsyn then MARKexp(e,region) else e,                  in (cMARKexp(e,region), tyv, updt)
                     tyv, updt)  
576                 end                 end
577             | SelectorExp s =>             | SelectorExp s =>
578                 (let val v = newVALvar s                 (let val v = newVALvar s
579                   in FNexp(completeMatch                   in FNexp(completeMatch
580                            [RULE(RECORDpat{fields=[(s,VARpat v)], flex=true,                            [RULE(RECORDpat{fields=[(s,VARpat v)], flex=true,
581                                            typ= ref UNDEFty},                                            typ= ref UNDEFty},
582                                  MARKexp(VARexp(ref v,[]),region))],UNDEFty)                                  cMARKexp(VARexp(ref v,[]),region))],UNDEFty)
583                  end,                  end,
584                  TS.empty, no_updt)                  TS.empty, no_updt)
585             | FlatAppExp items => elabExp(expParse(items,env,error),env,region))             | FlatAppExp items => elabExp(expParse(items,env,error),env,region))
# Line 699  Line 701 
701             | OvldDec dec  => elabOVERLOADdec(dec,env,rpath,region)             | OvldDec dec  => elabOVERLOADdec(dec,env,rpath,region)
702             | MarkDec(dec,region') =>             | MarkDec(dec,region') =>
703                 let val (d,env,tv,updt)= elabDec'(dec,env,rpath,region')                 let val (d,env,tv,updt)= elabDec'(dec,env,rpath,region')
704                  in (if !ElabControl.markabsyn then MARKdec(d,region') else d,                  in (cMARKdec(d,region'), env,tv,updt)
                     env,tv,updt)  
705                 end                 end
706             | StrDec _ => bug "strdec"             | StrDec _ => bug "strdec"
707             | AbsDec _ => bug "absdec"             | AbsDec _ => bug "absdec"
# Line 756  Line 757 
757    
758      (****  VALUE DECLARATIONS ****)      (****  VALUE DECLARATIONS ****)
759      and elabVB (MarkVb(vb,region),etvs,env,_) =      and elabVB (MarkVb(vb,region),etvs,env,_) =
760            elabVB(vb,etvs,env,region)          let val (d, tvs, u) = elabVB(vb,etvs,env,region)
761                val d' = cMARKdec (d, region)
762            in
763                (d', tvs, u)
764            end
765        | elabVB (Vb{pat,exp,lazyp},etvs,env,region) =        | elabVB (Vb{pat,exp,lazyp},etvs,env,region) =
766            let val (pat,pv) = elabPat(pat, env, region)            let val (pat,pv) = elabPat(pat, env, region)
767                val (exp,ev,updtExp) = elabExp(exp,env,region)                val (exp,ev,updtExp) = elabExp(exp,env,region)
# Line 859  Line 864 
864          in (SEQdec ds, bindVARp (pats,error region), TS.empty, updt)          in (SEQdec ds, bindVARp (pats,error region), TS.empty, updt)
865         end         end
866    
867      and elabRVB(MarkRvb(rvb,region),env,_) = elabRVB(rvb,env,region)      and elabRVB(MarkRvb(rvb,region),env,_) =
868            let val ({ match, ty, name }, tvs, u) = elabRVB(rvb,env,region)
869                val match' = cMARKexp (match, region)
870            in
871                ({ match = match', ty = ty, name = name }, tvs, u)
872            end
873        | elabRVB(Rvb{var,fixity,exp,resultty,lazyp},env,region) =        | elabRVB(Rvb{var,fixity,exp,resultty,lazyp},env,region) =
874           (case stripExpAst(exp,region)           (case stripExpAst(exp,region)
875              of (FnExp _,region')=>              of (FnExp _,region')=>
# Line 1021  Line 1031 
1031      and elabFUNdec(fb,etvs,env,rpath,region) =      and elabFUNdec(fb,etvs,env,rpath,region) =
1032          let val etvs = TS.mkTyvarset(ET.elabTyvList(etvs,error,region))          let val etvs = TS.mkTyvarset(ET.elabTyvList(etvs,error,region))
1033              (* makevar: parse the function header to determine the function name *)              (* makevar: parse the function header to determine the function name *)
1034              fun makevar _ (MarkFb(fb,region),ctx) = makevar region (fb,ctx)              fun makevar _ (MarkFb(fb,fbregion),ctx) = makevar fbregion (fb,ctx)
1035                | makevar region (Fb(clauses,lazyp),(lcl,env')) =                | makevar fbregion (Fb(clauses,lazyp),(lcl,env')) =
1036                   let fun getfix(SOME f) = LU.lookFix(env,f)                   let fun getfix(SOME f) = LU.lookFix(env,f)
1037                         | getfix NONE = Fixity.NONfix                         | getfix NONE = Fixity.NONfix
1038    
# Line 1092  Line 1102 
1102    
1103                       val _ = if List.exists (fn {funsym,...} =>                       val _ = if List.exists (fn {funsym,...} =>
1104                                          not(S.eq(var,funsym))) clauses                                          not(S.eq(var,funsym))) clauses
1105                               then  error region EM.COMPLAIN                               then  error fbregion EM.COMPLAIN
1106                                       "clauses don't all have same function name"                                       "clauses don't all have same function name"
1107                                       EM.nullErrorBody                                       EM.nullErrorBody
1108                               else ()                               else ()
1109    
1110  (* DBM: fix bug 1357  (* DBM: fix bug 1357
1111                       val _ = checkBoundConstructor(env,var,error region)                       val _ = checkBoundConstructor(env,var,error fbregion)
1112  *)  *)
1113                       val v = newVALvar var                       val v = newVALvar var
1114    
# Line 1109  Line 1119 
1119                                   in if List.exists                                   in if List.exists
1120                                          (fn {argpats,...} =>                                          (fn {argpats,...} =>
1121                                                len <> length argpats) rest                                                len <> length argpats) rest
1122                                      then error region EM.COMPLAIN                                      then error fbregion EM.COMPLAIN
1123                                     "clauses don't all have same number of patterns"                                     "clauses don't all have same number of patterns"
1124                                            EM.nullErrorBody                                            EM.nullErrorBody
1125                                      else ();                                      else ();
# Line 1148  Line 1158 
1158                                     argpats=map VarPat outerargs,                                     argpats=map VarPat outerargs,
1159                                     exp=curryApp(VarExp[lazyvar],                                     exp=curryApp(VarExp[lazyvar],
1160                                                       map VarExp outerargs)}                                                       map VarExp outerargs)}
1161                             in ((lv,innerclauses,region)::(v,[outerclause],region)                             in ((lv,innerclauses,fbregion)::(v,[outerclause],fbregion)
1162                                 ::lcl,                                 ::lcl,
1163                                 SE.bind(var,B.VALbind v,                                 SE.bind(var,B.VALbind v,
1164                                          SE.bind(lazyvar,B.VALbind lv, env')))                                          SE.bind(lazyvar,B.VALbind lv, env')))
1165                            end                            end
1166                       else ((v,clauses,region)::lcl,SE.bind(var,B.VALbind v,env'))                       else ((v,clauses,fbregion)::lcl,SE.bind(var,B.VALbind v,env'))
1167                   end (* makevar *)                   end (* makevar *)
1168              val (fundecs,env') = foldl (makevar region) ([],SE.empty) fb              val (fundecs,env') = foldl (makevar region) ([],SE.empty) fb
1169              val env'' = SE.atop(env',env)              val env'' = SE.atop(env',env)
# Line 1185  Line 1195 
1195                                    updt3::updt2)                                    updt3::updt2)
1196                               end)                               end)
1197                            ([],TS.empty,[]) clauses                            ([],TS.empty,[]) clauses
1198                   in ((var,rev cs1)::fs, union(tvs1,tvs,error region),                   in ((var,rev cs1,region)::fs, union(tvs1,tvs,error region),
1199                       updt1 @ updt)                       updt1 @ updt)
1200                  end                  end
1201              val (fbs1,ftyvars,updts) = foldl elabFundec ([],TS.empty,[]) fundecs              val (fbs1,ftyvars,updts) = foldl elabFundec ([],TS.empty,[]) fundecs
# Line 1198  Line 1208 
1208                   in tvref := TS.elements localtyvars;                   in tvref := TS.elements localtyvars;
1209                      app (fn f => f downtyvars) updts                      app (fn f => f downtyvars) updts
1210                  end                  end
1211              fun makefb (v as VALvar{path=SymPath.SPATH[_],...},cs) =              fun makefb (v as VALvar{path=SymPath.SPATH[_],...},cs,r) =
1212                    ({var=v,clauses=cs, tyvars=tvref})                    ({var=v,clauses=cs, tyvars=tvref,region=r})
1213                | makefb _ = bug "makeFUNdec.makefb"                | makefb _ = bug "makeFUNdec.makefb"
1214           in EU.checkUniq(error region, "duplicate function names in fun dec",           in EU.checkUniq(error region, "duplicate function names in fun dec",
1215                        (map (fn (VALvar{path=SymPath.SPATH[x],...},_) => x                        (map (fn (VALvar{path=SymPath.SPATH[x],...},_,_) => x
1216                               | _ => bug "makeFUNdec:checkuniq")                               | _ => bug "makeFUNdec:checkuniq")
1217                             fbs1));                             fbs1));
1218              (let val (ndec, nenv) =              (let val (ndec, nenv) =

Legend:
Removed from v.1644  
changed lines
  Added in v.1645

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