this sucks lol
This commit is contained in:
@@ -77,6 +77,7 @@ Eof : eof { () }
|
||||
|
||||
StandaloneProgram :: { Program Name }
|
||||
StandaloneProgram : Program eof { $1 }
|
||||
| eof { mempty }
|
||||
|
||||
Program :: { Program Name }
|
||||
Program : ScTypeSig ';' Program { insTypeSig $1 $3 }
|
||||
|
||||
@@ -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\
|
||||
|
||||
@@ -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
|
||||
|
||||
@@ -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
|
||||
|
||||
Reference in New Issue
Block a user