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

Diff of /sml/branches/primop-branch/src/compiler/Elaborator/types/typecheck.sml

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

sml/trunk/src/compiler/Elaborator/types/typecheck.sml revision 1332, Sun May 18 03:21:16 2003 UTC sml/branches/primop-branch/src/compiler/Elaborator/types/typecheck.sml revision 1475, Fri Apr 9 19:05:33 2004 UTC
# Line 11  Line 11 
11  end (* signature TYPECHECK *)  end (* signature TYPECHECK *)
12    
13    
14  (* functorized to factor out dependencies on FLINT... *)  (* No longer functorized to factor out dependencies on FLINT (ii2ty, ii_ispure)
15  functor TypecheckFn (val ii_ispure : II.ii -> bool   * Instead, TypesUtil depends directly on InlInfo -- it calls InlInfo.pureInfo to test
16                       val ii2ty : II.ii -> Types.ty option) : TYPECHECK =   * for the CAST primop in function isValue. *)
17    
18    structure Typecheck : TYPECHECK =
19  struct  struct
20    
21  local open Array List Types VarCon BasicTypes TypesUtil Unify Absyn  local open Array List Types VarCon BasicTypes TypesUtil Unify Absyn
# Line 25  Line 27 
27    structure EU = ElabUtil    structure EU = ElabUtil
28    structure ED = ElabDebug    structure ED = ElabDebug
29    structure OLL = OverloadLit    structure OLL = OverloadLit
30      structure PP = PrettyPrint
31    
32  in  in
33    
# Line 36  Line 39 
39    
40  fun bug msg = ErrorMsg.impossible("TypeCheck: "^msg)  fun bug msg = ErrorMsg.impossible("TypeCheck: "^msg)
41    
 val isValue = isValue { ii_ispure = ii_ispure }  
   
42  infix 9 sub  infix 9 sub
43  infix -->  infix -->
44    
# Line 90  Line 91 
91                val m = if m="" then name1 ^ " and " ^ name2 ^ " don't agree"                val m = if m="" then name1 ^ " and " ^ name2 ^ " don't agree"
92                        else m                        else m
93            in if name1="" then ()            in if name1="" then ()
94               else (add_newline ppstrm;               else (newline ppstrm;
95                     add_string ppstrm (name1 ^ ": " ^ pad1);                     PP.string ppstrm (name1 ^ ": " ^ pad1);
96                     ppType ppstrm ty1);                     ppType ppstrm ty1);
97               if name2="" then ()               if name2="" then ()
98                else (add_newline ppstrm;                else (newline ppstrm;
99                      add_string ppstrm (name2 ^ ": " ^ pad2);                      PP.string ppstrm (name2 ^ ": " ^ pad2);
100                      ppType ppstrm ty2);                      ppType ppstrm ty2);
101               if kindname="" then ()               if kindname="" then ()
102               else (add_newline ppstrm; add_string ppstrm("in "^kindname^":");               else (newline ppstrm; PP.string ppstrm("in "^kindname^":");
103                     add_break ppstrm (1,2); kind ppstrm (phrase,!printDepth))                     break ppstrm {nsp=1,offset=2}; kind ppstrm (phrase,!printDepth))
104           end));           end));
105         false)         false)
106    
# Line 163  Line 164 
164                                  \names of ALL the fields\n in this context)"                                  \names of ALL the fields\n in this context)"
165                              (fn ppstrm =>                              (fn ppstrm =>
166                                 (PPType.resetPPType();                                 (PPType.resetPPType();
167                                  add_newline ppstrm;                                  newline ppstrm;
168                                  add_string ppstrm "type: ";                                  PP.string ppstrm "type: ";
169                                  ppType ppstrm ty));                                  ppType ppstrm ty));
170                              WILDCARDty)                              WILDCARDty)
171                           else ty                           else ty
# Line 263  Line 264 
264    | generalizeTy _ = bug "generlizeTy - bad arg"    | generalizeTy _ = bug "generlizeTy - bad arg"
265    
266    
267    (* the VARpat case seems designed to ensure that only one variable in a pattern
268     * can have generalized type variables: either x or !tvs must be nil or a bug
269     * message is generated.  Why is this? [dbm] *)
270  fun generalizePat(pat: pat, userbound: tyvar list, occ: occ,  fun generalizePat(pat: pat, userbound: tyvar list, occ: occ,
271                    generalize: bool, region) =                    generalize: bool, region) =
272      let val tvs : tyvar list ref = ref []      let val tvs : tyvar list ref = ref []
# Line 353  Line 357 
357                    (message("constructor and argument don't agree in pattern",mode))                    (message("constructor and argument don't agree in pattern",mode))
358                    (fn ppstrm =>                    (fn ppstrm =>
359                     (PPType.resetPPType();                     (PPType.resetPPType();
360                      add_newline ppstrm;                      newline ppstrm;
361                      add_string ppstrm "constructor: ";                      PP.string ppstrm "constructor: ";
362                      ppType ppstrm typ; add_newline ppstrm;                      ppType ppstrm typ; newline ppstrm;
363                      add_string ppstrm "argument:    ";                      PP.string ppstrm "argument:    ";
364                      ppType ppstrm argty; add_newline ppstrm;                      ppType ppstrm argty; newline ppstrm;
365                      add_string ppstrm "in pattern:"; add_break ppstrm (1,2);                      PP.string ppstrm "in pattern:"; break ppstrm {nsp=1,offset=2};
366                      ppPat ppstrm (pat,!printDepth)));                      ppPat ppstrm (pat,!printDepth)));
367                   (pat,WILDCARDty))                   (pat,WILDCARDty))
368             end             end
# Line 402  Line 406 
406          end          end
407  in  in
408       case exp       case exp
409        of VARexp(r as ref(VALvar{typ, info, ...}), _) =>        of VARexp(r as ref(VALvar{typ, ...}), _) =>
          (case ii2ty info of  
               SOME st =>  
               let val (sty, insts) = instantiatePoly(st)  
                   val (nty, _) = instantiatePoly(!typ)  
               in  
                   unifyTy(sty, nty) handle _ => ();  (* ??? *)  
                   (VARexp(r, insts), sty)  
               end  
             | NONE =>  
410                let val (ty, insts) = instantiatePoly(!typ)                let val (ty, insts) = instantiatePoly(!typ)
411                in (VARexp(r, insts), ty)             in (VARexp(r, ty), ty)
412                end)            end
413    
414         | VARexp(refvar as ref(OVLDvar _),_) =>         | VARexp(refvar as ref(OVLDvar _),_) =>
415              (exp,pushOverloaded(refvar, err region))              (exp,pushOverloaded(refvar, err region))
416         | VARexp(r as ref ERRORvar, _) => (exp, WILDCARDty)         | VARexp(r as ref ERRORvar, _) => (exp, WILDCARDty)
# Line 448  Line 444 
444                    (message("selecting a non-existing field from a record",mode))                    (message("selecting a non-existing field from a record",mode))
445                    (fn ppstrm =>                    (fn ppstrm =>
446                     (PPType.resetPPType();                     (PPType.resetPPType();
447                      add_newline ppstrm;                      newline ppstrm;
448                      add_string ppstrm "the field name: ";                      PP.string ppstrm "the field name: ";
449                      (case l of LABEL{name,...} => ppSym ppstrm name);                      (case l of LABEL{name,...} => ppSym ppstrm name);
450                      add_newline ppstrm;                      newline ppstrm;
451                      add_string ppstrm "the record type:    ";                      PP.string ppstrm "the record type:    ";
452                      ppType ppstrm nty; add_newline ppstrm;                      ppType ppstrm nty; newline ppstrm;
453                      add_string ppstrm "in expression:";                      PP.string ppstrm "in expression:";
454                      add_break ppstrm (1,2);                      break ppstrm {nsp=1,offset=2};
455                      ppExp ppstrm (exp,!printDepth)));                      ppExp ppstrm (exp,!printDepth)));
456                      (exp, WILDCARDty))                      (exp, WILDCARDty))
457             end             end
# Line 494  Line 490 
490                     then (err region COMPLAIN                     then (err region COMPLAIN
491                            (message("operator and operand don't agree",mode))                            (message("operator and operand don't agree",mode))
492                            (fn ppstrm =>                            (fn ppstrm =>
493                             (add_newline ppstrm;                             (newline ppstrm;
494                              add_string ppstrm "operator domain: ";                              PP.string ppstrm "operator domain: ";
495                              ppType ppstrm (domain reducedRatorTy);                              ppType ppstrm (domain reducedRatorTy);
496                              add_newline ppstrm;                              newline ppstrm;
497                              add_string ppstrm "operand:         ";                              PP.string ppstrm "operand:         ";
498                              ppType ppstrm randTy; add_newline ppstrm;                              ppType ppstrm randTy; newline ppstrm;
499                              add_string ppstrm "in expression:";                              PP.string ppstrm "in expression:";
500                              add_break ppstrm (1,2);                              break ppstrm {nsp=1,offset=2};
501                              ppExp ppstrm (exp,!printDepth)));                              ppExp ppstrm (exp,!printDepth)));
502                           (exp,WILDCARDty))                           (exp,WILDCARDty))
503                     else (err region COMPLAIN                     else (err region COMPLAIN
504                            (message("operator is not a function",mode))                            (message("operator is not a function",mode))
505                            (fn ppstrm =>                            (fn ppstrm =>
506                              (add_newline ppstrm;                              (newline ppstrm;
507                               add_string ppstrm "operator: ";                               PP.string ppstrm "operator: ";
508                               ppType ppstrm (ratorTy); add_newline ppstrm;                               ppType ppstrm (ratorTy); newline ppstrm;
509                               add_string ppstrm "in expression:";                               PP.string ppstrm "in expression:";
510                               add_break ppstrm (1,2);                               break ppstrm {nsp=1,offset=2};
511                               ppExp ppstrm (exp,!printDepth)));                               ppExp ppstrm (exp,!printDepth)));
512                           (exp,WILDCARDty))                           (exp,WILDCARDty))
513                 end                 end

Legend:
Removed from v.1332  
changed lines
  Added in v.1475

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