From ff0b1d6f3d57700081408a3465c2bcadb144a6ef Mon Sep 17 00:00:00 2001 From: Daniel Harvey Date: Fri, 13 Sep 2024 23:43:31 +0100 Subject: [PATCH 1/7] Well some things are fucked --- wasm-calc11/src/Calc/Typecheck/Infer.hs | 3 + .../test/Test/Typecheck/TypecheckSpec.hs | 29 ++++++++ wasm-calc11/test/static/bigfunction.calc | 12 ++-- wasm-calc11/test/static/typecheck.calc | 67 +++++++++++++++++++ wasm-calc11/wasm-calc11.cabal | 1 + 5 files changed, 106 insertions(+), 6 deletions(-) create mode 100644 wasm-calc11/test/static/typecheck.calc diff --git a/wasm-calc11/src/Calc/Typecheck/Infer.hs b/wasm-calc11/src/Calc/Typecheck/Infer.hs index 2d1fb748..3a0fb8d7 100644 --- a/wasm-calc11/src/Calc/Typecheck/Infer.hs +++ b/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) = diff --git a/wasm-calc11/test/Test/Typecheck/TypecheckSpec.hs b/wasm-calc11/test/Test/Typecheck/TypecheckSpec.hs index 92611df7..020cdea3 100644 --- a/wasm-calc11/test/Test/Typecheck/TypecheckSpec.hs +++ b/wasm-calc11/test/Test/Typecheck/TypecheckSpec.hs @@ -1,8 +1,12 @@ {-# LANGUAGE NamedFieldPuns #-} {-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE TemplateHaskell #-} module Test.Typecheck.TypecheckSpec (spec) where +import Data.Bifunctor (second) +import Data.FileEmbed +import qualified Data.Text.Encoding as T import Calc.ExprUtils import Calc.Module import Calc.Parser @@ -16,6 +20,12 @@ import qualified Data.List.NonEmpty as NE import Data.Text (Text) import Test.Helpers import Test.Hspec +import Data.Either (isRight) + +-- these are saved in a file that is included in compilation +testInputs :: [(FilePath, Text)] +testInputs = + fmap (second T.decodeUtf8) $(makeRelativeToProject "test/static/" >>= embedDir) spec :: Spec spec = do @@ -220,6 +230,9 @@ spec = do describe "Successfully typechecking modules" $ do traverse_ testSucceedingModule succeeding + fdescribe "Successfully typechecking modules" $ do + traverse_ (uncurry testModuleTypechecks) testInputs + let failing = [ joinLines [ "function increment(b: Boolean) -> Boolean { a + 1 }", @@ -391,6 +404,22 @@ testSucceedingModule (input, md) = getOuterAnnotation . fnBody . getMainFunction <$> elaborateModule (void parsedMod) `shouldBe` Right md +testModuleTypechecks :: String -> Text -> Spec +testModuleTypechecks fileName input = + it fileName $ do + case parseModuleAndFormatError input of + Left e -> error (show e) + Right parsedModuleItems -> + case resolveModule parsedModuleItems of + Left e -> error (show e) + Right parsedMod -> do + let result = elaborateModule (void parsedMod) + case result of + Right _ -> pure () + Left e -> error (show e) + isRight result `shouldBe` True + + -- | find function called 'main' getMainFunction :: Module ann -> Function ann getMainFunction (Module {mdFunctions}) = diff --git a/wasm-calc11/test/static/bigfunction.calc b/wasm-calc11/test/static/bigfunction.calc index 4138af2c..d5efb505 100644 --- a/wasm-calc11/test/static/bigfunction.calc +++ b/wasm-calc11/test/static/bigfunction.calc @@ -8,17 +8,17 @@ function big( g: Int32, h: Int32 ) -> Int32 { - if 1 then + if True then 2 else { - let a: Int8 = 100; - if 3 then + let a: Int8 = 100; + if False then 4 else - if 5 then + if True then 6 else - if 7 then 8 else if 9 then 10 else 11 + if True then 8 else if False then 10 else 11 } -} \ No newline at end of file +} diff --git a/wasm-calc11/test/static/typecheck.calc b/wasm-calc11/test/static/typecheck.calc new file mode 100644 index 00000000..4c65acdf --- /dev/null +++ b/wasm-calc11/test/static/typecheck.calc @@ -0,0 +1,67 @@ +type Result = Left(e) | Right (a) + +type Type = TInt | TBoolean + +type Expr = EInt(ann, Int32) | EBoolean(ann,Boolean) | EIf (ann, Expr(ann),Expr(ann),Expr(ann)) + +type Unit = Unit + +type TypeError = ExpectedBooleanGotInt | TypeMismatch(Type,Type) + +function outerAnnotation(expr: Expr(ann)) -> ann { + case expr { + EInt(ann,_) -> ann, + EBoolean(ann, _) -> ann, + EIf(ann,_,_,_) -> ann + } +} + +function isBool(expr: Expr(Type)) -> Boolean { + case outerAnnotation(expr) { + TBoolean -> True, + _ -> False + } +} + +function typeEquals(typeA: Type, typeB: Type) -> Boolean { + case (typeA,typeB) { + (TInt,TInt) -> True, + (TBoolean,TBoolean) -> True, + _ -> False + } +} + +function typecheck(expr: Expr(Unit)) -> Result(TypeError,Expr(Type)) { + case expr { + EInt(_, i) -> Right(EInt(TInt, i)), + EBoolean(_, b) -> Right(EBoolean(TBoolean,b)), + EIf(_, predExpr,thenExpr, elseExpr) -> { + case typecheck(predExpr) { + Right(typedPred) -> { + if isBool(typedPred) then + case (typecheck(thenExpr), typecheck(elseExpr)) { + (Right(typedThen), Right(typedElse)) -> { + let tyThen = outerAnnotation(typedThen); + let tyElse = outerAnnotation(typedElse); + if typeEquals(tyThen,tyElse) then + Right(EIf(tyThen,typedPred, typedThen,typedElse)) + else + Left(TypeMismatch(tyThen,tyElse)) + + }, + (Left(e),Right(_)) -> Left(e), + (Right(_), Left(e)) -> Left(e), + + } + else + Left(ExpectedBooleanGotInt) + } + } + + + } + + + } +} + diff --git a/wasm-calc11/wasm-calc11.cabal b/wasm-calc11/wasm-calc11.cabal index 6e2c4680..4918871d 100644 --- a/wasm-calc11/wasm-calc11.cabal +++ b/wasm-calc11/wasm-calc11.cabal @@ -22,6 +22,7 @@ maintainer: danieljamesharvey@gmail.com extra-source-files: CHANGELOG.md static/malloc.wasm + test/static/*.calc common shared ghc-options: From 0a2edb7ccdf80e008f55b591298427a1cc985521 Mon Sep 17 00:00:00 2001 From: Daniel Harvey Date: Sat, 14 Sep 2024 20:10:48 +0100 Subject: [PATCH 2/7] WLL --- wasm-calc11/test/static/smalltypecheck.calc | 18 +++++++++ wasm-calc11/test/static/typecheck.calc | 44 ++++++++++----------- 2 files changed, 40 insertions(+), 22 deletions(-) create mode 100644 wasm-calc11/test/static/smalltypecheck.calc diff --git a/wasm-calc11/test/static/smalltypecheck.calc b/wasm-calc11/test/static/smalltypecheck.calc new file mode 100644 index 00000000..1844279b --- /dev/null +++ b/wasm-calc11/test/static/smalltypecheck.calc @@ -0,0 +1,18 @@ + + +type Type = TInt | TBoolean + +type Expr = EInt(ann, Int32) | EBoolean(ann,Boolean) + +type Unit = Unit + +function typecheck(expr: Expr(Unit)) -> Expr(Type) { + case expr { + EInt(_, i) -> EInt(TInt, i), + EBoolean(_, b) -> EBoolean(TBoolean,b) + } + + + + } + diff --git a/wasm-calc11/test/static/typecheck.calc b/wasm-calc11/test/static/typecheck.calc index 4c65acdf..abc3f64d 100644 --- a/wasm-calc11/test/static/typecheck.calc +++ b/wasm-calc11/test/static/typecheck.calc @@ -35,28 +35,28 @@ function typecheck(expr: Expr(Unit)) -> Result(TypeError,Expr(Type)) { case expr { EInt(_, i) -> Right(EInt(TInt, i)), EBoolean(_, b) -> Right(EBoolean(TBoolean,b)), - EIf(_, predExpr,thenExpr, elseExpr) -> { - case typecheck(predExpr) { - Right(typedPred) -> { - if isBool(typedPred) then - case (typecheck(thenExpr), typecheck(elseExpr)) { - (Right(typedThen), Right(typedElse)) -> { - let tyThen = outerAnnotation(typedThen); - let tyElse = outerAnnotation(typedElse); - if typeEquals(tyThen,tyElse) then - Right(EIf(tyThen,typedPred, typedThen,typedElse)) - else - Left(TypeMismatch(tyThen,tyElse)) - - }, - (Left(e),Right(_)) -> Left(e), - (Right(_), Left(e)) -> Left(e), - - } - else - Left(ExpectedBooleanGotInt) - } - } + EIf(_, predExpr,thnExpr, elsExpr) -> { + case typecheck(predExpr) { + Left(e) -> Left(e), + Right(typedPred) -> { + if isBool(typedPred) then + case (typecheck(thnExpr), typecheck(elsExpr)) { + (Right(typedThen), Right(typedElse)) -> { + let tyThen = outerAnnotation(typedThen); + let tyElse = outerAnnotation(typedElse); + if typeEquals(tyThen,tyElse) then + Right(EIf(tyThen,typedPred, typedThen,typedElse)) + else + Left(TypeMismatch(tyThen,tyElse)) + }, + (Left(e),Right(_)) -> Left(e), + (Right(_), Left(e)) -> Left(e), + + } + else + Left(ExpectedBooleanGotInt) + } + } } From ef202d4910d6f47393ede2f3b06307c1ea199f9e Mon Sep 17 00:00:00 2001 From: Daniel Harvey Date: Sat, 14 Sep 2024 20:22:51 +0100 Subject: [PATCH 3/7] OK, it somewhat works, let's make it kinder --- wasm-calc11/test/static/bigfunction.calc | 4 +- wasm-calc11/test/static/smalltypecheck.calc | 23 ++-- wasm-calc11/test/static/typecheck.calc | 114 +++++++++++--------- 3 files changed, 74 insertions(+), 67 deletions(-) diff --git a/wasm-calc11/test/static/bigfunction.calc b/wasm-calc11/test/static/bigfunction.calc index d5efb505..8ee1339e 100644 --- a/wasm-calc11/test/static/bigfunction.calc +++ b/wasm-calc11/test/static/bigfunction.calc @@ -12,7 +12,7 @@ function big( 2 else { - let a: Int8 = 100; + let a: Int8 = 100; if False then 4 else @@ -21,4 +21,4 @@ function big( else if True then 8 else if False then 10 else 11 } -} +} \ No newline at end of file diff --git a/wasm-calc11/test/static/smalltypecheck.calc b/wasm-calc11/test/static/smalltypecheck.calc index 1844279b..8a2f3b2e 100644 --- a/wasm-calc11/test/static/smalltypecheck.calc +++ b/wasm-calc11/test/static/smalltypecheck.calc @@ -1,18 +1,17 @@ +type Result = Left(e) | Right(a) +type Type = TBoolean | TInt -type Type = TInt | TBoolean - -type Expr = EInt(ann, Int32) | EBoolean(ann,Boolean) +type Expr = EBoolean(ann, Boolean) | EInt(ann, Int32) type Unit = Unit -function typecheck(expr: Expr(Unit)) -> Expr(Type) { - case expr { - EInt(_, i) -> EInt(TInt, i), - EBoolean(_, b) -> EBoolean(TBoolean,b) - } - - - - } +type Error = OhNo +function typecheck(expr: Expr(Unit)) -> Result(Error, +Expr(Type)) { + case expr { + EInt(_, i) -> Right(EInt(TInt, i)), + EBoolean(_, b) -> Right(EBoolean(TBoolean, b)) + } +} \ No newline at end of file diff --git a/wasm-calc11/test/static/typecheck.calc b/wasm-calc11/test/static/typecheck.calc index abc3f64d..acb13b2b 100644 --- a/wasm-calc11/test/static/typecheck.calc +++ b/wasm-calc11/test/static/typecheck.calc @@ -1,67 +1,75 @@ -type Result = Left(e) | Right (a) +type Result = Left(e) | Right(a) -type Type = TInt | TBoolean +type Type = TBoolean | TInt -type Expr = EInt(ann, Int32) | EBoolean(ann,Boolean) | EIf (ann, Expr(ann),Expr(ann),Expr(ann)) +type Expr = EBoolean(ann, + Boolean) + | EIf(ann, + Expr(ann), + Expr(ann), + Expr(ann)) + | EInt(ann, + Int32) type Unit = Unit -type TypeError = ExpectedBooleanGotInt | TypeMismatch(Type,Type) +type TypeError = ExpectedBooleanGotInt + | InternalNonsense + | TypeMismatch(Type, + Type) -function outerAnnotation(expr: Expr(ann)) -> ann { - case expr { - EInt(ann,_) -> ann, - EBoolean(ann, _) -> ann, - EIf(ann,_,_,_) -> ann - } +function outerAnnotation(expr: Expr(ann)) -> ann { + case expr { + EInt(ann, _) -> ann, + EBoolean(ann, _) -> ann, + EIf(ann, _, _, _) -> ann + } } -function isBool(expr: Expr(Type)) -> Boolean { - case outerAnnotation(expr) { - TBoolean -> True, - _ -> False - } +function isBool(expr: Expr(Type)) -> Boolean { + case outerAnnotation(expr) { + TBoolean -> True, _ -> False + } } -function typeEquals(typeA: Type, typeB: Type) -> Boolean { - case (typeA,typeB) { - (TInt,TInt) -> True, - (TBoolean,TBoolean) -> True, - _ -> False - } +function typeEquals(typeA: Type, typeB: Type) -> Boolean { + case (typeA, typeB) { + (TInt, TInt) -> True, + (TBoolean, TBoolean) -> True, + _ -> False + } } -function typecheck(expr: Expr(Unit)) -> Result(TypeError,Expr(Type)) { - case expr { - EInt(_, i) -> Right(EInt(TInt, i)), - EBoolean(_, b) -> Right(EBoolean(TBoolean,b)), - EIf(_, predExpr,thnExpr, elsExpr) -> { - case typecheck(predExpr) { - Left(e) -> Left(e), - Right(typedPred) -> { - if isBool(typedPred) then - case (typecheck(thnExpr), typecheck(elsExpr)) { - (Right(typedThen), Right(typedElse)) -> { - let tyThen = outerAnnotation(typedThen); - let tyElse = outerAnnotation(typedElse); - if typeEquals(tyThen,tyElse) then - Right(EIf(tyThen,typedPred, typedThen,typedElse)) - else - Left(TypeMismatch(tyThen,tyElse)) - }, - (Left(e),Right(_)) -> Left(e), - (Right(_), Left(e)) -> Left(e), - - } - else - Left(ExpectedBooleanGotInt) - } +function typecheck(expr: Expr(Unit)) -> Result(TypeError, +Expr(Type)) { + case expr { + EInt(_, i) -> Right(EInt(TInt, i)), + EBoolean(_, b) -> Right(EBoolean(TBoolean, b)), + EIf(_, predExpr, thnExpr, elsExpr) -> { + case typecheck(predExpr) { + Left(e) -> Left(e), + Right(typedPred) -> { + if isBool(typedPred) then + case (typecheck(thnExpr), typecheck(elsExpr)) { + (Right(typedThen), Right(typedElse)) -> { + let tyThen = outerAnnotation(typedThen); + let tyElse = outerAnnotation(typedElse); + if typeEquals(tyThen, tyElse) then + Right(EIf(tyThen, + typedPred, + typedThen, + typedElse)) + else + Left(TypeMismatch(tyThen, tyElse)) + }, + (_, Left(e)) -> Left(e), + (Left(e), _) -> Left(e), + _ -> Left(InternalNonsense) } - - - } - - - } + else + Left(ExpectedBooleanGotInt) + } + } + } + } } - From b1ed2c08882762289cf6157f8e1a4486d28fd07b Mon Sep 17 00:00:00 2001 From: Daniel Harvey Date: Sat, 14 Sep 2024 20:42:59 +0100 Subject: [PATCH 4/7] Make parser somewhat clearer --- wasm-calc11/src/Calc/Parser/Expr.hs | 13 +++++-------- wasm-calc11/src/Calc/Parser/Pattern.hs | 2 -- wasm-calc11/src/Calc/Parser/Shared.hs | 5 +---- wasm-calc11/test/Test/Typecheck/TypecheckSpec.hs | 2 +- wasm-calc11/test/static/typecheck.calc | 2 +- 5 files changed, 8 insertions(+), 16 deletions(-) diff --git a/wasm-calc11/src/Calc/Parser/Expr.hs b/wasm-calc11/src/Calc/Parser/Expr.hs index 45ed289a..06fff5fc 100644 --- a/wasm-calc11/src/Calc/Parser/Expr.hs +++ b/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" @@ -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 + sepBy1 patternCaseParser (stringLiteral ",") patternCaseParser :: Parser (Pattern Annotation, Expr Annotation) patternCaseParser = do - pat <- orInBrackets patternParser + pat <- patternParser stringLiteral "->" patExpr <- exprParserInternal pure (pat, patExpr) diff --git a/wasm-calc11/src/Calc/Parser/Pattern.hs b/wasm-calc11/src/Calc/Parser/Pattern.hs index da34f90b..7e0f426c 100644 --- a/wasm-calc11/src/Calc/Parser/Pattern.hs +++ b/wasm-calc11/src/Calc/Parser/Pattern.hs @@ -18,7 +18,6 @@ patternParser :: Parser ParserPattern patternParser = label "pattern match" - ( orInBrackets ( try patWildcardParser <|> patPrimParser <|> try patVariableParser @@ -26,7 +25,6 @@ patternParser = <|> patConstructorParser <|> patTupleParser ) - ) ---- diff --git a/wasm-calc11/src/Calc/Parser/Shared.hs b/wasm-calc11/src/Calc/Parser/Shared.hs index 0f3a8c4e..568cb50d 100644 --- a/wasm-calc11/src/Calc/Parser/Shared.hs +++ b/wasm-calc11/src/Calc/Parser/Shared.hs @@ -1,7 +1,7 @@ {-# LANGUAGE OverloadedStrings #-} module Calc.Parser.Shared - ( orInBrackets, + ( inBrackets, myLexeme, withLocation, @@ -48,9 +48,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) diff --git a/wasm-calc11/test/Test/Typecheck/TypecheckSpec.hs b/wasm-calc11/test/Test/Typecheck/TypecheckSpec.hs index 020cdea3..e0e7aa74 100644 --- a/wasm-calc11/test/Test/Typecheck/TypecheckSpec.hs +++ b/wasm-calc11/test/Test/Typecheck/TypecheckSpec.hs @@ -230,7 +230,7 @@ spec = do describe "Successfully typechecking modules" $ do traverse_ testSucceedingModule succeeding - fdescribe "Successfully typechecking modules" $ do + describe "Successfully typechecking modules" $ do traverse_ (uncurry testModuleTypechecks) testInputs let failing = diff --git a/wasm-calc11/test/static/typecheck.calc b/wasm-calc11/test/static/typecheck.calc index acb13b2b..33a8f629 100644 --- a/wasm-calc11/test/static/typecheck.calc +++ b/wasm-calc11/test/static/typecheck.calc @@ -72,4 +72,4 @@ Expr(Type)) { } } } -} +} \ No newline at end of file From 40194192f0de2f7451dab64fc2dba6eafad8050c Mon Sep 17 00:00:00 2001 From: Daniel Harvey Date: Sat, 14 Sep 2024 20:57:04 +0100 Subject: [PATCH 5/7] Better printing --- wasm-calc11/src/Calc/Parser/Data.hs | 2 +- wasm-calc11/src/Calc/Parser/Expr.hs | 8 ++++---- wasm-calc11/src/Calc/Parser/Function.hs | 4 ++-- wasm-calc11/src/Calc/Parser/Import.hs | 2 +- wasm-calc11/src/Calc/Parser/Pattern.hs | 4 ++-- wasm-calc11/src/Calc/Parser/Type.hs | 6 +++--- wasm-calc11/src/Calc/Types/Data.hs | 13 +++++-------- wasm-calc11/test/Test/Parser/ParserSpec.hs | 4 ++-- 8 files changed, 20 insertions(+), 23 deletions(-) diff --git a/wasm-calc11/src/Calc/Parser/Data.hs b/wasm-calc11/src/Calc/Parser/Data.hs index 860a7293..e0438789 100644 --- a/wasm-calc11/src/Calc/Parser/Data.hs +++ b/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 diff --git a/wasm-calc11/src/Calc/Parser/Expr.hs b/wasm-calc11/src/Calc/Parser/Expr.hs index 06fff5fc..a8fdc48d 100644 --- a/wasm-calc11/src/Calc/Parser/Expr.hs +++ b/wasm-calc11/src/Calc/Parser/Expr.hs @@ -139,7 +139,7 @@ applyParser :: Parser (Expr Annotation) applyParser = addLocation $ do fnName <- functionNameParser stringLiteral "(" - args <- sepBy exprParserInternal (stringLiteral ",") + args <- sepEndBy exprParserInternal (stringLiteral ",") stringLiteral ")" pure (EApply mempty fnName args) @@ -147,7 +147,7 @@ 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 @@ -223,7 +223,7 @@ matchExprWithParser = do patternMatchesParser :: Parser [(Pattern Annotation, Expr Annotation)] patternMatchesParser = do - sepBy1 + sepEndBy1 patternCaseParser (stringLiteral ",") diff --git a/wasm-calc11/src/Calc/Parser/Function.hs b/wasm-calc11/src/Calc/Parser/Function.hs index 5418fd1a..9c0efa88 100644 --- a/wasm-calc11/src/Calc/Parser/Function.hs +++ b/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 diff --git a/wasm-calc11/src/Calc/Parser/Import.hs b/wasm-calc11/src/Calc/Parser/Import.hs index 4b8defc4..c1772cce 100644 --- a/wasm-calc11/src/Calc/Parser/Import.hs +++ b/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 diff --git a/wasm-calc11/src/Calc/Parser/Pattern.hs b/wasm-calc11/src/Calc/Parser/Pattern.hs index 7e0f426c..d9c6b123 100644 --- a/wasm-calc11/src/Calc/Parser/Pattern.hs +++ b/wasm-calc11/src/Calc/Parser/Pattern.hs @@ -47,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" @@ -77,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 [] diff --git a/wasm-calc11/src/Calc/Parser/Type.hs b/wasm-calc11/src/Calc/Parser/Type.hs index f15be7b0..2f84f2e4 100644 --- a/wasm-calc11/src/Calc/Parser/Type.hs +++ b/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 diff --git a/wasm-calc11/src/Calc/Types/Data.hs b/wasm-calc11/src/Calc/Types/Data.hs index 3bac6b35..3c2c3639 100644 --- a/wasm-calc11/src/Calc/Types/Data.hs +++ b/wasm-calc11/src/Calc/Types/Data.hs @@ -36,16 +36,13 @@ renderDataType (Data tyCon vars' constructors') = <> if M.null constructors' then mempty else - PP.group $ - PP.softline + " =" <+> + PP.line <> indentMulti 2 ( PP.align $ PP.vsep $ - zipWith - (<+>) - ("=" : repeat "|") - (printCons <$> M.toList constructors') + PP.punctuate " |" (printCons <$> M.toList constructors') ) where printVars [] = @@ -59,10 +56,10 @@ renderDataType (Data tyCon vars' constructors') = PP.pretty consName <> PP.softline' <> "(" - <> PP.hang + <> PP.group (PP.hang 0 ( PP.align $ PP.vsep (PP.punctuate "," (prettyMt <$> args)) - ) + )) <> ")" prettyMt = PP.pretty diff --git a/wasm-calc11/test/Test/Parser/ParserSpec.hs b/wasm-calc11/test/Test/Parser/ParserSpec.hs index b34fcd8d..7b221f64 100644 --- a/wasm-calc11/test/Test/Parser/ParserSpec.hs +++ b/wasm-calc11/test/Test/Parser/ParserSpec.hs @@ -430,7 +430,7 @@ spec = do ("True || False", EInfix () OpOr (bool True) (bool False)), ("if True then 1 else 2", EIf () (bool True) (int 1) (int 2)), ("a + 1", EInfix () OpAdd (var "a") (int 1)), - ("add(1,2)", EApply () "add" [int 1, int 2]), + ("add(1,2,)", EApply () "add" [int 1, int 2]), ("go()", EApply () "go" []), ("Box(1)", EBox () (int 1)), ("let a = 100; a", ELet () (PVar () "a") (int 100) (var "a")), @@ -474,7 +474,7 @@ spec = do ] ) ), - ( "case a { 1 -> 0, other -> other }", + ( "case a { 1 -> 0, other -> other, }", EMatch () (var "a") From f24e66a39fdd4fd10bcce4743fa183d2e76057bf Mon Sep 17 00:00:00 2001 From: Daniel Harvey Date: Sat, 14 Sep 2024 21:17:59 +0100 Subject: [PATCH 6/7] Increase pleasantness --- wasm-calc11/src/Calc/PrettyPrint.hs | 2 +- wasm-calc11/src/Calc/Types/Data.hs | 16 +++--- wasm-calc11/src/Calc/Types/Expr.hs | 10 +++- wasm-calc11/src/Calc/Types/Function.hs | 9 +--- wasm-calc11/src/Calc/Types/Import.hs | 9 +--- wasm-calc11/src/Calc/Types/Test.hs | 6 +-- wasm-calc11/src/Calc/Types/Type.hs | 12 ++++- wasm-calc11/src/Calc/Utils.hs | 15 +++++- wasm-calc11/test/static/datatypes.calc | 36 +++++++++----- wasm-calc11/test/static/smalltypecheck.calc | 23 ++++++--- wasm-calc11/test/static/typecheck.calc | 54 ++++++++++++--------- 11 files changed, 115 insertions(+), 77 deletions(-) diff --git a/wasm-calc11/src/Calc/PrettyPrint.hs b/wasm-calc11/src/Calc/PrettyPrint.hs index 8faab3c1..e3ca9738 100644 --- a/wasm-calc11/src/Calc/PrettyPrint.hs +++ b/wasm-calc11/src/Calc/PrettyPrint.hs @@ -3,7 +3,7 @@ {-# LANGUAGE MultiParamTypeClasses #-} module Calc.PrettyPrint - ( prettyPrint, + ( prettyPrint ) where diff --git a/wasm-calc11/src/Calc/Types/Data.hs b/wasm-calc11/src/Calc/Types/Data.hs index 3c2c3639..9c89bef5 100644 --- a/wasm-calc11/src/Calc/Types/Data.hs +++ b/wasm-calc11/src/Calc/Types/Data.hs @@ -4,6 +4,7 @@ module Calc.Types.Data (Data (..)) where +import Calc.Utils import Calc.Types.Constructor import Calc.Types.DataName import Calc.Types.Type @@ -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,14 +33,15 @@ renderDataType (Data tyCon vars' constructors') = <> if M.null constructors' then mempty else - " =" <+> - PP.line - <> indentMulti + PP.line <> ( + indentMulti 2 ( PP.align $ PP.vsep $ - PP.punctuate " |" (printCons <$> M.toList constructors') - ) + zipWith + (<+>) + ("=" : repeat "|") + (printCons <$> M.toList constructors'))) where printVars [] = mempty diff --git a/wasm-calc11/src/Calc/Types/Expr.hs b/wasm-calc11/src/Calc/Types/Expr.hs index 93e50cfb..df0567c6 100644 --- a/wasm-calc11/src/Calc/Types/Expr.hs +++ b/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) = diff --git a/wasm-calc11/src/Calc/Types/Function.hs b/wasm-calc11/src/Calc/Types/Function.hs index ace01f3b..9b756642 100644 --- a/wasm-calc11/src/Calc/Types/Function.hs +++ b/wasm-calc11/src/Calc/Types/Function.hs @@ -13,6 +13,7 @@ module Calc.Types.Function ) where +import Calc.Utils import Calc.Types.Expr import Calc.Types.FunctionName import Calc.Types.Type @@ -24,14 +25,6 @@ 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 diff --git a/wasm-calc11/src/Calc/Types/Import.hs b/wasm-calc11/src/Calc/Types/Import.hs index d16af231..3113500f 100644 --- a/wasm-calc11/src/Calc/Types/Import.hs +++ b/wasm-calc11/src/Calc/Types/Import.hs @@ -14,14 +14,7 @@ import Calc.Types.Identifier import Calc.Types.Type 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' +import Calc.Utils data Import ann = Import { impAnn :: ann, diff --git a/wasm-calc11/src/Calc/Types/Test.hs b/wasm-calc11/src/Calc/Types/Test.hs index 4fdc30bc..3a6995ac 100644 --- a/wasm-calc11/src/Calc/Types/Test.hs +++ b/wasm-calc11/src/Calc/Types/Test.hs @@ -9,6 +9,7 @@ import Calc.Types.Expr import Calc.Types.Identifier import Prettyprinter ((<+>)) import qualified Prettyprinter as PP +import Calc.Utils data Test ann = Test { tesAnn :: ann, @@ -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" diff --git a/wasm-calc11/src/Calc/Types/Type.hs b/wasm-calc11/src/Calc/Types/Type.hs index 0b8f8694..b0d7e20e 100644 --- a/wasm-calc11/src/Calc/Types/Type.hs +++ b/wasm-calc11/src/Calc/Types/Type.hs @@ -9,6 +9,7 @@ import Calc.Types.TypeVar import qualified Data.List.NonEmpty as NE import GHC.Natural import qualified Prettyprinter as PP +import Calc.Utils data TypePrim = TBool @@ -56,5 +57,12 @@ 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) + diff --git a/wasm-calc11/src/Calc/Utils.hs b/wasm-calc11/src/Calc/Utils.hs index ebf93876..6ba48948 100644 --- a/wasm-calc11/src/Calc/Utils.hs +++ b/wasm-calc11/src/Calc/Utils.hs @@ -1,6 +1,7 @@ -module Calc.Utils (prettyShow, ltrace, ltraceM, neZipWith, neZipWithM, neUnzip) where +module Calc.Utils (prettyShow, ltrace, ltraceM, neZipWith, neZipWithM, neUnzip, indentMulti, newlines) where -- useful junk goes here +import qualified Prettyprinter as PP import Control.Monad (zipWithM) import Data.Bifunctor @@ -37,3 +38,15 @@ ltraceM lbl x = Debug.traceM (lbl <> ": " <> TL.unpack (PS.pShow x)) prettyShow :: (Show a) => a -> String prettyShow = TL.unpack . PS.pShow + + +-- 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' + + + diff --git a/wasm-calc11/test/static/datatypes.calc b/wasm-calc11/test/static/datatypes.calc index 25a66219..391c521d 100644 --- a/wasm-calc11/test/static/datatypes.calc +++ b/wasm-calc11/test/static/datatypes.calc @@ -1,14 +1,28 @@ -type Colour = Blue | Green | Red - -type Maybe = Just(a) | Nothing - -type Either = Left(e) | Right(a) - -type These = That(b) | These(a, b) | This(a) - -type Expr = EBool(ann, Boolean) | EInt(ann, Int32) - -type List = Cons(a, List(a)) | Nil +type Colour + = Blue + | Green + | Red + +type Maybe + = Just(a) + | Nothing + +type Either + = Left(e) + | Right(a) + +type These + = That(b) + | These(a, b) + | This(a) + +type Expr + = EBool(ann, Boolean) + | EInt(ann, Int32) + +type List + = Cons(a, List(a)) + | Nil function matchList() -> Boolean { let list = Cons(True, Cons(False, Cons(True, Nil))); diff --git a/wasm-calc11/test/static/smalltypecheck.calc b/wasm-calc11/test/static/smalltypecheck.calc index 8a2f3b2e..2335fe00 100644 --- a/wasm-calc11/test/static/smalltypecheck.calc +++ b/wasm-calc11/test/static/smalltypecheck.calc @@ -1,15 +1,24 @@ -type Result = Left(e) | Right(a) +type Result + = Left(e) + | Right(a) -type Type = TBoolean | TInt +type Type + = TBoolean + | TInt -type Expr = EBoolean(ann, Boolean) | EInt(ann, Int32) +type Expr + = EBoolean(ann, Boolean) + | EInt(ann, Int32) -type Unit = Unit +type Unit + = Unit -type Error = OhNo +type Error + = OhNo -function typecheck(expr: Expr(Unit)) -> Result(Error, -Expr(Type)) { +function typecheck(expr: Expr(Unit)) -> Result( + Error, Expr(Type) +) { case expr { EInt(_, i) -> Right(EInt(TInt, i)), EBoolean(_, b) -> Right(EBoolean(TBoolean, b)) diff --git a/wasm-calc11/test/static/typecheck.calc b/wasm-calc11/test/static/typecheck.calc index 33a8f629..e53b4762 100644 --- a/wasm-calc11/test/static/typecheck.calc +++ b/wasm-calc11/test/static/typecheck.calc @@ -1,22 +1,23 @@ -type Result = Left(e) | Right(a) +type Result + = Left(e) + | Right(a) -type Type = TBoolean | TInt +type Type + = TBoolean + | TInt -type Expr = EBoolean(ann, - Boolean) - | EIf(ann, - Expr(ann), - Expr(ann), - Expr(ann)) - | EInt(ann, - Int32) +type Expr + = EBoolean(ann, Boolean) + | EIf(ann, Expr(ann), Expr(ann), Expr(ann)) + | EInt(ann, Int32) -type Unit = Unit +type Unit + = Unit -type TypeError = ExpectedBooleanGotInt - | InternalNonsense - | TypeMismatch(Type, - Type) +type TypeError + = ExpectedBooleanGotInt + | InternalNonsense + | TypeMismatch(Type, Type) function outerAnnotation(expr: Expr(ann)) -> ann { case expr { @@ -40,25 +41,32 @@ function typeEquals(typeA: Type, typeB: Type) -> Boolean { } } -function typecheck(expr: Expr(Unit)) -> Result(TypeError, -Expr(Type)) { +function typecheck(expr: Expr(Unit)) -> Result( + TypeError, Expr(Type) +) { case expr { EInt(_, i) -> Right(EInt(TInt, i)), EBoolean(_, b) -> Right(EBoolean(TBoolean, b)), - EIf(_, predExpr, thnExpr, elsExpr) -> { + EIf(_, predExpr, thenExpr, elseExpr) -> { case typecheck(predExpr) { Left(e) -> Left(e), Right(typedPred) -> { if isBool(typedPred) then - case (typecheck(thnExpr), typecheck(elsExpr)) { + case ( + typecheck(thenExpr), typecheck(elseExpr) + ) { (Right(typedThen), Right(typedElse)) -> { let tyThen = outerAnnotation(typedThen); let tyElse = outerAnnotation(typedElse); if typeEquals(tyThen, tyElse) then - Right(EIf(tyThen, - typedPred, - typedThen, - typedElse)) + Right( + EIf( + tyThen, + typedPred, + typedThen, + typedElse + ) + ) else Left(TypeMismatch(tyThen, tyElse)) }, From a5aff295d1aaf8f51ea16c778391adfb7ff82871 Mon Sep 17 00:00:00 2001 From: Daniel Harvey Date: Sat, 14 Sep 2024 21:23:11 +0100 Subject: [PATCH 7/7] Well --- wasm-calc11/src/Calc/Parser/Pattern.hs | 14 ++++---- wasm-calc11/src/Calc/Parser/Shared.hs | 3 +- wasm-calc11/src/Calc/PrettyPrint.hs | 2 +- wasm-calc11/src/Calc/Types/Data.hs | 33 ++++++++++--------- wasm-calc11/src/Calc/Types/Expr.hs | 8 ++--- wasm-calc11/src/Calc/Types/Function.hs | 2 +- wasm-calc11/src/Calc/Types/Import.hs | 2 +- wasm-calc11/src/Calc/Types/Test.hs | 2 +- wasm-calc11/src/Calc/Types/Type.hs | 7 ++-- wasm-calc11/src/Calc/Utils.hs | 6 +--- .../test/Test/Typecheck/TypecheckSpec.hs | 16 ++++----- 11 files changed, 45 insertions(+), 50 deletions(-) diff --git a/wasm-calc11/src/Calc/Parser/Pattern.hs b/wasm-calc11/src/Calc/Parser/Pattern.hs index d9c6b123..9d075315 100644 --- a/wasm-calc11/src/Calc/Parser/Pattern.hs +++ b/wasm-calc11/src/Calc/Parser/Pattern.hs @@ -18,13 +18,13 @@ patternParser :: Parser ParserPattern patternParser = label "pattern match" - ( try patWildcardParser - <|> patPrimParser - <|> try patVariableParser - <|> try patBoxParser - <|> patConstructorParser - <|> patTupleParser - ) + ( try patWildcardParser + <|> patPrimParser + <|> try patVariableParser + <|> try patBoxParser + <|> patConstructorParser + <|> patTupleParser + ) ---- diff --git a/wasm-calc11/src/Calc/Parser/Shared.hs b/wasm-calc11/src/Calc/Parser/Shared.hs index 568cb50d..a57af351 100644 --- a/wasm-calc11/src/Calc/Parser/Shared.hs +++ b/wasm-calc11/src/Calc/Parser/Shared.hs @@ -1,8 +1,7 @@ {-# LANGUAGE OverloadedStrings #-} module Calc.Parser.Shared - ( - inBrackets, + ( inBrackets, myLexeme, withLocation, stringLiteral, diff --git a/wasm-calc11/src/Calc/PrettyPrint.hs b/wasm-calc11/src/Calc/PrettyPrint.hs index e3ca9738..8faab3c1 100644 --- a/wasm-calc11/src/Calc/PrettyPrint.hs +++ b/wasm-calc11/src/Calc/PrettyPrint.hs @@ -3,7 +3,7 @@ {-# LANGUAGE MultiParamTypeClasses #-} module Calc.PrettyPrint - ( prettyPrint + ( prettyPrint, ) where diff --git a/wasm-calc11/src/Calc/Types/Data.hs b/wasm-calc11/src/Calc/Types/Data.hs index 9c89bef5..9766c5c4 100644 --- a/wasm-calc11/src/Calc/Types/Data.hs +++ b/wasm-calc11/src/Calc/Types/Data.hs @@ -4,11 +4,11 @@ module Calc.Types.Data (Data (..)) where -import Calc.Utils 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 @@ -33,15 +33,16 @@ renderDataType (Data tyCon vars' constructors') = <> if M.null constructors' then mempty else - PP.line <> ( - 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 @@ -54,10 +55,12 @@ renderDataType (Data tyCon vars' constructors') = PP.pretty consName <> PP.softline' <> "(" - <> PP.group (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 diff --git a/wasm-calc11/src/Calc/Types/Expr.hs b/wasm-calc11/src/Calc/Types/Expr.hs index df0567c6..d87cdbf8 100644 --- a/wasm-calc11/src/Calc/Types/Expr.hs +++ b/wasm-calc11/src/Calc/Types/Expr.hs @@ -92,8 +92,8 @@ instance PP.Pretty (Expr ann) where <> PP.group (PP.line' <> indentMulti 2 (PP.cat pArgs) <> PP.line') <> ")" where - pArgs - = PP.punctuate ", " (PP.pretty <$> args) + 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) = @@ -119,8 +119,8 @@ instance PP.Pretty (Expr ann) where pretty (ETuple _ a as) = "(" <> PP.group (PP.line' <> indentMulti 2 (PP.cat prettyItems) <> PP.line') <> ")" where - prettyItems - = PP.punctuate ", " (PP.pretty <$> tupleItems a as) + prettyItems = + PP.punctuate ", " (PP.pretty <$> tupleItems a as) tupleItems :: a -> NE.NonEmpty a -> [a] tupleItems b bs = b : NE.toList bs diff --git a/wasm-calc11/src/Calc/Types/Function.hs b/wasm-calc11/src/Calc/Types/Function.hs index 9b756642..e1a7ee74 100644 --- a/wasm-calc11/src/Calc/Types/Function.hs +++ b/wasm-calc11/src/Calc/Types/Function.hs @@ -13,11 +13,11 @@ module Calc.Types.Function ) where -import Calc.Utils 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) diff --git a/wasm-calc11/src/Calc/Types/Import.hs b/wasm-calc11/src/Calc/Types/Import.hs index 3113500f..9bd87e62 100644 --- a/wasm-calc11/src/Calc/Types/Import.hs +++ b/wasm-calc11/src/Calc/Types/Import.hs @@ -12,9 +12,9 @@ where import Calc.Types.FunctionName import Calc.Types.Identifier import Calc.Types.Type +import Calc.Utils import Prettyprinter ((<+>)) import qualified Prettyprinter as PP -import Calc.Utils data Import ann = Import { impAnn :: ann, diff --git a/wasm-calc11/src/Calc/Types/Test.hs b/wasm-calc11/src/Calc/Types/Test.hs index 3a6995ac..dab82cea 100644 --- a/wasm-calc11/src/Calc/Types/Test.hs +++ b/wasm-calc11/src/Calc/Types/Test.hs @@ -7,9 +7,9 @@ module Calc.Types.Test where import Calc.Types.Expr import Calc.Types.Identifier +import Calc.Utils import Prettyprinter ((<+>)) import qualified Prettyprinter as PP -import Calc.Utils data Test ann = Test { tesAnn :: ann, diff --git a/wasm-calc11/src/Calc/Types/Type.hs b/wasm-calc11/src/Calc/Types/Type.hs index b0d7e20e..f7c7bc33 100644 --- a/wasm-calc11/src/Calc/Types/Type.hs +++ b/wasm-calc11/src/Calc/Types/Type.hs @@ -6,10 +6,10 @@ 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 -import Calc.Utils data TypePrim = TBool @@ -63,6 +63,5 @@ instance PP.Pretty (Type ann) where <> PP.group (PP.line' <> indentMulti 2 (PP.cat tyArgs) <> PP.line') <> ")" where - tyArgs - = PP.punctuate ", " (PP.pretty <$> args) - + tyArgs = + PP.punctuate ", " (PP.pretty <$> args) diff --git a/wasm-calc11/src/Calc/Utils.hs b/wasm-calc11/src/Calc/Utils.hs index 6ba48948..ca0ec4f7 100644 --- a/wasm-calc11/src/Calc/Utils.hs +++ b/wasm-calc11/src/Calc/Utils.hs @@ -1,13 +1,13 @@ module Calc.Utils (prettyShow, ltrace, ltraceM, neZipWith, neZipWithM, neUnzip, indentMulti, newlines) where -- useful junk goes here -import qualified Prettyprinter as PP import Control.Monad (zipWithM) import Data.Bifunctor import qualified Data.List.NonEmpty as NE import qualified Data.Text.Lazy as TL import qualified Debug.Trace as Debug +import qualified Prettyprinter as PP import qualified Text.Pretty.Simple as PS neZipWithM :: @@ -39,7 +39,6 @@ ltraceM lbl x = Debug.traceM (lbl <> ": " <> TL.unpack (PS.pShow x)) prettyShow :: (Show a) => a -> String prettyShow = TL.unpack . PS.pShow - -- when on multilines, indent by `i`, if not then nothing indentMulti :: Integer -> PP.Doc style -> PP.Doc style indentMulti i doc = @@ -47,6 +46,3 @@ indentMulti i doc = newlines :: PP.Doc style -> PP.Doc style newlines a = PP.line' <> a <> PP.line' - - - diff --git a/wasm-calc11/test/Test/Typecheck/TypecheckSpec.hs b/wasm-calc11/test/Test/Typecheck/TypecheckSpec.hs index e0e7aa74..602720f7 100644 --- a/wasm-calc11/test/Test/Typecheck/TypecheckSpec.hs +++ b/wasm-calc11/test/Test/Typecheck/TypecheckSpec.hs @@ -4,23 +4,22 @@ module Test.Typecheck.TypecheckSpec (spec) where -import Data.Bifunctor (second) -import Data.FileEmbed -import qualified Data.Text.Encoding as T import Calc.ExprUtils import Calc.Module import Calc.Parser import Calc.Typecheck import Calc.Types import Control.Monad -import Data.Either (isLeft) +import Data.Bifunctor (second) +import Data.Either (isLeft, isRight) +import Data.FileEmbed import Data.Foldable (traverse_) import qualified Data.List as List import qualified Data.List.NonEmpty as NE import Data.Text (Text) +import qualified Data.Text.Encoding as T import Test.Helpers import Test.Hspec -import Data.Either (isRight) -- these are saved in a file that is included in compilation testInputs :: [(FilePath, Text)] @@ -405,7 +404,7 @@ testSucceedingModule (input, md) = `shouldBe` Right md testModuleTypechecks :: String -> Text -> Spec -testModuleTypechecks fileName input = +testModuleTypechecks fileName input = it fileName $ do case parseModuleAndFormatError input of Left e -> error (show e) @@ -415,10 +414,9 @@ testModuleTypechecks fileName input = Right parsedMod -> do let result = elaborateModule (void parsedMod) case result of - Right _ -> pure () + Right _ -> pure () Left e -> error (show e) - isRight result `shouldBe` True - + isRight result `shouldBe` True -- | find function called 'main' getMainFunction :: Module ann -> Function ann