reduce code to 42 lines to honor ObjectIO's *World
authorMart Lubbers <mart@martlubbers.net>
Thu, 10 Nov 2016 19:27:23 +0000 (20:27 +0100)
committerMart Lubbers <mart@martlubbers.net>
Thu, 10 Nov 2016 19:27:23 +0000 (20:27 +0100)
cleanbf.icl

index 57064c5..1e6f65b 100644 (file)
@@ -1,15 +1,15 @@
 module cleanbf
 
 import Data.Either
-import System.CommandLine
 import Data.Error
+import Data.Tuple
+import StdEnv
+import System.CommandLine
 import System.File
+import _SystemArray
 
 from Data.Func import $
 
-import _SystemArray
-import StdEnv
-
 TAPESIZE :== 1024
 :: *BFState = {pc :: Int, tc :: Int, io :: *File, cs :: [Int], tape :: *{Int},
        prog :: String}
@@ -18,8 +18,8 @@ bf :: *BFState -> Either *BFState *BFState
 bf st=:{prog,pc,tc,tape,cs}
 | st.pc == size st.prog = Left st
 = let (b, tape`) = uselect tape tc in Right $ case select prog pc of
-       '<' = {st & pc=pc+1, tape=tape`, tc=tc-1}
-       '>' = {st & pc=pc+1, tape=tape`, tc=tc+1}
+       '<' = {st & pc=pc+1, tc=tc-1}
+       '>' = {st & pc=pc+1, tc=tc+1}
        '+' = {st & pc=pc+1, tape=update tape` tc (b+1)}
        '-' = {st & pc=pc+1, tape=update tape` tc (b-1)}
        '.' = {st & pc=pc+1, tape=tape`, io=st.io <<< toChar b}
@@ -30,18 +30,13 @@ bf st=:{prog,pc,tc,tape,cs}
        ']' = {st & pc=hd cs, cs=tl cs}
        _ = {st & pc=pc+1}
 
-f :: (.a -> (Either .a .a)) -> .(.a -> .a)
-f g = (either id (f g)) o g
-
-mkState :: !*File String -> *BFState
-mkState f s = {pc=0,tc=0,io=f,cs=[],tape={0\\_<-[0..TAPESIZE]},prog=s}
-
 Start w
-# ([_:p], w) = getCommandLine w
-# (io, w) = stdio w
-| isEmpty p = snd (fclose (io <<< "Pleasy supply a filename\n") w)
+# ([_:p], (io, w)) = appSnd stdio $ getCommandLine w
+| isEmpty p = snd $ fclose (io <<< "Pleasy supply a filename\n") w
 # (io, w) = case readFile (hd p) w of
        (Error e, w) = (io <<< "File error: " <<< toString e <<< "\n", w)
-       (Ok s, w) = let st` = f bf (mkState io s) in (st`.io, w)
-# (_, w) = fclose io w
-= w
+       (Ok s, w) = let st` = run bf $ mkState io s in (st`.io, w)
+       with
+               run g = (either id (run g)) o g
+               mkState f s = {pc=0,tc=0,io=f,cs=[],tape={0\\_<-[0..TAPESIZE]},prog=s}
+= snd $ fclose io w