structure Semant : SEMANT = struct

structure T = Types
       (* & *)
structure A = Absyn
structure S = Symbol	      
       (* S *)
	      
type expty = {exp : Translate.exp, ty: Types.ty}
type venv = Env.enventry Symbol.table
type tenv = Types.ty Symbol.table
		  
local
    val error = ErrorMsg.error
    fun assertType (exptypes, s, ty, p) =
	if List.exists (fn x => x = ty) exptypes then
	    ()
	else
	    ErrorMsg.error p s
    fun assertInt (exptype, pos) =
	assertType ([T.INT], "integer expected", exptype, pos)
    fun assertString (exptype, pos) =
	assertType ([T.STRING], "string expected", exptype, pos)
    fun assertUnit (exptype, pos) =
	assertType ([T.UNIT], "unit expected", exptype, pos)	
    fun assertSame (ty1, ty2, pos) =
	if ty1 = ty2 then
	    ()
	else
	    ErrorMsg.error pos "types not equivalent, you fat fuck"
    fun assertStringOrInt (exptype, pos) =
	assertType ([T.STRING, T.INT], "string expected",
		    exptype, pos)
in
(* ----------------------------------------------------------------- *)
fun transExp (venv, tenv, A.OpExp{left, oper=A.PlusOp, right, pos}) =
    let val {exp=expleft, ty=tyleft} = transExp (venv, tenv, left)
	val {exp=expright,ty=tyright} = transExp (venv, tenv, right)
    in
	assertInt(tyleft, pos);
	assertInt(tyright, pos);
	{exp = (), ty = Types.INT }
    end
  | transExp (venv, tenv, A.OpExp{left, oper=A.MinusOp, right, pos}) =
        let val {exp=expleft, ty=tyleft} = transExp (venv, tenv, left)
	val {exp=expright, ty=tyright} = transExp (venv, tenv, right)
    in
	assertInt(tyleft, pos);
	assertInt(tyright, pos);
	{exp = (), ty = Types.INT }
    end
  | transExp (venv, tenv, A.OpExp{left, oper=A.TimesOp, right, pos}) =
        let val {exp=expleft, ty=tyleft} = transExp (venv, tenv, left)
	val {exp=expright, ty=tyright} = transExp (venv, tenv, right)
    in
	assertInt(tyleft, pos);
	assertInt(tyright, pos);
	{exp = (), ty = Types.INT }
    end
  | transExp (venv, tenv, A.OpExp{left, oper=A.DivideOp, right, pos}) =
        let val {exp=expleft, ty=tyleft} = transExp (venv, tenv, left)
	val {exp=expright, ty=tyright} = transExp (venv, tenv, right)
    in
	assertInt(tyleft, pos);
	assertInt(tyright, pos);
	{exp = (), ty = Types.INT }
    end
  | transExp (venv, tenv, A.OpExp{left, oper=A.EqOp, right, pos}) =
        let val {exp=expleft, ty=tyleft} = transExp (venv, tenv, left)
	val {exp=expright, ty=tyright} = transExp (venv, tenv, right)
    in
	assertStringOrInt(tyleft, pos);
	assertStringOrInt(tyright, pos);
	{exp = (), ty = Types.INT }
    end
  | transExp (venv, tenv, A.OpExp{left, oper=A.NeqOp, right, pos}) =
        let val {exp=expleft, ty=tyleft} = transExp (venv, tenv, left)
	val {exp=expright, ty=tyright} = transExp (venv, tenv, right)
    in
	assertStringOrInt(tyleft, pos);
	assertStringOrInt(tyright, pos);
	{exp = (), ty = Types.INT }
    end
  | transExp (venv, tenv, A.OpExp{left, oper=A.LtOp, right, pos}) =
        let val {exp=expleft, ty=tyleft} = transExp (venv, tenv, left)
	val {exp=expright, ty=tyright} = transExp (venv, tenv, right)
    in
	assertStringOrInt(tyleft, pos);
	assertStringOrInt(tyright, pos);
	{exp = (), ty = Types.INT }
    end

  | transExp (venv, tenv, A.OpExp{left, oper=A.LeOp, right, pos}) =
        let val {exp=expleft, ty=tyleft} = transExp (venv, tenv, left)
	val {exp=expright, ty=tyright} = transExp (venv, tenv, right)
    in
	assertStringOrInt(tyleft, pos);
	assertStringOrInt(tyright, pos);
	{exp = (), ty = Types.INT }
    end

  | transExp (venv, tenv, A.OpExp{left, oper=A.GtOp, right, pos}) =
        let val {exp=expleft, ty=tyleft} = transExp (venv, tenv, left)
	val {exp=expright, ty=tyright} = transExp (venv, tenv, right)
    in
 	assertStringOrInt(tyleft, pos);
	assertStringOrInt(tyright, pos);	    
	{exp = (), ty = Types.INT }
    end

  | transExp (venv, tenv, A.OpExp{left, oper=A.GeOp, right, pos}) =
        let val {exp=expleft, ty=tyleft} = transExp (venv, tenv, left)
	val {exp=expright, ty=tyright} = transExp (venv, tenv, right)
    in
 	assertStringOrInt(tyleft, pos);
	assertStringOrInt(tyright, pos);	    
	{exp = (), ty = Types.INT }
    end
  (*  constants *)
  | transExp (venv, tenv, A.IntExp(x))	= {exp = (), ty = Types.INT }
  | transExp (venv, tenv, A.StringExp(x, pos)) = {exp = (), ty = Types.STRING }
  | transExp (venv, tenv, A.NilExp) = {exp = (), ty = Types.NIL }
  (*  | transExp (venv, tenv, A.VarExp(A.SimpleVar(s, p))) =
   *    case S.look (venv, s) of (SOME x) => {exp = (), ty = x}
   *  			 | NONE => {exp = (), ty = T.NIL} *)
  | transExp (venv, tenv, A.SeqExp(x)) =
    let fun transSeq [] = {exp = (), ty = T.UNIT}
	  | transSeq ((e, pos)::[]) = transExp(venv, tenv, e)
	  | transSeq ((e, pos)::t) = (transExp(venv, tenv, e); transSeq(t))
    in
	transSeq(x)
    end
  | transExp (venv, tenv, A.IfExp{test, then', else', pos}) =
    let val {exp=testexp, ty=testty} = transExp(venv, tenv, test)
	val {exp=thenexp, ty=thenty} = transExp(venv, tenv, then')
    in
	assertInt(testty, pos);
	case else' of SOME x =>
		      let val {exp=elseexp, ty=elsety} = transExp (venv, tenv, x)
		      in
			  assertSame(thenty, elsety, pos);
			  {exp = (), ty = thenty}
		      end
		    | NONE =>
		      (assertUnit(thenty, pos);
		       {exp = (), ty = T.UNIT})
    end
  | transExp (venv, tenv, A.WhileExp{test, body, pos}) =
    let val {exp=testexp, ty=testty} = transExp(venv, tenv, test)
    in
	assertInt(testty, pos);
	transExp(venv,tenv,body)
    end
  | transExp (venv, tenv, A.LetExp{decs=decs, body=body, pos=pos}) =
    let
	val {venv=venv', tenv=tenv'} = transDecs (venv,tenv,decs)
    in
	transExp(venv', tenv', body)

    end
  | transExp (venv, tenv, A.VarExp(v)) =
    transVar(venv, tenv, v)
  | transExp (venv, tenv, A.ArrayExp{typ,size,init,pos}) =
    let
	val {exp=_, ty=initty} = transExp(venv, tenv, init)
	val retty = case S.look(tenv,typ)
		     of SOME (T.ARRAY(ty, unique)) => T.ARRAY(ty, unique)
		      | SOME t => (error pos "That doesn't look like an array type.  Do you think this is PERL?"; T.UNIT)
		      | NONE => (error pos "What?  You think you can just NOT DECLARE YOUR ARRAY TYPES?  HUH?"; T.UNIT)
    in
	assertSame(initty, retty, pos);
	{exp=(), ty=retty}
    end
and transDecs (venv, tenv, []) = {venv=venv, tenv=tenv}
  | transDecs (venv, tenv, dec::tail) = 
    let val {venv=venv1, tenv=tenv1} = transDec(venv, tenv, dec)
    in
	transDecs(venv1, tenv1, tail)
    end
and transVar (venv, tenv, A.SimpleVar (sym,pos)) =
    let val exp = ()
	val typ = case S.look(venv,sym) of SOME (Env.VarEntry t) => #ty t
					 | SOME (Env.FunEntry t) => #result t
					 | _ => (error pos "Dude.  You can't even get a variable expression right.  Don't you think it's time for 'M-x doctor'?"; T.UNIT)
    in
	{exp=exp, ty=typ}
    end
  | transVar (venv, tenv, A.FieldVar(var, fieldname, pos)) =
    let
   	val {exp=_, ty=ty} = transVar(venv, tenv, var)
    in
   	{exp = (),
	 ty = case ty of T.RECORD (elts, unique) =>
			 (case (List.find (fn (sym, ty) => fieldname = sym) elts)
			   of SOME (sym', ty') => ty'
			    | NONE => (error pos ("You will die a horrible death because: no such element in record "
				       ^ S.name(fieldname)); T.UNIT))
		       | _ => (error pos ("No such record type " ^ S.name(fieldname)); T.UNIT)}
    end
  | transVar (venv, tenv, A.SubscriptVar(var, exp, pos)) =
    let
	val {exp=_, ty=indexty} = transExp(venv,tenv,exp)
	val {exp=varexp, ty=varty} = transVar(venv,tenv,var)
	val retty =
	    case indexty of T.INT =>
			    (case varty of T.ARRAY (ty, unique) =>
					   ty
					 | _ => (error pos "Are you TRYING TO FUCK WITH ME?  That's not a array!"; T.UNIT))
			  | _ => (error pos "You really think you can index into an array with a non-integer, don't you?  My mommy warned me about people like you.  I bet you were the freak in your class.  Well, we don't need that here.  I'm not taking any candy from you."; T.UNIT)
    in
	{exp = (), ty=retty}
    end
and transDec (venv, tenv, A.VarDec{name,typ=NONE,init, pos, escape}) =
    let
	val {exp,ty} = transExp(venv, tenv, init)
    in
	{tenv=tenv, venv=S.enter(venv, name, Env.VarEntry{ty=ty})}
    end
  | transDec (venv, tenv, A.VarDec{name, typ=SOME (sym, decpos), init, pos,escape}) =
    let
   	val {exp=varexp, ty=varty} = transExp(venv, tenv, init)
    in
   	let val decty =
		case S.look(tenv, sym) of SOME t => t
					| NONE => (error pos "you bitch! unknown return type!!1!";
						   T.UNIT)
	in
	    assertSame(decty, varty, pos);
	    {venv=S.enter(venv, name, Env.VarEntry{ty=decty}), tenv=tenv}
	end
    end
<<<<<<< semant.sml
  | transDec (venv, tenv, A.TypeDec[{name, ty, pos}]) =
<<<<<<< semant.sml
    {venv=venv,tenv=S.enter(tenv, name, transTy (tenv, ty))}
(*isaac*)
  | transDec (venv, tenv, A.TypeDec ({name, ty, pos}::tail)) =
    (*should probably still do empty list... *)
	let fun getHeaders (tenv, A.TypeDec [{name,ty,pos}]) = 
		S.enter(tenv, name, Types.NAME(name, ref NONE))	    
	      | getHeaders (tenv, A.TypeDec ({name,ty,pos}::tail)) = 
		let val tenv' = S.enter(tenv, name, Types.NAME(name, ref NONE)) 
		in
		    getHeaders (tenv', A.TypeDec(tail))
		end
	in
	    let 
		val mylist =  {name, ty, pos}::tail
		val tenv1  = getHeaders (tenv, mylist)
		val tenv'' = S.enter(tenv1, name, transTy (tenv', ty)) 
	    in
		transDec (venv, tenv'', tail)
	    end
	end (* getHeaders sub *)
	
(*isaac*)
=======
    {venv=venv,tenv=S.enter(tenv, name, transTy(tenv, ty))}
>>>>>>> 1.15
=======
| transDec (venv, tenv, A.TypeDec ({name, ty, pos}::tail)) =
    (*should probably still do empty list... *)
	let fun getHeaders (tenv, A.TypeDec [{name,ty,pos}]) = 
		S.enter(tenv, name, Types.NAME(name, ref NONE))	    
	      | getHeaders (tenv, A.TypeDec ({name,ty,pos}::tail)) = 
		let val tenv' = S.enter(tenv, name, Types.NAME(name, ref NONE)) 
		in
		    getHeaders (tenv', A.TypeDec(tail))
		end
	in
	    let 
		val mylist = {name=name, ty=ty, pos=pos}::tail
		val tenv1  = getHeaders (tenv, mylist : A.dec)
		val tenv'' = S.enter(tenv1, name, transTy (tenv1, ty)) 
	    in
		transDec (venv, tenv'', tail)
	    end
	end (* getHeaders sub *)
>>>>>>> 1.16
  | transDec (venv, tenv, A.FunctionDec [{name, params, body, pos, result=SOME (retsym,retpos)}]) = 
    let val rettype = 
	    case S.look(tenv, retsym) of 
		SOME (foobar) => foobar
	      | NONE => (error pos "parsing yielding lacking or faulty typing binder, uncle fucka'"; T.UNIT);
	    fun transparam {name, typ, pos, escape} =
		case S.look (tenv, typ)
		 of SOME t => {name=name, ty=t}
		  | NONE => (error pos "fool, parsing yielding lacking typing declaritor in actual parameter declaration list"; 
			     {name=name, ty=T.UNIT});
            val params' = map transparam params
	    val venv' = S.enter (venv, name,
				 Env.FunEntry{formals=map #ty params',
					    result=rettype})
	    fun enterparam ({name,ty},venv)=
		S.enter(venv,name,
			Env.VarEntry{ty=ty})
	    val venv'' = List.foldr enterparam venv' params'
    in transExp(venv'', tenv, body);
    {venv=venv', tenv=tenv}
    end
<<<<<<< semant.sml

and transTy (tenv, A.RecordTy (lisp)) = 
=======
and transTy (tenv, A.RecordTy (lisp)) = 
>>>>>>> 1.15
  T.RECORD
      (map (fn {name=name,typ=typ,escape=ref escape,pos=pos} : A.field =>
	       case S.look(tenv, typ) of SOME t =>
					 (name, t)
				       | NONE => (error pos "frobnication failed (probable cause: user stupidity)"; (name, T.UNIT)))
	   lisp, ref ())
| transTy (tenv, A.NameTy (sym, pos)) = 
    (case S.look(tenv, sym) of 
	 SOME foobar => foobar
       | NONE => (error pos "parsing yielding lacking or faulty typing binder within typed name type ty statement, uncle fucka"; T.UNIT))
| transTy (tenv, A.ArrayTy (sym, pos)) = 
  (case S.look (tenv, sym) of 
       SOME (foobar) => foobar
     | NONE => (error pos "YOU JUST DON'T GET IT, DO YOU!  DECLARE YOUR FUCKING ARRAY TYPES!!1!!1"; T.UNIT))

end			       
end