From: Mart Lubbers <mart@martlubbers.net>
Date: Thu, 10 Nov 2016 19:15:00 +0000 (+0100)
Subject: add clean implementation
X-Git-Url: https://git.martlubbers.net/?a=commitdiff_plain;h=6011ba781f0aab6a7fcdcd00d8e6c1a36f664e07;p=bf.git

add clean implementation
---

diff --git a/Makefile b/Makefile
index 05499c6..5f88de6 100644
--- 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
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