// The MIT License (MIT)
// 
// Copyright (c) 2015 Camil Staps
// 
// Permission is hereby granted, free of charge, to any person obtaining a copy
// of this software and associated documentation files (the "Software"), to deal
// in the Software without restriction, including without limitation the rights
// to use, copy, modify, merge, publish, distribute, sublicense, and/or sell
// copies of the Software, and to permit persons to whom the Software is
// furnished to do so, subject to the following conditions:
// 
// The above copyright notice and this permission notice shall be included in all
// copies or substantial portions of the Software.
// 
// THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
// IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
// FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
// AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
// LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
// OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE
// SOFTWARE.

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 [0,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
    // 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"
        | otherwise = run` p (iptr + 1) dptr (update t dptr c) world
    // must be OUT now
    # io = io <<< toChar (t!!dptr)
    # (ok,world) = fclose io world
    | not ok = abort "Couldn't close stdio"
    | otherwise = run` p (iptr + 1) dptr t world
    where 
        convert :: Cell -> Cell
        convert n
        | n < 0 = 0
        | n > 255 = 255
        | otherwise = 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]

        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)
        | otherwise = 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)
        | otherwise = 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