Initial import of l4c

[snipe.git] / parse / ast.sml

diff --git a/parse/ast.sml b/parse/ast.sml
index fce70ab9d9e69275415d4acdf39563621bece8b2..84b2356b74c146f728a598769b02264092c17176 100644 (file)
--- a/parse/ast.sml
+++ b/parse/ast.sml
@@ -13,8 +13,12 @@ signature AST =
 sig
   type ident = Symbol.symbol
   
 sig
   type ident = Symbol.symbol
   

-  datatype vtype = Int
+  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
   type variable = ident * vtype

+  datatype typedef = Struct of variable list
+                   | MarkedTypedef of typedef Mark.marked

 
   datatype oper = 
      PLUS
 
   datatype oper = 
      PLUS


@@ -45,8 +49,17 @@ sig
    | OpExp of oper * exp list
    | Marked of (* Kane *) exp Mark.marked
    | FuncCall of ident * (exp list)
    | 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 =
   and stm =

-     Assign of ident * exp
+     Assign of exp * exp
+   | AsnOp of oper * exp * exp
+   | Effect of exp (* Just side effect the expression *)

    | Return of exp
    | Nop
    | Break
    | Return of exp
    | Nop
    | Break


@@ -57,27 +70,39 @@ sig
    | MarkedStm of stm Mark.marked
 
   datatype function =
    | MarkedStm of stm Mark.marked
 
   datatype function =

-     Extern of vtype * ident * (variable list)
-   | Function of vtype * ident * (variable list) * (variable list) * stm list
+     Extern of vtype * (variable list)
+   | Function of vtype * (variable list) * (variable list) * stm list
+   | MarkedFunction of function Mark.marked

   
   

-  type program = function list
+  type program = typedef Symbol.table * function Symbol.table

 
   (* print as source, with redundant parentheses *)
   structure Print :
   sig
     val pp_exp : exp -> string
 
   (* 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
     val pp_stm : stm -> string
     val pp_program : program -> string
   end

-

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

-  datatype vtype = Int
+  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
   type variable = ident * vtype

+  datatype typedef = Struct of variable list
+                   | MarkedTypedef of typedef Mark.marked

 
   datatype oper = 
      PLUS
 
   datatype oper = 
      PLUS


@@ -108,8 +133,17 @@ struct
    | OpExp of oper * exp list
    | Marked of exp Mark.marked
    | FuncCall of ident * (exp list)
    | 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 =
   and stm =

-     Assign of ident * exp
+     Assign of exp * exp
+   | AsnOp of oper * exp * exp
+   | Effect of exp (* Just side effect the expression *)

    | Return of exp
    | Nop
    | Break
    | Return of exp
    | Nop
    | Break


@@ -120,10 +154,11 @@ struct
    | MarkedStm of stm Mark.marked
 
   datatype function =
    | MarkedStm of stm Mark.marked
 
   datatype function =

-     Extern of vtype * ident * (variable list)
-   | Function of vtype * ident * (variable list) * (variable list) * stm list
+     Extern of vtype * (variable list)
+   | Function of vtype * (variable list) * (variable list) * stm list
+   | MarkedFunction of function Mark.marked

   
   

-  type program = function list
+  type program = typedef Symbol.table * function Symbol.table

 
   (* print programs and expressions in source form
    * using redundant parentheses to clarify precedence
 
   (* print programs and expressions in source form
    * using redundant parentheses to clarify precedence


@@ -166,22 +201,33 @@ struct
       | pp_exp (FuncCall(id, l)) = pp_ident id ^ "(" ^ pp_expl l ^ ")"
       | pp_exp (Marked(marked_exp)) =
          pp_exp (Mark.data marked_exp)
       | 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_expl nil = ""
       | pp_expl (e::a::l) = (pp_exp e) ^ ", " ^ (pp_expl (a::l))
       | pp_expl (e::l) = (pp_exp e) ^ (pp_expl l)
 

-    fun pp_stm (Assign (id,e)) =
-       pp_ident id ^ " = " ^ pp_exp e ^ ";"
+    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) =
       | pp_stm (Return e) =

-         "return " ^ pp_exp e ^ ";"
-      | pp_stm Nop = ";"
-      | pp_stm Break = "break;"
-      | pp_stm Continue = "continue;"
-      | pp_stm (If (e, s, NONE)) = "if ("^pp_exp e^")"^pp_block s
-      | pp_stm (If (e, s, SOME s2)) = "if ("^pp_exp e^")"^pp_block s^" else "^pp_block s2
-      | pp_stm (While (e, s)) = "while ("^pp_exp e^") "^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 "") ^ ")" ^ pp_block s
+         "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_stm (MarkedStm m) = pp_stm (Mark.data m)
 
     and pp_block (nil) = ";"


@@ -196,6 +242,10 @@ struct
       | pp_stms (s::ss) = pp_stm s ^ "\n" ^ pp_stms ss
     
     and pp_type Int = "int"
       | 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))
     
     and pp_params nil = ""
       | pp_params ((i, t)::a::l) = (pp_ident i) ^ " : " ^ (pp_type t) ^ ", " ^ (pp_params (a::l))


@@ -204,9 +254,13 @@ struct
     and pp_vars nil = ""
       | pp_vars ((i, t)::l) = "var " ^ (pp_ident i) ^ " : " ^ (pp_type t) ^ ";\n" ^ (pp_vars l)
 
     and pp_vars nil = ""
       | pp_vars ((i, t)::l) = "var " ^ (pp_ident i) ^ " : " ^ (pp_type t) ^ ";\n" ^ (pp_vars l)
 

-    and pp_function (Extern(t, n, pl)) = "extern " ^ (pp_type t) ^ " " ^ (pp_ident n) ^ "(" ^ (pp_params pl) ^ ");\n"
-      | pp_function (Function(t, n, 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"
+    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 (p) = String.concat (map pp_function p)
+    and pp_program (types, funs) = String.concat ((map pp_typedef (Symbol.elemsi types)) @ (map pp_function (Symbol.elemsi funs)))

   end
 end
   end
 end