Skip to content

Commit

Permalink
Fix CaseOfCase UPLC transform.
Browse files Browse the repository at this point in the history
  • Loading branch information
Unisay committed May 8, 2024
1 parent f79ed35 commit f3d65a7
Show file tree
Hide file tree
Showing 4 changed files with 29 additions and 19 deletions.
Original file line number Diff line number Diff line change
Expand Up @@ -27,11 +27,15 @@ import Control.Lens
caseOfCase :: (fun ~ PLC.DefaultFun) => Term name uni fun a -> Term name uni fun a
caseOfCase = transformOf termSubterms $ \case
Case ann scrut alts
| ( ite@(Force _ (Builtin _ PLC.IfThenElse))
| ( ite@(Force a (Builtin _ PLC.IfThenElse))
, [cond, (trueAnn, true@Constr{}), (falseAnn, false@Constr{})]
) <-
splitApplication scrut ->
mkIterApp
ite
[cond, (trueAnn, Case ann true alts), (falseAnn, Case ann false alts)]
Force a $
mkIterApp
ite
[ cond
, (trueAnn, Delay trueAnn (Case ann true alts))
, (falseAnn, Delay falseAnn (Case ann false alts))
]
other -> other
Original file line number Diff line number Diff line change
@@ -1,7 +1,9 @@
[
(force
[
[ (force (builtin ifThenElse)) b_0 ]
(case (constr 0) (con integer 1) (con integer 2))
[
[ (force (builtin ifThenElse)) b_0 ]
(delay (case (constr 0) (con integer 1) (con integer 2)))
]
(delay (case (constr 1) (con integer 1) (con integer 2)))
]
(case (constr 1) (con integer 1) (con integer 2))
]
)
Original file line number Diff line number Diff line change
@@ -1,7 +1,9 @@
[
(force
[
[ (force (builtin ifThenElse)) b_0 ]
(case (constr 0 x_1 xs_2) f_3 (con integer 2))
[
[ (force (builtin ifThenElse)) b_0 ]
(delay (case (constr 0 x_1 xs_2) f_3 (con integer 2)))
]
(delay (case (constr 1) f_3 (con integer 2)))
]
(case (constr 1) f_3 (con integer 2))
]
)
Original file line number Diff line number Diff line change
@@ -1,7 +1,9 @@
[
(force
[
[ (force (builtin ifThenElse)) (con bool True) ]
(case (constr 0) (con unit ()) (error))
[
[ (force (builtin ifThenElse)) (con bool True) ]
(delay (case (constr 0) (con unit ()) (error)))
]
(delay (case (constr 1) (con unit ()) (error)))
]
(case (constr 1) (con unit ()) (error))
]
)

0 comments on commit f3d65a7

Please sign in to comment.