Return Styles: Pseud0ch, Terminal, Valhalla, NES, Geocities, Blue Moon. Entire thread

i love haskell, what do?

Name: Anonymous 2012-01-23 7:24

/program/, help me. I'm learning Haskell, and I love it. What can I do to rectify my correct opinion that functional programming is a wonderful and powerful tool?

Name: Anonymous 2012-01-23 15:57

>>21
C/C++

int main(int argc, char **argv) {
   char* code = argv[1], data = 0, *p = &data;
   while(*code)
      switch(*code++) {
         case '>': ++p; break;
         case '<': --p; break;
         case '+': ++(*p); break;
         case '-': --(*p); break;
         case '.': putchar(*p); break;
         case ',': *p = getchar(); break;
      }
}



Haskell (http://hackage.haskell.org/packages/archive/brainfuck/0.1/doc/html/src/Language-Brainfuck.html#Core)

module Language.Brainfuck where

import Data.Array.IO
import Data.Array hiding (array)
import Data.Array.Base   (unsafeRead, unsafeWrite, array)
import Data.Word         ( Word8 )
import Data.Char         ( ord, chr )
import Data.List         ( groupBy )
import Data.Maybe        ( catMaybes )
import Control.Monad.State

{- | The complete BF language:

* \>    Increment the pointer.
* \<    Decrement the pointer.
* +     Increment the byte at the pointer.
* \-    Decrement the byte at the pointer.
* .     Output the byte at the pointer.
* ,     Input a byte and store it in the byte at the pointer.
* [     Jump forward past the matching ] if the byte at the pointer is zero.
* ]     Jump backward to the matching [ unless the byte at the pointer is zero.

-}

data Command = IncPtr
             | IncPtrBy !Int  -- ^ Increment pointer by set amount
             | DecPtr
             | IncByte
             | IncByteBy !Int -- ^ Increment by a set amount
             | DecByte
             | OutputByte
         --  | InputByte
             | JmpForward  !Int -- ^ nesting level
             | JmpBackward !Int -- ^ nesting level
             | SetIpTo !Int   -- ^ Sets the instruction ptr to a specific value
             | Halt
             | Ignored
             deriving (Show, Eq)

type Core = IOUArray Int Word8

type InstPtr = Int
type CorePtr = Int
data BF = BF !Core !CorePtr !InstPtr

instance Show BF where
    show (BF _ cp ip) = "BF <core> CorePtr = " ++ show cp ++ " InstPtr = " ++ show ip

coreSize = 30000

core :: IO Core
core = newArray (0, coreSize - 1) (0::Word8)

decode :: Char -> State Int Command
decode '>' = return IncPtr
decode '<' = return DecPtr
decode '+' = return IncByte
decode '-' = return DecByte
decode '.' = return OutputByte
-- decode ',' = return InputByte
decode '[' = do n <- get
                put (n+1)
                return $ JmpForward n
decode ']' = do n <- get
                put (n-1)
                return $ JmpBackward (n-1)
decode '@' = return Halt
decode _   = return Ignored

debug :: Bool
debug = False

incIP :: InstPtr -> InstPtr
incIP = (+ 1)
{-# INLINE incIP #-}

incCP :: CorePtr -> CorePtr
incCP = (`mod` coreSize) . (1 +)
{-# inlinE incCP #-}

decCP :: CorePtr -> CorePtr
decCP = (`mod` coreSize) . subtract 1
{-# INLINE decCP #-}

doCommand :: Array Int Command -> BF -> IO BF
doCommand cmds bf@(BF _ _ ip) = doCommand' (cmds ! ip) cmds bf
  where
  doCommand' :: Command -> Array Int Command -> BF -> IO BF
  doCommand' Halt _ _ = undefined
  doCommand' Ignored _ (BF c cp ip) = {-# SCC "Ignored" #-} do
    when debug $ putStrLn $ "Ignored " ++ show bf
    return (BF c cp (incIP ip))
  doCommand' IncPtr _ bf@(BF c cp ip) = {-# SCC "IncPtr" #-} do
    when debug $ putStrLn $ "IncPtr " ++ show bf
    return (BF c (incCP cp) (incIP ip))
  doCommand' DecPtr _ bf@(BF c cp ip) = {-# SCC "DecPtr" #-} do
    when debug $ putStrLn $ "DecPtr " ++ show bf
    return (BF c (decCP cp) (incIP ip))
  doCommand' (IncPtrBy n) _ bf@(BF c cp ip) = {-# SCC "IncPtrBy" #-} do
    when debug $ putStrLn $ "IncPtrBy " ++ show n ++ " " ++ show bf
    return (BF c ((cp + n) `mod` coreSize) (incIP ip))
  doCommand' IncByte _ bf = {-# SCC "IncByte" #-} do
    when debug $ putStrLn $ "IncByte " ++ show bf
    updateByte bf (+1)
  doCommand' DecByte _ bf = {-# SCC "DecByte" #-} do
    when debug $ putStrLn $ "DecByte " ++ show bf
    updateByte bf (subtract 1)
  doCommand' (IncByteBy n) _ bf = {-# SCC "IncByteBy" #-} do
    when debug $ putStrLn $ "IncByteBy " ++ show n ++ " " ++ show bf
    updateByte bf (+ fromIntegral n)
  doCommand' OutputByte _ bf@(BF c cp ip) = {-# SCC "OutputByte" #-} do
    when debug $ putStrLn $ "OutputByte " ++ show bf
    c' <- unsafeRead c cp
    putChar (word8ToChr c')
    return (BF c cp (incIP ip))

{-
  doCommand' InputByte _ bf@(BF c cp ip) = {-# SCC "InputByte" #-} do
    when debug $ putStrLn $ "InputByte " ++ show bf
    c' <- getChar
    let newByte = chrToWord8 c'
    unsafeWrite c cp newByte
    return (BF c cp (incIP ip))
-}

  doCommand' (JmpForward n) cmds bf@(BF c cp ip) = {-# SCC "JmpForw" #-} do
    c' <- unsafeRead c cp
    case c' of
      0 -> {-# SCC "JmpForward1" #-} do
        when debug $ putStrLn $ "JmpForward1 " ++ show bf
        return (BF c cp newInstPtr)
      _ -> {-# SCC "JmpForward2" #-} do
        when debug $ putStrLn $ "JmpForward2 " ++ show bf
        let newBF = (BF c cp (incIP ip))
        when debug $ putStrLn $ "JmpForward3" ++ show newBF
        return newBF
    where
    -- we add one to go one past the next back jump
    newInstPtr = (nextJmp cmds ip (+1) (JmpBackward n)) + 1
  doCommand' (JmpBackward n) cmds bf@(BF c cp ip) = {-# SCC "JmpBack" #-} do
    c' <- unsafeRead c cp
    if (c' /= 0)
      then do when debug $ putStrLn $ "JmpBackward1 " ++ show bf
              return (BF c cp newInstPtr)
      else do when debug $ putStrLn $ "JmpBackward2 " ++ show bf
              return (BF c cp (incIP ip))
    where
    newInstPtr = nextJmp cmds ip (subtract 1) (JmpForward n)
  doCommand' (SetIpTo i) _ bf@(BF c cp ip) = {-# SCC "SetIPTo" #-} do
    c' <- unsafeRead c cp
    when debug $ putStrLn $ "SetIpTo " ++ show i ++ " "
                          ++ show bf ++ " @" ++ show c'

Newer Posts
Don't change these.
Name: Email:
Entire Thread Thread List