type/typechecker.sml

   1 (* L1 Compiler
   2  * TypeChecker
   3  * Author: Alex Vaynberg <alv@andrew.cmu.edu>
   4  * Modified: Frank Pfenning <fp@cs.cmu.edu>
   5  *
   6  * Simple typechecker that is based on a unit Symbol.table
   7  * This is all that is needed since there is only an integer type present
   8  *)
   9
  10 signature TYPE_CHECK =
  11 sig
  12   (* prints error message and raises ErrorMsg.error if error found *)
  13   val typecheck : Ast.program -> Ast.program
  14 end;
  15
  16 structure TypeChecker :> TYPE_CHECK =
  17 struct
  18   structure A = Ast
  19
  20   fun returns nil = false
  21     | returns (A.Assign _ :: stms) = returns stms
  22     | returns (A.Return _ :: stms) = true
  23     | returns (A.Nop :: stms) = returns stms
  24     | returns (A.Break :: stms) = true (* blah *)
  25     | returns (A.Continue :: stms) = true (* blah *)
  26     | returns (A.If (_, s1, NONE) :: stms) = returns stms
  27     | returns (A.If (_, s1, SOME s2) :: stms) = (returns s1 andalso returns s2) orelse returns stms
  28     | returns (A.For _ :: stms) = returns stms
  29     | returns (A.While _ :: stms) = returns stms
  30     | returns (A.MarkedStm m :: stms) = returns (Mark.data m :: stms)
  31
  32   fun breakcheck nil mark = ()
  33     | breakcheck (A.Break :: stms) mark = ( ErrorMsg.error mark ("Illegal break outside loop") ;
  34                                              raise ErrorMsg.Error )
  35     | breakcheck (A.Continue :: stms) mark = ( ErrorMsg.error mark ("Illegal continue outside loop") ;
  36                                                 raise ErrorMsg.Error )
  37     | breakcheck (A.If (_, s1, NONE) :: stms) mark =
  38         ( breakcheck s1 mark;
  39           breakcheck stms mark)
  40     | breakcheck (A.If (_, s1, SOME s2) :: stms) mark =
  41         ( breakcheck s1 mark;
  42           breakcheck s2 mark;
  43           breakcheck stms mark)
  44     | breakcheck (A.MarkedStm m :: stms) mark = (breakcheck [(Mark.data m)] (Mark.ext m); breakcheck stms mark)
  45     | breakcheck (_ :: stms) mark = breakcheck stms mark
  46
  47   fun varcheck_exp env (A.Var v) mark =
  48         ( case Symbol.look env v
  49           of NONE => ( ErrorMsg.error mark ("undefined variable `" ^ Symbol.name v ^ "'") ;
  50                        raise ErrorMsg.Error )
  51            | SOME _ => ())
  52     | varcheck_exp env (A.ConstExp _) mark = ()
  53     | varcheck_exp env (A.OpExp (_, l)) mark = List.app (fn znt => varcheck_exp env znt mark) l
  54     | varcheck_exp env (A.Marked m) mark = varcheck_exp env (Mark.data m) (Mark.ext m)
  55
  56   fun computeassigns env nil = env
  57     | computeassigns env (A.Assign (id,e) :: stms) =
  58         computeassigns (Symbol.bind env (id, ())) stms
  59     | computeassigns env (A.Return _ :: stms) = env
  60     | computeassigns env (A.Nop :: stms) = computeassigns env stms
  61     | computeassigns env (A.Break :: stms) = env
  62     | computeassigns env (A.Continue :: stms) = env
  63     | computeassigns env (A.If (e, s1, NONE) :: stms) = computeassigns env stms
  64     | computeassigns env (A.If (e, s1, SOME s2) :: stms) =
  65         let
  66           val env1 = computeassigns env s1
  67           val env2 = computeassigns env s2
  68           val env' = Symbol.intersect (env1, env2)
  69           val env' =
  70             if (returns s1) then env2
  71             else if (returns s2) then env1
  72             else env'
  73         in
  74           computeassigns env' stms
  75         end
  76     | computeassigns env (A.While (e, s1) :: stms) = computeassigns env stms
  77     | computeassigns env (A.For (sbegin, e, sloop, inner) :: stms) =
  78        let
  79          val env' = case sbegin
  80                     of SOME(s) => computeassigns env [s]
  81                      | NONE => env
  82        in
  83          computeassigns env' stms
  84        end
  85     | computeassigns env (A.MarkedStm m :: stms) = computeassigns env ((Mark.data m) :: stms)
  86
  87   fun varcheck env nil mark = nil
  88     | varcheck env (A.Assign (id, e) :: stms) mark =
  89         ( varcheck_exp env e mark ;
  90           A.Assign (id, e) :: (varcheck (Symbol.bind env (id, ())) stms mark) )
  91     | varcheck env (A.Return (e) :: stms) mark =
  92         ( varcheck_exp env e mark;
  93           A.Return (e) :: nil )
  94     | varcheck env (A.Nop :: stms) mark =
  95         ( A.Nop :: (varcheck env stms mark))
  96     | varcheck env (A.Break :: stms) mark =
  97         ( A.Break :: nil )
  98     | varcheck env (A.Continue :: stms) mark =
  99         ( A.Continue :: nil )
 100     | varcheck env (A.If (e, s1, NONE) :: stms) mark =
 101         ( varcheck_exp env e mark ;
 102           varcheck env s1 mark ;
 103           A.If (e, s1, NONE) :: (varcheck env stms mark) )
 104     | varcheck env ((i as A.If (e, s1, SOME s2)) :: stms) mark =
 105         ( varcheck_exp env e mark ;
 106           varcheck env s1 mark ;
 107           varcheck env s2 mark ;
 108           A.If (e, s1, SOME s2) ::
 109             (if (returns [i])
 110              then nil
 111              else varcheck (computeassigns env [i]) stms mark)  )
 112     | varcheck env (A.While (e, s1) :: stms) mark =
 113         ( varcheck_exp env e mark ;
 114           varcheck env s1 mark ;
 115           A.While (e, s1) :: (varcheck env stms mark) )
 116     | varcheck env (A.For (sbegin, e, sloop, inner) :: stms) mark =
 117         let
 118           val sbegin = case sbegin
 119                        of SOME(s) => SOME (hd (varcheck env [s] mark))
 120                         | NONE => NONE
 121           val env' = case sbegin
 122                      of SOME(s) => computeassigns env [s]
 123                       | NONE => env
 124           val _ = varcheck_exp env' e
 125           val inner = varcheck env' inner mark
 126           val env'' = computeassigns env' inner
 127           val sloop = case sloop
 128                   of SOME(s) => SOME (hd (varcheck env'' [s] mark))
 129                    | NONE => NONE
 130         in
 131           A.For (sbegin, e, sloop, inner) :: (varcheck env' stms mark)
 132         end
 133     | varcheck env (A.MarkedStm m :: stms) mark = varcheck env ((Mark.data m) :: stms) (Mark.ext m)
 134
 135   fun typecheck prog =
 136       ( breakcheck prog NONE ;
 137         if not (returns prog)
 138         then (ErrorMsg.error NONE ("program does not return in all cases"); raise ErrorMsg.Error)
 139         else varcheck Symbol.empty prog NONE)
 140 end