aboutsummaryrefslogtreecommitdiffhomepage
diff options
context:
space:
mode:
Diffstat
-rw-r--r--samples/io/random.bruijn6
-rw-r--r--src/Binary.hs4
-rw-r--r--src/Eval.hs6
-rw-r--r--src/Helper.hs16
-rw-r--r--src/Reducer.hs41
5 files changed, 37 insertions, 36 deletions
diff --git a/samples/io/random.bruijn b/samples/io/random.bruijn
new file mode 100644
index 0000000..ab23f91
--- /dev/null
+++ b/samples/io/random.bruijn
@@ -0,0 +1,6 @@
+# "cat /dev/random | bruijn random.bruijn"
+# prints number between 0 and 255 - stdin laziness!
+
+:import std/Pair .
+
+main [^0]
diff --git a/src/Binary.hs b/src/Binary.hs
index ac08ca7..a9e8028 100644
--- a/src/Binary.hs
+++ b/src/Binary.hs
@@ -10,7 +10,6 @@ import Data.Binary ( decode
, encode
)
import qualified Data.BitString as Bit
-import qualified Data.ByteString.Lazy as Byte
import Data.Word ( Word8 )
import Helper
@@ -43,8 +42,7 @@ fromBinary = fst . fromBinary'
-- 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 :: Word8)
+ [ Bit.bitStringLazy $ encode (fromIntegral $ length str `mod` 8 :: Word8)
, Bit.fromList $ map
(\case
'0' -> False
diff --git a/src/Eval.hs b/src/Eval.hs
index 03e1201..c91329c 100644
--- a/src/Eval.hs
+++ b/src/Eval.hs
@@ -9,7 +9,7 @@ import Control.Exception
import Control.Monad.State
import qualified Control.Monad.State.Strict as StrictState
import qualified Data.BitString as Bit
-import qualified Data.ByteString as Byte
+import qualified Data.ByteString.Lazy as Byte
import Data.Function ( on )
import Data.List
import qualified Data.Map as M
@@ -448,11 +448,11 @@ evalMain = do
case args of
[] -> runRepl
["-b", path] -> dumpFile path
- (Byte.putStr . Bit.realizeBitStringStrict)
+ (Byte.putStr . Bit.realizeBitStringLazy)
(toBitString . toBinary)
["-B", path] -> dumpFile path putStrLn toBinary
["-e", path] ->
- exec path (try . Byte.readFile) (fromBitString . Bit.bitString)
+ exec path (try . Byte.readFile) (fromBitString . Bit.bitStringLazy)
["-E", path] -> exec path (try . readFile) id
["-y", path] -> evalYolo path
['-' : _] -> usage
diff --git a/src/Helper.hs b/src/Helper.hs
index 9571c00..110fd4f 100644
--- a/src/Helper.hs
+++ b/src/Helper.hs
@@ -9,8 +9,8 @@ module Helper where
import qualified Control.Monad.State as S
import Data.Array
import qualified Data.BitString as Bit
-import qualified Data.ByteString as Byte
-import qualified Data.ByteString.Char8 as C
+import qualified Data.ByteString.Lazy as Byte
+import qualified Data.ByteString.Lazy.Char8 as C
import Data.List
import qualified Data.Map as M
import Text.Megaparsec
@@ -195,14 +195,14 @@ encodeByte bits = Abstraction $ Abstraction $ Abstraction $ binarify
-- TODO: There must be a better way to do this :D
encodeBytes :: Byte.ByteString -> Expression
encodeBytes bytes = listify $ map
- (encodeByte . Bit.toList . Bit.bitString . Byte.pack . (: []))
+ (encodeByte . Bit.toList . Bit.bitStringLazy . Byte.pack . (: []))
(Byte.unpack bytes)
stringToExpression :: String -> Expression
stringToExpression = encodeBytes . C.pack
charToExpression :: Char -> Expression
-charToExpression ch = encodeByte $ Bit.toList $ Bit.bitString $ C.pack [ch]
+charToExpression ch = encodeByte $ Bit.toList $ Bit.bitStringLazy $ C.pack [ch]
encodeStdin :: IO Expression
encodeStdin = do
@@ -232,7 +232,7 @@ decodeStdout e = do
u <- unlistify e
pure $ C.unpack $ Byte.concat $ map
(\m -> case decodeByte m of
- Just b -> Bit.realizeBitStringStrict $ Bit.fromList b
+ Just b -> Bit.realizeBitStringLazy $ Bit.fromList b
Nothing -> Byte.empty
)
u
@@ -373,9 +373,3 @@ ternaryToDecimal e = do
resolve (Abstraction (Abstraction (Abstraction (Abstraction n)))) =
resolve' n
resolve _ = Nothing
-
-huh :: (a -> Bool) -> [a] -> ([a], [a])
-huh f s = (left, right)
- where
- (left, right') = break f s
- right = if null right' then [] else tail right'
diff --git a/src/Reducer.hs b/src/Reducer.hs
index 82de067..8823b3c 100644
--- a/src/Reducer.hs
+++ b/src/Reducer.hs
@@ -9,6 +9,7 @@ import Data.List ( elemIndex )
import Data.Map ( Map )
import qualified Data.Map as Map
import Helper
+import System.IO.Unsafe ( unsafePerformIO )
import System.Random ( randomIO )
type Store = Map Int Box
@@ -20,30 +21,32 @@ data Rvar = Num Int | Hole
data Redex = Rabs Int Redex | Rapp Redex Redex | Rvar Rvar | Rclosure Redex Store | Rcache Box Redex
data Conf = Econf Redex Store Stack | Cconf Stack Redex | End
-toRedex :: Expression -> IO Redex
+-- TODO: unsafePerformIO is very unpure and ugly!! Unfortunately IO seems to
+-- make this function and therefore the entire reduction strict :/
+toRedex :: Expression -> Redex
toRedex = convertWorker []
where
- convertWorker ns (Abstraction e) = do
- v <- randomIO :: IO Int
- t <- convertWorker (v : ns) e
- pure $ Rabs v t
- convertWorker ns (Application l r) = do
- lhs <- convertWorker ns l
- rhs <- convertWorker ns r
- pure $ Rapp lhs rhs
+ convertWorker ns (Abstraction e) =
+ let v = unsafePerformIO randomIO :: Int
+ t = convertWorker (v : ns) e
+ in Rabs v t
+ convertWorker ns (Application l r) =
+ let lhs = convertWorker ns l
+ rhs = convertWorker ns r
+ in Rapp lhs rhs
convertWorker ns (Bruijn i) =
- pure $ Rvar $ Num (if i < 0 || i >= length ns then i else ns !! i)
+ Rvar $ Num (if i < 0 || i >= length ns then i else ns !! i)
convertWorker _ _ = invalidProgramState
-fromRedex :: Redex -> IO Expression
+fromRedex :: Redex -> Expression
fromRedex = convertWorker []
where
- convertWorker es (Rabs n e) = Abstraction <$> convertWorker (n : es) e
- convertWorker es (Rapp l r) = do
- lhs <- convertWorker es l
- rhs <- convertWorker es r
- pure $ Application lhs rhs
- convertWorker es (Rvar (Num n)) = pure $ Bruijn $ maybe n id (elemIndex n es)
+ convertWorker es (Rabs n e) = Abstraction $ convertWorker (n : es) e
+ convertWorker es (Rapp l r) =
+ let lhs = convertWorker es l
+ rhs = convertWorker es r
+ in Application lhs rhs
+ convertWorker es (Rvar (Num n)) = Bruijn $ maybe n id (elemIndex n es)
convertWorker _ _ = invalidProgramState
transition :: Conf -> IO Conf
@@ -95,7 +98,7 @@ loadTerm t = Econf t Map.empty []
reduce :: Expression -> IO Expression
reduce e = do
- redex <- toRedex e
+ redex <- pure $ toRedex e
forEachState (loadTerm redex) transition >>= \case
- Cconf [] v -> fromRedex v
+ Cconf [] v -> pure $ fromRedex v
_ -> invalidProgramState