Try and build a program

wasm-calc11/src/Calc/Parser/Data.hs

@@ -61,6 +61,6 @@ oneTypeConstructor = do
 constructorArgsParser :: Parser [Type Annotation]
 constructorArgsParser = do
   stringLiteral "("
-  types <- sepBy typeParser (stringLiteral ",")
+  types <- sepEndBy typeParser (stringLiteral ",")
   stringLiteral ")"
   pure types

wasm-calc11/src/Calc/Parser/Expr.hs

@@ -42,7 +42,6 @@ exprParserInternal =
           <|> try tupleParser
           <|> constructorParser
           <|> boxParser
-          <|> inBrackets (addLocation exprParserInternal)
           <|> primExprParser
           <|> ifParser
           <|> loadParser
@@ -52,6 +51,7 @@ exprParserInternal =
           <|> try applyParser
           <|> try varParser
           <|> blockParser
+          <|> inBrackets (addLocation exprParserInternal)
           <?> "term"
    in addLocation (makeExprParser parser table) <?> "expression"
 
@@ -139,15 +139,15 @@ applyParser :: Parser (Expr Annotation)
 applyParser = addLocation $ do
   fnName <- functionNameParser
   stringLiteral "("
-  args <- sepBy exprParserInternal (stringLiteral ",")
+  args <- sepEndBy exprParserInternal (stringLiteral ",")
   stringLiteral ")"
   pure (EApply mempty fnName args)
 
 tupleParser :: Parser (Expr Annotation)
 tupleParser = label "tuple" $
   addLocation $ do
     _ <- stringLiteral "("
-    neArgs <- NE.fromList <$> sepBy1 exprParserInternal (stringLiteral ",")
+    neArgs <- NE.fromList <$> sepEndBy1 exprParserInternal (stringLiteral ",")
     neTail <- case NE.nonEmpty (NE.tail neArgs) of
       Just ne -> pure ne
       _ -> fail "Expected at least two items in a tuple"
@@ -198,7 +198,7 @@ constructorParser :: Parser (Expr Annotation)
 constructorParser =
   let argsParser = do
         stringLiteral "("
-        args <- sepBy1 exprParserInternal (stringLiteral ",")
+        args <- sepEndBy1 exprParserInternal (stringLiteral ",")
         stringLiteral ")"
         pure args
    in label "constructor" $ addLocation $ do
@@ -210,10 +210,7 @@ patternMatchParser :: Parser (Expr Annotation)
 patternMatchParser = addLocation $ do
   matchExpr <- matchExprWithParser
   stringLiteral "{"
-  patterns <-
-    try patternMatchesParser
-      <|> pure
-      <$> patternCaseParser
+  patterns <- patternMatchesParser
   stringLiteral "}"
   case NE.nonEmpty patterns of
     (Just nePatterns) -> pure $ EMatch mempty matchExpr nePatterns
@@ -225,14 +222,14 @@ matchExprWithParser = do
   exprParserInternal
 
 patternMatchesParser :: Parser [(Pattern Annotation, Expr Annotation)]
-patternMatchesParser =
-  sepBy
+patternMatchesParser = do
+  sepEndBy1
     patternCaseParser
     (stringLiteral ",")
 
 patternCaseParser :: Parser (Pattern Annotation, Expr Annotation)
 patternCaseParser = do
-  pat <- orInBrackets patternParser
+  pat <- patternParser
   stringLiteral "->"
   patExpr <- exprParserInternal
   pure (pat, patExpr)

wasm-calc11/src/Calc/Parser/Function.hs

@@ -49,7 +49,7 @@ functionParser =
       fnName <- functionNameParser
       generics <- try genericsParser <|> pure mempty
       stringLiteral "("
-      args <- sepBy argTypeParser (stringLiteral ",")
+      args <- sepEndBy argTypeParser (stringLiteral ",")
       stringLiteral ")"
       stringLiteral "->"
       returnType <- typeParser
@@ -80,7 +80,7 @@ abilityConstraintsParser = myLexeme $ do
 genericsParser :: Parser [TypeVar]
 genericsParser = do
   stringLiteral "<"
-  generics <- sepBy typeVarParser (stringLiteral ",")
+  generics <- sepEndBy typeVarParser (stringLiteral ",")
   stringLiteral ">"
   pure generics
 

wasm-calc11/src/Calc/Parser/Import.hs

@@ -27,7 +27,7 @@ importParser =
       stringLiteral "as"
       impName <- functionNameParser
       stringLiteral "("
-      args <- sepBy argTypeParser (stringLiteral ",")
+      args <- sepEndBy argTypeParser (stringLiteral ",")
       stringLiteral ")"
       stringLiteral "->"
       impReturnType <- typeParser

wasm-calc11/src/Calc/Parser/Pattern.hs

@@ -18,14 +18,12 @@ patternParser :: Parser ParserPattern
 patternParser =
   label
     "pattern match"
-    ( orInBrackets
-        ( try patWildcardParser
-            <|> patPrimParser
-            <|> try patVariableParser
-            <|> try patBoxParser
-            <|> patConstructorParser
-            <|> patTupleParser
-        )
+    ( try patWildcardParser
+        <|> patPrimParser
+        <|> try patVariableParser
+        <|> try patBoxParser
+        <|> patConstructorParser
+        <|> patTupleParser
     )
 
 ----
@@ -49,7 +47,7 @@ patTupleParser :: Parser ParserPattern
 patTupleParser = label "tuple" $
   withLocation (\loc (pHead, pTail) -> PTuple loc pHead pTail) $ do
     _ <- stringLiteral "("
-    neArgs <- NE.fromList <$> sepBy1 patternParser (stringLiteral ",")
+    neArgs <- NE.fromList <$> sepEndBy1 patternParser (stringLiteral ",")
     neTail <- case NE.nonEmpty (NE.tail neArgs) of
       Just ne -> pure ne
       _ -> fail "Expected at least two items in a tuple"
@@ -79,7 +77,7 @@ patArgsParser :: Parser [ParserPattern]
 patArgsParser =
   let argsWithBrackets = do
         stringLiteral "("
-        args <- sepBy1 patternParser (stringLiteral ",")
+        args <- sepEndBy1 patternParser (stringLiteral ",")
         stringLiteral ")"
         pure args
    in try argsWithBrackets <|> pure []

wasm-calc11/src/Calc/Parser/Shared.hs

@@ -1,8 +1,7 @@
 {-# LANGUAGE OverloadedStrings #-}
 
 module Calc.Parser.Shared
-  ( orInBrackets,
-    inBrackets,
+  ( inBrackets,
     myLexeme,
     withLocation,
     stringLiteral,
@@ -48,9 +47,6 @@ addTypeLocation = withLocation (mapOuterTypeAnnotation . const)
 inBrackets :: Parser a -> Parser a
 inBrackets = between2 '(' ')'
 
-orInBrackets :: Parser a -> Parser a
-orInBrackets parser = try parser <|> try (inBrackets parser)
-
 myLexeme :: Parser a -> Parser a
 myLexeme = L.lexeme (L.space space1 empty empty)
 

wasm-calc11/src/Calc/Parser/Type.hs

@@ -15,7 +15,7 @@ import qualified Data.List.NonEmpty as NE
 import Text.Megaparsec
   ( MonadParsec (try),
     label,
-    sepBy1,
+    sepEndBy1,
     (<|>),
   )
 
@@ -56,7 +56,7 @@ tyTupleParser :: Parser ParserType
 tyTupleParser = label "tuple" $
   addTypeLocation $ do
     _ <- stringLiteral "("
-    neArgs <- NE.fromList <$> sepBy1 typeParser (stringLiteral ",")
+    neArgs <- NE.fromList <$> sepEndBy1 typeParser (stringLiteral ",")
     _neTail <- case NE.nonEmpty (NE.tail neArgs) of
       Just ne -> pure ne
       _ -> fail "Expected at least two items in a tuple"
@@ -72,7 +72,7 @@ tyConstructorParser :: Parser ParserType
 tyConstructorParser =
   let argsParser = do
         stringLiteral "("
-        args <- sepBy1 typeParser (stringLiteral ",")
+        args <- sepEndBy1 typeParser (stringLiteral ",")
         stringLiteral ")"
         pure args
    in label "type constructor" $ addTypeLocation $ do

wasm-calc11/src/Calc/Typecheck/Infer.hs

@@ -31,6 +31,9 @@ check ty (EInfix ann op a b) =
   checkInfix (Just ty) ann op a b
 check ty (EMatch ann matchExpr pats) =
   checkMatch (Just ty) ann matchExpr pats
+check ty (EBlock ann inner) = do
+  elabInner <- check ty inner
+  pure $ EBlock (getOuterAnnotation elabInner $> ann) elabInner
 check (TContainer _ tyItems) (ETuple ann fstExpr restExpr) =
   checkTuple (Just tyItems) ann fstExpr restExpr
 check ty (ELet ann pat expr rest) =

wasm-calc11/src/Calc/Types/Data.hs

@@ -8,6 +8,7 @@ import Calc.Types.Constructor
 import Calc.Types.DataName
 import Calc.Types.Type
 import Calc.Types.TypeVar
+import Calc.Utils
 import qualified Data.Map.Strict as M
 import Prettyprinter ((<+>))
 import qualified Prettyprinter as PP
@@ -22,10 +23,6 @@ data Data ann = Data
 instance PP.Pretty (Data ann) where
   pretty = renderDataType
 
--- when on multilines, indent by `i`, if not then nothing
-indentMulti :: Integer -> PP.Doc style -> PP.Doc style
-indentMulti i doc = PP.flatAlt (PP.indent (fromIntegral i) doc) doc
-
 renderDataType ::
   Data ann ->
   PP.Doc style
@@ -36,17 +33,16 @@ renderDataType (Data tyCon vars' constructors') =
     <> if M.null constructors'
       then mempty
       else
-        PP.group $
-          PP.softline
-            <> indentMulti
-              2
-              ( PP.align $
-                  PP.vsep $
-                    zipWith
-                      (<+>)
-                      ("=" : repeat "|")
-                      (printCons <$> M.toList constructors')
-              )
+        PP.line
+          <> indentMulti
+            2
+            ( PP.align $
+                PP.vsep $
+                  zipWith
+                    (<+>)
+                    ("=" : repeat "|")
+                    (printCons <$> M.toList constructors')
+            )
   where
     printVars [] =
       mempty
@@ -59,10 +55,12 @@ renderDataType (Data tyCon vars' constructors') =
       PP.pretty consName
         <> PP.softline'
         <> "("
-        <> PP.hang
-          0
-          ( PP.align $
-              PP.vsep (PP.punctuate "," (prettyMt <$> args))
+        <> PP.group
+          ( PP.hang
+              0
+              ( PP.align $
+                  PP.vsep (PP.punctuate "," (prettyMt <$> args))
+              )
           )
         <> ")"
     prettyMt = PP.pretty

wasm-calc11/src/Calc/Types/Expr.hs

@@ -89,8 +89,11 @@ instance PP.Pretty (Expr ann) where
   pretty (EConstructor _ constructor args) =
     PP.pretty constructor
       <> "("
-      <> PP.cat (PP.punctuate ", " (PP.pretty <$> args))
+      <> PP.group (PP.line' <> indentMulti 2 (PP.cat pArgs) <> PP.line')
       <> ")"
+    where
+      pArgs =
+        PP.punctuate ", " (PP.pretty <$> args)
   pretty (EInfix _ op a b) =
     PP.pretty a <+> PP.pretty op <+> PP.pretty b
   pretty (EIf _ predExpr thenExpr elseExpr) =
@@ -114,8 +117,11 @@ instance PP.Pretty (Expr ann) where
     where
       pArgs = PP.punctuate ", " (PP.pretty <$> args)
   pretty (ETuple _ a as) =
-    "(" <> PP.cat (PP.punctuate ", " (PP.pretty <$> tupleItems a as)) <> ")"
+    "(" <> PP.group (PP.line' <> indentMulti 2 (PP.cat prettyItems) <> PP.line') <> ")"
     where
+      prettyItems =
+        PP.punctuate ", " (PP.pretty <$> tupleItems a as)
+
       tupleItems :: a -> NE.NonEmpty a -> [a]
       tupleItems b bs = b : NE.toList bs
   pretty (EBox _ inner) =

wasm-calc11/src/Calc/Types/Function.hs

@@ -17,21 +17,14 @@ import Calc.Types.Expr
 import Calc.Types.FunctionName
 import Calc.Types.Type
 import Calc.Types.TypeVar
+import Calc.Utils
 import qualified Data.Set as S
 import Data.String
 import Data.Text (Text)
 import qualified Data.Text as T
 import Prettyprinter ((<+>))
 import qualified Prettyprinter as PP
 
--- when on multilines, indent by `i`, if not then nothing
-indentMulti :: Integer -> PP.Doc style -> PP.Doc style
-indentMulti i doc =
-  PP.flatAlt (PP.indent (fromIntegral i) doc) doc
-
-newlines :: PP.Doc style -> PP.Doc style
-newlines a = PP.line' <> a <> PP.line'
-
 data AbilityConstraint
   = NoGlobalMutate
   | NoAllocate

wasm-calc11/src/Calc/Types/Import.hs

@@ -12,17 +12,10 @@ where
 import Calc.Types.FunctionName
 import Calc.Types.Identifier
 import Calc.Types.Type
+import Calc.Utils
 import Prettyprinter ((<+>))
 import qualified Prettyprinter as PP
 
--- when on multilines, indent by `i`, if not then nothing
-indentMulti :: Integer -> PP.Doc style -> PP.Doc style
-indentMulti i doc =
-  PP.flatAlt (PP.indent (fromIntegral i) doc) doc
-
-newlines :: PP.Doc style -> PP.Doc style
-newlines a = PP.line' <> a <> PP.line'
-
 data Import ann = Import
   { impAnn :: ann,
     impArgs :: [ImportArg ann],

wasm-calc11/src/Calc/Types/Test.hs

@@ -7,6 +7,7 @@ module Calc.Types.Test where
 
 import Calc.Types.Expr
 import Calc.Types.Identifier
+import Calc.Utils
 import Prettyprinter ((<+>))
 import qualified Prettyprinter as PP
 
@@ -17,11 +18,6 @@ data Test ann = Test
   }
   deriving stock (Eq, Ord, Show, Functor)
 
--- when on multilines, indent by `i`, if not then nothing
-indentMulti :: Integer -> PP.Doc style -> PP.Doc style
-indentMulti i doc =
-  PP.flatAlt (PP.indent (fromIntegral i) doc) doc
-
 instance PP.Pretty (Test ann) where
   pretty (Test {tesName, tesExpr}) =
     "test"

wasm-calc11/src/Calc/Types/Type.hs

@@ -6,6 +6,7 @@ module Calc.Types.Type (Type (..), TypePrim (..)) where
 
 import Calc.Types.DataName
 import Calc.Types.TypeVar
+import Calc.Utils
 import qualified Data.List.NonEmpty as NE
 import GHC.Natural
 import qualified Prettyprinter as PP
@@ -56,5 +57,11 @@ instance PP.Pretty (Type ann) where
     "(" <> PP.cat (PP.punctuate "," (PP.pretty <$> NE.toList as)) <> ")"
   pretty (TConstructor _ dataName []) =
     PP.pretty dataName
-  pretty (TConstructor _ dataName vars) =
-    PP.pretty dataName <> "(" <> PP.cat (PP.punctuate "," (PP.pretty <$> vars)) <> ")"
+  pretty (TConstructor _ dataName args) =
+    PP.pretty dataName
+      <> "("
+      <> PP.group (PP.line' <> indentMulti 2 (PP.cat tyArgs) <> PP.line')
+      <> ")"
+    where
+      tyArgs =
+        PP.punctuate ", " (PP.pretty <$> args)