(* <Pre>  *)

type Id = string;

(** Representing types for mini-Java **)

datatype Basic = Bool | Int | Real;

datatype Type
  = BasicType of Basic
  | ArrayType of Basic
  | ObjType of Id
  | VoidType;


(* A slot of type (`x TC) is an option *)
(* type. The parser places NONE there  *)
(* and the type-checker fills it in    *)
(* with (SOME x) when "x" is known     *)

type 'x TC = 'x option;

(******** Representing Programs *******)

datatype Op                 (* infix operators *)
  = ADD | SUB | MUL | DIV        (* Arithmetic *)
  | AND | OR                     (* logical    *)
  | EQ | NE | LT | LE | GT | GE  (* relational *)

datatype Constant         (* Literal constants *)
  = Cint of int
  | Creal of string
  | Cbool of bool

datatype Exp
  = Literal of Constant                 (* 5, 6.3, true *)
  | Binop of Op * Exp * Exp             (* x + 3        *)
  | Relop of Op * Exp * Exp             (* x < 7.7      *)
  | Not of Exp                          (* ! x          *)
  | ArrayElm of Exp * Exp * (Basic TC)  (* x[3]         *)
  | ArrayLen of Exp                     (* x.length()   *)
  | Call of Exp * Id *(Id TC)* Exp list (* x.f(1,z)     *)
  | NewArray of Basic * Exp             (* new int[3]   *)
  | NewObject of Id                     (* new point()  *)
  (* Coerce is used only in type checking               *)
  | Coerce of Exp


datatype Stmt
  = Block of Stmt list       (* {x:5; print(2)}           *)
  | Assign of Exp option * Id * Exp option * Exp
                             (* p.x[2]=5  p.x=5  x=5      *)
  | CallStmt of Exp * Id * (Id TC)* Exp list
                             (* x.f(1,z)                  *)
  | If of Exp * Stmt * Stmt  (* if (p<2) x=5 else x=6     *)
  | While of Exp * Stmt      (* while (p) s               *)
  | PrintE of Exp            (* System.out.println(x)     *)
  | PrintT of string         (* System.out.println("zbc") *)
  | Return of Exp option;    (* return (x+3)              *)

datatype VarDecl = VarDecl of Type * Id * Exp option;

datatype Formal = Formal of Type * Id;

datatype MetDecl = MetDecl of Type * Id *
                   Formal list * VarDecl list *
                   Stmt list;

datatype VarDecl
  = VarDecl of Type * Id * Exp

datatype ClassDec
  = ClassDec of Id * Id * VarDecl list * MetDecl list;


datatype Program = Program of ClassDec list;


datatype CTab
   = Node of
        Id *                            (* Class Name      *)
        (Id * Type)list *               (* Class Variables *)
        (Id * Type list * Type)list *   (* Class Methods   *)
        CTab ref *                      (* Parent Class    *)
        CTab list                       (* Sub Classes     *)
   | NullClass;

val root = Node("object",[],[],ref NullClass,[]);


exception NoParent of string;
fun newClass name vars methods parent NullClass = NullClass
  | newClass name vars methods parent (n as Node(nm,vs,ms,p,subs)) =
     if parent=nm
        then let val p1 = ref n
                 val new = Node(name,vars,methods,p1,[])
                 val newP = Node(nm,vs,ms,p,new::subs)
                 val _ = p1 := newP
             in newP end
        else Node(nm,vs,ms,p,map (newClass name vars methods parent) subs)

val t1 = newClass "point" [] [] "object" root;

val t2 = newClass "colorpoint" [] [] "point" t1;

fun basiceq (x,y) =
case (x,y) of
  (Real,Real) => true
| (Int,Int) => true
| (Bool,Bool) => true
| (_,_) => false

fun typeeq (x,y) =
case (x,y) of
  (BasicType x,BasicType y) => basiceq(x,y)
| (ArrayType x,ArrayType y) => basiceq(x,y)
| (ObjType x,ObjType y) => x=y
| (VoidType,VoidType) => true
| (_,_) => false

fun defines name NullClass = false
  | defines name (Node(n,vs,ms,p,ss)) =
      if name=n then true else List.exists (defines name) ss;

fun useTree NullClass (x,y) = false
  | useTree (Node(nm,vs,ms,p,ss)) (x,y) =
     if nm = y
        then List.exists (defines x) ss
        else List.exists (fn t => useTree t (x,y)) ss

fun subtype classH (x,y) =
  case (x,y) of
    (x,ObjType "object") => true
  | (BasicType Int,ObjType "numeric") => true
  | (BasicType Real,ObjType "numeric") => true
  | (ObjType x,ObjType y) => useTree classH (x,y)
  | (_,_) => typeeq(x,y)




(* </Pre> *)