+ structure AU = AstUtils
+
+ fun typeof (tds, funcs) vars mark e =
+ ( case e
+ of A.Var a => (case Symbol.look vars a
+ of NONE => (ErrorMsg.error mark ("variable `"^(Symbol.name a)^"' not declared here") ; raise ErrorMsg.Error)
+ | SOME t => t)
+ | A.ConstExp _ => A.Int
+ | A.OpExp (A.EQ, [a, b]) =>
+ (case (typeof (tds, funcs) vars mark a, typeof (tds, funcs) vars mark b)
+ of (A.Int, A.Int) => A.Int (* You shall pass! *)
+ | (a', b') =>
+ if (A.typeeq (a', A.TNull) andalso A.castable (b', A.TNull)) orelse
+ (A.typeeq (b', A.TNull) andalso A.castable (a', A.TNull)) orelse
+ (A.typeeq (a', b'))
+ then A.Int
+ else (ErrorMsg.error mark ("incorrect types for equality opexp: " ^ A.Print.pp_type a' ^ ", " ^ A.Print.pp_type b') ; raise ErrorMsg.Error ))
+ | A.OpExp (A.NEQ, el) => typeof (tds, funcs) vars mark (A.OpExp (A.EQ, el))
+ | A.OpExp (_, el) => (List.app
+ (fn e =>
+ (case (typeof (tds, funcs) vars mark e)
+ of A.Int => ()
+ | _ => (ErrorMsg.error mark ("incorrect type for opexp; needed int") ; raise ErrorMsg.Error)))
+ el ; A.Int)
+ | A.Marked e => typeof (tds, funcs) vars (Mark.ext e) (Mark.data e)
+ | A.FuncCall (i, exps) =>
+ let
+ val func = (case Symbol.look funcs i
+ of NONE => (ErrorMsg.error mark ("function `"^(Symbol.name i)^"' not declared") ; raise ErrorMsg.Error)
+ | SOME f => f)
+ val funcmark = AU.Function.mark func
+ val (ftype, fparams) = (AU.Function.returntype func, AU.Function.params func)
+ val exptypes = List.map (fn znt => typeof (tds, funcs) vars mark znt) exps
+ val () = if (length exptypes = length fparams) then ()
+ else (ErrorMsg.error mark ("call to function `"^(Symbol.name i)^"' has incorrect parameter count [you must construct additional tycons]") ; raise ErrorMsg.Error)
+ val () = List.app
+ (fn (t, (i, t')) =>
+ if not (A.castable (t', t))
+ then (ErrorMsg.error mark ("parameter `"^(Symbol.name i)^"' in function call has wrong type [you must construct additional tycons]") ; raise ErrorMsg.Error)
+ else ())
+ (ListPair.zip (exptypes, fparams))
+ in
+ ftype
+ end
+ | A.Member (e, i) =>
+ let
+ val t = typeof (tds, funcs) vars mark e
+ val name = case t
+ of (A.Typedef i) => i
+ | _ => (ErrorMsg.error mark ("member operation only exists for struct types") ; raise ErrorMsg.Error)
+ val s = case Symbol.look tds name
+ of SOME s => s
+ | NONE => (ErrorMsg.error mark ("undefined structure `"^(Symbol.name name)^"' in type") ; raise ErrorMsg.Error)
+ val (s, smark) = (AU.Typedef.data s, AU.Typedef.mark s)
+ val vl = case s
+ of A.Struct vl => vl
+ | _ => raise ErrorMsg.InternalError "mark of marked typedef?"
+ val t = case (List.find (fn (i', t) => (Symbol.name i = Symbol.name i')) vl)
+ of SOME (_, t) => t
+ | NONE => (ErrorMsg.error mark ("undefined member `"^(Symbol.name i)^"' in struct") ; ErrorMsg.error smark ("struct `"^(Symbol.name name)^"' defined here") ; raise ErrorMsg.Error)
+ in
+ t
+ end
+ | A.DerefMember (e, i) =>
+ let
+ val t = typeof (tds, funcs) vars mark e
+ val name = case t
+ of (A.Pointer (A.Typedef i)) => i
+ | _ => (ErrorMsg.error mark ("dereference and member operation only exists for struct pointer types") ; raise ErrorMsg.Error)
+ val s = case Symbol.look tds name
+ of SOME s => s
+ | NONE => (ErrorMsg.error mark ("undefined structure `"^(Symbol.name name)^"' in type") ; raise ErrorMsg.Error)
+ val (s, smark) = case s
+ of A.Struct vl => (s, NONE)
+ | A.MarkedTypedef m => (Mark.data m, Mark.ext m)
+ val vl = case s
+ of A.Struct vl => vl
+ | _ => raise ErrorMsg.InternalError "mark of marked typedef?"
+ val t = case (List.find (fn (i', t) => (Symbol.name i = Symbol.name i')) vl)
+ of SOME (_, t) => t
+ | NONE => (ErrorMsg.error mark ("undefined member `"^(Symbol.name i)^"' in struct") ; ErrorMsg.error smark ("struct `"^(Symbol.name name)^"' defined here") ; raise ErrorMsg.Error)
+ in
+ t
+ end
+ | A.Dereference e =>
+ (case typeof (tds, funcs) vars mark e
+ of (A.Pointer e') => e'
+ | _ => (ErrorMsg.error mark ("cannot deference non-pointer type") ; raise ErrorMsg.Error))
+ | A.ArrIndex (e, i) =>
+ (case (typeof (tds, funcs) vars mark e, typeof (tds, funcs) vars mark i)
+ of (A.Array e', A.Int) => e'
+ | (_, A.Int) => (ErrorMsg.error mark ("cannot index non-array type") ; raise ErrorMsg.Error)
+ | _ => (ErrorMsg.error mark ("cannot index using non-int type") ; raise ErrorMsg.Error))
+ | A.New (t) => A.Pointer t
+ | A.NewArr (t, s) =>
+ (case typeof (tds, funcs) vars mark s
+ of A.Int => (A.Array t)
+ | _ => (ErrorMsg.error mark ("cannot specify non-int array dimension") ; raise ErrorMsg.Error))
+ | A.Null => A.TNull
+ )