wip

pact-core/Pact/Core/Errors.hs

@@ -130,6 +130,8 @@ data DesugarError
   --
   | EmptyDefPact Text
   -- ^ Defpact without steps
+  | LastStepWithRollback QualifiedName
+  -- ^ Last Step has Rollback error
   deriving Show
 
 instance Exception DesugarError
@@ -183,6 +185,8 @@ instance Pretty DesugarError where
       Pretty.hsep ["Invalid Interface attempted to be used as module reference:", pretty mn]
     EmptyBindingBody -> "Bind expression lacks an accompanying body"
     EmptyDefPact dp -> Pretty.hsep ["Defpact has no steps:", pretty dp]
+    LastStepWithRollback mn ->
+      Pretty.hsep ["rollbacks aren't allowed on the last step in:", pretty mn]
 
 -- data TypecheckError
 --   = UnificationError (Type Text) (Type Text)

pact-core/Pact/Core/IR/Desugar.hs

@@ -363,7 +363,8 @@ desugarDefPact
   :: forall i m raw reso. MonadDesugar raw reso i m
   => Lisp.DefPact i
   -> m (DefPact ParsedName DesugarType raw i)
-desugarDefPact (Lisp.DefPact dpname _ _ [] _ _ i) = throwDesugarError (EmptyDefPact dpname) i
+desugarDefPact (Lisp.DefPact dpname _ _ [] _ _ i) =
+  throwDesugarError (EmptyDefPact dpname) i
 desugarDefPact (Lisp.DefPact dpname margs rt (step:steps) _ _ i) =
   view reCurrModule >>= \case
     Just mn -> do
@@ -383,7 +384,12 @@ desugarDefPact (Lisp.DefPact dpname margs rt (step:steps) _ _ i) =
           <$> desugarStep s
           <*> desugarStep rb
           <*> desugarMSteps ms
-      pure $ DefPact dpname args' rt (NE.reverse steps') i
+
+      -- In Pact, last steps are not allowed to roll back.
+      when (hasRollback $ NE.last steps') $
+        throwDesugarError (LastStepWithRollback (QualifiedName dpname mn)) i
+
+      pure $ DefPact dpname args' rt steps' i
     Nothing -> error "Defpact is module-less"
 
 desugarDefConst

pact-core/Pact/Core/IR/Eval/CEK.hs

@@ -539,6 +539,13 @@ returnCEKValue (StackPopC mty cont) handler v = do
   v' <- (`maybeTCType` mty) =<< enforcePactValue v
   -- Todo: unsafe use of tail here. need `tailMay`
   (esStack %%= tail) *> returnCEKValue cont handler (VPactValue v')
+returnCEKValue (PactStepC cont) handler v = do
+  -- We need to reset the `yield` value of the current pact exection
+  -- environment to match pact semantics. This `PactStepC` frame is
+  -- only used as a continuation which resets the `yield`.
+  setEvalState (esPactExec . _Just . peYield) Nothing
+  returnCEKValue cont handler v
+
 
 
 applyLam

pact-core/Pact/Core/IR/Eval/Runtime/Types.hs

@@ -442,6 +442,7 @@ data Cont b i m
   | CapBodyC (CEKEnv b i m) (EvalTerm b i) (Cont b i m)
   | CapPopC CapPopState (Cont b i m)
   | StackPopC (Maybe Type) (Cont b i m)
+  | PactStepC (Cont b i m)
   | Mt
   deriving Show
 

pact-core/Pact/Core/IR/Eval/Runtime/Utils.hs

@@ -118,7 +118,7 @@ enforcePactValue = \case
 -- viewsCEKEnv :: (MonadEval b i m) => Lens' (EvalEnv b i m) s -> (s -> a) -> m a
 -- viewsCEKEnv l f = views f l <$> cekReadEnv f
 
-setEvalState :: (MonadEval b i m) => Lens' (EvalState b i) s -> s -> m ()
+setEvalState :: (MonadEval b i m) => Traversal' (EvalState b i) s -> s -> m ()
 setEvalState l s = modifyEvalState (set l s)
 
 -- overEvalState :: (MonadEval b i m) => Lens' (EvalState b i) s -> (s -> s) -> m ()

pact-core/Pact/Core/Repl/Runtime/ReplBuiltin.hs

@@ -119,7 +119,7 @@ continuePact info b = mkReplBuiltinFn info b \cont handler -> \case
                 Step s' _ -> toClosure s'
                 StepWithRollback s' _rb _ -> toClosure s'
               setEvalState esPactExec (Just $ over peStep (+1) pe)
-              returnCEK cont handler v
+              returnCEK (PactStepC cont) handler v
           | otherwise ->
             throwExecutionError info (ContinuePactInvalidContext s (toInteger (_peStep pe)) (toInteger (_peStepCount pe)))
         _ -> pure (VError "continuation is not a defpact")

pact-core/Pact/Core/Syntax/Parser.y

@@ -262,7 +262,7 @@ Defcap :: { SpanInfo -> DefCap SpanInfo }
 
 DefPact :: { SpanInfo -> DefPact SpanInfo }
   : defpact IDENT MTypeAnn '(' MArgs ')' MDocOrModel Steps
-    { DefPact (getIdent $2) $5 $3 $8 (fst $7) (snd $7) }
+  { DefPact (getIdent $2) $5 $3 (reverse $8) (fst $7) (snd $7) }
 
 Steps :: { [PactStep SpanInfo] }
   : Steps Step { $2:$1 }