diff options
| -rw-r--r-- | Brainfuck.dcl | 4 | ||||
| -rw-r--r-- | Brainfuck.icl | 48 |
2 files changed, 27 insertions, 25 deletions
diff --git a/Brainfuck.dcl b/Brainfuck.dcl index 133e34d..50179ed 100644 --- a/Brainfuck.dcl +++ b/Brainfuck.dcl @@ -25,11 +25,11 @@ definition module Brainfuck import StdEnv, StdList :: Command = INC | DEC | INCP | DECP | OUT | IN | IFZ | IFNZ -:: Program :== [Command] +:: Program :== {Command} :: InstrPointer :== Int :: Cell :== Int -:: Tape :== [Cell] +:: *Tape :== *{#Cell} :: DataPointer :== Int run :: Program *env -> *env | FileSystem env diff --git a/Brainfuck.icl b/Brainfuck.icl index 89f8407..af7a942 100644 --- a/Brainfuck.icl +++ b/Brainfuck.icl @@ -37,29 +37,30 @@ instance == Command where // Run a program run :: Program *env -> *env | FileSystem env -run p world = run` p 0 0 [0,0..] world +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 >= length 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 + | 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 + | 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 (update t dptr c) world + = run` p (iptr + 1) dptr {t & [dptr] = toInt c} world // must be OUT now - # io = io <<< toChar (t!!dptr) + # (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 @@ -68,24 +69,25 @@ where convert n = max 0 (min 255 n) apply :: Command DataPointer Tape -> Tape - apply INC dptr t = update t dptr (t!!dptr + 1) - apply DEC dptr t = update t dptr (t!!dptr - 1) - - update :: Tape DataPointer a -> Tape | toInt a - update t ptr c = (take ptr t) ++ [convert (toInt c) : drop (ptr + 1) t] + 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) + | 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) + | 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 @@ -96,7 +98,7 @@ where // Read a string into a program read :: String -> Program -read s = [readC c \\ c <- fromString s | isMember c ['><+-.,[]']] +read s = {readC c \\ c <- fromString s | isMember c ['><+-.,[]']} where readC :: Char -> Command readC '>' = INCP |