Merge pull request #133 from hhefesto/fix-prelude-usage

Fix prelude usage being unnecessarily passed down process

Author: sfultong

app/Repl.hs

@@ -85,7 +85,7 @@ maybeToRight Nothing  = Left CompileConversionError
 resolveBinding' :: String
                 -> [(String, UnprocessedParsedTerm)]
                 -> Maybe Term3
-resolveBinding' name bindings = lookup name taggedBindings >>= (rightToMaybe . process taggedBindings)
+resolveBinding' name bindings = lookup name taggedBindings >>= (rightToMaybe . process)
   where
     taggedBindings = (fmap . fmap) (tag DummyLoc) bindings
 
@@ -107,7 +107,7 @@ printLastExpr eval bindings = do
         let compile' x = case compileUnitTest x of
                            Left err -> Left . show $ err
                            Right r  -> Right r
-        case compile' =<< process bindings' (DummyLoc :< LetUPF bindings' upt) of
+        case compile' =<< process (DummyLoc :< LetUPF bindings' upt) of
           Left err -> putStrLn err
           Right iexpr' -> do
             iexpr <- eval (SetEnv (Pair (Defer iexpr') Zero))

src/Telomare/Eval.hs

@@ -304,7 +304,7 @@ calculateRecursionLimits t3 =
 
 eval2IExpr :: [(String, AnnotatedUPT)] -> String -> Either String IExpr
 eval2IExpr prelude str = bimap errorBundlePretty (\x -> DummyLoc :< LetUPF prelude x) (runParser (parseOneExprOrTopLevelDefs prelude) "" str)
-                           >>= process prelude
+                           >>= process
                            >>= first show . compileUnitTest
 
 tagIExprWithEval :: IExpr -> Cofree IExprF (Int, IExpr)
@@ -361,7 +361,7 @@ tagUPTwithIExpr :: [(String, AnnotatedUPT)]
                 -> Cofree UnprocessedParsedTermF (Int, Either String IExpr)
 tagUPTwithIExpr prelude upt = evalState (para alg upt) 0 where
   upt2iexpr :: UnprocessedParsedTerm -> Either String IExpr
-  upt2iexpr u = process prelude (tag DummyLoc u) >>= first show . compileUnitTest
+  upt2iexpr u = process (tag DummyLoc u) >>= first show . compileUnitTest
   alg :: Base UnprocessedParsedTerm
               ( UnprocessedParsedTerm
               , State Int (Cofree UnprocessedParsedTermF (Int, Either String IExpr))

src/Telomare/Resolver.hs

@@ -311,21 +311,18 @@ splitExpr t = let (bf, (_,_,m)) = State.runState (splitExpr' t) (toEnum 0, FragI
 
 -- |`makeLambda ps vl t1` makes a `TLam` around `t1` with `vl` as arguments.
 -- Automatic recognition of Close or Open type of `TLam`.
-makeLambda :: [(String, AnnotatedUPT)] -- ^Bindings
-           -> String                            -- ^Variable name
+makeLambda :: String                            -- ^Variable name
            -> Term1                             -- ^Lambda body
            -> Term1
-makeLambda bindings str term1@(anno :< _) =
+makeLambda str term1@(anno :< _) =
   if unbound == Set.empty then anno :< TLamF (Closed str) term1 else anno :< TLamF (Open str) term1
-  where bindings' = Set.fromList $ fst <$> bindings
-        v = varsTerm1 term1
-        unbound = (v \\ bindings') \\ Set.singleton str
+  where v = varsTerm1 term1
+        unbound = v \\ Set.singleton str
 
 -- |Transformation from `AnnotatedUPT` to `Term1` validating and inlining `VarUP`s
-validateVariables :: [(String, AnnotatedUPT)] -- ^ Prelude
-                  -> AnnotatedUPT
+validateVariables :: AnnotatedUPT
                   -> Either String Term1
-validateVariables prelude term =
+validateVariables term =
   let validateWithEnvironment :: AnnotatedUPT
                               -> State.StateT (Map String Term1) (Either String) Term1
       validateWithEnvironment = \case
@@ -334,7 +331,7 @@ validateVariables prelude term =
           State.modify (Map.insert v (anno :< TVarF v))
           result <- validateWithEnvironment x
           State.put oldState
-          pure $ makeLambda prelude v result
+          pure $ makeLambda v result
         anno :< VarUPF n -> do
           definitionsMap <- State.get
           case Map.lookup n definitionsMap of
@@ -430,29 +427,26 @@ addBuiltins aupt = DummyLoc :< LetUPF
   aupt
 
 -- |Process an `AnnotatedUPT` to a `Term3` with failing capability.
-process :: [(String, AnnotatedUPT)] -- ^Prelude
-        -> AnnotatedUPT
+process :: AnnotatedUPT
         -> Either String Term3
-process prelude upt = (\dt -> debugTrace ("Resolver process term:\n" <> prettyPrint dt) dt) . splitExpr <$> process2Term2 prelude upt
+process upt = (\dt -> debugTrace ("Resolver process term:\n" <> prettyPrint dt) dt) . splitExpr <$> process2Term2 upt
 
-process2Term2 :: [(String, AnnotatedUPT)] -- ^Prelude
-              -> AnnotatedUPT
+process2Term2 :: AnnotatedUPT
               -> Either String Term2
-process2Term2 prelude = fmap generateAllHashes
-                      . debruijinize [] <=< validateVariables prelude
-                      . removeCaseUPs
-                      . optimizeBuiltinFunctions
-                      . addBuiltins
+process2Term2 = fmap generateAllHashes
+              . debruijinize [] <=< validateVariables
+              . removeCaseUPs
+              . optimizeBuiltinFunctions
+              . addBuiltins
 
 -- |Helper function to compile to Term2
 runTelomareParser2Term2 :: TelomareParser AnnotatedUPT -- ^Parser to run
-                        -> [(String, AnnotatedUPT)]    -- ^Prelude
-                        -> String                               -- ^Raw string to be parsed
-                        -> Either String Term2                  -- ^Error on Left
-runTelomareParser2Term2 parser prelude str =
-  first errorBundlePretty (runParser parser "" str) >>= process2Term2 prelude
+                        -> String                      -- ^Raw string to be parsed
+                        -> Either String Term2         -- ^Error on Left
+runTelomareParser2Term2 parser str =
+  first errorBundlePretty (runParser parser "" str) >>= process2Term2
 
 parseMain :: [(String, AnnotatedUPT)] -- ^Prelude: [(VariableName, BindedUPT)]
-          -> String                            -- ^Raw string to be parserd.
-          -> Either String Term3               -- ^Error on Left.
-parseMain prelude s = parseWithPrelude prelude s >>= process prelude
+          -> String                   -- ^Raw string to be parserd.
+          -> Either String Term3      -- ^Error on Left.
+parseMain prelude s = parseWithPrelude prelude s >>= process

test/ResolverTests.hs

@@ -126,12 +126,12 @@ unitTests :: TestTree
 unitTests = testGroup "Unit tests"
   [
     testCase "different values get different hashes" $ do
-      let res1 = generateAllHashes <$> runTelomareParser2Term2 parseLet [] hashtest0
-          res2 = generateAllHashes <$> runTelomareParser2Term2 parseLet [] hashtest1
+      let res1 = generateAllHashes <$> runTelomareParser2Term2 parseLet hashtest0
+          res2 = generateAllHashes <$> runTelomareParser2Term2 parseLet hashtest1
       (res1 == res2) `compare` False @?= EQ
   , testCase "same functions have the same hash even with different variable names" $ do
-     let res1 = generateAllHashes <$> runTelomareParser2Term2 parseLet [] hashtest2
-         res2 = generateAllHashes <$> runTelomareParser2Term2 parseLet [] hashtest3
+     let res1 = generateAllHashes <$> runTelomareParser2Term2 parseLet hashtest2
+         res2 = generateAllHashes <$> runTelomareParser2Term2 parseLet hashtest3
      res1 @?= res2
   , testCase "Ad hoc user defined types success" $ do
       res <- testUserDefAdHocTypes userDefAdHocTypesSuccess
@@ -141,25 +141,25 @@ unitTests = testGroup "Unit tests"
       res @?= "MyInt must not be 0\ndone"
   , testCase "test automatic open close lambda" $ do
       res <- runTelomareParser (parseLambda <* scn <* eof) "\\x -> \\y -> (x, y)"
-      (forget <$> validateVariables [] res) @?= Right closedLambdaPair
+      (forget <$> validateVariables res) @?= Right closedLambdaPair
   , testCase "test automatic open close lambda 2" $ do
       res <- runTelomareParser (parseLambda <* scn <* eof) "\\x y -> (x, y)"
-      (forget <$> validateVariables [] res) @?= Right closedLambdaPair
+      (forget <$> validateVariables res) @?= Right closedLambdaPair
   , testCase "test automatic open close lambda 3" $ do
       res <- runTelomareParser (parseLambda <* scn <* eof) "\\x -> \\y -> \\z -> z"
-      (forget <$> validateVariables [] res) @?= Right expr6
+      (forget <$> validateVariables res) @?= Right expr6
   , testCase "test automatic open close lambda 4" $ do
       res <- runTelomareParser (parseLambda <* scn <* eof) "\\x -> (x, x)"
-      (forget <$> validateVariables [] res) @?= Right expr5
+      (forget <$> validateVariables res) @?= Right expr5
   , testCase "test automatic open close lambda 5" $ do
       res <- runTelomareParser (parseLambda <* scn <* eof) "\\x -> \\x -> \\x -> x"
-      (forget <$> validateVariables [] res) @?= Right expr4
+      (forget <$> validateVariables res) @?= Right expr4
   , testCase "test automatic open close lambda 6" $ do
       res <- runTelomareParser (parseLambda <* scn <* eof) "\\x -> \\y -> \\z -> [x,y,z]"
-      (forget <$> validateVariables [] res) @?= Right expr3
+      (forget <$> validateVariables res) @?= Right expr3
   , testCase "test automatic open close lambda 7" $ do
       res <- runTelomareParser (parseLambda <* scn <* eof) "\\a -> (a, (\\a -> (a,0)))"
-      (forget <$> validateVariables [] res) @?= Right expr2
+      (forget <$> validateVariables res) @?= Right expr2
   , testCase "test tictactoe.tel" $ do
       res <- tictactoe
       res @?= fullRunTicTacToeString
@@ -322,7 +322,7 @@ showAllTransformations input = do
   --     diff = getGroupedDiff str1 str2
   -- section "optimizeBindingsReference" . show $ optimizeBindingsReferenceVar
   -- section "Diff optimizeBindingsReference" $ ppDiff diff
-  let validateVariablesVar = validateVariables prelude optimizeBuiltinFunctionsVar
+  let validateVariablesVar = validateVariables optimizeBuiltinFunctionsVar
       str3 = lines . show $ validateVariablesVar
       diff = getGroupedDiff str3 str1
   section "validateVariables" . show $ validateVariablesVar

test/Spec.hs

@@ -360,7 +360,7 @@ qcDecompileIExprAndBackEvalsSame (IExprWrapper x) = pure (showResult $ eval' x)
         debruijinize' x = case debruijinize [] x of
           Just r -> r
           _      -> error "debruijinize error"
-        validateVariables' x = case validateVariables [] x of
+        validateVariables' x = case validateVariables x of
           Right r -> r
           Left e  -> error ("validateVariables " <> e)
         parseLongExpr' x = case runTelomareParser (scn *> parseLongExpr <* scn) x of