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/types/typecheck.sml
ViewVC logotype

Diff of /sml/trunk/src/compiler/Elaborator/types/typecheck.sml

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

revision 1680, Sat Oct 30 16:02:13 2004 UTC revision 1681, Mon Nov 8 23:03:24 2004 UTC
# Line 17  Line 17 
17  struct  struct
18    
19  local open Array List Types VarCon BasicTypes TypesUtil Unify Absyn  local open Array List Types VarCon BasicTypes TypesUtil Unify Absyn
20             Overload ErrorMsg PrettyPrint PPUtil PPType PPAbsyn             ErrorMsg PrettyPrint PPUtil PPType PPAbsyn
21    
22    structure SE = StaticEnv    structure SE = StaticEnv
23    (* structure II = InlInfo *)    (* structure II = InlInfo *)
24    structure DA = Access    structure DA = Access
25    structure EU = ElabUtil    structure EU = ElabUtil
26    structure ED = ElabDebug    structure ED = ElabDebug
   structure OLL = OverloadLit  
27    structure PP = PrettyPrint    structure PP = PrettyPrint
28    
29  in  in
# Line 60  Line 59 
59  fun decType(env,dec,toplev,err,region) =  fun decType(env,dec,toplev,err,region) =
60  let  let
61    
62    val { push = oll_push, resolve = oll_resolve } = OverloadLit.new ()
63    val { push = ol_push, resolve = ol_resolve } = Overload.new ()
64    
65  val ppType = PPType.ppType env  val ppType = PPType.ppType env
66  val ppPat = PPAbsyn.ppPat env  val ppPat = PPAbsyn.ppPat env
67  val ppExp = PPAbsyn.ppExp(env,NONE)  val ppExp = PPAbsyn.ppExp(env,NONE)
# Line 294  Line 296 
296                (typ := mkMETAtyBounded depth; (pat,!typ))                (typ := mkMETAtyBounded depth; (pat,!typ))
297                                       (* multiple occurrence due to or-pat *)                                       (* multiple occurrence due to or-pat *)
298         | VARpat(VALvar{typ, ...}) => (pat, !typ)         | VARpat(VALvar{typ, ...}) => (pat, !typ)
299         | INTpat (_,ty) => (OLL.push ty; (pat,ty))         | INTpat (_,ty) => (oll_push ty; (pat,ty))
300         | WORDpat (_,ty) => (OLL.push ty; (pat,ty))         | WORDpat (_,ty) => (oll_push ty; (pat,ty))
301         | REALpat _ => (pat,realTy)         | REALpat _ => (pat,realTy)
302         | STRINGpat _ => (pat,stringTy)         | STRINGpat _ => (pat,stringTy)
303         | CHARpat _ => (pat,charTy)         | CHARpat _ => (pat,charTy)
# Line 417  Line 419 
419                in (VARexp(r, insts), ty)                in (VARexp(r, insts), ty)
420                end)                end)
421         | VARexp(refvar as ref(OVLDvar _),_) =>         | VARexp(refvar as ref(OVLDvar _),_) =>
422              (exp,pushOverloaded(refvar, err region))              (exp, ol_push (refvar, err region))
423         | VARexp(r as ref ERRORvar, _) => (exp, WILDCARDty)         | VARexp(r as ref ERRORvar, _) => (exp, WILDCARDty)
424         | CONexp(dcon as DATACON{typ,...},_) =>         | CONexp(dcon as DATACON{typ,...},_) =>
425             let val (ty,insts) = instantiatePoly typ             let val (ty,insts) = instantiatePoly typ
426              in (CONexp(dcon,insts),ty)              in (CONexp(dcon,insts),ty)
427             end             end
428         | INTexp (_,ty) => (OLL.push ty; (exp,ty))         | INTexp (_,ty) => (oll_push ty; (exp,ty))
429         | WORDexp (_,ty) => (OLL.push ty; (exp,ty))         | WORDexp (_,ty) => (oll_push ty; (exp,ty))
430         | REALexp _ => (exp,realTy)         | REALexp _ => (exp,realTy)
431         | STRINGexp _ => (exp,stringTy)         | STRINGexp _ => (exp,stringTy)
432         | CHARexp _ => (exp,charTy)         | CHARexp _ => (exp,charTy)
# Line 853  Line 855 
855  and strbType (occ,region) (STRB{str,def,name}) =  and strbType (occ,region) (STRB{str,def,name}) =
856      STRB{str=str,def=strexpType (occ,region) def,name=name}      STRB{str=str,def=strexpType (occ,region) def,name=name}
857    
 val _ = debugmsg ">>decType: resetOverloaded"  
 val _ = resetOverloaded()  
 val _ = debugmsg ">>decType: OverloadedLit.reset"  
 val _ = OLL.reset ()  
858  val _ = debugmsg ">>decType: calling decType0"  val _ = debugmsg ">>decType: calling decType0"
859  val dec' = decType0(dec, if toplev then Root else (LetDef Root), region);  val dec' = decType0(dec, if toplev then Root else (LetDef Root), region);
860  val _ = debugmsg ">>decType: OverloadedLit.resolve"  in
861  val _ = OLL.resolve ()      oll_resolve ();
862  val _ = debugmsg ">>decType: resolveOverloaded"      ol_resolve env;
863  val _ = resolveOverloaded env      debugmsg "<<decType: returning";
864  val _ = debugmsg "<<decType: returning"      dec'
  in dec'  
865  end (* function decType *)  end (* function decType *)
866    
867  val decType = Stats.doPhase (Stats.makePhase "Compiler 035 typecheck") decType  val decType = Stats.doPhase (Stats.makePhase "Compiler 035 typecheck") decType

Legend:
Removed from v.1680  
changed lines
  Added in v.1681

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