module cleanbf

import Data.Either
import Data.Error
import Data.Tuple
import StdEnv
import System.CommandLine
import System.File
import _SystemArray

from Data.Func import $

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, 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}
	',' = 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 & pc=hd cs, cs=tl cs}
	_ = {st & pc=pc+1}

Start 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` = 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