diff options
Diffstat (limited to 'Brainfuck.icl')
| -rw-r--r-- | Brainfuck.icl | 37 |
1 files changed, 18 insertions, 19 deletions
diff --git a/Brainfuck.icl b/Brainfuck.icl index ca7d7d1..009b907 100644 --- a/Brainfuck.icl +++ b/Brainfuck.icl @@ -25,16 +25,17 @@ 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 + == 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 [0,0..] world where @@ -62,18 +63,18 @@ where | not ok = abort "Couldn't close stdio" | otherwise = run` p (iptr + 1) dptr t world where - cast :: Cell -> Cell - cast n + convert :: Cell -> Cell + convert n | n < 0 = 0 | n > 255 = 255 | otherwise = n apply :: Command DataPointer Tape -> Tape - apply INC dptr t = (take dptr t) ++ [cast (t!!dptr + 1)] ++ (drop (dptr + 1) t) - apply DEC dptr t = (take dptr t) ++ [cast (t!!dptr - 1)] ++ (drop (dptr + 1) t) + apply INC dptr t = update t dptr (t!!dptr + 1) + apply DEC dptr t = update t dptr (t!!dptr - 1) - update :: Tape DataPointer Char -> Tape - update t ptr c = (take ptr t) ++ [fromChar c : drop (ptr + 1) t] + update :: Tape DataPointer a -> Tape | toInt a + update t ptr c = (take ptr t) ++ [convert (toInt c) : drop (ptr + 1) t] forward` :: Program InstrPointer Int -> InstrPointer forward` _ ptr 0 = ptr @@ -95,8 +96,9 @@ where 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 <- sanitize (fromString s)] +read s = [readC c \\ c <- fromString s | isMember c ['>','<','+','-','.',',','[',']']] where readC :: Char -> Command readC '>' = INCP @@ -107,6 +109,3 @@ where readC ',' = IN readC '[' = IFZ readC ']' = IFNZ - - sanitize :: [Char] -> [Char] - sanitize cs = [c \\ c <- cs | isMember c ['>','<','+','-','.',',','[',']']] |