Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with
or
.
Download ZIP
Browse files

added record comparisons

  • Loading branch information...
commit 2d7128fe49e8fe9fdb3eef5906b5dc486f3398dd 1 parent c5b4e64
@yangsu yangsu authored
Showing with 34 additions and 5 deletions.
  1. +28 −5 RegisterAllocation/semant.sml
  2. +6 −0 RegisterAllocation/translate.sml
View
33 RegisterAllocation/semant.sml
@@ -79,7 +79,12 @@ structure Semant :> SEMANT = struct
Types.STRING => ()
| _ => err pos "string required");
exp)
-
+
+ fun checkRecord (rty, {exp, ty}, pos) =
+ ((if compare_ty(rty, ty, pos) then ()
+ else err pos "string required");
+ exp)
+
(* Takes venv, tenv, exp *)
fun transExp(venv, tenv, break, level) = (*removed break to make things compile*)
@@ -99,8 +104,24 @@ structure Semant :> SEMANT = struct
checkInt(right', pos);
{exp=Tr.intOpExp(oper, #exp left', #exp right'), ty=Types.INT})
end
- else if oper = A.EqOp orelse oper = A.NeqOp orelse oper = A.LtOp orelse
- oper = A.LeOp orelse oper = A.GtOp orelse oper = A.GeOp then
+ else if oper = A.LtOp orelse oper = A.LeOp orelse oper = A.GtOp orelse oper = A.GeOp then
+ let
+ val left' = trexp left
+ val right' = trexp right
+ in
+ (case #ty left' of
+ Types.INT =>
+ (checkInt(left', pos);
+ checkInt(right', pos);
+ {exp=Tr.intOpExp(oper, #exp left', #exp right'), ty=Types.INT})
+ | Types.STRING =>
+ (checkString(left', pos);
+ checkString(right', pos);
+ {exp=Tr.stringOpExp(oper, #exp left', #exp right'), ty=Types.INT})
+ | _ => (err pos "can't perform comparisons on this type";
+ {exp=Tr.nilExp(), ty=Types.INT}))
+ end
+ else if oper = A.EqOp orelse oper = A.NeqOp then
let
val left' = trexp left
val right' = trexp right
@@ -114,6 +135,9 @@ structure Semant :> SEMANT = struct
(checkString(left', pos);
checkString(right', pos);
{exp=Tr.stringOpExp(oper, #exp left', #exp right'), ty=Types.INT})
+ | Types.RECORD(symtys, uq) =>
+ (checkRecord(Types.RECORD(symtys, uq), right', pos);
+ {exp=Tr.recordCompExp(oper, #exp left', #exp right'), ty=Types.INT})
| _ => (err pos "can't perform comparisons on this type";
{exp=Tr.nilExp(), ty=Types.INT}))
end
@@ -147,8 +171,7 @@ structure Semant :> SEMANT = struct
val then'' = trexp (then')
in
(checkInt (test', pos);
- checkUnit (then'', pos);
- {exp=(Tr.ifThenExp(#exp test', #exp then'')), ty=Types.UNIT})
+ {exp=(Tr.ifThenExp(#exp test', #exp then'')), ty=(#ty then'')})
end
| SOME else' =>
let
View
6 RegisterAllocation/translate.sml
@@ -35,6 +35,7 @@ sig
val forExp : exp * Tree.label * exp * exp * exp -> exp
val callExp : level * Tree.label * exp list -> exp
val recordExp : exp list -> exp
+ val recordCompExp : Absyn.oper * exp * exp -> exp
val simpleVar : access * level -> exp
val subscriptExp : exp * exp -> exp
@@ -265,6 +266,11 @@ structure Translate : TRANSLATE = struct
| stringOpExp (A.GtOp, left, right) = relopStrExp (T.GT, left, right, "stringGreaterThan")
| stringOpExp (A.GeOp, left, right) = relopStrExp (T.GE, left, right, "stringGreaterThanEqual")
| stringOpExp (_, _, _) = raise Impossible ("illegal operation on strings")
+
+ fun recordCompExp (A.EqOp, left, right) = relopExp (T.EQ, left, right)
+ | recordCompExp (A.NeqOp, left, right) = relopExp (T.NE, left, right)
+ | recordCompExp (_, _, _) = raise Impossible ("illegal operation on records")
+
fun callExp (_:level, label, exps:exp list) = Ex(T.CALL(T.NAME(label), map unEx exps))
fun letExp ([], body) = body
Please sign in to comment.
Something went wrong with that request. Please try again.