fix tc step types (#1333)

src/Pact/Typechecker.hs

@@ -839,20 +839,22 @@ withScopeBodyToFun fnname modname funTy body deftype info = do
   return $ FDefun info modname fnname deftype funType args tcs funId
 
 assocStepYieldReturns :: TopLevel Node -> [AST Node] -> TC ()
-assocStepYieldReturns (TopFun (FDefun _ _ _ Defpact _ _ _ _) _) steps =
+assocStepYieldReturns (TopFun (FDefun _ _ _ Defpact _ _ _ rty) _) steps =
   void $ toStepYRs >>= foldM go (Nothing,0::Int)
   where
     lastStep = pred $ length steps
     toStepYRs = forM steps $ \step -> case step of
-      Step{..} -> case (_aYieldResume, _aRollback) of
-
-        -- check that a cross-chain yield and rollback do not occur
-        -- in the same step, otherwise build the tuple
-        (Just y, Just{}) ->
-          if _yrCrossChain y
-          then die'' step "Illegal rollback with yield"
-          else return (_aNode, _aYieldResume)
-        _ -> return (_aNode, _aYieldResume)
+      Step{..} -> do
+        -- Associate the DefPact return type with each step
+        assocNode rty _aNode
+        case (_aYieldResume, _aRollback) of
+          -- check that a cross-chain yield and rollback do not occur
+          -- in the same step, otherwise build the tuple
+          (Just y, Just{}) ->
+            if _yrCrossChain y
+            then die'' step "Illegal rollback with yield"
+            else return (_aNode, _aYieldResume)
+          _ -> return (_aNode, _aYieldResume)
       _ -> die'' step "Non-step in defpact"
     yrMay l yr = preview (_Just . l . _Just) yr
     go :: (Maybe (YieldResume Node),Int) -> (Node, Maybe (YieldResume Node)) -> TC (Maybe (YieldResume Node),Int)
@@ -879,7 +881,6 @@ assocStepYieldReturns (TopFun (FDefun _ _ _ Defpact _ _ _ _) _) steps =
       b' <- lookupSchemaTy b
       debug $ "assocYRSchemas: " ++ showPretty ((a,a'),(b,b'))
       assocParams (_aId a) a' b'
-
 assocStepYieldReturns _ _ = return ()
 
 

tests/pact/caps.repl

@@ -60,7 +60,7 @@
 
   (defpact test-pact-guards (id:string)
     (step (step1 id))
-    (step (step2 (read-msg "id"))))
+    (step (let ((s2 (step2 (read-msg "id")))) "step2")))
 
   (defun step1 (id:string)
     (insert guard-table id { "g": (create-pact-guard "test")}))
@@ -207,7 +207,7 @@
 
 (env-data { "id": "a"})
 
-(expect "pact enforce succeeds" 1 (at 'result (continue-pact 1 false (hash "pact-guards-a-id"))))
+(expect "pact enforce succeeds" "step2"  (continue-pact 1 false (hash "pact-guards-a-id")))
 
 (pact-state true)
 (env-hash (hash "pact-guards-b-id"))

tests/pact/tc.repl

@@ -329,6 +329,16 @@
     "test anon lambdas"
     (map (lambda (i) (> i 1)) [1 2 3]))
 
+  (defpact fail-steps-type-missmatch: integer ()
+    "test type missmatch of steps"
+    (step "missmatch")
+    (step 1))
+
+  (defpact tc-steps-type-pass: integer ()
+    "test type match of steps"
+    (step 1)
+    (step 1))
+
 )
 
 (create-table persons)