Skip to content

Commit 5c12951

Browse files
committed
Switch to top-down traversal, do not evaluate under delay
1 parent 13e8d0b commit 5c12951

6 files changed

Lines changed: 80 additions & 35 deletions

File tree

plutus-core/untyped-plutus-core/src/UntypedPlutusCore/Transform/EvaluateBuiltins.hs

Lines changed: 6 additions & 5 deletions
Original file line numberDiff line numberDiff line change
@@ -12,7 +12,7 @@ import UntypedPlutusCore.Core
1212
import UntypedPlutusCore.Transform.Certify.Trace
1313
import UntypedPlutusCore.Transform.Optimizer
1414

15-
import Control.Lens (transformOf, (^.))
15+
import Control.Lens (over, (^.))
1616
import Data.Functor (void)
1717

1818
evaluateBuiltinsPass
@@ -40,8 +40,7 @@ evaluateBuiltins
4040
-> CostingPart uni fun
4141
-> Term name uni fun a
4242
-> OptimizerT name uni fun a m (Term name uni fun a)
43-
evaluateBuiltins preserveLogging binfo costModel =
44-
pure . transformOf termSubterms processTerm
43+
evaluateBuiltins preserveLogging binfo costModel = pure . processTerm
4544
where
4645
-- Nothing means "leave the original term as it was"
4746
eval
@@ -72,10 +71,12 @@ evaluateBuiltins preserveLogging binfo costModel =
7271
eval _ _ = Nothing
7372

7473
processTerm :: Term name uni fun a -> Term name uni fun a
74+
-- We should never evaluate under a delay
75+
processTerm t@(Delay {}) = t
7576
-- See Note [Context splitting in a recursive pass]
7677
processTerm t@(splitAppCtx -> (Builtin x bn, argCtx)) =
7778
let runtime = toBuiltinRuntime costModel (toBuiltinMeaning (binfo ^. biSemanticsVariant) bn)
78-
in case eval runtime argCtx of
79+
in over termSubterms processTerm $ case eval runtime argCtx of
7980
-- Builtin evaluation gives us a fresh term with no annotation.
8081
-- Use the annotation of the builtin node, arbitrarily. This is slightly
8182
-- suboptimal, e.g. in `ifThenElse True x y`, we will get back `x`, but
@@ -84,4 +85,4 @@ evaluateBuiltins preserveLogging binfo costModel =
8485
-- See Note [Unserializable constants]
8586
Just t' | termIsSerializable binfo t' -> x <$ t'
8687
_ -> t
87-
processTerm t = t
88+
processTerm t = over termSubterms processTerm t
Lines changed: 4 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -1,5 +1,8 @@
11
force
22
(force
33
(case
4-
(constr 0 [False, (delay (addInteger 3 3)), (delay 3)])
4+
(constr 0
5+
[ False
6+
, (delay ((\cse -> addInteger cse cse) (addInteger 1 2)))
7+
, (delay (addInteger 1 2)) ])
58
[ifThenElse]))

plutus-core/untyped-plutus-core/test/Transform/floatDelay2.golden.certifier-hints

Lines changed: 13 additions & 10 deletions
Original file line numberDiff line numberDiff line change
@@ -20,18 +20,21 @@ NoHints
2020
NoHints
2121

2222
-- Certifier hints #8 (Right Inline) --
23-
InlDrop
24-
InlApply
23+
InlApply
24+
InlLam
2525
InlApply
26-
InlBuiltin
26+
InlApply
27+
InlBuiltin
28+
InlForce
29+
InlVar
2730
InlForce
28-
InlExpand
29-
InlDelay
30-
InlCon
31-
InlForce
32-
InlExpand
33-
InlDelay
34-
InlCon
31+
InlVar
32+
InlDelay
33+
InlApply
34+
InlApply
35+
InlBuiltin
36+
InlCon
37+
InlCon
3538

3639

3740
-- Certifier hints #9 (Right ApplyToCase) --
Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -1 +1 @@
1-
addInteger (force (delay 3)) (force (delay 3))
1+
(\a -> addInteger (force a) (force a)) (delay (addInteger 1 2))

plutus-tx-plugin/test/Budget/9.6/toFromData.golden.eval

Lines changed: 4 additions & 4 deletions
Original file line numberDiff line numberDiff line change
@@ -1,7 +1,7 @@
1-
CPU: 885_395
2-
Memory: 3_960
3-
AST Size: 41
4-
Flat Size: 72
1+
CPU: 1_994_272
2+
Memory: 8_584
3+
AST Size: 95
4+
Flat Size: 115
55

66
(constr
77
1 (constr 0 (constr 0 (con bool True) (con integer 1) (con bool False)))
Lines changed: 52 additions & 14 deletions
Original file line numberDiff line numberDiff line change
@@ -1,16 +1,54 @@
11
(program
22
1.1.0
3-
(constr 1
4-
[ (constr 0
5-
[ (constr 0
6-
[ (case
7-
(1, [])
8-
[ (\index args ->
9-
case index [(\ds -> False), (\ds -> True)] args) ])
10-
, (unIData (force headList [I 1, Constr 0 []]))
11-
, (case
12-
(unConstrData
13-
(force headList (force tailList [I 1, Constr 0 []])))
14-
[ (\index args ->
15-
case index [(\ds -> False), (\ds -> True)]
16-
args) ]) ]) ]) ]))
3+
(case
4+
1
5+
[ (\ds -> constr 0 [(unIData (force headList ds))])
6+
, (\ds ->
7+
constr 1
8+
[ (case
9+
(unConstrData (force headList ds))
10+
[ (\index args ->
11+
case
12+
index
13+
[ (\ds ->
14+
constr 0
15+
[ (case
16+
(unConstrData (force headList ds))
17+
[ (\index args ->
18+
case
19+
index
20+
[ (\ds ->
21+
(\l ->
22+
constr 0
23+
[ (case
24+
(unConstrData
25+
(force headList
26+
ds))
27+
[ (\index args ->
28+
case
29+
index
30+
[ (\ds ->
31+
False)
32+
, (\ds ->
33+
True) ]
34+
args) ])
35+
, (unIData
36+
(force headList l))
37+
, (case
38+
(unConstrData
39+
(force headList
40+
(force tailList
41+
l)))
42+
[ (\index args ->
43+
case
44+
index
45+
[ (\ds ->
46+
False)
47+
, (\ds ->
48+
True) ]
49+
args) ]) ])
50+
(force tailList ds)) ]
51+
args) ]) ])
52+
, (\ds -> constr 1 []) ]
53+
args) ]) ]) ]
54+
[Constr 0 [Constr 0 [Constr 1 [], I 1, Constr 0 []]]]))

0 commit comments

Comments
 (0)