(** Interpréteur BF (partie 2) *)
(** Pour rappel, voici les instructions de BF. Les deux dernières sont ce qu'on
veut supporter en plus maintenant.
| Instruction | Action |
|-------------|-------------------------------------------------------------------------------------------------------|
| `>` | Avance d'une case mémoire |
| `<` | Recule d'une case mémoire |
| `+` | Incrémente la valeur de case mémoire courante |
| `-` | Décrémente la valeur de case mémoire courante |
| `,` | Lit un caractère de l'utilisateur et le stocke dans la case mémoire courante |
| `.` | Affiche le caractère contenu dans la case mémoire courante |
| `[` | Si la case mémoire courante est zéro, se déplace vers la droite jusqu'au `]` correspondant |
| `]` | Si la case mémoire courante n'est **pas** zéro, se déplace vers la gauche jusqu'au `[` correspondant | *)
(** État de la machine
------------------
Dans la première partie, nous avons été bloqué pour implémenter les instructions
qui manipulent le pointeur d'instruction de notre interpréteur. Il faut que
celui-ci soit représenté dans notre état.
Pour rappel, nous avions introduit des types énumératifs pour les commandes
de base. On va maintenant ajouter les nouvelles commandes, et définir un
type qui regroupe toutes nos commandes. *)
type memory_command =
| MoveLeft (* caractère '<' *)
| MoveRight (* caractère '>' *)
| Increment (* caractère '+' *)
| Decrement (* caractère '-' *)
type io_command =
| Write (* caractère '.' *)
| Read (* caractère ',' *)
type control_command =
| LoopBegin (* caractère '[' *)
| LoopEnd (* caractère ']' *)
type command =
| Memory of memory_command
| IO of io_command
| Control of control_command
let command_to_string : command -> string = function
| Memory MoveLeft -> "<"
| Memory MoveRight -> ">"
| Memory Increment -> "+"
| Memory Decrement -> "-"
| IO Write -> "."
| IO Read -> ","
| Control LoopBegin -> "["
| Control LoopEnd -> "]"
(** Un état de notre machine contient une mémoire (et un pointeur de
mémoire), et du code à éxécuter (ainsi qu'un pointeur vers l'endroit où on se
trouve dans le code). On peut représenter cela comme ceci :
mémoire : [0, 0, 0, 0, 0, ...]
pointeur de données : ^
code : >>++[-]
pointeur d'instruction : ^
On va représenter notre code de façon similaire à la mémoire : une structure
contenant d'une part le code précédent le pointeur (sous forme de liste
inversée), et d'autre part le code à partir du pointeur (sous forme de liste).
Comme on va se retrouver avec deux représentations très similaires, on
généralise cela dans un seul type : `list_and_pointer`. *)
type 'a list_and_pointer = {
before : 'a list;
after : 'a list;
}
(** Ce type est un type *paramétré* : il prend un autre type en argument. On
peut remplacer `a` par n'importe quel type.
On peut donc représenter notre mémoire et son pointeur par : *)
type data_state = char list_and_pointer
(** Et notre code et son pointeur par : *)
type code_state = command list_and_pointer
(** On peut donc représenter l'état de notre machine par un état mémoire et un état du code. *)
type state = {
code : code_state;
data : data_state;
}
(** L'état initial de la mémoire ne change pas par rapport à avant, on adapte juste son nom et type. *)
let memory_size : int = 256
let initial_data_state : data_state = {
before = [];
after = List.init memory_size (fun _ -> Char.chr 0);
}
(** L'état initial du code est défini à partir du programme que l'on va
interpréter. Un programme est une liste d'instruction, et l'état initial
contient notre programme après notre pointeur. On verra par la suite comment
*parser* un programme en entrée vers une liste de commandes. *)
type program = command list
let initial_control_state (program : program) : code_state = {
before = [];
after = program
}
let initial_state (program : program) : state = {
code = initial_control_state program;
data = initial_data_state;
}
(** Se déplacer dans un état et lire une valeur
-------------------------------------------
On adapte nos fonctions `move_right` et `move_left` à nos nouveaux types. On en
aura besoin sur la mémoire **et** sur notre code, donc on les définit sur
`list_and_pointer` directement. Ce sont des fonctions *polymorphiques*. *)
exception OutsideMemory
let move_right (l : 'a list_and_pointer) : 'a list_and_pointer =
match l.after with
| [] -> raise OutsideMemory
| cell :: after -> { before = cell :: l.before; after = after }
let move_left (l : 'a list_and_pointer) : 'a list_and_pointer =
match l.before with
| [] -> raise OutsideMemory
| cell :: before -> { before = before; after = cell :: l.after }
(** Il en est de même pour lire la valeur courante, on en aura besoin pour lire
l'instruction courante, donc on définit cela sur `list_and_pointer`. *)
let read_cell (l : 'a list_and_pointer) : 'a =
match l.after with
| [] -> raise OutsideMemory
| cell :: _ -> cell
(** Modifier la mémoire
-------------------
On ne va pas modifier notre code BF lors de son éxécution. Les fonctions qui
manipulent les données en mémoire sont donc définies uniquement sur notre
`data_state`. On voit ici l'utilité d'avoir types différents : on est plus
explicite sur ce que chaque fonction peut faire. On ne veut pas pouvoir
modifier la partie code, seulement la partie donnée. Les types nous
permettent de garantir cela. *)
let write_cell (new_cell : char) (state : data_state) : data_state =
match state.after with
| [] -> raise OutsideMemory
| _ :: after -> { state with after = new_cell :: after }
let increment_cell (state : data_state) : data_state =
write_cell (Char.chr (Char.code (read_cell state) + 1)) state
let decrement_cell (state : data_state) : data_state =
write_cell (Char.chr (Char.code (read_cell state) - 1)) state
(** Commandes
--------- *)
(** Évaluation des commandes mémoires
----------------------------------
Les commandes mémoires agissent maintenant sur un `data_state`, mais leur
évaluation reste la même. *)
let eval_memory_command (command : memory_command) (state : data_state) : data_state =
match command with
| MoveLeft -> move_left state
| MoveRight -> move_right state
| Increment -> increment_cell state
| Decrement -> decrement_cell state
(** Évaluation des entrées-sorties
------------------------------
Il en est de même pour les entrées et sorties : *)
let eval_io_command (command : io_command) (state : data_state) : data_state =
match command with
| Write ->
print_char (read_cell state);
state
| Read ->
let c = input_char stdin in
write_cell c state
(** Commandes de saut
-----------------
On peut enfin s'atteler à l'évaluation de `[` et `]`. Quand on doit évaluer un
`[`, on regarde avant tout la *valeur mémoire courante*. Si elle vaut autre
chose que 0, on ne fait rien et on continue l'éxécution normalement. Si elle
vaut 0, on cherche le `]` **correspondant**. Attention, on ne cherche pas le
premier `]`. Ainsi, considérez le programme suivant où le pointeur
d'instruction est représenté (il est au premier `[`) :
[[--]+++]
^
Comme la valeur mémoire courante est de 0, on doit sauter jusqu'au `]`
correspondant, c'est-à-dire le dernier `]`.
On va définir notre fonction la plus compliquée de cet exemple. Cette fonction,
`do_until_matching`, effectue une action jusqu'à trouver le caractère
correspondant à un caractère donné. On a donc besoin :
- du caractère à partir duquel on cherche (par exemple, `[`), car si on en
voit un en plus dans notre recherche, il faut prendre en compte que le
caractère opposé que l'on trouve n'est pas le correspondant. Par exemple,
si on cherche le `]` correspondant au premier `[` dans `[[-]]`, il faut trouver
le dernier caractère et non l'avant dernier.
- du caractère opposé au caractère qu'on cherche (par exemple, `]`)
- de l'action a effectuer, dans notre cas l'action se fera sur l'état du code
(`code_state`) afin de déplacer le pointeur d'instructions
- de l'état initial avant d'effectuer ces actions
Pour définir cette fonction, on va utiliser une fonction d'aide (*helper
function*) que l'on défini en même temps. Notre fonction d'aide maintient un
état (qui évolue au fur et à mesure qu'on avance dans le code), et compte le
nombre de caractères à trouver : si on cherche un `]` mais que pendant cette
recherche, on a déjà trouvé deux `[`, il faut encore éliminer deux `]` avant de
trouver le `]` que l'on cherchait.
Notre fonction d'aide s'arrête quand elle trouve le caractère fermant et que `n`
vaut 0, indiquant que c'est celui qu'on cherchait. On applique alors une
dernière fois notre action (car on veut se retrouver après/avant ce caractère,
pas dessus)
Si on n'est pas au caractère fermant, on applique l'action et on continue notre
recherche. On prend soin d'augmenter ou diminuer `n` si on rencontre un
caractère ouvrant ou fermant en chemin.
*)
let rec do_until_matching
(c_open : control_command)
(c_close : control_command)
(action : code_state -> code_state)
(state : code_state) : code_state =
let rec helper (cur_state : code_state) (count : int) : code_state =
let cell = read_cell cur_state in
match cell with
| Control c when c = c_close && count = 0 ->
(* On a trouvé le caractère correspondant *)
cur_state
| Control c when c = c_close ->
(* On a trouvé un caractère de fermeture, mais ce n'est pas le bon *)
helper (action cur_state) (count - 1) (* on décrémente donc le compteur et on continue *)
| Control c when c = c_open ->
(* On a trouvé un autre caractère d'ouverture, on incrémente alors le compteur et on continue *)
helper (action cur_state) (count + 1)
| _ ->
(* On est sur un autre caractère, on continue *)
helper (action cur_state) count
in
(* On avance d'un caractère et on cherche, avec le compteur initialisé à 0 *)
helper (action state) 0
(** On peut donc définir comment évaluer une commande de saut. Notez qu'on prend en
argument un état de la machine, mais qu'on ne retourne qu'un `code_state`. On
aurait pu retourner un `state`, mais c'est un choix cosmétique qui est fait pour
expliciter que l'on ne modifie pas la mémoire ici.
Le caractère `'\000'` n'est autre que le caractère dont la valeur numérique est 0.*)
let eval_control_command (command : control_command) (state : state) : code_state =
match (command, read_cell state.data) with
| LoopBegin, '\000' -> do_until_matching LoopBegin LoopEnd move_right state.code
| LoopBegin, _ -> state.code
| LoopEnd, '\000' -> state.code
| LoopEnd, _ -> do_until_matching LoopEnd LoopBegin move_left state.code
(** Évaluation d'un programme
=========================
Maintenant qu'on peut évaluer chacune de nos commandes, on peut finalement
regrouper tout cela au sein d'un évaluateur général.
Transition d'un état à l'état suivant
-------------------------------------
On défini une fonction de transition (*step*) qui à partir d'un état, appelle la
fonction d'évaluation correspondante définie plus haut. On retourne le type qui
englobe tous les autres types :
- `eval_memory_command` nous retourne un `data_state`
- `eval_io_command` nous retourne un `data_state`
- `eval_jump_command` nous retourne un `code_state`
On retourne donc un `state`, qui peut contenir tout cela. On délègue à la bonne
fonction d'évaluation, en s'assurant d'adapter les valeurs de retour pour
correspondre à notre type `state`. *)
let step_command (command : command) (state : state) : state =
match command with
| Memory c ->
{ state with data = eval_memory_command c state.data }
| IO c ->
{ state with data = eval_io_command c state.data }
| Control c ->
{ state with code = eval_control_command c state }
(** On peut définir une fonction `step` qui agit directement sur un `State`, lit la
commande courante et l'éxécute. *)
let step (state : state) : state =
step_command (read_cell state.code) state
(** Il va falloir savoir quand arrêter notre exécution. La fonction `at_end`
regarde s'il reste du code à évaluer et retourne `true` s'il n'y en a plus. *)
let at_end (state : state) : bool =
state.code.after = []
(** La fonction `eval_commands` évalue la commande courante s'il y en a une, déplace
le pointeur d'instruction vers la droite, et continue l'évaluation avec un appel
récursif. *)
let rec eval_commands (state : state) : state =
if at_end state then
state
else
let state' = step state in
eval_commands { state' with code = move_right state'.code }
(** On peut enfin définir comment évaluer un programme. Il faut *injecter* le
programme dans un état initial, et on peut ensuite appeler `eval_commands`.
Cette fonction nous retourne un état, mais on l'ignore pour `eval` car nous ne
sommes intéressé que dans les effets de bords (lectures et affichages). La
fonction `eval` retourne donc la valeur de type `unit` *)
let eval (program : program) : unit =
let _ = eval_commands (initial_state program) in
()
(** Lire un programme
=================
Pour pouvoir exécuter un programme depuis sa représentation textuelle, il
faut le transformer en liste de commandes. C'est ce que la fonction `parse`
fait : elle lit un programme caractère par caractère, et transforme chaque
caractère en une commande. Chaque caractère qui ne correspond pas à une
commande est ignoré *)
let parse (program : string) : command list =
let parse_char = function
| '[' -> Some (Control LoopBegin)
| ']' -> Some (Control LoopEnd)
| '.' -> Some (IO Write)
| ',' -> Some (IO Read)
| '+' -> Some (Memory Increment)
| '-' -> Some (Memory Decrement)
| '>' -> Some (Memory MoveRight)
| '<' -> Some (Memory MoveLeft)
| _ -> None in
program
|> String.to_seq
|> List.of_seq (* note: `x |> String.to_seq |> List.of_seq` permet de convertir un string en char list *)
|> List.filter_map parse_char
(** Finalement, on définit une fonction `run` qui lit le programme et l'exécute *)
let run (program : string) : unit =
eval (parse program)
(** On peut maintenant faire tourner un programme:
# run ",[-.]";;
Ce programme lit un caractère (`,`), démarre une boucle (`[`) qui va décrémenter
la case mémoire actuelle (`-`), l'afficher (`.`), et continuer à boucler jusqu'à
arriver à 0.
En entrant A et tapant entrée, on obtient: $t@?>=<;:9876543210...
*)
(** Interface avec le système d'exploitation
----------------------------------------
On peut finalement interfacer notre `run` avec le système d'exploitation. La
fonction `suivante` prend un chemin vers un fichier et nous retourne le contenu
du fichier. *)
let read_whole_file (filename : string) : string =
(* open_in_bin works correctly on Unix and Windows *)
let ch = open_in_bin filename in
let s = really_input_string ch (in_channel_length ch) in
close_in ch;
s
(** La fonction run_file va donc lire un fichier et l'exécuter *)
let run_file (filename : string) : unit =
run (read_whole_file filename)
(** Le "main" doit donc appeler `run_file` avec le premier argument passé au programme : *)
let _ =
let filename = Array.get Sys.argv 1 in
run_file filename
(** Voici un *Hello, World!* repris de Wikipédia pour tester le programme :
```
1 +++++ +++ Set Cell #0 to 8
2 [
3 >++++ Add 4 to Cell #1; this will always set Cell #1 to 4
4 [ as the cell will be cleared by the loop
5 >++ Add 4*2 to Cell #2
6 >+++ Add 4*3 to Cell #3
7 >+++ Add 4*3 to Cell #4
8 >+ Add 4 to Cell #5
9 <<<<- Decrement the loop counter in Cell #1
10 ] Loop till Cell #1 is zero
11 >+ Add 1 to Cell #2
12 >+ Add 1 to Cell #3
13 >- Subtract 1 from Cell #4
14 >>+ Add 1 to Cell #6
15 [<] Move back to the first zero cell you find; this will
16 be Cell #1 which was cleared by the previous loop
17 <- Decrement the loop Counter in Cell #0
18 ] Loop till Cell #0 is zero
19
20 The result of this is:
21 Cell No : 0 1 2 3 4 5 6
22 Contents: 0 0 72 104 88 32 8
23 Pointer : ^
24
25 >>. Cell #2 has value 72 which is 'H'
26 >---. Subtract 3 from Cell #3 to get 101 which is 'e'
27 +++++ ++..+++. Likewise for 'llo' from Cell #3
28 >>. Cell #5 is 32 for the space
29 <-. Subtract 1 from Cell #4 for 87 to give a 'W'
30 <. Cell #3 was set to 'o' from the end of 'Hello'
31 +++.----- -.----- ---. Cell #3 for 'rl' and 'd'
32 >>+. Add 1 to Cell #5 gives us an exclamation point
33 >++. And finally a newline from Cell #6
```
(Notez comment les caractères autres que les commandes supportées sont tous
ignorés, ce qui permet facilement de commenter du code BF)
On peut donc compiler et essayer le tout, en sauvant le programme BF ci dessus dans hello.bf :
```shell
$ ocamlc bf_full.ml -o bf
$ ./bf hello.bf
Hello World!
``` *)
(** Envie d'aller plus loin ?
=========================
Il y a beaucoup de chose améliorables dans notre interpréteur. À titre
d'exemple :
- la gestion des erreurs est inexistante, un programme BF incorrect (par exemple : `+[`
est un programme incorrect) donnera une erreur peu compréhensible
- nous n'avons pas écrit de tests
- on pourrait procéder à certaines optimisations évidentes (par exemple, `+++` requiert
trois additions, alors qu'on pourrait faire cela en une seule addition en machine)
Aussi, il existe beaucoup d'autres [langages
ésotériques](https://esolangs.org/wiki/Language_list) Un exemple proche de
BF est le [Whitespace](https://fr.wikipedia.org/wiki/Whitespace) est un
langage où chaque suite d'espaces représente une commande. En Whitespace, il y a
plus de commandes qu'en BF. Un bon exercice est de développer un
interpréteur Whitespace de façon similaire à l'interpréteur que nous avons
développé ici. *)
