Core: simplify parser further, remove do keyword

pact-lsp/Pact/Core/LanguageServer/Utils.hs

@@ -22,7 +22,8 @@ termAt p term
       t@(App tm1 tm2 _) ->
         termAt p tm1 <|> getAlt (foldMap (Alt . termAt p) tm2) <|> Just t
       t@(Let _ tm1 tm2 _) -> termAt p tm1 <|> termAt p tm2 <|> Just t
-      t@(Sequence tm1 tm2 _) -> termAt p tm1 <|> termAt p tm2 <|> Just t
+      -- Note: no term will ever match `Sequence`. It is generated by the compiler 
+      Sequence tm1 tm2 _ -> termAt p tm1 <|> termAt p tm2
       t@(BuiltinForm op' _) ->
         case op' of
           CAnd a b  -> termAt p a <|> termAt p b

pact-tests/Pact/Core/Test/LexerParserTests.hs

@@ -135,22 +135,21 @@ exprGen = Gen.recursive Gen.choice
   [ Gen.subtermM exprGen $ \x -> do
       xs <- Gen.list (Range.linear 0 8) exprGen
       pure $ Lisp.App x xs ()
-  , (`Lisp.Block` ()) <$> Gen.nonEmpty (Range.linear 1 8) (Gen.subterm exprGen id)
   , (`Lisp.List` ()) <$> Gen.list (Range.linear 1 8) (Gen.subterm exprGen id)
   , lamGen
-  , Gen.subtermM exprGen letGen
+  , letGen
   ]
   where
     lamGen = do
       par <- Gen.list (Range.linear 0 8) $ do
         i <- identGen
         ty <- Gen.maybe typeGen
         pure (Lisp.MArg i ty ())
-      expr <- Gen.subterm exprGen id
-      pure $ Lisp.Lam par expr ()
+      Lisp.Lam par <$> Gen.nonEmpty (Range.linear 1 8) exprGen <*> pure ()
 
-    letGen inner = do
+    letGen = do
       binders <- Gen.nonEmpty (Range.constant 1 8) binderGen
+      inner <- Gen.nonEmpty (Range.linear 1 8) exprGen
       pure $ Lisp.Let LFLetNormal binders inner ()
 
     typeGen :: Gen Lisp.Type

pact-tests/Pact/Core/Test/StaticErrorTests.hs

@@ -83,13 +83,66 @@ desugarTests =
           )
         )
       |])
-  , ("enforce-one_no_list", isDesugarError _InvalidSyntax, [text|
-      (module m g (defcap g () true)
-        (defun enforce-cap ()
-          (enforce-one "foo" 1)
-          )
-        )
+  , ("empty_if", isDesugarError _InvalidSyntax, [text|
+      (if)
+      |])
+
+  , ("if_invalid_args", isDesugarError _InvalidSyntax, [text|
+      (if 1)
+      |])
+
+  , ("empty_do", isDesugarError _InvalidSyntax, [text|
+      (do)
+      |])
+
+  , ("empty_with_cap", isDesugarError _InvalidSyntax, [text|
+      (with-capability)
+      |])
+
+  , ("one_arg_with_cap", isDesugarError _InvalidSyntax, [text|
+      (with-capability 1)
+      |])
+
+  , ("empty_enforce_one", isDesugarError _InvalidSyntax, [text|
+      (enforce-one)
+      |])
+
+  , ("one_arg_enforce_one", isDesugarError _InvalidSyntax, [text|
+      (enforce-one 1)
+      |])
+
+  , ("empty_suspend", isDesugarError _InvalidSyntax, [text|
+      (suspend)
+      |])
+
+  , ("n-ary_suspend", isDesugarError _InvalidSyntax, [text|
+      (suspend 2 3 4 5 6)
+      |])
+
+  , ("empty_cond", isDesugarError _InvalidSyntax, [text|
+      (cond)
+      |])
+
+  , ("invalid_cond", isDesugarError _InvalidSyntax, [text|
+      (cond 1 2 3)
+      |])
+
+  , ("empty_create-user-guard", isDesugarError _InvalidSyntax, [text|
+      (create-user-guard)
+      |])
+
+  , ("n-ary_create-user-guard", isDesugarError _InvalidSyntax, [text|
+      (create-user-guard 2 3 4 5 6)
       |])
+
+  , ("empty_try", isDesugarError _InvalidSyntax, [text|
+      (try)
+      |])
+
+  , ("n-ary_try", isDesugarError _InvalidSyntax, [text|
+      (try 2 3 4 5 6)
+      |])
+
   , ("managed_invalid", isDesugarError _InvalidManagedArg, [text|
       (module mgd-mod G
         (defcap G () true)
@@ -561,6 +614,14 @@ executionTests =
 
       (module another ag (defcap ag () true))
     |])
+  , ("enforce-one_no_list", isExecutionError _NativeExecutionError, [text|
+      (enforce-one "asdf" 1)
+      |])
+
+  , ("user_guard_no_app", isExecutionError _NativeExecutionError, [text|
+      (create-user-guard 1)
+      |])
+
   , ("enforce_ns_install_interface", isExecutionError _NamespaceInstallError, [text|
       (module m g (defcap g () true)
         (defun manage (ns guard) true)

pact-tests/constructor-tag-goldens/DesugarError.golden

@@ -13,15 +13,14 @@
 {"conName":"InvalidDefInTermVariable","conIndex":"c"}
 {"conName":"InvalidModuleReference","conIndex":"d"}
 {"conName":"EmptyBindingBody","conIndex":"e"}
-{"conName":"EmptyDefPact","conIndex":"f"}
-{"conName":"LastStepWithRollback","conIndex":"10"}
-{"conName":"ExpectedFreeVariable","conIndex":"11"}
-{"conName":"InvalidManagedArg","conIndex":"12"}
-{"conName":"InvalidImports","conIndex":"13"}
-{"conName":"InvalidImportModuleHash","conIndex":"14"}
-{"conName":"InvalidSyntax","conIndex":"15"}
-{"conName":"InvalidDefInSchemaPosition","conIndex":"16"}
-{"conName":"InvalidDynamicInvoke","conIndex":"17"}
-{"conName":"DuplicateDefinition","conIndex":"18"}
-{"conName":"InvalidBlessedHash","conIndex":"19"}
+{"conName":"LastStepWithRollback","conIndex":"f"}
+{"conName":"ExpectedFreeVariable","conIndex":"10"}
+{"conName":"InvalidManagedArg","conIndex":"11"}
+{"conName":"InvalidImports","conIndex":"12"}
+{"conName":"InvalidImportModuleHash","conIndex":"13"}
+{"conName":"InvalidSyntax","conIndex":"14"}
+{"conName":"InvalidDefInSchemaPosition","conIndex":"15"}
+{"conName":"InvalidDynamicInvoke","conIndex":"16"}
+{"conName":"DuplicateDefinition","conIndex":"17"}
+{"conName":"InvalidBlessedHash","conIndex":"18"}
 

pact-tests/gas-goldens/builtinGas.golden

@@ -81,7 +81,7 @@ not: 139
 not?: 139
 or?: 139
 pact-id: 60000271
-pairing-check: 67003096
+pairing-check: 67003097
 parse-time: 2102
 point-add: 5425
 poseidon-hash-hack-a-chain: 6393700

pact-tests/pact-tests/yield.repl

@@ -92,7 +92,7 @@
 
 ;; check events
 (expect "step 0 events"
- [{"module-hash": "oKFbzkuEYAFhP-S2mW7hRvRJUPJf2FvMFy1CpxhGs4o"
+ [{"module-hash": "rmN99MpBmJbapgVRV3GjII6I4UUkl8k5pBF7-k92Lt8"
    ,"name": "pact.X_YIELD"
    ,"params": ["1" "yieldtest.cross-chain" ["emily"]]}]
  (env-events true))
@@ -106,7 +106,7 @@
 
 ;; check events
 (expect "step 1 events"
- [{"module-hash": "oKFbzkuEYAFhP-S2mW7hRvRJUPJf2FvMFy1CpxhGs4o"
+ [{"module-hash": "rmN99MpBmJbapgVRV3GjII6I4UUkl8k5pBF7-k92Lt8"
     ,"name": "pact.X_RESUME"
     ,"params": ["0" "yieldtest.cross-chain" ["emily"]]}]
  (env-events true))

pact/Pact/Core/Capabilities.hs

@@ -55,24 +55,6 @@ dcMetaFqName f = \case
     DefManaged . DefManagedMeta i . FQName <$> f fqn
   p -> pure p
 
--- data CapForm name e
---   = WithCapability e e
---   | CreateUserGuard name [e]
---   deriving (Show, Functor, Foldable, Traversable, Eq, Generic)
-
-
--- capFormName :: Traversal (CapForm name e) (CapForm name' e) name name'
--- capFormName f = \case
---   WithCapability e e' -> pure (WithCapability e e')
---   CreateUserGuard name es -> (`CreateUserGuard` es) <$> f name
-
--- instance (Pretty name, Pretty e) => Pretty (CapForm name e) where
---   pretty = \case
---     WithCapability cap body ->
---       parens ("with-capability" <+> parens (pretty cap <+> pretty body))
---     CreateUserGuard name es ->
---       parens ("create-user-guard" <+> parens (pretty name <+> hsep (pretty <$> es)))
-
 -- | An acquired capability token
 -- with the reference
 data CapToken name v
@@ -168,7 +150,6 @@ instance (Pretty name, Pretty v) => Pretty (CapToken name v) where
     pretty $ PrettyLispApp qn args
 
 instance (NFData name, NFData v) => NFData (Signer name v)
--- instance (NFData name, NFData e) => NFData (CapForm name e)
 instance (NFData name, NFData v) => NFData (ManagedCap name v)
 instance NFData v => NFData (ManagedCapType v)
 instance NFData v => NFData (PactEvent v)

pact/Pact/Core/Errors.hs

@@ -75,7 +75,6 @@ module Pact.Core.Errors
  , _InvalidDefInTermVariable
  , _InvalidModuleReference
  , _EmptyBindingBody
- , _EmptyDefPact
  , _LastStepWithRollback
  , _ExpectedFreeVariable
  , _InvalidManagedArg
@@ -306,8 +305,6 @@ data DesugarError
   -- ^ Invalid: Interface used as module reference
   | EmptyBindingBody
   -- ^ Binding form has no expressions to bind to
-  | EmptyDefPact Text
-  -- ^ Defpact without steps
   | LastStepWithRollback QualifiedName
   -- ^ Last Step has Rollback error
   | ExpectedFreeVariable Text
@@ -372,7 +369,6 @@ instance Pretty DesugarError where
     InvalidModuleReference mn ->
       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]
     ExpectedFreeVariable t ->