Skip to content

Commit

Permalink
Transform some conditionals to and/or expressions
Browse files Browse the repository at this point in the history
  • Loading branch information
minoki committed Sep 9, 2024
1 parent 07d6008 commit f2271dc
Show file tree
Hide file tree
Showing 2 changed files with 72 additions and 6 deletions.
4 changes: 4 additions & 0 deletions src/codegen-lua.sml
Original file line number Diff line number Diff line change
Expand Up @@ -1703,6 +1703,10 @@ struct
, vector (doCExp (ctx, env', SOME contParam, body))
)
end
| doExp (ctx, env, N.LogicalAnd (x, y)) =
L.BinExp (L.AND, doExp (ctx, env, x), doExp (ctx, env, y))
| doExp (ctx, env, N.LogicalOr (x, y)) =
L.BinExp (L.OR, doExp (ctx, env, x), doExp (ctx, env, y))
and doDecs (ctx, env, defaultCont, decs, finalExp, revStats: L.Stat list) =
(case decs of
[] => List.revAppend (revStats, doCExp (ctx, env, defaultCont, finalExp))
Expand Down
74 changes: 68 additions & 6 deletions src/nested.sml
Original file line number Diff line number Diff line change
Expand Up @@ -22,6 +22,8 @@ sig
, body: Stat
, attr: CSyntax.AbsAttr
} (* non-recursive function *)
| LogicalAnd of Exp * Exp
| LogicalOr of Exp * Exp
(* TODO: direct-style function application? *)
and Dec =
ValDec of {exp: Exp, results: (Var option) list}
Expand Down Expand Up @@ -71,6 +73,8 @@ struct
, body: Stat
, attr: CSyntax.AbsAttr
} (* non-recursive function *)
| LogicalAnd of Exp * Exp
| LogicalOr of Exp * Exp
and Dec =
ValDec of {exp: Exp, results: (Var option) list}
| RecDec of
Expand Down Expand Up @@ -206,6 +210,10 @@ struct
| goExp (ExnTag _) = ()
| goExp (Projection {record, ...}) = goExp record
| goExp (Abs {body, ...}) = goStat body
| goExp (LogicalAnd (x, y)) =
(goExp x; goExp y)
| goExp (LogicalOr (x, y)) =
(goExp x; goExp y)
and goDec (ValDec {exp, ...}) = goExp exp
| goDec (RecDec decs) =
List.app (fn {body, ...} => goStat body) decs
Expand Down Expand Up @@ -289,6 +297,10 @@ struct
{label = label, record = record, fieldTypes = fieldTypes})
(goExp record)
| goExp (Abs _) = NONE
| goExp (LogicalAnd (x, y)) =
Option.map (fn x => LogicalAnd (x, y)) (goExp x)
| goExp (LogicalOr (x, y)) =
Option.map (fn x => LogicalOr (x, y)) (goExp x)
fun goDecs [] = NONE
| goDecs (ValDec {exp, results} :: decs) =
Option.map
Expand Down Expand Up @@ -354,6 +366,10 @@ struct
, body = goStat body
, attr = attr
}
| goExp (LogicalAnd (x, y)) =
LogicalAnd (goExp x, goExp y)
| goExp (LogicalOr (x, y)) =
LogicalOr (goExp x, goExp y)
and goDecs (_, [], revAcc) = revAcc (* reversed *)
| goDecs (i, ValDec {exp, results as [SOME v]} :: decs, revAcc) =
let
Expand Down Expand Up @@ -434,7 +450,12 @@ struct
then
case #goStat (replaceOnce (v, exp)) cont of
SOME cont =>
Let {decs = List.rev revDecs1, cont = goStat cont}
let
val cont = goStat cont
in
if List.null revDecs1 then cont
else Let {decs = List.rev revDecs1, cont = cont}
end
| NONE =>
Let {decs = List.rev revDecs0, cont = goStat cont}
else
Expand All @@ -451,11 +472,52 @@ struct
| goStat (AppCont {applied, args}) =
AppCont {applied = applied, args = List.map goExp args}
| goStat (If {cond, thenCont, elseCont}) =
If
{ cond = goExp cond
, thenCont = goStat thenCont
, elseCont = goStat elseCont
}
let
val cond = goExp cond
val thenCont = goStat thenCont
val elseCont = goStat elseCont
fun Not
(PrimOp
{ primOp = FSyntax.PrimCall Primitives.Bool_not
, tyargs = _
, args = [x]
}) = x
| Not x =
PrimOp
{ primOp = FSyntax.PrimCall Primitives.Bool_not
, tyargs = []
, args = [x]
}
val toLogicalAndOr =
case (thenCont, elseCont) of
( AppCont {applied, args = [x]}
, AppCont {applied = applied', args = [y]}
) =>
if applied = applied' then
case (x, y) of
(Value (C.BoolConst true), Value (C.BoolConst false)) =>
SOME (applied, cond)
| (Value (C.BoolConst false), Value (C.BoolConst true)) =>
SOME (applied, Not cond)
| (_, Value (C.BoolConst true)) =>
SOME (applied, LogicalOr (Not cond, x))
| (_, Value (C.BoolConst false)) =>
SOME (applied, LogicalAnd (cond, x))
| (Value (C.BoolConst true), _) =>
SOME (applied, LogicalOr (cond, y))
| (Value (C.BoolConst false), _) =>
SOME (applied, LogicalAnd (Not cond, y))
| _ => NONE
else
NONE
| _ => NONE
in
case toLogicalAndOr of
SOME (applied, exp) =>
AppCont {applied = applied, args = [exp]}
| NONE =>
If {cond = cond, thenCont = thenCont, elseCont = elseCont}
end
| goStat
(Handle
{body, handler = (e, h), successfulExitIn, successfulExitOut}) =
Expand Down

0 comments on commit f2271dc

Please sign in to comment.