Fixed BLC

2 files changed, 28 insertions, 17 deletions

diff --git a/src/Binary.hs b/src/Binary.hs
index 4d8a797..44ac1bd 100644
--- a/src/Binary.hs
+++ b/src/Binary.hs
@@ -10,7 +10,7 @@ import           Data.Binary                    ( decode
                                                 )
 import qualified Data.BitString                as Bit
 import qualified Data.ByteString.Lazy          as Byte
-import           Data.Int                       ( Int8 )
+import           Data.Word                      ( Word8 )
 import           Helper
 
 toBinary :: Expression -> String
@@ -27,7 +27,7 @@ fromBinary' inp = case inp of
         (exp2, rst2) = fromBinary' rst1
     in  (Application exp1 exp2, rst2)
   '1' : _ : rst -> binaryBruijn rst
-  _             -> error "invalid"
+  e             -> error $ "invalid: " <> e
  where
   binaryBruijn rst =
     let idx = (length $ takeWhile (== '1') $ inp) - 1
@@ -39,11 +39,11 @@ fromBinary :: String -> Expression
 fromBinary = fst . fromBinary'
 
 -- 1 byte indicating bit-padding at end + n bytes filled with bits
--- TODO: technically only 1 nibble is needed (versioning/sth?)
+-- TODO: technically only 1 nibble is needed (use other nibble for versioning/sth?)
 toBitString :: String -> Bit.BitString
 toBitString str = Bit.concat
   [ Bit.bitString $ Byte.toStrict $ encode
-    (fromIntegral $ length str `mod` 8 :: Int8)
+    (fromIntegral $ length str `mod` 8 :: Word8)
   , Bit.fromList $ map
     (\case
       '0' -> False
@@ -53,7 +53,6 @@ toBitString str = Bit.concat
     str
   ]
 
--- TODO: Fix this
 fromBitString :: Bit.BitString -> String
 fromBitString bits =
   map
@@ -62,6 +61,8 @@ fromBitString bits =
         True  -> '1'
       )
     $ Bit.toList
-    $ Bit.take (Bit.length bits - pad bits)
+    $ Bit.take (Bit.length bits - (fromIntegral $ pad bits))
     $ Bit.drop 8 bits
-  where pad = decode . Bit.realizeBitStringLazy . Bit.take 8
+ where
+  pad :: Bit.BitString -> Word8
+  pad = decode . Bit.realizeBitStringLazy . Bit.take 8
diff --git a/src/Eval.hs b/src/Eval.hs
index 94a98a6..9978a45 100644
--- a/src/Eval.hs
+++ b/src/Eval.hs
@@ -193,27 +193,37 @@ evalMainFunc (Environment env) arg = do
   e <- lookup "main" (map fst env)
   pure $ reduce $ Application e arg
 
-evalFileConf :: String -> (a -> IO ()) -> (Expression -> a) -> EvalConf -> IO ()
-evalFileConf path wr conv conf = do
-  EnvState env _ <- loadFile path conf
+evalFileConf :: String -> (a -> IO ()) -> (Expression -> a) -> EvalConf -> ExpCache -> IO ()
+evalFileConf path wr conv conf cache = do
+  EnvState env _ _ <- loadFile path conf cache
   arg          <- encodeStdin
   case evalMainFunc env arg of
     Nothing  -> print $ ContextualError (UndeclaredFunction "main") (Context "" path)
     Just e -> wr $ conv e
 
+defaultConf :: String -> EvalConf
+defaultConf path = EvalConf { isRepl = False, evalTests = True, nicePath = path, tested = [], evalPaths = [] }
+
+reduceFile :: String -> (a -> IO ()) -> (Expression -> a) -> IO ()
+reduceFile path wr conv = do
+  EnvState (Environment env) _ _ <- loadFile path (defaultConf path) H.empty
+  case lookup "main" (map fst env) of
+    Nothing  -> print $ ContextualError (UndeclaredFunction "main") (Context "" path)
+    Just e -> wr $ conv e
+
 evalFile :: String -> (a -> IO ()) -> (Expression -> a) -> IO ()
-evalFile path wr conv = evalFileConf path wr conv (EvalConf { isRepl = False, evalTests = True, nicePath = path, tested = [], evalPaths = [] })
+evalFile path wr conv = evalFileConf path wr conv (defaultConf path) H.empty
 
 -- TODO: Merge with evalFile
 evalYolo :: String -> (a -> IO ()) -> (Expression -> a) -> IO ()
-evalYolo path wr conv = evalFileConf path wr conv (EvalConf { isRepl = False, evalTests = False, nicePath = path, tested = [], evalPaths = [] })
+evalYolo path wr conv = evalFileConf path wr conv (defaultConf path) { evalTests = False } H.empty
 
 exec :: String -> (String -> IO (Either IOError a)) -> (a -> String) -> IO ()
 exec path rd conv = do
   f <- rd path
   case f of
     Left  exception -> print (exception :: IOError)
-    Right f'      -> print $ reduce $ fromBinary $ conv f'
+    Right f'      -> putStr $ humanifyExpression $ reduce' $ Application (fromBinary $ conv f') arg
 
 repl :: EnvState -> InputT M ()
 repl (EnvState env conf) =
@@ -252,8 +262,8 @@ runRepl = do
     looper = runInputTWithPrefs
         prefs
         (completionSettings history)
-        (withInterrupt $ repl $ EnvState (Environment []) conf)
-  code <- StrictState.evalStateT looper (EnvState (Environment []) conf)
+        (withInterrupt $ repl $ EnvState (Environment []) conf H.empty)
+  code <- StrictState.evalStateT looper (EnvState (Environment []) conf H.empty)
   return code
 
 usage :: IO ()
@@ -276,10 +286,10 @@ evalMain = do
   args <- getArgs
   case args of
     []           -> runRepl
-    ["-b", path] -> evalFile path
+    ["-b", path] -> reduceFile path
                              (Byte.putStr . Bit.realizeBitStringStrict)
                              (toBitString . toBinary)
-    ["-B", path] -> evalFile path putStrLn toBinary
+    ["-B", path] -> reduceFile path putStrLn toBinary
     ["-e", path] ->
       exec path (try . Byte.readFile) (fromBitString . Bit.bitString)
     ["-E", path] -> exec path (try . readFile) id