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

revision 902, Wed Aug 15 21:17:05 2001 UTC revision 1332, Sun May 18 03:21:16 2003 UTC
# Line 386  Line 386 
386         | p => bug "patType -- unexpected pattern"         | p => bug "patType -- unexpected pattern"
387    
388  fun expType(exp: exp, occ: occ, region) : exp * ty =  fun expType(exp: exp, occ: occ, region) : exp * ty =
389    let fun boolUnifyErr { ty, name, message } =
390            unifyErr { ty1 = ty, name1 = name, ty2 = boolTy, name2 = "",
391                       message = message, region = region, kind = ppExp,
392                       kindname = "expression", phrase = exp }
393        fun boolshortcut (con, what, e1, e2) =
394            let val (e1', t1) = expType (e1, occ, region)
395                val (e2', t2) = expType (e2, occ, region)
396                val m = String.concat ["operand of ", what, " is not of type bool"]
397            in
398                if boolUnifyErr { ty = t1, name = "operand", message = m }
399                andalso boolUnifyErr { ty = t2, name = "operand", message = m }
400                then (con (e1', e2'), boolTy)
401                else (exp, WILDCARDty)
402            end
403    in
404       case exp       case exp
405        of VARexp(r as ref(VALvar{typ, info, ...}), _) =>        of VARexp(r as ref(VALvar{typ, info, ...}), _) =>
406           (case ii2ty info of           (case ii2ty info of
# Line 568  Line 583 
583             end             end
584                   (* this causes case to behave differently from let, i.e.                   (* this causes case to behave differently from let, i.e.
585                      bound variables do not have generic types *)                      bound variables do not have generic types *)
586           | IFexp { test, thenCase, elseCase } =>
587               let val (test', tty) = expType (test, occ, region)
588                   val (thenCase', tct) = expType (thenCase, occ, region)
589                   val (elseCase', ect) = expType (elseCase, occ, region)
590               in
591                   if boolUnifyErr
592                          { ty = tty, name = "test expression",
593                            message="test expression in if is not of type bool" }
594                   andalso
595                      unifyErr { ty1 = tct, name1 = "then branch",
596                                 ty2 = ect, name2 = "else branch",
597                                 message="types of if branches do not agree",
598                                 region = region, kind = ppExp,
599                                 kindname = "expression", phrase = exp }
600                   then
601                       (IFexp { test = test', thenCase = thenCase',
602                                elseCase = elseCase' },
603                        tct)
604                   else
605                       (exp, WILDCARDty)
606               end
607           | ANDALSOexp (e1, e2) =>
608               boolshortcut (ANDALSOexp, "andalso", e1, e2)
609           | ORELSEexp (e1, e2) =>
610               boolshortcut (ORELSEexp, "orelse", e1, e2)
611           | WHILEexp { test, expr } =>
612               let val (test', tty) = expType (test, occ, region)
613                   val (expr', _) = expType (expr, occ, region)
614               in
615                   if boolUnifyErr { ty = tty, name = "test expression",
616                                     message = "test expression in while is not of type bool" }
617                   then
618                       (WHILEexp { test = test', expr = expr' }, unitTy)
619                   else
620                       (exp, WILDCARDty)
621               end
622         | FNexp(rules,_) =>         | FNexp(rules,_) =>
623             let val (rules',ty,rty) = matchType(rules,occ,region)             let val (rules',ty,rty) = matchType(rules,occ,region)
624              in (FNexp(rules',ty),rty)              in (FNexp(rules',ty),rty)
# Line 577  Line 628 
628              in (MARKexp(e',region),et)              in (MARKexp(e',region),et)
629             end             end
630         | _ => bug "exptype -- bad expression"         | _ => bug "exptype -- bad expression"
631    end
632    
633  and ruleType(RULE(pat,exp),occ,region) =  and ruleType(RULE(pat,exp),occ,region) =
634   let val occ = Abstr occ   let val occ = Abstr occ

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

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