implementation module Brainfuck

import StdEnv

instance == Command where
    == INC INC = True
    == DEC DEC = True
    == INCP INCP = True
    == DECP DECP = True
    == OUT OUT = True
    == IN IN = True
    == IFZ IFZ = True
    == IFNZ IFNZ = True
    == _ _ = False

// Run a program
run :: Program *env -> *env | FileSystem env
run p world = run` p 0 0 (createArray 10000 0) world
where
    run` :: Program InstrPointer DataPointer Tape *env -> *env | FileSystem env
    run` p iptr dptr t world
    | iptr >= size p = world
    | p.[iptr] == INC || p.[iptr] == DEC
		= run` p (iptr + 1) dptr (apply (p.[iptr]) dptr t) world
    | p.[iptr] == INCP = run` p (iptr + 1) (dptr + 1) t world
    | p.[iptr] == DECP = run` p (iptr + 1) (dptr - 1) t world
    | p.[iptr] == IFZ && t.[dptr] <> 0 = run` p (iptr + 1) dptr t world
    | p.[iptr] == IFZ = run` p (forward p iptr) dptr t world
    | p.[iptr] == IFNZ && t.[dptr] == 0 = run` p (iptr + 1) dptr t world
    | p.[iptr] == IFNZ = run` p (backward p iptr) dptr t world
    // must be IN / OUT now
    # (io,world) = stdio world
    | p.[iptr] == IN
        # (ok,c,io) = freadc io
        | not ok = abort "Couldn't read input"
        # (ok,world) = fclose io world
        | not ok = abort "Couldn't close stdio"
        = run` p (iptr + 1) dptr {t & [dptr] = toInt c} world
    // must be OUT now
	# (d,t) = t![dptr]
    # io = io <<< toChar d
    # (ok,world) = fclose io world
    | not ok = abort "Couldn't close stdio"
    = run` p (iptr + 1) dptr t world
    where 
        convert :: Cell -> Cell
        convert n = max 0 (min 255 n)

        apply :: Command DataPointer Tape -> Tape
        apply INC dptr t
		# (d,t) = t![dptr]
		= {t & [dptr] = d + 1}
        apply DEC dptr t
		# (d,t) = t![dptr]
		= {t & [dptr] = d - 1}

        forward` :: Program InstrPointer Int -> InstrPointer
        forward` _ ptr 0 = ptr
        forward` p ptr i
        | p.[ptr] == IFZ = forward` p (ptr+1) (i+1)
        | p.[ptr] == IFNZ = forward` p (ptr+1) (i-1)
        = forward` p (ptr+1) i

        backward` :: Program InstrPointer Int -> InstrPointer
        backward` _ ptr 0 = ptr + 1
        backward` p ptr i
        | p.[ptr] == IFZ = backward` p (ptr-1) (i-1)
        | p.[ptr] == IFNZ = backward` p (ptr-1) (i+1)
        = backward` p (ptr-1) i

        forward :: Program InstrPointer -> InstrPointer
        forward p ptr = forward` p (ptr+1) 1

        backward :: Program InstrPointer -> InstrPointer
        backward p ptr = backward` p (ptr-1) 1

// Read a string into a program
read :: String -> Program
read s = {readC c \\ c <- fromString s | isMember c ['><+-.,[]']}
where
    readC :: Char -> Command
    readC '>' = INCP
    readC '<' = DECP
    readC '+' = INC
    readC '-' = DEC
    readC '.' = OUT
    readC ',' = IN
    readC '[' = IFZ
    readC ']' = IFNZ