Initial import of l4c

[snipe.git] / parse / ast.sml

(* L3 Compiler
 * Abstract Syntax Trees
 * Author: Alex Vaynberg
 * Modified: Frank Pfenning <fp@cs.cmu.edu>
 * Modified: Joshua Wise <jwise@andrew.cmu.edu>
 * Modified: Chris Lu <czl@andrew.cmu.edu>
 *
 * Uses pretty printing library
 * structure PP  -- see util/pp.sml
 *)

signature AST =
sig
  type ident = Symbol.symbol
  
  datatype vtype = Int | Typedef of ident | Pointer of vtype | Array of vtype | TNull
  val typeeq : vtype * vtype -> bool
  val castable : vtype * vtype -> bool (* true if the second type can be casted to the first implicitly *)
  type variable = ident * vtype
  datatype typedef = Struct of variable list
                   | MarkedTypedef of typedef Mark.marked

  datatype oper = 
     PLUS
   | MINUS
   | TIMES
   | DIVIDEDBY
   | MODULO
   | NEGATIVE			(* unary minus *)
   | LSH
   | RSH
   | LOGOR
   | LOGAND
   | BITAND
   | BITXOR
   | BITOR
   | BITNOT
   | BANG                       (* logical not *)
   | NEQ
   | EQ
   | LT
   | LE
   | GE
   | GT

  datatype exp =
     Var of ident
   | ConstExp of Word32.word
   | OpExp of oper * exp list
   | Marked of (* Kane *) exp Mark.marked
   | FuncCall of ident * (exp list)
   | Member of exp * ident
   | DerefMember of exp * ident
   | Dereference of exp
   | ArrIndex of exp * exp
   | New of vtype
   | NewArr of vtype * exp
   | Null
  and stm =
     Assign of exp * exp
   | AsnOp of oper * exp * exp
   | Effect of exp (* Just side effect the expression *)
   | Return of exp
   | Nop
   | Break
   | Continue
   | If of exp * stm list * stm list option
   | For of stm option * exp * stm option * stm list
   | While of exp * stm list
   | MarkedStm of stm Mark.marked

  datatype function =
     Extern of vtype * (variable list)
   | Function of vtype * (variable list) * (variable list) * stm list
   | MarkedFunction of function Mark.marked
  
  type program = typedef Symbol.table * function Symbol.table

  (* print as source, with redundant parentheses *)
  structure Print :
  sig
    val pp_exp : exp -> string
    val pp_type : vtype -> string
    val pp_stm : stm -> string
    val pp_program : program -> string
  end
end

structure Ast :> AST =
struct
  type ident = Symbol.symbol

  datatype vtype = Int | Typedef of ident | Pointer of vtype | Array of vtype | TNull
  fun typeeq (Int, Int) = true
    | typeeq (Typedef a, Typedef b) = (Symbol.name a) = (Symbol.name b)
    | typeeq (Pointer a, Pointer b) = typeeq (a, b)
    | typeeq (Array a, Array b) = typeeq (a, b)
    | typeeq (TNull, TNull) = true
    | typeeq _ = false
  fun castable (Pointer _, TNull) = true
    | castable (Array _, TNull) = true
    | castable (a, b) = typeeq (a, b)
  type variable = ident * vtype
  datatype typedef = Struct of variable list
                   | MarkedTypedef of typedef Mark.marked

  datatype oper = 
     PLUS
   | MINUS
   | TIMES
   | DIVIDEDBY
   | MODULO
   | NEGATIVE			(* unary minus *)
   | LSH
   | RSH
   | LOGOR
   | LOGAND
   | BITAND
   | BITXOR
   | BITOR
   | BITNOT
   | BANG
   | NEQ
   | EQ
   | LT
   | LE
   | GE
   | GT

  datatype exp =
     Var of ident
   | ConstExp of Word32.word
   | OpExp of oper * exp list
   | Marked of exp Mark.marked
   | FuncCall of ident * (exp list)
   | Member of exp * ident
   | DerefMember of exp * ident
   | Dereference of exp
   | ArrIndex of exp * exp
   | New of vtype
   | NewArr of vtype * exp
   | Null
  and stm =
     Assign of exp * exp
   | AsnOp of oper * exp * exp
   | Effect of exp (* Just side effect the expression *)
   | Return of exp
   | Nop
   | Break
   | Continue
   | If of exp * stm list * stm list option
   | For of stm option * exp * stm option * stm list
   | While of exp * stm list
   | MarkedStm of stm Mark.marked

  datatype function =
     Extern of vtype * (variable list)
   | Function of vtype * (variable list) * (variable list) * stm list
   | MarkedFunction of function Mark.marked
  
  type program = typedef Symbol.table * function Symbol.table

  (* print programs and expressions in source form
   * using redundant parentheses to clarify precedence
   *)
  structure Print =
  struct
    fun pp_ident id = Symbol.name id

    fun pp_oper PLUS = "+"
      | pp_oper MINUS = "-"
      | pp_oper TIMES = "*"
      | pp_oper DIVIDEDBY = "/"
      | pp_oper MODULO = "%"
      | pp_oper NEGATIVE = "-"
      | pp_oper LSH = "<<"
      | pp_oper RSH = ">>"
      | pp_oper LOGAND = "&&"
      | pp_oper LOGOR = "||"
      | pp_oper BITAND = "&"
      | pp_oper BITXOR = "^"
      | pp_oper BITOR = "|"
      | pp_oper BITNOT = "~"
      | pp_oper BANG = "!"
      | pp_oper NEQ = "!="
      | pp_oper EQ = "=="
      | pp_oper LT = "<"
      | pp_oper LE = "<="
      | pp_oper GT = ">"
      | pp_oper GE = ">="

    fun pp_exp (Var(id)) = pp_ident id
      | pp_exp (ConstExp(c)) = Word32Signed.toString c
      | pp_exp (OpExp(oper, [e])) =
	  pp_oper oper ^ "(" ^ pp_exp e ^ ")"
      | pp_exp (OpExp(oper, [e1,e2])) =
	  "(" ^ pp_exp e1 ^ " " ^ pp_oper oper
	  ^ " " ^ pp_exp e2 ^ ")"
      | pp_exp (OpExp(oper, _)) =
          pp_oper oper
      | pp_exp (FuncCall(id, l)) = pp_ident id ^ "(" ^ pp_expl l ^ ")"
      | pp_exp (Marked(marked_exp)) =
	  pp_exp (Mark.data marked_exp)
      | pp_exp (Member(e, i)) = pp_exp e ^ "." ^ pp_ident i
      | pp_exp (DerefMember(e, i)) = pp_exp e ^ "->" ^ pp_ident i
      | pp_exp (Dereference(e)) = "*(" ^ pp_exp e ^ ")"
      | pp_exp (ArrIndex(e1, e2)) = pp_exp e1 ^ "[" ^pp_exp e2 ^ "]"
      | pp_exp (New t) = "new(" ^ pp_type t ^ ")"
      | pp_exp (NewArr (t, s)) = "new(" ^ pp_type t ^ "[" ^ pp_exp s ^ "])"
      | pp_exp Null = "NULL"
    
    and pp_expl nil = ""
      | pp_expl (e::a::l) = (pp_exp e) ^ ", " ^ (pp_expl (a::l))
      | pp_expl (e::l) = (pp_exp e) ^ (pp_expl l)

    and pp_stm (Assign (e1,e2)) =
          pp_exp e1 ^ " = " ^ pp_exp e2 ^ ";\n"
      | pp_stm (AsnOp (oop, e1, e2)) =
          pp_exp e1 ^ " " ^ pp_oper oop ^ "= " ^ pp_exp e2 ^ ";\n"
      | pp_stm (Effect (e)) = 
          pp_exp e ^ ";\n"
      | pp_stm (Return e) =
	  "return " ^ pp_exp e ^ ";\n"
      | pp_stm Nop = ";\n"
      | pp_stm Break = "break;\n"
      | pp_stm Continue = "continue;\n"
      | pp_stm (If (e, s, NONE)) = "if ("^pp_exp e^")\n"^pp_block s
      | pp_stm (If (e, s, SOME s2)) = "if ("^pp_exp e^")\n"^pp_block s^"else\n"^pp_block s2
      | pp_stm (While (e, s)) = "while ("^pp_exp e^")\n"^pp_block s
      | pp_stm (For (so1, e, so2, s)) = "for ("^ (if (isSome so1) then pp_stm (valOf so1) else "") ^ pp_exp e ^ (if(isSome so2) then pp_stm (valOf so2) else "") ^ ")\n" ^ pp_block s
      | pp_stm (MarkedStm m) = pp_stm (Mark.data m)

    and pp_block (nil) = ";"
      | pp_block (a::nil) = pp_stm a
      | pp_block (l) = let
          val contents = map pp_stm l
        in
          "{\n" ^ String.concat contents ^ "}\n"
        end

    and pp_stms nil = ""
      | pp_stms (s::ss) = pp_stm s ^ "\n" ^ pp_stms ss
    
    and pp_type Int = "int"
      | pp_type (Typedef i) = pp_ident i
      | pp_type (Pointer t) = pp_type t ^ "*"
      | pp_type (Array t) = pp_type t ^ "[]"
      | pp_type TNull = "{NULL type}"
    
    and pp_params nil = ""
      | pp_params ((i, t)::a::l) = (pp_ident i) ^ " : " ^ (pp_type t) ^ ", " ^ (pp_params (a::l))
      | pp_params ((i, t)::l) = (pp_ident i) ^ " : " ^ (pp_type t) ^ (pp_params l)
    
    and pp_vars nil = ""
      | pp_vars ((i, t)::l) = "var " ^ (pp_ident i) ^ " : " ^ (pp_type t) ^ ";\n" ^ (pp_vars l)

    and pp_function (n, Extern(t, pl)) = "extern " ^ (pp_type t) ^ " " ^ (pp_ident n) ^ "(" ^ (pp_params pl) ^ ");\n"
      | pp_function (n, Function(t, pl, vl, stms)) = (pp_type t) ^ " " ^ (pp_ident n) ^ "(" ^ (pp_params pl) ^ ")\n{\n" ^ (pp_vars vl) ^ (String.concat (map pp_stm stms)) ^ "\n}\n"
      | pp_function (n, MarkedFunction d) = pp_function (n, Mark.data d)
    
    and pp_typedef (i, Struct (v)) = "struct " ^ (pp_ident i) ^ " {\n" ^ (String.concat (map (fn (i', t) => "  " ^ (pp_ident i') ^ " : " ^ (pp_type t) ^ ";\n") v)) ^ "}\n"
      | pp_typedef (i, MarkedTypedef d) = pp_typedef (i, Mark.data d)
    
    and pp_program (types, funs) = String.concat ((map pp_typedef (Symbol.elemsi types)) @ (map pp_function (Symbol.elemsi funs)))
  end
end