From ed5473a94f48c6f90e463c9af64045d6880f39cc Mon Sep 17 00:00:00 2001
From: Mart Lubbers <mart@martlubbers.net>
Date: Thu, 10 Nov 2016 20:27:23 +0100
Subject: [PATCH] reduce code to 42 lines to honor ObjectIO's *World

---
 cleanbf.icl | 31 +++++++++++++------------------
 1 file changed, 13 insertions(+), 18 deletions(-)

diff --git a/cleanbf.icl b/cleanbf.icl
index 57064c5..1e6f65b 100644
--- a/cleanbf.icl
+++ b/cleanbf.icl
@@ -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
-- 
2.20.1