diff --git a/src/Core/Parse.y b/src/Core/Parse.y index f70d401..cae58d9 100644 --- a/src/Core/Parse.y +++ b/src/Core/Parse.y @@ -77,6 +77,7 @@ Eof : eof { () } StandaloneProgram :: { Program Name } StandaloneProgram : Program eof { $1 } + | eof { mempty } Program :: { Program Name } Program : ScTypeSig ';' Program { insTypeSig $1 $3 } diff --git a/tst/Core/ParseSpec.hs b/tst/Core/ParseSpec.hs index 2793cd2..c965b70 100644 --- a/tst/Core/ParseSpec.hs +++ b/tst/Core/ParseSpec.hs @@ -17,9 +17,10 @@ import Test.QuickCheck spec :: Spec spec = do - it "should be a right-inverse to the unparser\ + it "should be a right-inverse to the unparser \ \up to source code congruency" $ - property $ \p -> (unparse <=< parse) p ~== Right p + withMaxSuccess 20 $ property $ + \p -> (unparse <=< parse) p ~== Right p -- TODO: abitrary ASTs -- it "should be a right-inverse to the unparser\ diff --git a/tst/CoreSyntax.hs b/tst/CoreSyntax.hs index 83f7ef9..7bd7cd0 100644 --- a/tst/CoreSyntax.hs +++ b/tst/CoreSyntax.hs @@ -25,7 +25,7 @@ import Lens.Micro.Platform.Internal (IsText(..)) ---------------------------------------------------------------------------------- newtype ProgramSrc = ProgramSrc Text - deriving (Show, Eq, Semigroup, Monoid, IsString) + deriving (Show, Read, Eq, Semigroup, Monoid, IsString) instance Arbitrary ProgramSrc where arbitrary = sized genProg where @@ -68,8 +68,8 @@ instance Arbitrary ProgramSrc where , wrapParens <$> gen n' 0 , genApp n p , genLet n p - , genLam n p - , genCase n p + -- , genLam n p + -- , genCase n p ] where n' = next n @@ -114,7 +114,7 @@ instance Arbitrary ProgramSrc where var = oneof [genName, wrapParens <$> genSymName] n' = next n - genLam n p = conseq [l, ws, bs, pure "->", ws, gen n' 0] + genLam n p = conseq [l, ws, bs, ws, pure "->", ws, gen n' 0] <&> pprec 0 p where -- whitespace because reserved op shenanigans :3 @@ -207,6 +207,11 @@ congruentSrc = (==) `on` (justParseSrc . T.unpack . coerce) ---------------------------------------------------------------------------------- +-- TODO: unparseCoreProg :: Program -> [CoreToken] +-- womp womp. + +-- TODO: implement shrink + -- | @unparseCoreProg@ should be inverse to @parseCoreProg@ up to source code -- congruency, newtype coercion and errors handling. unparseCoreProg :: Program' -> ProgramSrc @@ -221,7 +226,9 @@ unparseTypeSig :: Name -> Type -> ProgramSrc unparseTypeSig n t = unparseName n <> " :: " <> unparseType t unparseName :: Name -> ProgramSrc -unparseName = coerce +unparseName n + | T.head n `elem` (':' : nameSymbols) = coerce $ wrapParens n + | otherwise = coerce n unparseType :: Type -> ProgramSrc unparseType = go 0 where @@ -267,6 +274,7 @@ unparseExpr = go 0 where <> " -> " <> go 0 e & pprec 0 p go p (Let r bs e) = mconcat [lw," { ",bs'," } in ",go 0 e] + & pprec 0 p where lw = case r of { NonRec -> "let"; Rec -> "letrec" } bs' = srci "; " $ unparseBinding <$> bs diff --git a/tst/GMSpec.hs b/tst/GMSpec.hs index dd5957a..0610bbe 100644 --- a/tst/GMSpec.hs +++ b/tst/GMSpec.hs @@ -21,7 +21,7 @@ spec = do resultOf [coreProg|id x = x; main = (id (-#)) 3 2;|] `shouldBe` Just (NNum 1) it "should correctly evaluate arbitrary arithmetic" $ do - property $ \e -> + withMaxSuccess 40 $ property $ \e -> let arithRes = Just (evalArith e) coreRes = evalCore e in coreRes `shouldBe` arithRes