Skip to content

Instantly share code, notes, and snippets.

@hhefesto

hhefesto/diff

Created March 4, 2022 18:44
Show Gist options
  • Star 0 You must be signed in to star a gist
  • Fork 0 You must be signed in to fork a gist
  • Save hhefesto/cbaeb8a5469f9ab5a9d5d0b0f980868b to your computer and use it in GitHub Desktop.
Save hhefesto/cbaeb8a5469f9ab5a9d5d0b0f980868b to your computer and use it in GitHub Desktop.
Download ZIP
039312d and HEAD~1
Raw
diff
diff --git a/Prelude.tel b/Prelude.tel
index 555aa9f..8908c75 100644
--- a/Prelude.tel
+++ b/Prelude.tel
@@ -89,3 +89,6 @@ quicksort = let layer = \recur l -> if right l
in listPlus (recur p2) (t,(recur p1))
else l
in ? layer (\l -> 0)
+
+abort = \str -> let x : (\y -> listPlus "abort: " str) = 1
+ in x
diff --git a/app/Main.hs b/app/Main.hs
index aaf0d04..80219d1 100644
--- a/app/Main.hs
+++ b/app/Main.hs
@@ -40,7 +40,7 @@ main = do
prelude = case parsePrelude preludeString of
Right p -> p
Left pe -> error pe
- runMain s = case compile <$> parseMain prelude s of
+ runMain s = case compileMain <$> parseMain prelude s of
Left e -> putStrLn $ concat ["failed to parse ", s, " ", e]
Right (Right g) -> evalLoop g
Right z -> putStrLn $ "compilation failed somehow, with result " <> show z
diff --git a/app/MiniRepl.hs b/app/MiniRepl.hs
index 5a1e9b6..d14954f 100644
--- a/app/MiniRepl.hs
+++ b/app/MiniRepl.hs
@@ -93,7 +93,7 @@ resolveBinding' name bindings = lookup name bindings >>= (rightToMaybe . process
-- |Obtain expression from the bindings and transform them maybe into a IExpr.
resolveBinding :: String -> [(String, UnprocessedParsedTerm)] -> Maybe IExpr
-resolveBinding name bindings = rightToMaybe $ compile =<< (maybeToRight $ resolveBinding' name bindings)
+resolveBinding name bindings = rightToMaybe $ compileUnitTest =<< (maybeToRight $ resolveBinding' name bindings)
-- |Print last expression bound to
-- the _tmp_ variable in the bindings
@@ -105,7 +105,7 @@ printLastExpr :: (MonadIO m)
printLastExpr printer eval bindings = case lookup "_tmp_" bindings of
Nothing -> printer "Could not find _tmp_ in bindings"
Just upt -> do
- let compile' x = case compile x of
+ let compile' x = case compileUnitTest x of
Left err -> Left . show $ err
Right r -> Right r
case compile' =<< (process bindings (LetUP bindings upt)) of
@@ -136,7 +136,7 @@ replStep eval bindings s = do
outputStrLn $ "Parse error: " ++ err
return bindings
Right (ReplExpr new_bindings) -> do
- printLastExpr (outputStrLn) (liftIO . eval) new_bindings
+ printLastExpr outputStrLn (liftIO . eval) new_bindings
return bindings
Right (ReplAssignment new_bindings) -> do
return new_bindings
diff --git a/examples.tel b/examples.tel
index 7e1b0f6..33f58bb 100644
--- a/examples.tel
+++ b/examples.tel
@@ -6,16 +6,16 @@
-- -- refinement fail
-- main : (\x -> if x then "fail" else 0) = 1
-abort : (\x -> "abort") = 1
+-- abort : (\x -> "abort") = 1
-- Ad hoc user defined types example:
MyInt = let wrapper = \h -> ( \i -> if not i
- then abort
+ then abort "MyInt cannot be 0"
else i
, \i -> if dEqual (left i) h
then 0
- else abort
+ else abort "Not a MyInt"
)
in wrapper (# wrapper)
--- main = \i -> ((left MyInt) 0, 0)
-main = abort
+main = \i -> ((left MyInt) 0, 0)
+-- main = abort
diff --git a/src/Telomare.hs b/src/Telomare.hs
index ab52162..ed0fac9 100644
--- a/src/Telomare.hs
+++ b/src/Telomare.hs
@@ -122,6 +122,7 @@ data ParserTerm l v
| TLimitedRecursion
deriving (Eq, Ord, Functor, Foldable, Traversable)
makeBaseFunctor ''ParserTerm -- Functorial version ParserTermF
+makePrisms ''ParserTerm
instance Plated (ParserTerm l v) where
plate f = \case
diff --git a/src/Telomare/Eval.hs b/src/Telomare/Eval.hs
index 068c78d..27666ad 100644
--- a/src/Telomare/Eval.hs
+++ b/src/Telomare/Eval.hs
@@ -111,17 +111,35 @@ removeChecks (Term4 m) =
in Term4 $ Map.map (transform f) newM
runStaticChecks :: Term4 -> Maybe String
-runStaticChecks (Term4 termMap) = case ((toPossible (termMap Map.!) staticAbortSetEval AnyX (rootFrag termMap)) :: Either String (PossibleExpr Void Void)) of
- Left s -> pure s
- _ -> Nothing
-
-compile :: Term3 -> Either EvalError IExpr
-compile t = let sized = findChurchSize t
- in case runStaticChecks sized of
- Nothing -> case toTelomare $ removeChecks sized of
- Just i -> pure i
- Nothing -> Left CompileConversionError
- Just s -> Left $ StaticCheckError s
+runStaticChecks (Term4 termMap) =
+ case (toPossible (termMap Map.!) staticAbortSetEval AnyX (rootFrag termMap) :: Either String (PossibleExpr Void Void)) of
+ Left s -> pure s
+ _ -> Nothing
+
+runStaticChecksMain :: Term4 -> Maybe String
+runStaticChecksMain (Term4 termMap) =
+ let (PairFrag (DeferFrag i) y) = rootFrag termMap
+ in case (toPossible (termMap Map.!) staticAbortSetEval AnyX (termMap Map.! i) :: Either String (PossibleExpr Void Void)) of
+ Left s -> pure s
+ _ -> Nothing
+
+
+compileMain :: Term3 -> Either EvalError IExpr
+compileMain = compile runStaticChecksMain
+
+compileUnitTest :: Term3 -> Either EvalError IExpr
+compileUnitTest = compile runStaticChecks
+
+compile :: (Term4 -> Maybe String) -> Term3 -> Either EvalError IExpr
+compile f t =
+ let sized = findChurchSize t
+ in case f sized of
+ Nothing -> case toTelomare $ removeChecks sized of
+ Just i -> pure i
+ Nothing -> Left CompileConversionError
+ Just s -> Left $ StaticCheckError s
+
+
{-
findAllSizes :: Term2 -> (Bool, Term3)
findAllSizes = let doChild (True, x) = TTransformedGrammar $ findChurchSize x
diff --git a/src/Telomare/Parser.hs b/src/Telomare/Parser.hs
index 587535c..dca4d97 100644
--- a/src/Telomare/Parser.hs
+++ b/src/Telomare/Parser.hs
@@ -278,15 +278,15 @@ parseITE = do
elseExpr <- parseLongExpr <* scn
pure $ ITEUP cond thenExpr elseExpr
-parseUnique :: TelomareParser UnprocessedParsedTerm
-parseUnique = do
+parseHash :: TelomareParser UnprocessedParsedTerm
+parseHash = do
symbol "#" <* scn
upt <- parseSingleExpr :: TelomareParser UnprocessedParsedTerm
pure $ HashUP upt
-- |Parse a single expression.
parseSingleExpr :: TelomareParser UnprocessedParsedTerm
-parseSingleExpr = choice $ try <$> [ parseUnique
+parseSingleExpr = choice $ try <$> [ parseHash
, parseString
, parseNumber
, parsePair
@@ -448,6 +448,7 @@ makeLambda bindings str term1 =
v = vars term1
unbound = (v \\ bindings') \\ Set.singleton str
+-- |Transformation from `UnprocessedParsedTerm` to `Term1` validating and inlining `VarUP`s
validateVariables :: [(String, UnprocessedParsedTerm)] -- ^ Prelude
-> UnprocessedParsedTerm
-> Either String Term1
@@ -516,8 +517,8 @@ optimizeBuiltinFunctions = transform optimize where
-- |Process an `Term2` to have all `HashUP` replaced by a unique number.
-- The unique number is constructed by doing a SHA1 hash of the Term2 and
-- adding one for all consecutive HashUP's.
-generateAllUniques :: Term2 -> Term2
-generateAllUniques = transform interm where
+generateAllHashes :: Term2 -> Term2
+generateAllHashes = transform interm where
hash' :: ByteString -> Digest SHA256
hash' = hash
term2Hash :: Term2 -> ByteString
@@ -529,10 +530,6 @@ generateAllUniques = transform interm where
THash term1 -> bs2Term2 . term2Hash $ term1
x -> x
--- |All HashUP arguments of the form VarUP should be resolved
-resolveAllUniques :: UnprocessedParsedTerm -> UnprocessedParsedTerm
-resolveAllUniques = id
-
-- |Process an `UnprocessedParsedTerm` to a `Term3` with failing capability.
process :: [(String, UnprocessedParsedTerm)] -- ^Prelude
-> UnprocessedParsedTerm
@@ -542,10 +539,9 @@ process prelude upt = splitExpr <$> process2Term2 prelude upt
process2Term2 :: [(String, UnprocessedParsedTerm)] -- ^Prelude
-> UnprocessedParsedTerm
-> Either String Term2
-process2Term2 prelude = fmap generateAllUniques
+process2Term2 prelude = fmap generateAllHashes
. debruijinize [] <=< validateVariables prelude
. optimizeBuiltinFunctions
- . resolveAllUniques
-- |Parse with specified prelude
parseWithPrelude :: [(String, UnprocessedParsedTerm)] -- ^Prelude
@@ -558,3 +554,11 @@ parseMain :: [(String, UnprocessedParsedTerm)] -- ^Prelude: [(VariableName, Bind
-> String -- ^Raw string to be parserd.
-> Either String Term3 -- ^Error on Left.
parseMain prelude s = parseWithPrelude prelude s >>= process prelude
+
+
+aux1 = unlines [ "let b = \\y -> y"
+ , "in (# b)"
+ ]
+aux2 = unlines [ "let a = \\x -> x"
+ , "in (# a)"
+ ]
diff --git a/src/Telomare/Possible.hs b/src/Telomare/Possible.hs
index fd8acf7..a78400a 100644
--- a/src/Telomare/Possible.hs
+++ b/src/Telomare/Possible.hs
@@ -70,9 +70,12 @@ possibleString' x = case getFirstNonZero x of
type BasicPossible = PossibleExpr Void
-toPossible :: (Show a, Eq a, Show b, Eq b, Monad m) => (FragIndex -> FragExpr b)
- -> ((PossibleExpr a b -> FragExpr b -> m (PossibleExpr a b)) -> PossibleExpr a b-> PossibleExpr a b-> PossibleExpr a b -> m (PossibleExpr a b))
- -> PossibleExpr a b -> FragExpr b -> m (PossibleExpr a b)
+toPossible :: (Show a, Eq a, Show b, Eq b, Monad m)
+ => (FragIndex -> FragExpr b)
+ -> ((PossibleExpr a b -> FragExpr b -> m (PossibleExpr a b)) -> PossibleExpr a b-> PossibleExpr a b-> PossibleExpr a b -> m (PossibleExpr a b))
+ -> PossibleExpr a b
+ -> FragExpr b
+ -> m (PossibleExpr a b)
toPossible fragLookup setEval env =
let toPossible' = toPossible fragLookup setEval
recur = toPossible' env
diff --git a/telomare.cabal b/telomare.cabal
index 18fa38c..d92d5c3 100644
--- a/telomare.cabal
+++ b/telomare.cabal
@@ -20,7 +20,6 @@ data-files: bench/MemoryBench/cases
library
hs-source-dirs: src
- , test
include-dirs: cbits/include
c-sources: cbits/Telomare.c
other-extensions: GADTs
@@ -44,7 +43,6 @@ library
, Telomare.TypeChecker
, Telomare.Serializer
, Telomare.Serializer.C
- , Common
build-depends: base
, base16-bytestring
, binary
@@ -77,7 +75,7 @@ library
extra-libraries: gc
, jumper
-- uncomment this line to get a cabal repl. Use appropiate complete path (will error with a relative path).
- -- extra-lib-dirs: /home/hhefesto/src/telomare/lib
+ extra-lib-dirs: /home/hhefesto/src/telomare/lib
default-language: Haskell2010
ghc-options: -ddump-to-file -ddump-splices
diff --git a/test/Common.hs b/test/Common.hs
index 8513913..875c989 100644
--- a/test/Common.hs
+++ b/test/Common.hs
@@ -297,3 +297,17 @@ instance Arbitrary Term1 where
TITE i t e -> i : t : e : [TITE ni nt ne | (ni, nt, ne) <- shrink (i,t,e)]
TPair a b -> a : b : [TPair na nb | (na, nb) <- shrink (a,b)]
TApp f i -> f : i : [TApp nf ni | (nf, ni) <- shrink (f,i)]
+
+instance Arbitrary Term2 where
+ arbitrary = (arbitrary :: Gen Term1)
+ shrink = \case
+ TZero -> []
+ TLimitedRecursion -> []
+ TVar _ -> []
+ TLeft x -> x : map TLeft (shrink x)
+ TRight x -> x : map TRight (shrink x)
+ TTrace x -> x : map TTrace (shrink x)
+ TLam v x -> x : map (TLam v) (shrink x)
+ TITE i t e -> i : t : e : [TITE ni nt ne | (ni, nt, ne) <- shrink (i,t,e)]
+ TPair a b -> a : b : [TPair na nb | (na, nb) <- shrink (a,b)]
+ TApp f i -> f : i : [TApp nf ni | (nf, ni) <- shrink (f,i)]
diff --git a/test/ParserTests.hs b/test/ParserTests.hs
index b6ee776..887dd71 100644
--- a/test/ParserTests.hs
+++ b/test/ParserTests.hs
@@ -51,98 +51,82 @@ tests = testGroup "Tests" [unitTests, qcProps]
qcProps = testGroup "Property tests (QuickCheck)"
[ QC.testProperty "Arbitrary UnprocessedParsedTerm to test hash uniqueness of HashUP's" $
\x ->
- containsHashUP x QC.==> checkAllUniques . generateAllUniques $ x
- , QC.testProperty "Have the total amount of HashUP + ListUP be equal to total ListUP after generateAllUniques" $
+ containsTHash x QC.==> checkAllHashes . generateAllHashes $ x
+ , QC.testProperty "Have the total amount of HashUP + ListUP be equal to total ListUP after generateAllHashes" $
\x ->
- containsHashUP x QC.==> checkNumberOfUniques x
- , QC.testProperty "See that generateAllUniques only changes HashUP to ListUP" $
+ containsTHash x QC.==> checkNumberOfHashes x
+ , QC.testProperty "See that generateAllHashes only changes HashUP to ListUP" $
\x ->
- containsHashUP x QC.==> onlyHashUPAndIntUP x
+ containsTHash x QC.==> onlyHashUPAndIntUP x
]
-checkNumberOfUniques :: UnprocessedParsedTerm -> Bool
-checkNumberOfUniques upt = let tupt = generateAllUniques upt
- in ((length $ upt ^.. (cosmos . _HashUP)) + (length $ upt ^.. (cosmos . _ListUP))) == (length $ tupt ^.. (cosmos . _ListUP))
-
-containsHashUP :: UnprocessedParsedTerm -> Bool
-containsHashUP = \case
- HashUP _ -> True
- LetUP xs a -> containsHashUP a || (or $ (containsHashUP . snd) <$> xs)
- ITEUP a b c -> containsHashUP a || containsHashUP b || containsHashUP c
- ListUP ls -> or $ containsHashUP <$> ls
- PairUP a b -> containsHashUP a || containsHashUP b
- AppUP a b -> containsHashUP a || containsHashUP b
- CheckUP a b -> containsHashUP a || containsHashUP b
- LamUP _ a -> containsHashUP a
- LeftUP a -> containsHashUP a
- RightUP a -> containsHashUP a
- TraceUP a -> containsHashUP a
- x -> False
-
-onlyHashUPAndIntUP :: UnprocessedParsedTerm -> Bool
-onlyHashUPAndIntUP upt = let diffList = diffUPT (upt, generateAllUniques upt)
- isHashUP :: UnprocessedParsedTerm -> Bool
- isHashUP = \case
- HashUP _ -> True
- _ -> False
- isListUP :: UnprocessedParsedTerm -> Bool
- isListUP = \case
- ListUP _ -> True
- _ -> False
- in and $ fmap (isHashUP . fst) diffList ++ fmap (isListUP . snd) diffList
-
-diffUPT :: (UnprocessedParsedTerm, UnprocessedParsedTerm) -> [(UnprocessedParsedTerm, UnprocessedParsedTerm)]
-diffUPT = \case
- (ITEUP a b c, ITEUP a' b' c') -> diffUPT (a, a') ++ diffUPT (b, b') ++ diffUPT (c, c')
- (ListUP ls, ListUP ls') -> concat $ diffUPT <$> (zip ls ls')
- (PairUP a b, PairUP a' b') -> diffUPT (a, a') ++ diffUPT (b, b')
- (AppUP a b, AppUP a' b') -> diffUPT (a, a') ++ diffUPT (b, b')
- (CheckUP a b, CheckUP a' b') -> diffUPT (a, a') ++ diffUPT (b, b')
- (LamUP _ a, LamUP _ a') -> diffUPT (a, a')
- (LeftUP a, LeftUP a') -> diffUPT (a, a')
- (RightUP a, RightUP a') -> diffUPT (a, a')
- (TraceUP a, TraceUP a') -> diffUPT (a, a')
- (LetUP xs a, LetUP xs' a') -> diffUPT (a, a') ++ (concat $ diffUPT <$> zs)
- where ys = snd <$> xs
- ys'= snd <$> xs'
- zs = zip ys ys'
+checkNumberOfHashes :: Term2 -> Bool
+checkNumberOfHashes term2 = let tterm2 = generateAllHashes term2
+ in (length (term2 ^.. (cosmos . _THash)) + length (term2 ^.. (cosmos . _TPair))) == length (tterm2 ^.. (cosmos . _TPair))
+
+containsTHash :: Term2 -> Bool
+containsTHash = \case
+ THash _ -> True
+ TITE a b c -> containsTHash a || containsTHash b || containsTHash c
+ TPair a b -> containsTHash a || containsTHash b
+ TApp a b -> containsTHash a || containsTHash b
+ TCheck a b -> containsTHash a || containsTHash b
+ TLam _ a -> containsTHash a
+ TLeft a -> containsTHash a
+ TRight a -> containsTHash a
+ TTrace a -> containsTHash a
+ x -> False
+
+onlyHashUPAndIntUP :: Term2 -> Bool
+onlyHashUPAndIntUP term2 = let diffList = diffTerm2 (term2, generateAllHashes term2)
+ isHash :: Term2 -> Bool
+ isHash = \case
+ THash _ -> True
+ _ -> False
+ in and $ fmap (isHash . fst) diffList
+
+diffTerm2 :: (Term2, Term2) -> [(Term2, Term2)]
+diffTerm2 = \case
+ (TITE a b c, TITE a' b' c') -> diffTerm2 (a, a') <> diffTerm2 (b, b') <> diffTerm2 (c, c')
+ (TPair a b, TPair a' b') -> diffTerm2 (a, a') <> diffTerm2 (b, b')
+ (TApp a b, TApp a' b') -> diffTerm2 (a, a') <> diffTerm2 (b, b')
+ (TCheck a b, TCheck a' b') -> diffTerm2 (a, a') <> diffTerm2 (b, b')
+ (TLam _ a, TLam _ a') -> diffTerm2 (a, a')
+ (TLeft a, TLeft a') -> diffTerm2 (a, a')
+ (TRight a, TRight a') -> diffTerm2 (a, a')
+ (TTrace a, TTrace a') -> diffTerm2 (a, a')
(x, x') | x /= x' -> [(x, x')]
_ -> []
-checkAllUniques :: UnprocessedParsedTerm -> Bool
-checkAllUniques = noDups . allUniquesToIntUPList
+checkAllHashes :: Term2 -> Bool
+checkAllHashes = noDups . allHashesToTerm2
noDups = not . f []
where
f seen (x:xs) = x `elem` seen || f (x:seen) xs
f seen [] = False
-allUniquesToIntUPList :: UnprocessedParsedTerm -> [[UnprocessedParsedTerm]]
-allUniquesToIntUPList upt =
- let uptWithUniquesAsInts = generateAllUniques upt
- interm :: (UnprocessedParsedTerm, UnprocessedParsedTerm) -> [[UnprocessedParsedTerm]]
+allHashesToTerm2 :: Term2 -> [Term2]
+allHashesToTerm2 term2 =
+ let term2WithoutTHash = generateAllHashes term2
+ interm :: (Term2, Term2) -> [Term2]
interm = \case
- (HashUP _ , ListUP x) -> [x]
- (ITEUP a b c, ITEUP a' b' c') -> interm (a, a') ++ interm (b, b') ++ interm (c, c')
- (ListUP ls, ListUP ls') -> concat $ interm <$> (zip ls ls')
- (PairUP a b, PairUP a' b') -> interm (a, a') ++ interm (b, b')
- (AppUP a b, AppUP a' b') -> interm (a, a') ++ interm (b, b')
- (CheckUP a b, CheckUP a' b') -> interm (a, a') ++ interm (b, b')
- (LamUP _ a, LamUP _ a') -> interm (a, a')
- (LeftUP a, LeftUP a') -> interm (a, a')
- (RightUP a, RightUP a') -> interm (a, a')
- (TraceUP a, TraceUP a') -> interm (a, a')
- (LetUP xs a, LetUP xs' a') -> interm (a, a') ++ (concat $ interm <$> zs)
- where ys = snd <$> xs
- ys'= snd <$> xs'
- zs = zip ys ys'
- (x, x') | x /= x' -> error "x and x' should be the same (inside of allUniquesToIntUPList, within interm)"
+ (THash _ , x) -> [x]
+ (TITE a b c, TITE a' b' c') -> interm (a, a') <> interm (b, b') <> interm (c, c')
+ (TPair a b, TPair a' b') -> interm (a, a') <> interm (b, b')
+ (TApp a b, TApp a' b') -> interm (a, a') <> interm (b, b')
+ (TCheck a b, TCheck a' b') -> interm (a, a') <> interm (b, b')
+ (TLam _ a, TLam _ a') -> interm (a, a')
+ (TLeft a, TLeft a') -> interm (a, a')
+ (TRight a, TRight a') -> interm (a, a')
+ (TTrace a, TTrace a') -> interm (a, a')
+ (x, x') | x /= x' -> error "x and x' should be the same (inside of allHashesToTerm2, within interm)"
(x, x') -> []
- in curry interm upt uptWithUniquesAsInts
+ in curry interm term2 term2WithoutTHash
-- debruijinize [] <=< validateVariables prelude
-- . optimizeBuiltinFunctions
--- . generateAllUniques
+-- . generateAllHashes
aux1 = unlines [ "let a = \\y -> y"
, "in (# a)"
@@ -162,18 +146,19 @@ hashtest1 = unlines ["let var = 3",
" in (# var)"]
unitTests :: TestTree
unitTests = testGroup "Unit tests"
- [ testCase "different variable names get different hashes" $ do
- res1 <- extract <$> generateAllUniques <$> runTelomareParser parseLet hashtest0
- res2 <- extract <$> generateAllUniques <$> runTelomareParser parseLet hashtest1
- (res1 == res2) `compare` False @?= EQ
+ -- [
+ -- testCase "different variable names get different hashes" $ do
+ -- res1 <- extract . generateAllHashes <$> runTelomareParser parseLet hashtest0
+ -- res2 <- extract . generateAllHashes <$> runTelomareParser parseLet hashtest1
+ -- (res1 == res2) `compare` False @?= EQ
-- #^This commmented test tests if two variables having the same value are assigned the same hash
--,
--testCase "same functions have the same hash" $ do
- -- res1 <- extract <$> generateAllUniques <$> runTelomareParser parseLet aux1
- -- res2 <- extract <$> generateAllUniques <$> runTelomareParser parseLet aux2
+ -- res1 <- extract <$> generateAllHashes <$> runTelomareParser parseLet aux1
+ -- res2 <- extract <$> generateAllHashes <$> runTelomareParser parseLet aux2
-- res1 `compare` res2 @?= EQ
- , testCase "parse uniqueUP" $ do
- res <- parseSuccessful parseUnique "# (\\x -> x)"
+ [ testCase "parse uniqueUP" $ do
+ res <- parseSuccessful parseHash "# (\\x -> x)"
res `compare` True @?= EQ
, testCase "Ad hoc user defined types success" $ do
res <- testUserDefAdHocTypes userDefAdHocTypesSuccess
@@ -354,7 +339,7 @@ testUserDefAdHocTypes input = do
Right p -> p
Left pe -> error pe
runMain :: String -> IO String
- runMain s = case compile <$> parseMain prelude s of
+ runMain s = case compileUnitTest <$> parseMain prelude s of
Left e -> error $ concat ["failed to parse ", s, " ", e]
Right (Right g) -> evalLoop_ g
Right z -> error $ "compilation failed somehow, with result " <> show z
@@ -824,8 +809,8 @@ testList5 = unlines $
-- p str = State.runStateT $ parseMain prelude str
-- case runParser (dbg "debug" p) "" tictactoe of
-- Right (a, s) -> do
--- putStrLn ("Result: " ++ show a)
--- putStrLn ("Final state: " ++ show s)
+-- putStrLn ("Result: " <> show a)
+-- putStrLn ("Final state: " <> show s)
-- Left err -> putStr (errorBundlePretty err)
-- runTictactoe = do
@@ -834,11 +819,11 @@ testList5 = unlines $
-- let
-- prelude = case parsePrelude preludeFile of
-- Right p -> p
--- Left pe -> error $ "woot2!!!" ++ getErrorString pe
+-- Left pe -> error $ "woot2!!!" <> getErrorString pe
-- putStrLn "Not broken till here."
-- case parseMain' prelude $ tictactoe of
-- Right x -> putStrLn . show $ x
--- Left err -> putStrLn $ "woot!!! " ++ getErrorString err
+-- Left err -> putStrLn $ "woot!!! " <> getErrorString err
-- -- |Parse main.
diff --git a/test/Spec.hs b/test/Spec.hs
index 86b98f2..48de6b2 100644
--- a/test/Spec.hs
+++ b/test/Spec.hs
@@ -640,7 +640,7 @@ nexprTests = do
foreign import capi "gc.h GC_INIT" gcInit :: IO ()
foreign import ccall "gc.h GC_allow_register_threads" gcAllowRegisterThreads :: IO ()
-unitTest2' parse s r = it s $ case fmap compile (parse s) of
+unitTest2' parse s r = it s $ case fmap compileUnitTest (parse s) of
Left e -> expectationFailure $ concat ["failed to parse ", s, " ", show e]
Right (Right g) -> fmap (show . PrettyIExpr) (testEval g) >>= \r2 -> if r2 == r
then pure ()
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment