Créer un compilateur/interpréteur Brainfuck

$ ./bf "++++[>+++++<-]>[<+++++>-]+<+[>[>+>+<<-]++>>[<<+>>-]>>>[-]++>[-]+>>>+[[-]++++++>>>]<<<[[<++++++++<++>>-]+<.<[>----<-]<]<<[>>>>>[>>>[-]+++++++++<[>-<-]+++++++++>[-[<->-]+[<<<]]<[>+<-]>]<<-]<<-]"
0
1
4
9
16
25
36
49
64
81
100
121
144
169
196
225
256
289
324
361
400
441
484
529
576
625
676
729
784
841
900
961
1024
1089
1156
1225
1296
1369
1444
1521
1600
1681
1764
1849
1936
2025
2116
2209
2304
2401
2500
2601
2704
2809
2916
3025
3136
3249
3364
3481
3600
3721
3844
3969
4096
4225
4356
4489
4624
4761
4900
5041
5184
5329
5476
5625
5776
5929
6084
6241
6400
6561
6724
6889
7056
7225
7396
7569
7744
7921
8100
8281
8464
8649
8836
9025
9216
9409
9604
9801
10000

; 4FF:       488B05A2FFFFFF   MOV RAX, [RIP-94]               ; '*MEMORY*
                                                              ; no-arg-parsing entry point
; 506:       8B48F5           MOV ECX, [RAX-11]
; 509:       498B0C0C         MOV RCX, [R12+RCX]
; 50D:       83F961           CMP ECX, 97
; 510:       480F4448F9       CMOVEQ RCX, [RAX-7]
; 515:       488B0594FFFFFF   MOV RAX, [RIP-108]              ; '*POINTER*
; 51C:       8B50F5           MOV EDX, [RAX-11]
; 51F:       498B1414         MOV RDX, [R12+RDX]
; 523:       83FA61           CMP EDX, 97
; 526:       480F4450F9       CMOVEQ RDX, [RAX-7]
; 52B:       488BDA           MOV RBX, RDX
; 52E:       488B5C9901       MOV RBX, [RCX+RBX*4+1]
; 533:       48D1FB           SAR RBX, 1
; 536:       48FFC3           INC RBX
; 539:       48D1E3           SHL RBX, 1
; 53C:       48895C9101       MOV [RCX+RDX*4+1], RBX
; 541:       488B0560FFFFFF   MOV RAX, [RIP-160]              ; '*MEMORY*
; 548:       8B48F5           MOV ECX, [RAX-11]
; 54B:       498B0C0C         MOV RCX, [R12+RCX]
; 54F:       83F961           CMP ECX, 97
; 552:       480F4448F9       CMOVEQ RCX, [RAX-7]
; 557:       488B0552FFFFFF   MOV RAX, [RIP-174]              ; '*POINTER*
; 55E:       8B50F5           MOV EDX, [RAX-11]
; 561:       498B1414         MOV RDX, [R12+RDX]
; 565:       83FA61           CMP EDX, 97
; 568:       480F4450F9       CMOVEQ RDX, [RAX-7]
; 56D:       488BDA           MOV RBX, RDX
; 570:       488B5C9901       MOV RBX, [RCX+RBX*4+1]
; 575:       48D1FB           SAR RBX, 1
; 578:       48FFC3           INC RBX
; 57B:       48D1E3           SHL RBX, 1
; 57E:       48895C9101       MOV [RCX+RDX*4+1], RBX
; 583:       488B051EFFFFFF   MOV RAX, [RIP-226]              ; '*MEMORY*
; 58A:       8B48F5           MOV ECX, [RAX-11]
; 58D:       498B0C0C         MOV RCX, [R12+RCX]
; 591:       83F961           CMP ECX, 97
; 594:       480F4448F9       CMOVEQ RCX, [RAX-7]
; 599:       488B0510FFFFFF   MOV RAX, [RIP-240]              ; '*POINTER*
; 5A0:       8B50F5           MOV EDX, [RAX-11]
; 5A3:       498B1414         MOV RDX, [R12+RDX]
; 5A7:       83FA61           CMP EDX, 97
; 5AA:       480F4450F9       CMOVEQ RDX, [RAX-7]
; 5AF:       488BDA           MOV RBX, RDX
; 5B2:       488B5C9901       MOV RBX, [RCX+RBX*4+1]
; 5B7:       48D1FB           SAR RBX, 1
; 5BA:       48FFC3           INC RBX
; 5BD:       48D1E3           SHL RBX, 1
; 5C0:       48895C9101       MOV [RCX+RDX*4+1], RBX
; 5C5:       EB4C             JMP L1
; 5C7:       660F1F840000000000 NOP
; 5D0: L0:   488B05D1FEFFFF   MOV RAX, [RIP-303]              ; '*MEMORY*
; 5D7:       8B48F5           MOV ECX, [RAX-11]
; 5DA:       498B0C0C         MOV RCX, [R12+RCX]
; 5DE:       83F961           CMP ECX, 97
; 5E1:       480F4448F9       CMOVEQ RCX, [RAX-7]
; 5E6:       488B05C3FEFFFF   MOV RAX, [RIP-317]              ; '*POINTER*
; 5ED:       8B50F5           MOV EDX, [RAX-11]
; 5F0:       498B1414         MOV RDX, [R12+RDX]
; 5F4:       83FA61           CMP EDX, 97
; 5F7:       480F4450F9       CMOVEQ RDX, [RAX-7]
; 5FC:       488BDA           MOV RBX, RDX
; 5FF:       488B5C9901       MOV RBX, [RCX+RBX*4+1]
; 604:       48D1FB           SAR RBX, 1
; 607:       4883EB01         SUB RBX, 1
; 60B:       48D1E3           SHL RBX, 1
; 60E:       48895C9101       MOV [RCX+RDX*4+1], RBX
; 613: L1:   488B058EFEFFFF   MOV RAX, [RIP-370]              ; '*MEMORY*
; 61A:       8B48F5           MOV ECX, [RAX-11]
; 61D:       498B0C0C         MOV RCX, [R12+RCX]
; 621:       83F961           CMP ECX, 97
; 624:       480F4448F9       CMOVEQ RCX, [RAX-7]
; 629:       488B0580FEFFFF   MOV RAX, [RIP-384]              ; '*POINTER*
; 630:       8B50F5           MOV EDX, [RAX-11]
; 633:       498B1414         MOV RDX, [R12+RDX]
; 637:       83FA61           CMP EDX, 97
; 63A:       480F4450F9       CMOVEQ RDX, [RAX-7]
; 63F:       488B449101       MOV RAX, [RCX+RDX*4+1]
; 644:       4885C0           TEST RAX, RAX
; 647:       7587             JNE L0
; 649:       BA17001020       MOV EDX, 537919511
; 64E:       488BE5           MOV RSP, RBP
; 651:       F8               CLC
; 652:       5D               POP RBP
; 653:       C3               RET

import Data.Char
import Text.Parsec
import Text.Parsec.String
import System.Environment

-- Un Zipper pour la mémoire
type Path a = [a]

type ListZipper a = (Path a, [a])

back ([], list) = error "Déjà à gauche"
back (x:xs, list) = (xs, x:list)

forward (path, []) = error "Déjà à droite"
forward (path, x:xs) = (x:path, xs)

set (_, []) _ = error "fin de liste"
set (chemin, x:xs) y = (chemin, y:xs)

get (_, []) = error "fin de liste"
get (_, x:_) = x

fromList :: [a] -> ListZipper a
fromList xs = ([], xs)

data Token = Incr | Decr | Forward | Back | Print | Read | Loop [Token] 
             deriving Show

-- Pour parser le fichier d'entrée et construire une liste d'instructions ([Token]) 
parseGen :: Char -> Token -> Parser Token
parseGen x y = char x >> return y

parseBack, parseForward, parseIncr, parseDecr, parsePrint, parseRead, parseLoop :: Parser Token

parseBack = parseGen '<' Back
parseForward = parseGen '>' Forward
parseIncr = parseGen '+' Incr
parseDecr = parseGen '-' Decr
parsePrint = parseGen '.' Print
parseRead = parseGen ',' Read
parseLoop = do char '['
               code <- parseTokens
               char ']'
               return $ Loop code

parseComment :: Parser ()
parseComment = do many $ noneOf "<>+-,.[]"
                  return ()
  
parseToken :: Parser Token
parseToken = do parseComment 
                i <- parseBack <|> parseForward <|> parseIncr <|> parseDecr <|> parsePrint 
                       <|> parseRead <|> parseLoop
                parseComment
                return i

parseTokens :: Parser [Token]
parseTokens = many parseToken

-- Évaluer les instructions
eval :: [Token] -> IO (ListZipper Int)
eval tokens =
  let eval' [] memory = return memory
      eval' (Incr : xs) memory = eval' xs . set memory $ get memory + 1
      eval' (Decr : xs) memory = eval' xs . set memory $ get memory - 1
      eval' (Forward : xs) memory = eval' xs (forward memory)
      eval' (Back : xs) memory = eval' xs (back memory)
      eval' (Print : xs) memory = (putChar . chr $ get memory) >> eval' xs memory
      eval' (Read : xs) memory = getChar >>= eval' xs . set memory . ord
      eval' (Loop ys : xs) memory =
        if get memory == 0 then eval' xs memory 
        else eval' ys memory >>= eval' (Loop ys : xs)
  in eval' tokens . fromList $ replicate 30000 0

-- Donner un fichier bf en entrée
main :: IO ()
main = do args <- getArgs
          res <- parseFromFile parseTokens (head args)
          case res of
            Left err -> print err
            Right tokens -> do _ <- eval tokens
                               return ()

import Data.Char
import Text.Parsec
import Text.Parsec.String
import System.Environment

-- Un Zipper pour la mémoire
type ListZipper a = ([a], [a])
type Memory = ListZipper Int

fromList :: [a] -> ListZipper a
fromList xs = ([], xs)

back :: Memory -> Memory
back ([], list) = ([], 0:list)
back (x:xs, list) = (xs, x:list)

forward :: Memory -> Memory
forward (path, []) = (0:path, [])
forward (path, x:xs) = (x:path, xs)

set :: Memory -> Int -> Memory
set (path, []) y = (path, y:[])
set (path, x:xs) y = (path, y:xs)

get :: Memory -> Int
get (_, []) = 0
get (_, x:_) = x

data Token = Incr | Decr | Forward | Back | Print | Read | Loop [Token] 
            deriving Show

-- Pour parser le fichier d'entrée et construire une liste d'instructions ([Token]) 
parseGen :: Char -> Token -> Parser Token
parseGen x y = char x >> return y

parseBack, parseForward, parseIncr, parseDecr, parsePrint, parseRead, parseLoop :: Parser Token

parseBack = parseGen '<' Back
parseForward = parseGen '>' Forward
parseIncr = parseGen '+' Incr
parseDecr = parseGen '-' Decr
parsePrint = parseGen '.' Print
parseRead = parseGen ',' Read
parseLoop = do char '['
              code <- parseTokens
              char ']'
              return $ Loop code

parseComment :: Parser ()
parseComment = do many $ noneOf "<>+-,.[]"
                 return ()
 
parseToken :: Parser Token
parseToken = do parseComment 
               i <- parseBack <|> parseForward <|> parseIncr <|> parseDecr <|> parsePrint 
                      <|> parseRead <|> parseLoop
               parseComment
               return i

parseTokens :: Parser [Token]
parseTokens = many parseToken

-- Évaluer les instructions
eval :: [Token] -> IO Memory
eval tokens =
 let eval' [] memory = return memory
     eval' (Incr : xs) memory = eval' xs . set memory $ get memory + 1
     eval' (Decr : xs) memory = eval' xs . set memory $ get memory - 1
     eval' (Forward : xs) memory = eval' xs (forward memory)
     eval' (Back : xs) memory = eval' xs (back memory)
     eval' (Print : xs) memory = (putChar . chr $ get memory) >> eval' xs memory
     eval' (Read : xs) memory = getChar >>= eval' xs . set memory . ord
     eval' (Loop ys : xs) memory =
       if get memory == 0 then eval' xs memory 
       else eval' ys memory >>= eval' (Loop ys : xs)
 in eval' tokens . fromList $ replicate 30000 0

-- Donner un fichier bf en entrée
main :: IO ()
main = do args <- getArgs
         res <- parseFromFile parseTokens (head args)
         case res of
           Left err -> print err
           Right tokens -> do _ <- eval tokens
                              return ()

import Data.Char
import Text.Parsec
import Text.Parsec.String
import System.Environment

-- Un Zipper pour la mémoire
type ListZipper a = ([a], [a])
type Memory = ListZipper Int

fromList :: [a] -> ListZipper a
fromList xs = ([], xs)

back :: Memory -> Int -> Memory
back t 0 = t
back ([], list) i = ([], (replicate i 0) ++ list)
back (x:xs, list) i = back (xs, x:list) (i-1)

forward :: Memory -> Int -> Memory
forward t 0 = t
forward (path, []) i = ((replicate i 0) ++ path, [])
forward (path, x:xs) i = forward (x:path, xs) (i-1)

set :: Memory -> Int -> Memory
set (path, []) y = (path, y:[])
set (path, x:xs) y = (path, y:xs)

get :: Memory -> Int
get (_, []) = 0
get (_, x:_) = x

data Token = Move Int | Add Int | Print | Read | Loop [Token] | Reset deriving (Show)

-- Pour parser le fichier d'entrée et construire une liste d'instructions ([Token]) 
parseToken, parseLoop, parsePrint, parseRead, parseMove, parseAdd :: Parser Token

parseAdd = do xs <- many1 $ incr <|> decr <|> comment
             return $ Add (sum xs)
     where incr, decr, comment :: Parser Int
           incr = char '+' >> return 1
           comment = noneOf "<>+-,.[]" >> return 0
           decr = char '-' >> return (-1)

parseMove = do xs <- many1 $ forward <|> back <|> comment
              return $ Move (sum xs)
      where forward, back, comment :: Parser Int
            forward = char '>' >> return 1
            comment = noneOf "<>+-,.[]" >> return 0
            back = char '<' >> return (-1)

parsePrint = char '.' >> return Print
parseRead = char ',' >> return Read

parseLoop = do char '['
              code <- parseTokens
              char ']'
              case code of
                [Add x] -> return Reset -- [-] est réduit en une instruction Reset
                _ -> return $ Loop code

parseComment :: Parser ()
parseComment = (many $ noneOf "<>+-,.[]") >> return ()

parseToken = do parseComment 
              i <- parseAdd <|> parseMove <|> parsePrint <|> parseRead <|> parseLoop
              parseComment
              return i

parseTokens :: Parser [Token]
parseTokens = many parseToken

-- Évaluer les instructions
eval :: [Token] -> IO Memory
eval tokens =
 let eval' [] memory = return $! memory
     eval' (Add x : xs) memory = eval' xs $! set memory $! get memory + x
     eval' (Move x : xs) memory = eval' xs $! (if x > 0 then forward memory x else back memory (abs x))
     eval' (Print : xs) memory = (putChar . chr . get $! memory) >> (eval' xs $! memory)
     eval' (Read : xs) memory = do c <- getChar 
                                   eval' xs $! set memory . ord $ c
     eval' (Reset : xs) memory = eval' xs $! set memory 0
     eval' (Loop ys : xs) memory =
       if (get $! memory) == 0 then eval' xs $! memory 
       else do new <- eval' ys $! memory
               eval' (Loop ys : xs) $! new
 in eval' tokens . fromList $ replicate 1000 0

-- Donner un fichier bf en entrée
main :: IO ()
main = do args <- getArgs
         res <- parseFromFile parseTokens (head args)
         case res of
           Left err -> print err
           Right tokens -> do _ <- eval tokens
                              return ()

#!/usr/bin/env python
# -*- coding: utf-8 -*-

import ast


######################
# Bases ast elements #
######################

# For no-controls elements (><+-.,), define basic ast.

# Names of internal elements
__MEM_NAME = "__MEM__"      # Memory list
__PTR_NAME = "__PTR__"      # Pointer

# Init statement added to each BF source code
__INIT_AST_STMT = [# import sys
                   ast.Import([ast.alias('sys', None)]),
                   # @__MEM_NAME = [0]
                   ast.Assign([ast.Name(__MEM_NAME, ast.Store())], ast.List( [ast.Num(0)], ast.Load())),
                   # @__PTR_NAME = 0
                   ast.Assign([ast.Name(__PTR_NAME, ast.Store())], ast.Num(0))
                   ]

# Increment pointer (>)
__INCPTR_AST_STMT = [
                     # @__PTR_NAME += 1
                     ast.AugAssign(ast.Name(__PTR_NAME, ast.Store()), ast.Add(), ast.Num(1) ),
                     # while len(@__MEM_NAME) <= @__PTR_NAME:
                     ast.While(ast.Compare(
                         ast.Call(ast.Name("len", ast.Load()), [ast.Name(__MEM_NAME, ast.Load())], [],None,None),
                         [ast.LtE()],
                         [ast.Name(__PTR_NAME, ast.Load())]),
                     #     (@__MEM_NAME).append(0)
                         [ast.Expr(ast.Call(
                             ast.Attribute(ast.Name(__MEM_NAME, ast.Load()), "append", ast.Load()),
                             [ast.Num(0)],
                             [],None,None))],
                         [],),
                     ]

# Decrement pointer (<)
__DECPTR_AST_STMT = [
                     # @__PTR_NAME -= 1
                     ast.AugAssign(ast.Name(__PTR_NAME, ast.Store()), ast.Sub(), ast.Num(1) ),
                    ]

# Increment value (+)
__INCVALUE_AST_STMT = [ # @__MEM_NAME[@__PTR_NAME] += 1
                        ast.AugAssign(
                            ast.Subscript(
                                ast.Name(__MEM_NAME, ast.Load()),
                                ast.Index(ast.Name(__PTR_NAME, ast.Load())),
                                ast.Store()),
                            ast.Add(),
                            ast.Num(1))
                       ]

# Decrement value (-)
__DECVALUE_AST_STMT = [ # @__MEM_NAME[@__PTR_NAME] -= 1
                        ast.AugAssign(
                            ast.Subscript(
                                ast.Name(__MEM_NAME, ast.Load()),
                                ast.Index(ast.Name(__PTR_NAME, ast.Load())),
                                ast.Store()),
                            ast.Sub(),
                            ast.Num(1))
                       ]

# Print value (.)
__PRINTVALUE_AST_STMT = [ # sys.stdout.write(chr(@__MEM_NAME[@__PTR_NAME]))
                          ast.Expr(
                              ast.Call(
                                  ast.Attribute(
                                      ast.Attribute(ast.Name('sys', ast.Load()), 'stdout', ast.Load()),
                                      'write',
                                      ast.Load()),
                                  [
                                      ast.Call(
                                          ast.Name('chr', ast.Load()),
                                          [ast.Subscript(
                                              ast.Name(__MEM_NAME, ast.Load()),
                                              ast.Index(ast.Name(__PTR_NAME, ast.Load())),
                                              ast.Load())
                                          ],
                                          [], None, None)
                                  ],
                                  [], None, None))
                        ]

# Read value (,)
__READVALUE_AST_STMT = [ # @__MEM_NAME[@__PTR_NAME] = ord(sys.stdin.read(1))
                         ast.Assign(
                             [ast.Subscript(
                                 ast.Name(__MEM_NAME, ast.Load()),
                                 ast.Index(ast.Name(__PTR_NAME, ast.Load())),
                                 ast.Store())],
                             ast.Call(
                                 ast.Name('ord', ast.Load()),
                                 [ast.Call(
                                     ast.Attribute(
                                         ast.Attribute(ast.Name('sys', ast.Load()), 'stdin', ast.Load()),
                                         'read',
                                         ast.Load()),
                                     [ast.Num(1)],
                                     [], None, None)
                                 ],
                                 [], None, None))
                        ]

# Helper debug function (?) : print current memory and pointer
# _PRINT_AST_STMT = [ # print @__MEM_NAME, @__PTR_NAME)
#                     ast.Print(None,
#                               [
#                                   ast.Name(__MEM_NAME, ast.Load()),
#                                   ast.Name(__PTR_NAME, ast.Load())],
#                               True)
#                    ]



# While loop to evaluate [...] statements

#@__MEM_NAME[@__PTR_NAME] != 0
__INTERNAL__TESTNOTNULL_AST_EXPR = ast.Compare(
                                           ast.Subscript(
                                               ast.Name(__MEM_NAME, ast.Load()),
                                               ast.Index(ast.Name(__PTR_NAME, ast.Load())),
                                               ast.Load()),
                                           [ast.NotEq()],
                                           [ast.Num(0)])

# while @__MEM_NAME[@__PTR_NAME] != 0:
#    content_instr
def create_loop_ast_stmt(content_instr):
    return [ast.While(__INTERNAL__TESTNOTNULL_AST_EXPR, content_instr, [])]


###################
# Instruction set #
###################

INST_SET = {}
INST_SET['>'] = __INCPTR_AST_STMT
INST_SET['<'] = __DECPTR_AST_STMT
INST_SET['+'] = __INCVALUE_AST_STMT
INST_SET['-'] = __DECVALUE_AST_STMT
INST_SET['.'] = __PRINTVALUE_AST_STMT
INST_SET[','] = __READVALUE_AST_STMT
#INST_SET['?'] = __PRINT_AST_STMT


###################
# AST constructor #
###################

def construct_ast(it_source, endVal=None):
    """This function take a char iterator and construct an AST until it reach the iterator end or the endVal char"""

    c_ast=[]
    for c in it_source:
        if c == endVal:
            # If end char, end function. Maybe raise exception if endVal != None ?
            break
        elif c == "[":
            # If "[", recursively eval content until "]"
            c_ast.extend( create_loop_ast_stmt(construct_ast(it_source, "]") ))
        elif c in INST_SET:
            # Add expressions from know instruction set
            c_ast.extend( INST_SET[c] )
        else:
            # other character are ignored
            continue

    return c_ast

################
# BF Evaluator #
################

def eval_bf(source_code):
    # Transform BF source code to Python Module AST
    nast = ast.Module(__INIT_AST_STMT + construct_ast(iter(source_code)))
    # Add missing attribute (false line numbers to AST)
    ast.fix_missing_locations(nast)
    # Compile AST to Python bytecode
    code = compile(nast, "", 'exec')
    # Execute the code
    exec (code)

if __name__ == "__main__":
    # wikipedia's hello-world
    eval_bf("++++++++[>++++[>++>+++>+++>+<<<<-]>+>+>->>+[<]<-]>>.>---.+++++++..+++.>>.<-.<.+++.------.--------.>>+.>++.")

    # Rot-13 std input
    #eval_bf("""-,+[-[>>++++[>++++++++<-]<+<-[>+>+>-[>>>]<[[>+<-]>>+>]<<<<<-]]>>>[-]+>--[-[<->+++[-]]]<[++++++++++++<[
    #           >-[>+>>]>[+[<+>-]>+>>]<<<<<-]>>[<+>-]>[-[-<<[-]>>]<<[<<->>-]>>]<<[<<+>>-]]<[-]<.[-]<-,+]""")