add clean implementation

diff --git a/Makefile b/Makefile
index 05499c6..5f88de6 100644 (file)
--- a/Makefile
+++ b/Makefile
@@ -1,7 +1,22 @@
 CFLAGS:=-g
-PROGRAMS:=bf bfll
+CLEAN_HOME?=/opt/clean
+CLM:=clm
+CLMFLAGS+=-dynamics -l -no-pie -h 200M -t -nt -lat
+CLMLIBS:=\
+       -I $(CLEAN_HOME)/lib/clean-platform/OS-Independent\
+       -I $(CLEAN_HOME)/lib/clean-platform/OS-Independent/Deprecated/StdLib\
+       -I $(CLEAN_HOME)/lib/clean-platform/OS-Posix\
+       -I $(CLEAN_HOME)/lib/clean-platform/OS-Linux\
+       -I $(CLEAN_HOME)/lib/clean-platform/OS-Linux-64\
+       -I $(CLEAN_HOME)/lib/StdEnv\
+       -I $(CLEAN_HOME)/lib/Generics\
+       -I $(CLEAN_HOME)/lib/Dynamics
+PROGRAMS:=bf bfll cleanbf
 
 all: $(PROGRAMS)
 
+%: %.icl
+       $(CLM) $(CLMLIBS) $(CLMFLAGS) $(basename $<) -o $@
+
 clean:
-       $(RM) -v $(PROGRAMS)
+       $(RM) -r $(PROGRAMS) Clean\ System\ Files

diff --git a/cleanbf.icl b/cleanbf.icl
new file mode 100644 (file)
index 0000000..be3c422
--- /dev/null
+++ b/cleanbf.icl
@@ -0,0 +1,45 @@
+module cleanbf
+
+import Data.Either
+import System.CommandLine
+import Data.Error
+import System.File
+
+import _SystemArray
+import StdEnv
+
+TAPESIZE :== 1024
+:: *BFState = {pc :: Int, tc :: Int, io :: *File, cs :: [Int], tape :: *{Int},
+       prog :: String}
+
+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, 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}
+       ',' = let (_, c, io) = freadc st.io
+               in {st & pc=pc+1, tape=update tape` tc (toInt c), io=io}
+       '[' = let st` = {st & cs=[pc:cs], tape=tape`, pc=pc+1} in if (b == 0)
+                       {st` & pc=1+(while (\pc`->select prog pc` <> ']') ((+) 1) pc)} st`
+       ']' = {st & tape=tape`, 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..1024]},prog=s}
+
+Start w
+# ([_:p], w) = getCommandLine w
+# (io, w) = stdio 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