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 -> unit
  14 end;
  15
  16 structure TypeChecker :> TYPE_CHECK =
  17 struct
  18   structure A = Ast
  19
  20   (* tc_exp : unit Symbol.table -> Ast.exp -> Mark.ext option -> unit *)
  21   fun tc_exp env (A.Var(id)) ext =
  22       (case Symbol.look env id
  23         of NONE => ( ErrorMsg.error ext ("undefined variable `" ^ Symbol.name id ^ "'") ;
  24                      raise ErrorMsg.Error )
  25          | SOME _ => ())
  26     | tc_exp env (A.ConstExp(c)) ext = ()
  27     | tc_exp env (A.OpExp(oper,es)) ext =
  28       (* Note: it is syntactically impossible in this language to
  29        * apply an operator to an incorrect number of arguments
  30        * so we only check each of the arguments
  31        *)
  32         List.app (fn e => tc_exp env e ext) es
  33     | tc_exp env (A.Marked(marked_exp)) ext =
  34         tc_exp env (Mark.data marked_exp) (Mark.ext marked_exp)
  35
  36   (* tc_stms : unit Symbol.table -> Ast.program -> unit *)
  37   fun tc_stms env nil = ()
  38     | tc_stms env (A.Assign(id,e)::stms) =
  39         ( tc_exp env e NONE ;
  40           tc_stms (Symbol.bind env (id, ())) stms )
  41     | tc_stms env (A.Return(e)::nil) =
  42         tc_exp env e NONE
  43     | tc_stms env (A.Return _ :: _) =
  44         ( ErrorMsg.error NONE ("`return' not last statement") ;
  45           raise ErrorMsg.Error )
  46
  47   fun typecheck prog = tc_stms Symbol.empty prog
  48
  49 end