Créer un compilateur/interpréteur Brainfuck

Tous langages

a marqué ce sujet comme résolu.

Salut tout le monde!

Suite à une discussion sur ce topic, je vous propose un atelier dont l'énoncé sera très simple : créer un interpréteur ou un compilateur Brainfuck (au choix).

Si vous ne savez ce qu'est Brainfuck, il s'agit d'un langage de programmation minimaliste (ne possède que 8 instructions) que vous n'aurez pas trop de mal à comprendre rapidement. Vous pouvez consulter cette page pour apprendre très rapidement les bases du langage, aller sur la page wikipédia pour avoir plus de détails (certaines informations peuvent vous aider pour écrire un compilateur), ou même commencer à lire le tutoriel de Titi_Alone (pour l'instant en bêta).

Le choix du langage et de la méthode utilisée est libre, et vous pouvez tenter des trucs originaux. J'essaierai de tenir ce post à jour pour avoir une liste des réalisations de chacun par langage.

Enfin, et comme l'a fait remarqué SpaceFox sur le sujet original, le vrai challenge peut être d'implémenter un compilateur vers Brainfuck. Si vous pensez pouvoir y arriver, n'hésitez pas, ce sera très intéressant (mais pour le coup, vous risquez d'y passer un sacré moment :-° )!

Pour participer, vous pouvez écrire votre code directement sur le forum en utilisant les balises code, ou bien en donnant un lien vers votre Github / Bitbucket / blog personnel / whatever (EDIT : étant donné la taille des codes, l'idéal serait quand même de poster ici en utilisant les balises code et le bloc secret afin de faciliter la lecture).

Bonne chance à tous! :-D

PS : pour tester votre programme, vous pouvez utiliser le Hello, world Brainfuck classique :

1
++++++++++[>+++++++>++++++++++>+++>+<<<<-]>++.>+.+++++++..+++.>++.<<+++++++++++++++.>.+++.------.--------.>+.>.

Et ce programme qui affiche simplement un 'A', mais en utilisant 2 boucles imbriquées (suivant comment vous vous y prenez, ça vaut le coup de vérifier) :

1
++++++[>++++++++++[>+<-]<-]>>+++++.

Enfin, si vous voulez tester les performances de votre compilateur / interpréteur, vous pouvez utiliser ce code qui calcule et affiche un ensemble de Mandelbrot :

  1
  2
  3
  4
  5
  6
  7
  8
  9
 10
 11
 12
 13
 14
 15
 16
 17
 18
 19
 20
 21
 22
 23
 24
 25
 26
 27
 28
 29
 30
 31
 32
 33
 34
 35
 36
 37
 38
 39
 40
 41
 42
 43
 44
 45
 46
 47
 48
 49
 50
 51
 52
 53
 54
 55
 56
 57
 58
 59
 60
 61
 62
 63
 64
 65
 66
 67
 68
 69
 70
 71
 72
 73
 74
 75
 76
 77
 78
 79
 80
 81
 82
 83
 84
 85
 86
 87
 88
 89
 90
 91
 92
 93
 94
 95
 96
 97
 98
 99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
      A mandelbrot set fractal viewer in brainf*** written by Erik Bosman
+++++++++++++[->++>>>+++++>++>+<<<<<<]>>>>>++++++>--->>>>>>>>>>+++++++++++++++[[
>>>>>>>>>]+[<<<<<<<<<]>>>>>>>>>-]+[>>>>>>>>[-]>]<<<<<<<<<[<<<<<<<<<]>>>>>>>>[-]+
<<<<<<<+++++[-[->>>>>>>>>+<<<<<<<<<]>>>>>>>>>]>>>>>>>+>>>>>>>>>>>>>>>>>>>>>>>>>>
>+<<<<<<<<<<<<<<<<<[<<<<<<<<<]>>>[-]+[>>>>>>[>>>>>>>[-]>>]<<<<<<<<<[<<<<<<<<<]>>
>>>>>[-]+<<<<<<++++[-[->>>>>>>>>+<<<<<<<<<]>>>>>>>>>]>>>>>>+<<<<<<+++++++[-[->>>
>>>>>>+<<<<<<<<<]>>>>>>>>>]>>>>>>+<<<<<<<<<<<<<<<<[<<<<<<<<<]>>>[[-]>>>>>>[>>>>>
>>[-<<<<<<+>>>>>>]<<<<<<[->>>>>>+<<+<<<+<]>>>>>>>>]<<<<<<<<<[<<<<<<<<<]>>>>>>>>>
[>>>>>>>>[-<<<<<<<+>>>>>>>]<<<<<<<[->>>>>>>+<<+<<<+<<]>>>>>>>>]<<<<<<<<<[<<<<<<<
<<]>>>>>>>[-<<<<<<<+>>>>>>>]<<<<<<<[->>>>>>>+<<+<<<<<]>>>>>>>>>+++++++++++++++[[
>>>>>>>>>]+>[-]>[-]>[-]>[-]>[-]>[-]>[-]>[-]>[-]<<<<<<<<<[<<<<<<<<<]>>>>>>>>>-]+[
>+>>>>>>>>]<<<<<<<<<[<<<<<<<<<]>>>>>>>>>[>->>>>[-<<<<+>>>>]<<<<[->>>>+<<<<<[->>[
-<<+>>]<<[->>+>>+<<<<]+>>>>>>>>>]<<<<<<<<[<<<<<<<<<]]>>>>>>>>>[>>>>>>>>>]<<<<<<<
<<[>[->>>>>>>>>+<<<<<<<<<]<<<<<<<<<<]>[->>>>>>>>>+<<<<<<<<<]<+>>>>>>>>]<<<<<<<<<
[>[-]<->>>>[-<<<<+>[<->-<<<<<<+>>>>>>]<[->+<]>>>>]<<<[->>>+<<<]<+<<<<<<<<<]>>>>>
>>>>[>+>>>>>>>>]<<<<<<<<<[<<<<<<<<<]>>>>>>>>>[>->>>>>[-<<<<<+>>>>>]<<<<<[->>>>>+
<<<<<<[->>>[-<<<+>>>]<<<[->>>+>+<<<<]+>>>>>>>>>]<<<<<<<<[<<<<<<<<<]]>>>>>>>>>[>>
>>>>>>>]<<<<<<<<<[>>[->>>>>>>>>+<<<<<<<<<]<<<<<<<<<<<]>>[->>>>>>>>>+<<<<<<<<<]<<
+>>>>>>>>]<<<<<<<<<[>[-]<->>>>[-<<<<+>[<->-<<<<<<+>>>>>>]<[->+<]>>>>]<<<[->>>+<<
<]<+<<<<<<<<<]>>>>>>>>>[>>>>[-<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<+>>>>>>>>>>>>>
>>>>>>>>>>>>>>>>>>>>>>>]>>>>>]<<<<<<<<<[<<<<<<<<<]>>>>>>>>>+++++++++++++++[[>>>>
>>>>>]<<<<<<<<<-<<<<<<<<<[<<<<<<<<<]>>>>>>>>>-]+>>>>>>>>>>>>>>>>>>>>>+<<<[<<<<<<
<<<]>>>>>>>>>[>>>[-<<<->>>]+<<<[->>>->[-<<<<+>>>>]<<<<[->>>>+<<<<<<<<<<<<<[<<<<<
<<<<]>>>>[-]+>>>>>[>>>>>>>>>]>+<]]+>>>>[-<<<<->>>>]+<<<<[->>>>-<[-<<<+>>>]<<<[->
>>+<<<<<<<<<<<<[<<<<<<<<<]>>>[-]+>>>>>>[>>>>>>>>>]>[-]+<]]+>[-<[>>>>>>>>>]<<<<<<
<<]>>>>>>>>]<<<<<<<<<[<<<<<<<<<]<<<<<<<[->+>>>-<<<<]>>>>>>>>>+++++++++++++++++++
+++++++>>[-<<<<+>>>>]<<<<[->>>>+<<[-]<<]>>[<<<<<<<+<[-<+>>>>+<<[-]]>[-<<[->+>>>-
<<<<]>>>]>>>>>>>>>>>>>[>>[-]>[-]>[-]>>>>>]<<<<<<<<<[<<<<<<<<<]>>>[-]>>>>>>[>>>>>
[-<<<<+>>>>]<<<<[->>>>+<<<+<]>>>>>>>>]<<<<<<<<<[<<<<<<<<<]>>>>>>>>>[>>[-<<<<<<<<
<+>>>>>>>>>]>>>>>>>]<<<<<<<<<[<<<<<<<<<]>>>>>>>>>+++++++++++++++[[>>>>>>>>>]+>[-
]>[-]>[-]>[-]>[-]>[-]>[-]>[-]>[-]<<<<<<<<<[<<<<<<<<<]>>>>>>>>>-]+[>+>>>>>>>>]<<<
<<<<<<[<<<<<<<<<]>>>>>>>>>[>->>>>>[-<<<<<+>>>>>]<<<<<[->>>>>+<<<<<<[->>[-<<+>>]<
<[->>+>+<<<]+>>>>>>>>>]<<<<<<<<[<<<<<<<<<]]>>>>>>>>>[>>>>>>>>>]<<<<<<<<<[>[->>>>
>>>>>+<<<<<<<<<]<<<<<<<<<<]>[->>>>>>>>>+<<<<<<<<<]<+>>>>>>>>]<<<<<<<<<[>[-]<->>>
[-<<<+>[<->-<<<<<<<+>>>>>>>]<[->+<]>>>]<<[->>+<<]<+<<<<<<<<<]>>>>>>>>>[>>>>>>[-<
<<<<+>>>>>]<<<<<[->>>>>+<<<<+<]>>>>>>>>]<<<<<<<<<[<<<<<<<<<]>>>>>>>>>[>+>>>>>>>>
]<<<<<<<<<[<<<<<<<<<]>>>>>>>>>[>->>>>>[-<<<<<+>>>>>]<<<<<[->>>>>+<<<<<<[->>[-<<+
>>]<<[->>+>>+<<<<]+>>>>>>>>>]<<<<<<<<[<<<<<<<<<]]>>>>>>>>>[>>>>>>>>>]<<<<<<<<<[>
[->>>>>>>>>+<<<<<<<<<]<<<<<<<<<<]>[->>>>>>>>>+<<<<<<<<<]<+>>>>>>>>]<<<<<<<<<[>[-
]<->>>>[-<<<<+>[<->-<<<<<<+>>>>>>]<[->+<]>>>>]<<<[->>>+<<<]<+<<<<<<<<<]>>>>>>>>>
[>>>>[-<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<+>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
]>>>>>]<<<<<<<<<[<<<<<<<<<]>>>>>>>>>[>>>[-<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<+>
>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>]>>>>>>]<<<<<<<<<[<<<<<<<<<]>>>>>>>>>++++++++
+++++++[[>>>>>>>>>]<<<<<<<<<-<<<<<<<<<[<<<<<<<<<]>>>>>>>>>-]+[>>>>>>>>[-<<<<<<<+
>>>>>>>]<<<<<<<[->>>>>>>+<<<<<<+<]>>>>>>>>]<<<<<<<<<[<<<<<<<<<]>>>>>>>>>[>>>>>>[
-]>>>]<<<<<<<<<[<<<<<<<<<]>>>>+>[-<-<<<<+>>>>>]>[-<<<<<<[->>>>>+<++<<<<]>>>>>[-<
<<<<+>>>>>]<->+>]<[->+<]<<<<<[->>>>>+<<<<<]>>>>>>[-]<<<<<<+>>>>[-<<<<->>>>]+<<<<
[->>>>->>>>>[>>[-<<->>]+<<[->>->[-<<<+>>>]<<<[->>>+<<<<<<<<<<<<[<<<<<<<<<]>>>[-]
+>>>>>>[>>>>>>>>>]>+<]]+>>>[-<<<->>>]+<<<[->>>-<[-<<+>>]<<[->>+<<<<<<<<<<<[<<<<<
<<<<]>>>>[-]+>>>>>[>>>>>>>>>]>[-]+<]]+>[-<[>>>>>>>>>]<<<<<<<<]>>>>>>>>]<<<<<<<<<
[<<<<<<<<<]>>>>[-<<<<+>>>>]<<<<[->>>>+>>>>>[>+>>[-<<->>]<<[->>+<<]>>>>>>>>]<<<<<
<<<+<[>[->>>>>+<<<<[->>>>-<<<<<<<<<<<<<<+>>>>>>>>>>>[->>>+<<<]<]>[->>>-<<<<<<<<<
<<<<<+>>>>>>>>>>>]<<]>[->>>>+<<<[->>>-<<<<<<<<<<<<<<+>>>>>>>>>>>]<]>[->>>+<<<]<<
<<<<<<<<<<]>>>>[-]<<<<]>>>[-<<<+>>>]<<<[->>>+>>>>>>[>+>[-<->]<[->+<]>>>>>>>>]<<<
<<<<<+<[>[->>>>>+<<<[->>>-<<<<<<<<<<<<<<+>>>>>>>>>>[->>>>+<<<<]>]<[->>>>-<<<<<<<
<<<<<<<+>>>>>>>>>>]<]>>[->>>+<<<<[->>>>-<<<<<<<<<<<<<<+>>>>>>>>>>]>]<[->>>>+<<<<
]<<<<<<<<<<<]>>>>>>+<<<<<<]]>>>>[-<<<<+>>>>]<<<<[->>>>+>>>>>[>>>>>>>>>]<<<<<<<<<
[>[->>>>>+<<<<[->>>>-<<<<<<<<<<<<<<+>>>>>>>>>>>[->>>+<<<]<]>[->>>-<<<<<<<<<<<<<<
+>>>>>>>>>>>]<<]>[->>>>+<<<[->>>-<<<<<<<<<<<<<<+>>>>>>>>>>>]<]>[->>>+<<<]<<<<<<<
<<<<<]]>[-]>>[-]>[-]>>>>>[>>[-]>[-]>>>>>>]<<<<<<<<<[<<<<<<<<<]>>>>>>>>>[>>>>>[-<
<<<+>>>>]<<<<[->>>>+<<<+<]>>>>>>>>]<<<<<<<<<[<<<<<<<<<]>>>>>>>>>+++++++++++++++[
[>>>>>>>>>]+>[-]>[-]>[-]>[-]>[-]>[-]>[-]>[-]>[-]<<<<<<<<<[<<<<<<<<<]>>>>>>>>>-]+
[>+>>>>>>>>]<<<<<<<<<[<<<<<<<<<]>>>>>>>>>[>->>>>[-<<<<+>>>>]<<<<[->>>>+<<<<<[->>
[-<<+>>]<<[->>+>+<<<]+>>>>>>>>>]<<<<<<<<[<<<<<<<<<]]>>>>>>>>>[>>>>>>>>>]<<<<<<<<
<[>[->>>>>>>>>+<<<<<<<<<]<<<<<<<<<<]>[->>>>>>>>>+<<<<<<<<<]<+>>>>>>>>]<<<<<<<<<[
>[-]<->>>[-<<<+>[<->-<<<<<<<+>>>>>>>]<[->+<]>>>]<<[->>+<<]<+<<<<<<<<<]>>>>>>>>>[
>>>[-<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<+>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>]>
>>>>>]<<<<<<<<<[<<<<<<<<<]>>>>>[-]>>>>+++++++++++++++[[>>>>>>>>>]<<<<<<<<<-<<<<<
<<<<[<<<<<<<<<]>>>>>>>>>-]+[>>>[-<<<->>>]+<<<[->>>->[-<<<<+>>>>]<<<<[->>>>+<<<<<
<<<<<<<<[<<<<<<<<<]>>>>[-]+>>>>>[>>>>>>>>>]>+<]]+>>>>[-<<<<->>>>]+<<<<[->>>>-<[-
<<<+>>>]<<<[->>>+<<<<<<<<<<<<[<<<<<<<<<]>>>[-]+>>>>>>[>>>>>>>>>]>[-]+<]]+>[-<[>>
>>>>>>>]<<<<<<<<]>>>>>>>>]<<<<<<<<<[<<<<<<<<<]>>>[-<<<+>>>]<<<[->>>+>>>>>>[>+>>>
[-<<<->>>]<<<[->>>+<<<]>>>>>>>>]<<<<<<<<+<[>[->+>[-<-<<<<<<<<<<+>>>>>>>>>>>>[-<<
+>>]<]>[-<<-<<<<<<<<<<+>>>>>>>>>>>>]<<<]>>[-<+>>[-<<-<<<<<<<<<<+>>>>>>>>>>>>]<]>
[-<<+>>]<<<<<<<<<<<<<]]>>>>[-<<<<+>>>>]<<<<[->>>>+>>>>>[>+>>[-<<->>]<<[->>+<<]>>
>>>>>>]<<<<<<<<+<[>[->+>>[-<<-<<<<<<<<<<+>>>>>>>>>>>[-<+>]>]<[-<-<<<<<<<<<<+>>>>
>>>>>>>]<<]>>>[-<<+>[-<-<<<<<<<<<<+>>>>>>>>>>>]>]<[-<+>]<<<<<<<<<<<<]>>>>>+<<<<<
]>>>>>>>>>[>>>[-]>[-]>[-]>>>>]<<<<<<<<<[<<<<<<<<<]>>>[-]>[-]>>>>>[>>>>>>>[-<<<<<
<+>>>>>>]<<<<<<[->>>>>>+<<<<+<<]>>>>>>>>]<<<<<<<<<[<<<<<<<<<]>>>>+>[-<-<<<<+>>>>
>]>>[-<<<<<<<[->>>>>+<++<<<<]>>>>>[-<<<<<+>>>>>]<->+>>]<<[->>+<<]<<<<<[->>>>>+<<
<<<]+>>>>[-<<<<->>>>]+<<<<[->>>>->>>>>[>>>[-<<<->>>]+<<<[->>>-<[-<<+>>]<<[->>+<<
<<<<<<<<<[<<<<<<<<<]>>>>[-]+>>>>>[>>>>>>>>>]>+<]]+>>[-<<->>]+<<[->>->[-<<<+>>>]<
<<[->>>+<<<<<<<<<<<<[<<<<<<<<<]>>>[-]+>>>>>>[>>>>>>>>>]>[-]+<]]+>[-<[>>>>>>>>>]<
<<<<<<<]>>>>>>>>]<<<<<<<<<[<<<<<<<<<]>>>[-<<<+>>>]<<<[->>>+>>>>>>[>+>[-<->]<[->+
<]>>>>>>>>]<<<<<<<<+<[>[->>>>+<<[->>-<<<<<<<<<<<<<+>>>>>>>>>>[->>>+<<<]>]<[->>>-
<<<<<<<<<<<<<+>>>>>>>>>>]<]>>[->>+<<<[->>>-<<<<<<<<<<<<<+>>>>>>>>>>]>]<[->>>+<<<
]<<<<<<<<<<<]>>>>>[-]>>[-<<<<<<<+>>>>>>>]<<<<<<<[->>>>>>>+<<+<<<<<]]>>>>[-<<<<+>
>>>]<<<<[->>>>+>>>>>[>+>>[-<<->>]<<[->>+<<]>>>>>>>>]<<<<<<<<+<[>[->>>>+<<<[->>>-
<<<<<<<<<<<<<+>>>>>>>>>>>[->>+<<]<]>[->>-<<<<<<<<<<<<<+>>>>>>>>>>>]<<]>[->>>+<<[
->>-<<<<<<<<<<<<<+>>>>>>>>>>>]<]>[->>+<<]<<<<<<<<<<<<]]>>>>[-]<<<<]>>>>[-<<<<+>>
>>]<<<<[->>>>+>[-]>>[-<<<<<<<+>>>>>>>]<<<<<<<[->>>>>>>+<<+<<<<<]>>>>>>>>>[>>>>>>
>>>]<<<<<<<<<[>[->>>>+<<<[->>>-<<<<<<<<<<<<<+>>>>>>>>>>>[->>+<<]<]>[->>-<<<<<<<<
<<<<<+>>>>>>>>>>>]<<]>[->>>+<<[->>-<<<<<<<<<<<<<+>>>>>>>>>>>]<]>[->>+<<]<<<<<<<<
<<<<]]>>>>>>>>>[>>[-]>[-]>>>>>>]<<<<<<<<<[<<<<<<<<<]>>>[-]>[-]>>>>>[>>>>>[-<<<<+
>>>>]<<<<[->>>>+<<<+<]>>>>>>>>]<<<<<<<<<[<<<<<<<<<]>>>>>>>>>[>>>>>>[-<<<<<+>>>>>
]<<<<<[->>>>>+<<<+<<]>>>>>>>>]<<<<<<<<<[<<<<<<<<<]>>>>>>>>>+++++++++++++++[[>>>>
>>>>>]+>[-]>[-]>[-]>[-]>[-]>[-]>[-]>[-]>[-]<<<<<<<<<[<<<<<<<<<]>>>>>>>>>-]+[>+>>
>>>>>>]<<<<<<<<<[<<<<<<<<<]>>>>>>>>>[>->>>>[-<<<<+>>>>]<<<<[->>>>+<<<<<[->>[-<<+
>>]<<[->>+>>+<<<<]+>>>>>>>>>]<<<<<<<<[<<<<<<<<<]]>>>>>>>>>[>>>>>>>>>]<<<<<<<<<[>
[->>>>>>>>>+<<<<<<<<<]<<<<<<<<<<]>[->>>>>>>>>+<<<<<<<<<]<+>>>>>>>>]<<<<<<<<<[>[-
]<->>>>[-<<<<+>[<->-<<<<<<+>>>>>>]<[->+<]>>>>]<<<[->>>+<<<]<+<<<<<<<<<]>>>>>>>>>
[>+>>>>>>>>]<<<<<<<<<[<<<<<<<<<]>>>>>>>>>[>->>>>>[-<<<<<+>>>>>]<<<<<[->>>>>+<<<<
<<[->>>[-<<<+>>>]<<<[->>>+>+<<<<]+>>>>>>>>>]<<<<<<<<[<<<<<<<<<]]>>>>>>>>>[>>>>>>
>>>]<<<<<<<<<[>>[->>>>>>>>>+<<<<<<<<<]<<<<<<<<<<<]>>[->>>>>>>>>+<<<<<<<<<]<<+>>>
>>>>>]<<<<<<<<<[>[-]<->>>>[-<<<<+>[<->-<<<<<<+>>>>>>]<[->+<]>>>>]<<<[->>>+<<<]<+
<<<<<<<<<]>>>>>>>>>[>>>>[-<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<+>>>>>>>>>>>>>>>>>
>>>>>>>>>>>>>>>>>>>]>>>>>]<<<<<<<<<[<<<<<<<<<]>>>>>>>>>+++++++++++++++[[>>>>>>>>
>]<<<<<<<<<-<<<<<<<<<[<<<<<<<<<]>>>>>>>>>-]+>>>>>>>>>>>>>>>>>>>>>+<<<[<<<<<<<<<]
>>>>>>>>>[>>>[-<<<->>>]+<<<[->>>->[-<<<<+>>>>]<<<<[->>>>+<<<<<<<<<<<<<[<<<<<<<<<
]>>>>[-]+>>>>>[>>>>>>>>>]>+<]]+>>>>[-<<<<->>>>]+<<<<[->>>>-<[-<<<+>>>]<<<[->>>+<
<<<<<<<<<<<[<<<<<<<<<]>>>[-]+>>>>>>[>>>>>>>>>]>[-]+<]]+>[-<[>>>>>>>>>]<<<<<<<<]>
>>>>>>>]<<<<<<<<<[<<<<<<<<<]>>->>[-<<<<+>>>>]<<<<[->>>>+<<[-]<<]>>]<<+>>>>[-<<<<
->>>>]+<<<<[->>>>-<<<<<<.>>]>>>>[-<<<<<<<.>>>>>>>]<<<[-]>[-]>[-]>[-]>[-]>[-]>>>[
>[-]>[-]>[-]>[-]>[-]>[-]>>>]<<<<<<<<<[<<<<<<<<<]>>>>>>>>>[>>>>>[-]>>>>]<<<<<<<<<
[<<<<<<<<<]>+++++++++++[-[->>>>>>>>>+<<<<<<<<<]>>>>>>>>>]>>>>+>>>>>>>>>+<<<<<<<<
<<<<<<[<<<<<<<<<]>>>>>>>[-<<<<<<<+>>>>>>>]<<<<<<<[->>>>>>>+[-]>>[>>>>>>>>>]<<<<<
<<<<[>>>>>>>[-<<<<<<+>>>>>>]<<<<<<[->>>>>>+<<<<<<<[<<<<<<<<<]>>>>>>>[-]+>>>]<<<<
<<<<<<]]>>>>>>>[-<<<<<<<+>>>>>>>]<<<<<<<[->>>>>>>+>>[>+>>>>[-<<<<->>>>]<<<<[->>>
>+<<<<]>>>>>>>>]<<+<<<<<<<[>>>>>[->>+<<]<<<<<<<<<<<<<<]>>>>>>>>>[>>>>>>>>>]<<<<<
<<<<[>[-]<->>>>>>>[-<<<<<<<+>[<->-<<<+>>>]<[->+<]>>>>>>>]<<<<<<[->>>>>>+<<<<<<]<
+<<<<<<<<<]>>>>>>>-<<<<[-]+<<<]+>>>>>>>[-<<<<<<<->>>>>>>]+<<<<<<<[->>>>>>>->>[>>
>>>[->>+<<]>>>>]<<<<<<<<<[>[-]<->>>>>>>[-<<<<<<<+>[<->-<<<+>>>]<[->+<]>>>>>>>]<<
<<<<[->>>>>>+<<<<<<]<+<<<<<<<<<]>+++++[-[->>>>>>>>>+<<<<<<<<<]>>>>>>>>>]>>>>+<<<
<<[<<<<<<<<<]>>>>>>>>>[>>>>>[-<<<<<->>>>>]+<<<<<[->>>>>->>[-<<<<<<<+>>>>>>>]<<<<
<<<[->>>>>>>+<<<<<<<<<<<<<<<<[<<<<<<<<<]>>>>[-]+>>>>>[>>>>>>>>>]>+<]]+>>>>>>>[-<
<<<<<<->>>>>>>]+<<<<<<<[->>>>>>>-<<[-<<<<<+>>>>>]<<<<<[->>>>>+<<<<<<<<<<<<<<[<<<
<<<<<<]>>>[-]+>>>>>>[>>>>>>>>>]>[-]+<]]+>[-<[>>>>>>>>>]<<<<<<<<]>>>>>>>>]<<<<<<<
<<[<<<<<<<<<]>>>>[-]<<<+++++[-[->>>>>>>>>+<<<<<<<<<]>>>>>>>>>]>>>>-<<<<<[<<<<<<<
<<]]>>>]<<<<.>>>>>>>>>>[>>>>>>[-]>>>]<<<<<<<<<[<<<<<<<<<]>++++++++++[-[->>>>>>>>
>+<<<<<<<<<]>>>>>>>>>]>>>>>+>>>>>>>>>+<<<<<<<<<<<<<<<[<<<<<<<<<]>>>>>>>>[-<<<<<<
<<+>>>>>>>>]<<<<<<<<[->>>>>>>>+[-]>[>>>>>>>>>]<<<<<<<<<[>>>>>>>>[-<<<<<<<+>>>>>>
>]<<<<<<<[->>>>>>>+<<<<<<<<[<<<<<<<<<]>>>>>>>>[-]+>>]<<<<<<<<<<]]>>>>>>>>[-<<<<<
<<<+>>>>>>>>]<<<<<<<<[->>>>>>>>+>[>+>>>>>[-<<<<<->>>>>]<<<<<[->>>>>+<<<<<]>>>>>>
>>]<+<<<<<<<<[>>>>>>[->>+<<]<<<<<<<<<<<<<<<]>>>>>>>>>[>>>>>>>>>]<<<<<<<<<[>[-]<-
>>>>>>>>[-<<<<<<<<+>[<->-<<+>>]<[->+<]>>>>>>>>]<<<<<<<[->>>>>>>+<<<<<<<]<+<<<<<<
<<<]>>>>>>>>-<<<<<[-]+<<<]+>>>>>>>>[-<<<<<<<<->>>>>>>>]+<<<<<<<<[->>>>>>>>->[>>>
>>>[->>+<<]>>>]<<<<<<<<<[>[-]<->>>>>>>>[-<<<<<<<<+>[<->-<<+>>]<[->+<]>>>>>>>>]<<
<<<<<[->>>>>>>+<<<<<<<]<+<<<<<<<<<]>+++++[-[->>>>>>>>>+<<<<<<<<<]>>>>>>>>>]>>>>>
+>>>>>>>>>>>>>>>>>>>>>>>>>>>+<<<<<<[<<<<<<<<<]>>>>>>>>>[>>>>>>[-<<<<<<->>>>>>]+<
<<<<<[->>>>>>->>[-<<<<<<<<+>>>>>>>>]<<<<<<<<[->>>>>>>>+<<<<<<<<<<<<<<<<<[<<<<<<<
<<]>>>>[-]+>>>>>[>>>>>>>>>]>+<]]+>>>>>>>>[-<<<<<<<<->>>>>>>>]+<<<<<<<<[->>>>>>>>
-<<[-<<<<<<+>>>>>>]<<<<<<[->>>>>>+<<<<<<<<<<<<<<<[<<<<<<<<<]>>>[-]+>>>>>>[>>>>>>
>>>]>[-]+<]]+>[-<[>>>>>>>>>]<<<<<<<<]>>>>>>>>]<<<<<<<<<[<<<<<<<<<]>>>>[-]<<<++++
+[-[->>>>>>>>>+<<<<<<<<<]>>>>>>>>>]>>>>>->>>>>>>>>>>>>>>>>>>>>>>>>>>-<<<<<<[<<<<
<<<<<]]>>>]


Liste des participations :

Salut,

merci pour cet atelier [historique] :) , voilà ma participation (en OCaml) (le code optimise un peu l'entrée pendant la phase d'analyse (il transforme par exemple +++++++ en Add 7)) :

 1
 2
 3
 4
 5
 6
 7
 8
 9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
type instruction = 
  | Add of int
  | Dpl of int
  | Print
  | Read
  | Loop of instruction list  

let rec count (c: char) (n: int) (stream: char Stream.t) = match stream with parser 
  | [< 'e; r >] ->
    if e = c
    then
      count c (n + 1) r
    else
      (n, [< 'e; r >])
  | [< >] -> (n, [< >])

let rec analyzer (stream: char Stream.t) = match stream with parser
  | [< ''+'; r >] -> let n, s = count '+' 1 r in Add n :: analyzer s
  | [< ''-'; r >] -> let n, s = count '-' 1 r in Add (-n) :: analyzer s
  | [< ''>'; r >] -> let n, s = count '>' 1 r in Dpl n :: analyzer s
  | [< ''<'; r >] -> let n, s = count '<' 1 r in Dpl (-n) :: analyzer s
  | [< ''.'; r >] -> Print :: analyzer r
  | [< '','; r >] -> Read :: analyzer r
  | [< ''['; r >] -> let loop = analyzer r in
                     Loop loop :: analyzer r     (* let loop = analyzer r consume the stream until the ] *)
  | [< '']'; r >] -> []
  | [< 'e; r >] -> analyzer r
  | [< >] -> []

let interpreter (input: instruction list) =
  let memory = Array.make 30000 0 in
  let rec eval pnt = function
    | Add x :: t -> memory.(pnt) <- memory.(pnt) + x; eval pnt t
    | Dpl x :: t -> eval (pnt + x) t
    | Print :: t -> print_char (char_of_int memory.(pnt)); eval pnt t
    | Read :: t -> memory.(pnt) <- int_of_char (Scanf.scanf "%c" (fun x -> x)); eval pnt t
    | Loop l :: t ->
      if memory.(pnt) = 0
      then
        eval pnt t
      else
        let npnt = eval pnt l in     (* evaluate the loop then goes back until the [ to check the bit pointed (if 0 then jump until the ] else re-eval the loop *)
        eval npnt (Loop l :: t)
    | [] -> pnt
  in
  eval 0 input

let () =
  let input = Stream.of_channel stdin in
  let _ = interpreter (analyzer input) in
  print_newline ()

et un petit test :

  1
  2
  3
  4
  5
  6
  7
  8
  9
 10
 11
 12
 13
 14
 15
 16
 17
 18
 19
 20
 21
 22
 23
 24
 25
 26
 27
 28
 29
 30
 31
 32
 33
 34
 35
 36
 37
 38
 39
 40
 41
 42
 43
 44
 45
 46
 47
 48
 49
 50
 51
 52
 53
 54
 55
 56
 57
 58
 59
 60
 61
 62
 63
 64
 65
 66
 67
 68
 69
 70
 71
 72
 73
 74
 75
 76
 77
 78
 79
 80
 81
 82
 83
 84
 85
 86
 87
 88
 89
 90
 91
 92
 93
 94
 95
 96
 97
 98
 99
100
101
102
$ ./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

+3 -0

Et un compilateur (oui oui, je vous assure) en Common Lisp.

 1
 2
 3
 4
 5
 6
 7
 8
 9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
(in-package :cl-user)

(defvar *memory* (make-array '(8000) :element-type 'fixnum :initial-element 0))
(defvar *pointer* 4000)

(defmacro bf-loop (&body body)
  "Loop until (aref *memory* *pointer*) is 0."
  `(loop until (= 0 (aref *memory* *pointer*))
        do (progn ,@body)))

(defun read-instruction (stream)
  (case (read-char stream)
    (#\, '(setf (aref *memory* *pointer*) (read-char)))
    (#\. '(princ (aref *memory* *pointer*)))
    (#\+ '(incf (aref *memory* *pointer*)))
    (#\- '(decf (aref *memory* *pointer*)))
    (#\< '(decf *pointer*))
    (#\> '(incf *pointer*))
    (#\[ `(bf-loop ,@(loop for i = (read-instruction stream)
                       while i collect i)))
    ((#\] #\$) NIL)
    (otherwise (read-instruction stream))))

(defun |$-dispatcher| (stream char)
  "Reads a brainfuck expression, and return it."
  (declare (ignorable char))
  `(progn ,@(loop for i = (read-instruction stream)
               collect i while i)))

(set-macro-character #\$ #'|$-dispatcher|)

Utilisation : évaluez ce code, puis entrez dans votre REPL des instructions telles que $+++.$ et vous verrez le résultat.

Au point de l'implémentation, ce snippet modifie votre compilateur Common Lisp à la volée pour lui ajouter un parseur de BrainFuck. Ainsi, tout ce qui est compris entre des $ est parsé comme du BF, puis chaque instruction BF est compilée vers du Lisp, qui est ensuite classiquement compilée vers de l'assembleur, comme d'habitude.


EDIT : et pour prouver que c'est bien un compilateur, vous pouvez évaluer par exemple

1
2
3
(disassemble
 (lambda () (declare (optimize (speed 3) (debug 0) (safety 0)))
    $+++[-]$))

Ça crée une fonction qui exécute un bout de brainfuck, demande de l'optimiser à fond pour que le code assembleur obtenu soit plus compact, puis désassemble la fonction. Chez moi, j'obtiens :

 1
 2
 3
 4
 5
 6
 7
 8
 9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
; 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


EDIT 2 : si je compile le fichier mandelbrot.b qui circule sur ce topic, le résultat prend environ 95 secondes à être exécuté. Je suis persuadé qu'il est possible d'obtenir un code bien plus rapide en jouant avec les (declare (optimize ...)). Si j'arrive à obtenir une amélioration significative de performances, je posterai la nouvelle version dans un message à part sur ce topic.


EDIT 3 : suite à une discussion sur IRC, voici une rapide explication du fonctionnement du code.

Tout d'abord, il faut savoir que le fait de modifier le langage à la volée est la façon normale de faire en Common Lisp. Autrement dit, c'est vraiment la manière la plus simple et naturelle de faire. :)

Le (in-package :cl-user) permet de se placer dans un package (pensez module si vous faites du Python ou du Caml, et namespace si vous faites du C++ ou du C#). Le package cl-user est en quelque sorte le package fourre-tout par défaut.

Les deux (defvar …) déclarent chacun une variable globale. La variable *memory* est un tableau de 8000 entiers initialisés à zéro. La variable *pointer* est un entier initialisé à 4000.

La forme (defmacro bf-loop …) déclare un nouveau type de boucle (oui, on peut faire ça). En gros, chaque fois que j'écrirai (bf-loop bla bla bla), le code bla bla bla sera exécuté tant que memory[pointer] (ce qu'on note (aref *memory* *pointer*) en CL) est différent de zéro.

La forme (defun read-instruction …) déclare une fonction qui parse du Brainfuck. Cette fonction prend en paramètre un flux de fichier, lit un caractère depuis ce flux, et effectue un switch/case sur ce caractère pour savoir quoi renvoyer. Notez que #\, est la notation Lisp pour dire « le caractère virgule » ; dans beaucoup d'autres langages, on écrirait ','.

Le parseur renvoie un bout de code Lisp correspondant à l'instruction BF lue, sous forme d'AST. (Si vous ne savez pas ce qu'est un AST, renseignez-vous ou bien pensez : « chaîne de caractères »). Le caractère apostrophe ' demande à Lisp de ne pas évaluer l'expression qui suit, mais de renvoyer l'AST correspondant. On peut également utiliser l'apostrophe arrière ` pour créer un genre de template d'AST.

Enfin, la forme (defun |$-dispatcher| …) déclare une fonction toute simple qui appelle read-instruction en boucle, et concatène les résultats.

La forme (set-macro-character …) demande à Lisp de parser tout ce qui suit un caractère $ en utilisant la fonction $-dispatcher. Le code renvoyé par le parser est automatiquement compilé vers de l'assembleur par votre implémentation CL favorite.

+8 -0

Une modeste contribution à ce topic en haskell.

 1
 2
 3
 4
 5
 6
 7
 8
 9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
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 ()

Dans ton zipper, pourquoi déclares-tu un type Path séparé, plutôt que de simplement faire une paire de listes ?

Aussi, un zipper est supposé être infini, pourquoi as-tu des erreurs « déjà à gauche » etc. ? Si tu essaies d'aller à gauche alors que tu es déjà au bout de la liste, il te suffit de rajouter un nouvel élément à celle-ci, et l'aventure continue ! :)

J'aime bien l'utilisation de Parsec. Ça m'aurait semblé overkill a priori, mais finalement ça n'encombre pas tant le code que ça et un parser manuel aurait sans doute été pire (même pour un truc aussi simple).

Autrement, il y aurait sans doute moyen de faire une monade rigolote, par exemple basée sur la State Monad, mais avec les instructions du BrainFuck au lieu des classiques get/set. Ça permettrait de mélanger du code BF avec du code Haskell. :)

+0 -0

Certes, mais une approche impérative n'est pas si compliquée pour cet exercice.

Je profite aussi de ce post pour donner un compilateur vers C écrit en Flex. Certainement pas la version de l'exercice la plus intéressante (la conversion est immédiate), mais j'imagine que quelqu'un devait le faire.

 1
 2
 3
 4
 5
 6
 7
 8
 9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
%%

"+" printf("(*ptr)++;\n");
"-" printf("(*ptr)--;\n");
">" printf("ptr++;\n");
"<" printf("ptr--;\n");
"[" printf("while(*ptr){\n");
"]" printf("}\n");
"." printf("putchar(*ptr);\n");
"," printf("(*ptr) = getchar();​\n");
.|\n {}

%%

int main(void){
  printf("#include <stdio.h>\n"
     "#define MEM_SIZE 4000\n\n"
     "int main(void) {\n"
     "int mem[MEM_SIZE] = {0};\n"
     "int *ptr = mem;\n");
  yylex();
  printf("return 0;\n}\n");
  return 0;
}

Le brainfuck étant un langage assez sale, j'ai pris parti d'essayer d'implémenter un interprète le plus sale possible. Voici le résultat :

 1
 2
 3
 4
 5
 6
 7
 8
 9
10
11
12
13
14
15
16
17
18
19
20
21
22
#include <stdio.h>
#include <stdlib.h>

int* bf(FILE*f,int**c,int*d,int**i,int x) { for(;;) {
    for(;d<*c;d++) {
        if (x&&*d=='+') (**i)++;
        if (x&&*d=='-') (**i)--;
        if (x&&*d=='>') (*i)++;
        if (x&&*d=='<') (*i)--;
        if (x&&*d=='.') putchar(**i);
        if (x&&*d==',') **i=getchar();
        if (*d==']') return d; 
        if (*d=='[') { int *r=bf(f,c,d+1,i,x&&**i); d=(x&&**i?d-1:r); }
    }
    if ((*((*c)++)=getc(f))==EOF) exit(0);
} }
int main(int*argc,char**argv) {
    FILE *f=fopen(argv[1],"r");
    int p[1000];
    int *c=p,*i=(int*)calloc(10000,sizeof(int));
    bf(f,&c,p,&i,1);
}
+0 -0

GuilOooo, merci pour ton commentaire. À vrai dire, c’est la première fois que j’utilise cette structure de données.

 1
 2
 3
 4
 5
 6
 7
 8
 9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
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 ()

EDIT: Bon. Il faut rendre la fonction d’évaluation moins paresseuse pour pouvoir afficher mandelbrot (et j’ai aussi modifié le parser pour qu’il regroupe les >< et +-).

 1
 2
 3
 4
 5
 6
 7
 8
 9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
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 ()

+2 -0

Apparemment, la coloration C n'est pas automatique avec Markdown. Tu devrais la spécifier explicitement Alex.

Bibibye

Merci ! Ça ne marchait pas en mettant C comme langage de coloration, et je ne me serais jamais douté qu'il fallait mettre un c minuscule ^^

+0 -0

Pour faire plaisir a Bibibye, voici une version en Python.

Je concours aussi dans la catégorie "inutilement compliqué".

Le code :

  1
  2
  3
  4
  5
  6
  7
  8
  9
 10
 11
 12
 13
 14
 15
 16
 17
 18
 19
 20
 21
 22
 23
 24
 25
 26
 27
 28
 29
 30
 31
 32
 33
 34
 35
 36
 37
 38
 39
 40
 41
 42
 43
 44
 45
 46
 47
 48
 49
 50
 51
 52
 53
 54
 55
 56
 57
 58
 59
 60
 61
 62
 63
 64
 65
 66
 67
 68
 69
 70
 71
 72
 73
 74
 75
 76
 77
 78
 79
 80
 81
 82
 83
 84
 85
 86
 87
 88
 89
 90
 91
 92
 93
 94
 95
 96
 97
 98
 99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
#!/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("""-,+[-[>>++++[>++++++++<-]<+<-[>+>+>-[>>>]<[[>+<-]>>+>]<<<<<-]]>>>[-]+>--[-[<->+++[-]]]<[++++++++++++<[
    #           >-[>+>>]>[+[<+>-]>+>>]<<<<<-]>>[<+>-]>[-[-<<[-]>>]<<[<<->>-]>>]<<[<<+>>-]]<[-]<.[-]<-,+]""")

Les explications :

Le principe utilisé ici est d'utiliser un bulldozer pour écraser une mouche. Je parse le BF et construit au fur et a mesure un AST, mais pas n'importe lequel, un AST compatible Python. Je demande alors à Python de me compiler l'AST en Bytecode pour pouvoir l'executer. En fait ça faisait longtemps que je cherchais une excuse pour jouer avec.

En détail et en commençant par la fin et en remontant :

  • Lignes 192 et + : Tests sur quelques scripts
  • Lignes 178 - 191 : Appel la construction de l'AST, englobe ça avec des instructions d'init dans un module, le compile en Bytecode et l'execute
  • Lignes 140 - 177 : Définit un jeu d'instructions pour les éléments simples (tout sauf les crochets) pour mémoriser l'AST basique qu'ils représentent. Définit ensuite la fonction qui va se charger de parser la chaîne de caractère avec quelques appels récursifs pour les crochets.
  • Lignes 0 - 139 : La définition des AST pour chaque éléments. Les crochets ont le droit à une fonction pour injecter l'arbre de contenu.

Quelques remarques en plus :

  • En dé commentant les lignes 113-119 et 151, vous disposez d'une instruction supplémentaire "?" qui va afficher l'état courant de la machine (Liste en mémoire et pointeur)
  • Normalement la mémoire est "infinie". A chaque incrémentation du pointeur j'augmente la capacité de la liste représentant la mémoire si nécessaire.
  • Chaque case mémoire peut contenir n'importe quel entier supporté par Python mais vous risquez d'avoir une exception si vous asseyez d'imprimer un caractère hors de la zone ascii.
  • Améliorations envisageables :

    • Faire cohabiter code BF / Python : Normalement je devrais pouvoir appeler du code BF depuis Python si je l'enveloppe dans une fonction + quelques convention pour passer des arguments et récupérer le résultat.
    • En cas d'erreur, je devrait pouvoir indiquer la ligne et le caractère, dans la source BF, qui a causé l'exception puisque l'AST le permet.

Ok, Maëlan m'a fait remarquer que mon code ne fonctionne pas. Pour la simple et bonne raison que je n'ai pas posté le bon code. :> Je viens d'éditer mon premier message (je gérais mal les boucles dans le code erroné, je revenais toujours sur le même pointeur de données, ce qui causait des boucles infinies (en plus de ne pas avoir le bon résultat)).

En passant, très joli code et conception, GuilOoo. :)

+0 -0

En Python aussi:

 1
 2
 3
 4
 5
 6
 7
 8
 9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
import sys


class Brainfuck:
    def __init__(self):
        self.code = []
        self.labels = []
        self.loops = []
        self.mem = [0] * 60000
        self.actions = {
            '>': (None, self._incr_pos),
            '<': (None, lambda: self._incr_pos(-1)),
            '+': (None, self._incr_val),
            '-': (None, lambda: self._incr_val(-1)),
            '.': (None, self._put_char),
            ',': (None, self._get_char),
            '[': (self._enter_loop, self._cond_jmp),
            ']': (self._exit_loop, self._jmp)
        }

    def parse_string(self, s):
        for c in s:
            action = self.actions.get(c)
            if action:
                (action[0] or (lambda: self._append_instr(c)))()

    def _get_label(self):
        self.labels.append(None)
        return len(self.labels) - 1

    def _put_label(self, label):
        self.labels[label] = len(self.code)

    def _append_instr(self, *instr):
        self.code.append(instr)

    def _enter_loop(self):
        label1, label2 = self._get_label(), self._get_label()
        self._put_label(label1)
        self._append_instr('[', label2)
        self.loops.append((label1, label2))

    def _exit_loop(self):
        label1, label2 = self.loops.pop()
        self._append_instr(']', label1)
        self._put_label(label2)

    def _incr_pos(self, i=1):
        self.pos += i

    def _incr_val(self, i=1):
        self.mem[self.pos] += i

    def _put_char(self):
        print(chr(self.mem[self.pos]), end='')

    def _get_char(self):
        self.mem[self.pos] = ord(sys.stdin.read(1))

    def _jmp(self, label):
        self.pc = self.labels[label] - 1

    def _cond_jmp(self, label):
        if not self.mem[self.pos]:
            self._jmp(label)

    def execute(self):
        assert len(self.loops) == 0
        self.pc = 0
        self.pos = 0
        while self.pc < len(self.code):
            instr, *args = self.code[self.pc]
            _, action = self.actions.get(instr)
            action(*args)
            self.pc += 1


if __name__ == '__main__':
    bf = Brainfuck()
    bf.parse_string('++++++++[>++++[>++>+++>+++>+<<<<-]>+>+>->>+[<]<-]>>.>---.+++++++..+++.>>.<-.<.+++.------.--------.>>+.>++.')
    bf.execute()

Moi aussi en OCaml avec une opti' très basique, ocamllex et menhir(au final c'est plus chiant qu'à la main avec la petite syntaxe du bf).

lexer.mll

 1
 2
 3
 4
 5
 6
 7
 8
 9
10
11
12
13
14
15
{
  open Parser
}

rule lexer = parse
    | eof    { TEof }
    | "+"    { TPlus        }
    | "-"    { TMinus       }
    | ">"    { TSup         }
    | "<"    { TInf         }
    | "."    { TDot         }
    | ","    { TComma       }
    | "["    { TLBR         }
    | "]"    { TRBR         }
    | _      { lexer lexbuf }

parser.mly

 1
 2
 3
 4
 5
 6
 7
 8
 9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
%{

%}

%token TPlus TMinus
%token TSup TInf
%token TDot
%token TComma
%token TLBR TRBR
%token TEof

%start <Ast.ast list> prgm

%%

prgm:
| s = sequence TEof { s }

sequence:
| a = ast { [a] }
| a = ast s = sequence { a :: s }

ast:
| TPlus { Ast.Val [Ast.Succ] }
| TMinus { Ast.Val [Ast.Pred] }
| TSup { Ast.Depl [Ast.Succ] }
| TInf { Ast.Depl [Ast.Pred] }
| TDot { Ast.Putc }
| TComma { Ast.Getc }
| TLBR s = sequence TRBR { Ast.Loop s }
| TLBR TRBR { Ast.Loop [] }

ast.ml

 1
 2
 3
 4
 5
 6
 7
 8
 9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
type ast =
  | Val  of op list
  | Depl of op list
  | Putc
  | Getc
  | Loop of ast list

and op = Pred | Succ

let op_to_int = function
  | Pred -> (-1)
  | Succ -> 1

let op_list_to_int l = List.fold_left (+) 0 (List.map op_to_int l)

let print_op p s = function
  | Pred -> print_char p
  | Succ -> print_char s

let print_val = print_op '-' '+'
let print_depl = print_op '<' '>'

let rec print_ast_list l =
  let rec print_ast = function
    | Val v -> List.iter print_val v
    | Depl d -> List.iter print_depl d
    | Putc -> print_char '.'
    | Getc -> print_char ','
    | Loop l -> print_char '['; print_ast_list l; print_char ']'
  in List.iter print_ast l

main.ml

 1
 2
 3
 4
 5
 6
 7
 8
 9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
open Ast

let mem = Array.make 4096 0

let rec eval_prgm l i =
  let eval_instr i = function
    | Val v -> mem.(i) <- mem.(i) + op_list_to_int v; i
    | Depl d -> i + op_list_to_int d
    | Putc -> print_char (char_of_int mem.(i)); i
    | Getc -> mem.(i) <- int_of_char (input_char stdin); i
    | Loop l ->
      let rec aux i =
        if mem.(i) <> 0 then aux (eval_prgm l i)
        else i
      in aux i
  in List.fold_left eval_instr i l

let optimize l =
  let rec aux = function
    | [] -> []
    | Val v1 :: Val v2 :: xs -> aux (Val (v1 @ v2) :: xs)
    | Depl d1 :: Depl d2 :: xs -> aux (Depl (d1 @ d2) :: xs)
    | Loop l :: xs -> Loop (aux l) :: aux xs
    | x :: xs -> x :: aux xs
  in aux l

let () =
  let p = Parser.prgm Lexer.lexer (Lexing.from_channel (open_in Sys.argv.(1))) in
  print_endline "Print ast:"; print_ast_list p; print_newline ();
 (try ignore (eval_prgm (optimize p) 0)
  with Invalid_argument msg -> Printf.eprintf "Error: %s\n" msg);
  print_newline ()

Maintenant reste à savoir si l'optimisation à cause de la concaténation des deux listes ne la rend pas contre productif. :lol:

+0 -0

Question bête : quelqu'un connaît un vrai programme BrainFuck, genre un truc qui calcule des décimales de Pi ou n'importe quoi ? Ce serait pour m'amuser à tester les performances de diverses approches pour la compilation.

+0 -0

@Eyyub : Le truc, c'est que le parser sert uniquement pour les boucles, donc c'est un peu lourd pour pas grand chose. Sinon, tu ne catch nulle part l'exception LexError, ce qui fait planter ton programme sur un caractère qui n'est pas autorisé par BF. En fait, le comportement devrait être le même que pour les espaces (ce qui permet de commenter le BF).

@GuilOooo : très bonne question. J'ai trouvé ça, ça peut être un début.

@Eyyub : Le truc, c'est que le parser sert uniquement pour les boucles, donc c'est un peu lourd pour pas grand chose. Sinon, tu ne catch nulle part l'exception LexError, ce qui fait planter ton programme sur un caractère qui n'est pas autorisé par BF. En fait, le comportement devrait être le même que pour les espaces (ce qui permet de commenter le BF).

Concernant le parseur c'est effectivement le cas, mais j'me suis dit que puisque personne n'avait encore utilisé d'outils externes ici ce serait peut être intéressant pour les yeux de certains. :)
Pour l'exception LexError j'ai complètement oublié merci, faut que je catch Invalid_argument aussi.
Et d'accord pour le comportement, j'ai juste pris le tableau de l'article wikipedia c'était pas signifié !

+0 -0
Connectez-vous pour pouvoir poster un message.
Connexion

Pas encore membre ?

Créez un compte en une minute pour profiter pleinement de toutes les fonctionnalités de Zeste de Savoir. Ici, tout est gratuit et sans publicité.
Créer un compte