Version finale

.gitignore

@@ -0,0 +1,11 @@
+*.gz
+*.o
+*.s
+
+mcc
+Exemples/cat
+Exemples/fact
+Exemples/order
+Exemples/sieve
+Exemples/test
+Exemples/unitest0

Exemples/cat.c

@@ -0,0 +1,27 @@
+#ifdef MCC
+#define FILE char
+// pipeau: un FILE est quelque chose de plus complique, normalement...
+#define EOF (-1)
+// ca, par contre, c'est la vraie valeur de EOF.
+
+#else
+#include <stdio.h>
+#include <stdlib.h>
+#endif
+
+int main (int argc, char **argv)
+{
+  int i, c;
+
+  for (i=1; i<argc; i++)
+    {
+      FILE *f;
+
+      f = fopen (argv[i], "r");
+      while ((c = fgetc (f))!=EOF)
+	fputc (c, stdout);
+      fclose (f);
+    }
+  fflush (stdout);
+  exit (0);
+}

Exemples/fact.c

@@ -0,0 +1,42 @@
+#ifndef MCC
+#include <stdio.h>
+#include <stdlib.h>
+#endif
+
+int fact (int n)
+{
+  int res;
+
+  res = 1;
+  while (n!=0)
+    {
+      res = res * n;
+      n--;
+    }
+  return res;
+}
+
+int main (int argc, char **argv)
+{
+  if (argc!=2)
+    {
+      fprintf (stderr, "Usage: ./fact <n>\ncalcule et affiche la factorielle de <n>.\n");
+      fflush (stderr);
+      exit (10); /* non mais! */
+    }
+  {
+    int n, res;
+
+    n = atoi (argv[1]); /* conversion chaine -> entier. */
+    if (n<0)
+      {
+	fprintf (stderr, "Ah non, quand meme, un nombre positif ou nul, s'il-vous-plait...\n");
+	fflush (stderr);
+	exit (10);
+      }
+    res = fact (n);
+    printf ("La factorielle de %d vaut %d (en tout cas, modulo 2^32...).\n",
+	    n, res);
+  }
+  return 0;
+}

Exemples/ordre.c

@@ -0,0 +1,13 @@
+#ifndef MCC
+#include <stdio.h>
+#endif
+
+int main (int argc, char **argv)
+{
+  int i, j;
+
+  j = (i=3) + (i=4);
+  printf ("Valeur de j=%d (normalement 7), valeur de i=%d.\n", j, i);
+  fflush (stdout);
+  return 0;
+}

Exemples/sieve.c

@@ -0,0 +1,102 @@
+#ifdef MCC
+#define NULL 0
+#else
+#include <stdio.h>
+#include <stdlib.h>
+#endif
+
+int main (int argc, char **argv)
+{
+  if (argc!=2)
+    {
+      fprintf (stderr, "Usage: ./sieve <n>\ncalcule et affiche les nombres premiers inferieurs a <n>.\n");
+      fflush (stderr);
+      exit (10); /* non mais! */
+    }
+  {
+    int n;
+    int *bits;
+
+    n = atoi (argv[1]); // conversion chaine -> entier.
+    if (n<2)
+      {
+	fprintf (stderr, "Ah non, quand meme, un nombre >=2, s'il-vous-plait...\n");
+	fflush (stderr);
+	exit (10);
+      }
+    bits = malloc (8*n); // allouer de la place pour n entiers (booleens).
+    // Ca prend 32 fois trop de place.  Mais C-- n'a pas les operations &, |,
+    // qui nous permettraient de manipuler des bits individuellement...
+    if (bits==NULL)
+      {
+	fprintf (stderr, "%d est trop gros, je n'ai pas assez de place memoire...\n");
+	fflush (stderr);
+	exit (10);
+      }
+    zero_sieve (bits, n);
+    bits[0] = bits[1] = 1;
+    fill_sieve (bits, n);
+    print_sieve (bits, n);
+    free (bits); // et on libere la place memoire allouee pour bits[].
+  }
+  return 0;
+}
+
+int zero_sieve (int *bits, int n)
+{
+  int i;
+
+  for (i=0; i<n; i++)
+    bits[i] = 0;
+  return 0;
+}
+
+int fill_sieve (int *bits, int n)
+{
+  int last_prime;
+
+  for (last_prime = 2; last_prime<n; )
+    {
+      cross_out_prime (bits, n, last_prime);
+      while (++last_prime<n && bits[last_prime]);
+    }
+  return 0;
+}
+
+int cross_out_prime (int *bits, int n, int prime)
+{
+  int delta;
+
+  for (delta = prime; (prime = prime + delta) < n; )
+    bits[prime] = 1;
+  return 0;
+}
+
+int print_sieve (int *bits, int n)
+{
+  char *delim;
+  int i;
+  int k;
+  char *buf;
+
+  printf ("Les nombres premiers inferieurs a %d sont:\n", n);
+  delim = "  ";
+  k = 0;
+  for (i=0; i<n; i++)
+    {
+      if (bits[i]==0)
+	{
+	  printf ("%s%8d", delim, i);
+	  if (++k>=4)
+	    {
+	      printf ("\n"); // retour à la ligne.
+	      k = 0;
+	      delim = "  ";
+	    }
+	  else
+	    printf (" "); // espace.
+	}
+    }
+  fflush (stdout); // on vide le tampon de stdout, utilise par printf().
+  return 0;
+}

Exemples/test.c

@@ -0,0 +1,7 @@
+int global1;
+
+int main() {
+	global1 = 42;
+	printf("%d\n", global1);
+	return 0;
+}

Makefile

@@ -0,0 +1,92 @@
+#  Copyright (c) 2005 by Laboratoire Spécification et Vérification (LSV),
+#  CNRS UMR 8643 & ENS Cachan.
+#  Written by Jean Goubault-Larrecq.  Derived from the csur project.
+#
+#  Permission is granted to anyone to use this software for any
+#  purpose on any computer system, and to redistribute it freely,
+#  subject to the following restrictions:
+#
+#  1. Neither the author nor its employer is responsible for the consequences
+#     of use of this software, no matter how awful, even if they arise
+#     from defects in it.
+#
+#  2. The origin of this software must not be misrepresented, either
+#     by explicit claim or by omission.
+#
+#  3. Altered versions must be plainly marked as such, and must not
+#     be misrepresented as being the original software.
+#
+#  4. This software is restricted to non-commercial use only.  Commercial
+#     use is subject to a specific license, obtainable from LSV.
+
+%.cmo: %.ml
+	ocamlc -g -c $<
+
+%.cmi: %.mli
+	ocamlc -g -c $<
+
+.PHONY: all projet.tar.gz
+
+# Compilation parameters:
+CAMLOBJS=error.cmo cparse.cmo cprint.cmo \
+	ctab.cmo clex.cmo verbose.cmo genlab.cmo compile.cmo \
+	main.cmo
+CAMLSRC=$(addsuffix .ml,$(basename $(CAMLOBJS)))
+PJ=ProjetMiniC
+FILES=clex.mll cparse.ml cparse.mli ctab.mly \
+	  compile.ml compile.mli \
+	  cprint.ml cprint.mli \
+	  error.ml verbose.ml genlab.ml main.ml Makefile
+
+all: mcc
+
+projet: projet.tar.gz
+
+mcc: $(CAMLOBJS)
+	ocamlc -g -o mcc unix.cma $(CAMLOBJS)
+
+clean:
+	rm -f mcc *.cmi *.cmo
+	rm -f ctab.ml ctab.mli clex.ml
+	rm -rf projet.tar.gz $(PJ)
+	rm -rf Test/
+
+test: projet.tar.gz
+	-mkdir Test
+	-rm -rf Test/*
+	cp projet.tar.gz Test/
+	(cd Test/; tar -xvzf projet.tar.gz; cd ProjetMiniC/; cp ~/Papers/compile.ml .; make; cp mcc ~/bin)
+
+projet.tar.gz:
+	rm -rf $(PJ) && mkdir $(PJ)
+	cp $(FILES) $(PJ)
+	-mkdir $(PJ)/Exemples
+	cp Exemples/*.c $(PJ)/Exemples
+	cp cprint_skel.ml $(PJ)/cprint.ml
+	cp compile_skel.ml $(PJ)/compile.ml
+	tar -cvzf $@ $(PJ)
+
+P1=../boostrap
+P2=../../2/boostrap
+p2_links:
+	@echo Populating $(P2) with links for missing files...
+	@mkdir -p $(P2)
+	@for f in $(FILES) compile_skel.ml cprint_skel.ml ; do \
+	  test -f $(P2)/$$f || (echo Linking $$f... ; ln $(P1)/$$f $(P2)/$$f) ; done
+	@mkdir -p $(P2)/Exemples
+	@for f in Exemples/*.c ; do \
+	  test -f $(P2)/$$f || (echo Linking $$f... ; ln $(P1)/$$f $(P2)/$$f) ; done
+
+ctab.ml: ctab.mly
+	ocamlyacc -v ctab.mly
+
+clex.ml: clex.mll
+	ocamllex clex.mll
+
+compile.cmi: compile.mli
+compile.cmo: compile.ml compile.cmi
+
+depend: Makefile $(wildcard *.ml) $(wildcard *.mli) ctab.ml clex.ml
+	ocamldep *.mli *.ml > depend
+
+-include depend

README.md

@@ -0,0 +1,294 @@
+---
+title: Compilateur de C-\-
+author: Yohann D'ANELLO
+geometry:
+- top=0.5in
+- bottom=0.5in
+- left=1in
+- right=1in
+...
+
+\pagenumbering{gobble}
+
+`MCC` est un compilateur du langage `C--` codé en OCamL. Il prend en entrée un fichier source codé en `C--`, puis le traduit en code assembleur (Intel x86\_64), avant de l'assembler en exécutable machine. La sémantique de `C--` est disponible ici : [http://www.lsv.fr/~goubault/CoursProgrammation/prog1_sem1.pdf](http://www.lsv.fr/~goubault/CoursProgrammation/prog1_sem1.pdf)
+
+Un analyseur syntaxique commence par analyser le code, et le traduire en un *Abstract Syntax Tree* (AST, arbre de syntaxe abstrait). Le compilateur vient ensuite dérouler l'AST et produire le code assembleur nécessaire.
+
+La première chose effectuée par le compilateur est de récupérer la liste des fonctions déclarées par le code. Cela permet de savoir quelles sont les fonctions qui renvoient un entier codé sur 32 ou sur 64 bits, avec les fonctions système `malloc`, `calloc`, `realloc`, `fopen` et `exit`. Ensuite, le code est compilé.
+
+À la lecture du code, le compilateur dispose d'un environnement transmis et mis à jour à chaque appel de fonctions. Un environnement est modélisé par un 9-uplet contenant un compteur de nombre de labels déclarés, la liste des chaîne de caractères déjà rencontré ainsi que leur nombre, la liste des noms des variables globales, un booléen indiquant si le compilateur est actuellement en train de déclarer des paramètres d'une fonction ou non, un dictionnaire des variables locales indiquant à tout nom sa place sur la pile ainsi que la liste des fonctions disposant d'un retour sur 64 bits.
+
+# Déclaration d'une variable globale
+
+Les éléments les plus hauts dans l'AST sont les déclarations de variables globales et de fonctions. Pour déclarer une variable, le compilateur ajoute uniquement dans l'environnement le nom de la variable globale déclarée et ne produit aucun code assembleur. Il attendra d'avoir compilé tout le code avant de déclarer les variables globales dans la section `.data` via l'instruction `.comm <NAME>, 8, 8`.
+
+# Déclaration d'une fonction
+
+Le compilateur commence par déclarer créer un label vers la fonction, via `<NAME>:`{.asm}. Ensuite, la fonction va être parcourue une première fois afin d'estimer la place nécessaire à allouer sur la pile pour déclarer les variables. Pour cela, chaque paramètre et chaque variable déclarée (y compris dans les sous-blocs) compte pour 8 octets), afin de garantir d'avoir toujours de la place pour les besoins nécessaires. Ensuite, l'instruction `ENTERQ $N, 0`{.asm} est ajoutée, où `N` est le plus petit multiple de 16 supérieur ou égal à la place nécessaire pour la fonction. Ensuite, les paramètres sont déclarés, puis c'est au tour du code de la fonction. On convient que la valeur de retour de la fonction doit se trouver dans `%rax`{.asm}. Enfin, l'instruction `LEAVEQ`{.asm} permet d'effectuer l'instruction inverse de `ENTERQ`{.asm}, et donc de remettre `%rbp`{.asm} et `%rsp`{.asm} à leurs bonnes valeurs. L'instruction `RETQ`{.asm} suit ensuite, et va à l'instruction suivante.
+
+# Déclaration d'une variable locale, d'un paramètre
+
+Lors de la déclaration d'une variable locale, celle-ci est ajoutée à l'environnement. En mémoire est conservée la position de son adresse relativement à `%rsp`{.asm}, qui vaut alors la première place libre sur la pile. L'adresse de la `n`-ième variable locale est alors `-n(%rbp)`{.asm}. S'il s'agit d'un paramètre, alors cela implique que le paramètre est déjà initialisé, et donc on ajoute une instruction qui permet de récupérer la valeur du paramètre dans le bon registre, ou bien à la bonne position sur la pile s'il s'agit au moins du septième paramètre.
+
+# Évaluation d'un morceau de code
+
+Il existe 5 types de morceaux de code : les blocs, les expressions, les tests conditionnels `if`{.C}, les boucles `while`{.C} et les valeurs de retour `return`{.C}.
+
+## Les blocs de code
+
+Format : `CBLOCK(declaration list, code)`
+
+Un bloc de code commence par la déclaration des variables locales du bloc. Chaque variable est déclarée une à une, mettant à jour successivement l'environnement courant. Le code du bloc est ensuite exécuté. À la fin du bloc, les variables locales de l'environnement sont remplacées celles présentes avant l'entrée du code. Le reste est conservé.
+
+## Les expressions
+
+Format : `CEXPR(expression)`
+
+Un bloc d'expression évalue alors une expression. Une fois évaluée, la valeur de retour est toujours envoyée dans `%rax`{.asm}. Il existe 11 types d'expression : l'utilisation de variables, l'utilisation de constantes entières, l'utilisation de chaîne de caractères, l'affection dans une variable, l'affectation dans un tableau, l'appel d'une fonction, une opération unaire (opposé, négation binaire, {post,pré}-{in,dé}crémentation), une opération binaire (multiplication, division, modulo, addition, soustraction, accès à l'élément d'un tableau), la comparaison de deux éléments (infériorité stricte, infériorité large, égalité), les conditions ternaires et enfin les séquences d'expression.
+
+### Utilisation de variables
+
+Format : `VAR(name)`
+
+Une ligne d'assembleur est ajoutée, qui va alors chercher dans l'environnement la position sur la pile de la variable appelée si elle est locale, sinon donner son nom directement, pour placer le contenu dans `%rax`{.asm}.
+
+`MOVQ -24(%rbp), %rax`{.asm}\newline
+`MOVQ stdout(%rip), %rax`{.asm}
+
+### Utilisation de constantes entières
+
+Format : `CST(value)`
+
+La constante indiquée est directement enregistrée dans `%rax`{.asm}.
+
+`MOVQ $42, %rax`{.asm}
+
+### Utilisation de chaînes de caractères
+
+Format : `STRING(string)`
+
+La chaîne correspondante est ajoutée à l'environnement. Une optimisation du compilateur permet de ne pas enregistrer des chaînes de caractères déjà existantes. Après avoir compilé le code, dans la section `.data`{.asm}, toutes les chaînes de caractères sont ajoutées au code assembleur, sous le label `.strN`{.asm} où `N`{.asm} est le numéro de la chaîne, par ordre d'apparition, via l'instruction :
+
+`.strN:`{.asm}\newline
+`	.string STR`{.asm}\newline
+`	.text`{.asm}
+
+Le label en question est alors affecté à `%rax`{.asm} : `MOVQ $.strN, %rax`{.asm}
+
+### Affection dans une variable
+
+Format : `SET_VAR(name, expression)`
+
+L'expression à affecter est évaluée, puis le résultat (dans `%rax`{.asm}) est affecté dans la variable.
+
+`MOVQ %rax, -24(%rbp)`{.asm}
+
+### Affectation dans un tableau
+
+Format : `SET_ARRAY(name, expression, expression)`
+
+La première expression est d'abord évaluée, puis mise sur la pile. La seconde expression est ensuite évaluée, et le résultat est alors dans `%rax`{.asm}. La valeur mise sur la pile est ensuite dépilée dans `%rbx`{.asm}. `%rbx`{.asm} contient alors l'indice du tableau et `%rax`{.asm} la valeur à affecter. On récupère ensuite l'adresse de la case désirée, via des additions, puis on place le contenu `%rax`{.asm} dans la bonne case mémoire.
+
+`MOVQ $1, %rax`{.asm}\newline
+`PUSHQ %rax`{.asm}\newline
+`MOVQ $4, %rax`{.asm}\newline
+`POPQ %rbx`{.asm}\newline
+`MOVQ -24(%rbp), %rdx`{.asm}\newline
+`LEAQ 0(, %rbx, 8), %rbx`{.asm}\newline
+`ADDQ %rbx, %rdx`{.asm}\newline
+`MOVQ %rax, (%rdx)`{.asm}
+
+### Appel d'une fonction
+
+Format : `CALL(name, parameter list (expression list))`
+
+On commence par évaluer chacun des arguments, de droite à gauche, et les placer sur la pile un à un. Les (au plus) six premiers sont ensuite dépilés et mis dans l'ordre dans `%rdi`{.asm}, `%rsi`{.asm}, `%rdx`{.asm}, `%rcx`{.asm}, `%r8`{.asm}, `%r9`{.asm}. Par respect de la norme `C`, on fixe `%rax`{.asm} à `0`{.C}, puis on appelle la fonction. Une fois l'appel terminé, on dépile les arguments résiduels éventuels. Si jamais la fonction n'est pas dans la liste des fonctions ayant un retour sur 64 bits, on étend le signe de `%eax` dans `%rax`{.asm}, via l'instruction `CLTQ`{.asm}.
+
+`MOVQ $2, %rax`{.asm}\newline
+`PUSHQ %rax`{.asm}\newline
+`MOVQ $.str1, %rax`{.asm}\newline
+`PUSHQ %rax`{.asm}\newline
+`POPQ %rsi`{.asm}\newline
+`POPQ %rdi`{.asm}\newline
+`MOVQ $0, %rax`{.asm}\newline
+`CALLQ printf`{.asm}\newline
+`CLTQ`{.asm}\newline
+`...`{.asm}\newline
+`.str1:`{.asm}\newline
+`	.string "Valeur de deux = %d\n"`{.asm}\newline
+`  .text`{.asm}
+
+
+Cette suite d'instruction assembleur modélise l'appel `printf("Valeur de deux = %d\n", 2);`{.C}.
+
+### Opérateur unaire
+
+Format : `OP1(optype, expression)`
+
+L'expression est évaluée (le résultat est alors dans `%rax`{.asm}), puis traitée.
+
+#### Opposé
+
+Une seule instruction suffit : `NEGQ %rax`{.asm}
+
+#### Négation logique
+
+De même, il suffit d'une instruction assembleur : `NOTQ %rax`{.asm}
+
+#### {Post,Pré}-{in,dé}crémentation
+
+Si on est en post-{in,dé}crémentation, on commence par empiler la valeur de `%rax`{.asm}, qu'on dépilera plus tard, afin de renvoyer la bonne valeur. Sinon, d'abord on {in,dé}crémente, puis on met dans `%rax`{.asm} la valeur souhaitée.
+
+Une telle opération est, selon la sémantique `C--`, soit de la forme `s++`{.C} où `s`{.C} est une variable, soit de la forme `t[e]++`{.C} où `e`{.C} est une expression et `t`{.C} une variable. Dans le premier cas, on se contente d'incrémenter ou de décrémenter la variable via `INCQ`{.asm} ou `DECQ`{.asm}. Dans le second cas, on procède de la même manière que l'affectation dans un tableau en récupérant la bonne adresse, puis on {in,dé}crémente la valeur associée.
+
+### Opérateur binaire
+
+Format : `OP2(optype, expression1, expression2)`
+
+La deuxième expression est d'abord évaluée (en accord avec la sémantique de `C--` qui suggère de toujours évaluer de droite à gauche), puis la valeur est placée sur la pile. La première expression est ensuite évaluée, dont le résultat est dans `%rax`{.asm}. On récupère ensuite l'évaluation de la seconde expression dans `%rbx`{.asm}.
+
+#### Multiplication, addition, soustraction
+
+L'instruction `IMUL %rbx, %rax`{.asm} permet directement de multiplier `%rbx`{.asm} par `%rax`{.asm} et de placer le résultat dans `%rax`{.asm}, ce qui est ce que nous voulions. Les instructions `ADDQ`{.asm} et `SUBQ`{.asm} permettent la même chose pour l'addition et la soustraction.
+
+#### Division, modulo
+
+On commence par étendre le signe de `%rax`{.asm} dans `%rdx`{.asm} via l'instruction `CQO`{.asm}. On ajoute ensuite l'expression `IDIVQ %rbx`{.asm}, qui effectue la division euclidienne de `%rdx:%rax`{.asm} (nombre vu comme la concaténation des deux registres sur 128 bits) par `%rbx`{.asm}, et stocke le quotient dans `%rax`{.asm} et le reste dans `%rdx`{.asm}, selon la sémantique de `C--`. Selon les cas, on met la bonne valeur dans `%rax`{.asm}, puis pour des raisons de sécurité on remet `%rdx`{.asm} à `0`{.C}.
+
+#### Accès dans un tableau
+
+Comme précédemment, on récupère l'adresse de la bonne case mémoire, puis on place le contenu dans `%rax`{.asm} :
+
+`LEAQ (0, %rbx, 8), %rbx`{.asm}\newline
+ADDQ %rbx, %rax`{.asm}\newline
+MOVQ (%rax), %rax`{.asm}
+
+### Comparaison
+
+Format : `CMP(cmptype, expression1, expression 2)`
+
+On évalue la première expression dans `%rbx`{.asm}, puis la seconde dans `%rax`{.asm}. On compare ensuite `%rax`{.asm} à `rbx`. Puis, selon les cas (`JL` si l'inégalité est stricte, `JLE` si l'inégalité est large, `JE` si on veut l'égalité), on fait un saut vers le prochain label disponible. On se débrouille ensuite pour mettre `1` dans `%rax`{.asm} si la comparaison est concluante, `0` sinon.
+
+`CMPQ %rax, %rbx`{.asm}\newline
+`JE .destjump1`{.asm}\newline
+`MOVQ $0, %rax`{.asm}\newline
+`JMP .destjump2`{.asm}\newline
+`.destjump1:`{.asm}\newline
+`MOVQ $1, %rax`{.asm}\newline
+`.destjump2:`{.asm}
+
+### Condition ternaire
+
+Format : `EIF(expression1, expression2, expression3)`
+
+On évalue d'abord la première expression, qu'on compare à 0. S'il y a égalité, alors on saute vers un futur label où on évaluera la troisième expression (la partie `else`). Sinon, alors on évalue la deuxième expression, où on ajoute un saut vers la fin de la condition.
+
+Cette suite d'instruction simule `1 ? 5 : 7` :
+
+`MOVQ $1, %rax`{.asm}\newline
+`CMPQ $0, %rax`{.asm}\newline
+`JE .destjump1`{.asm}\newline
+`MOVQ $7, %rax`{.asm}\newline
+`JMP .destjump2`{.asm}\newline
+`.destjump1:`{.asm}\newline
+`MOVQ $5, %rax`{.asm}\newline
+`.destjump2:`{.asm}
+
+### Séquence d'expression
+
+Format : `ESEQ(expression list)`
+
+Cette expression se contente d'évaluer les sous-expressions et de mettre à jour l'environnement au besoin.
+
+## Instruction conditionnelle
+
+Format : `CIF(expression, code1, code2)`
+
+On procède de la même manière que pour les expressions ternaires, à la différence près qu'on compile des blocs de code au lieu d'évaluer des expressions.
+
+## Boucles
+
+Format : `CWHILE(expression, code)`
+
+On commence par créer un label en haut de la boucle. On en rajoutera un aussi en fin de boucle. On évalue ensuite l'expression, qu'on compare ensuite à `0`. Si la comparaison est concluante, alors on saute directement à la fin de la boucle. Juste avant la fin de boucle, on saute immédiatement en haut de la boucle.
+
+`.whileloop1:`{.asm}\newline
+`    MOVQ -8(%rbp), %rax`{.asm}\newline
+`    CMPQ $0, %rax`{.asm}\newline
+`    JE .endloop1`{.asm}\newline
+`    # code`{.asm}\newline
+`    JMP .whileloop1`{.asm}\newline
+`endloop1:`{.asm}
+
+## Valeurs de retour
+
+S'il n'y a pas de valeur de retour, alors on ne fait rien. La précédente valeur de `%rax`{.asm} servira de valeur de retour, en accord avec la sémantique qui autorise n'importe quelle valeur de retour si non précisée. Si non, alors on évalue la valeur de retour, qui sera directement dans `%rax`{.asm}. On ajoute ensuite les instructions `LEAVEQ`{.asm} et `RETQ{.asm}`, qui permettent de rétablir les précédentes valeurs de `%rsp`{.asm} et de `%rbp`{.asm} et de sauter à la nouvelle instruction. Il se peut qu'il y ait redondance avec les instructions ajoutées par la déclaration de la fonction, mais cela n'est pas un problème car ces instructions ne seront tout simplement jamais exécutées. Cela évite le problème d'absence d'instruction `return`{.C} dans le code `C`.
+
+# Optimisations possibles
+
+Certaines optimisations pourraient être réalisables, notamment celles qu'effectue `GCC` : on pourrait par exemple ne pas avoir à systématiquement affecter le contenu d'une variable dans `%rax`{.asm}, et utiliser directement l'adresse de la variable. Ce type d'optimisation nécessiterait néanmoins une meilleure maitrise de l'AST, quitte à le parcourir plusieurs fois, pour vérifier si certaines précautions sont nécessaires ou non.
+
+En espérant que ce compilateur vous sera d'une grande aide :)
+
+\newpage
+
+# Exemple de compilation
+
+## Code simple :
+
+`int main(int argc, char** argv) {`{.C}\newline
+`int i;`{.C}\newline
+`i = 0;`{.C}\newline
+`i = (i++ - --i) + 1 + i;`{.C}\newline
+`printf("Valeur de i = %d\n", i);`{.C}\newline
+`return i;`{.C}\newline
+`}`{.C}
+
+## Code assembleur généré :
+
+`.section	.text`{.asm}\newline
+`		.global main`{.asm}\newline
+`main:`{.asm}\newline
+`		ENTERQ		$32,		$0`{.asm}\newline
+`		MOVQ		%rdi,		-8(%rbp)	# argc`{.asm}\newline
+`		MOVQ		%rsi,		-16(%rbp)	# argv`{.asm}\newline
+`		MOVQ		$0,		%rax`{.asm}\newline
+`		MOVQ		%rax,		-24(%rbp)`{.asm}\newline
+`		MOVQ		-24(%rbp),	%rax		# i`{.asm}\newline
+`		PUSHQ		%rax`{.asm}\newline
+`		MOVQ		$1,		%rax`{.asm}\newline
+`		PUSHQ		%rax`{.asm}\newline
+`		DECQ		-24(%rbp)`{.asm}\newline
+`		MOVQ		-24(%rbp),	%rax		# i`{.asm}\newline
+`		PUSHQ		%rax`{.asm}\newline
+`		MOVQ		-24(%rbp),	%rax		# i`{.asm}\newline
+`		INCQ		-24(%rbp)`{.asm}\newline
+`		POPQ		%rbx`{.asm}\newline
+`		SUBQ		%rbx,		%rax`{.asm}\newline
+`		POPQ		%rbx`{.asm}\newline
+`		ADDQ		%rbx,		%rax`{.asm}\newline
+`		POPQ		%rbx`{.asm}\newline
+`		ADDQ		%rbx,		%rax`{.asm}\newline
+`		MOVQ		%rax,		-24(%rbp)`{.asm}\newline
+`		MOVQ		-24(%rbp),	%rax		# i`{.asm}\newline
+`		PUSHQ		%rax`{.asm}\newline
+`		MOVQ		$.str0,		%rax`{.asm}\newline
+`		PUSHQ		%rax`{.asm}\newline
+`		POPQ		%rdi`{.asm}\newline
+`		POPQ		%rsi`{.asm}\newline
+`		MOVQ		$0,		%rax`{.asm}\newline
+`		CALLQ		printf`{.asm}\newline
+`		CLTQ`{.asm}\newline
+`		MOVQ		-24(%rbp),	%rax		# i`{.asm}\newline
+`		LEAVEQ`{.asm}\newline
+`		RETQ`{.asm}\newline
+`.section	.data`{.asm}\newline
+`.str0:`{.asm}\newline
+`		.string		"Valeur de i = %d\n"`{.asm}\newline
+`		.text`{.asm}\newline
+
+### Sortie standard :
+
+`Valeur de i = 1\n`{.C}, code de sortie : `1`{.C}
+
+On peut bien sûr compiler des codes plus longs, mais l'assembleur généré ne tiendrait pas dans une page :)

clex.mll

@@ -0,0 +1,297 @@
+{
+
+(*
+ *	Copyright (c) 2005 by Laboratoire Spécification et Vérification (LSV),
+ *	UMR 8643 CNRS & ENS Cachan.
+ *	Written by Jean Goubault-Larrecq.  Derived from the csur project.
+ *
+ *	Permission is granted to anyone to use this software for any
+ *	purpose on any computer system, and to redistribute it freely,
+ *	subject to the following restrictions:
+ *
+ *	1. Neither the author nor its employer is responsible for the consequences of use of
+ *		this software, no matter how awful, even if they arise
+ *		from defects in it.
+ *
+ *	2. The origin of this software must not be misrepresented, either
+ *		by explicit claim or by omission.
+ *
+ *	3. Altered versions must be plainly marked as such, and must not
+ *		be misrepresented as being the original software.
+ *
+ *	4. This software is restricted to non-commercial use only.  Commercial
+ *		use is subject to a specific license, obtainable from LSV.
+ * 
+*)
+
+(* Analyse lexicale d'un sous-ensemble (tres) reduit de C.
+ *)
+
+open Cparse
+open Error
+open Ctab
+
+let string_buf = Buffer.create 256
+
+let string_iter f s = (* = String.iter; pas present en OCaml 2.04. *)
+	let n = String.length s
+	in for i=0 to n-1 do f (s.[i]) done
+
+let count yytext =
+	(oldcline := !cline; oldccol := !ccol;
+	string_iter (fun c -> match c with
+			'\n' -> (cline := !cline+1; ccol := 0)
+                      (* | '\t' -> (ccol := !ccol + 8 - (!ccol mod 8)) *)
+                      | _ -> ccol := !ccol+1) yytext)
+
+let parse_hex yytext tend =
+	let n = ref 0
+	in let len = String.length yytext-tend
+	in ((for i=2 to len-1 do
+	     let c = yytext.[i] in
+	     match c with
+	         '0'..'9' -> n := 16 * !n + (int_of_char c - int_of_char '0')
+               | 'a'..'f' -> n := 16 * !n + (int_of_char c + 10 - int_of_char 'a')
+               | 'A'..'F' -> n := 16 * !n + (int_of_char c + 10 - int_of_char 'A')
+	       | _ -> fatal (Some (!cfile, !cline, !ccol-len, !cline, !ccol))
+			("invalid hexadecimal number " ^ yytext)
+	     done);
+	    !n)
+
+let parse_oct yytext start tend =
+	let n = ref 0
+	in let len = String.length yytext-tend
+	in ((for i=start to len-1 do
+	     let c = yytext.[i] in
+	     match c with
+	         '0'..'7' -> n := 8 * !n + (int_of_char c - int_of_char '0')
+	       | _ -> fatal (Some (!cfile, !cline, !ccol-len, !cline, !ccol))
+			("invalid octal number " ^ yytext)
+	     done);
+	    !n)
+
+let parse_dec yytext tend =
+	let n = ref 0
+	in let len = String.length yytext-tend
+	in ((for i=0 to len-1 do
+	     let c = yytext.[i] in
+	     match c with
+	         '0'..'9' -> n := 10 * !n + (int_of_char c - int_of_char '0')
+	       | _ -> fatal (Some (!cfile, !cline, !ccol-len, !cline, !ccol))
+			("invalid number " ^ yytext)
+	    done);
+	    !n)
+
+}
+
+let digit  = ['0'-'9']
+let letter = ['a'-'z' 'A'-'Z' '_']
+let hex    = ['a'-'f' 'A'-'F' '0'-'9']
+let expo   = ['E' 'e'] ['+' '-']? digit+
+let fs     = ['f' 'F' 'l' 'L']
+let is     = ['u' 'U' 'l' 'L']*
+
+rule ctoken = parse
+    "/*" { count (Lexing.lexeme lexbuf); comment lexbuf; ctoken lexbuf }
+  | "//" { count (Lexing.lexeme lexbuf); inlcomment lexbuf; ctoken lexbuf }
+  | "auto" { count (Lexing.lexeme lexbuf); AUTO }
+  | "break" { count (Lexing.lexeme lexbuf); BREAK }
+  | "case" { count (Lexing.lexeme lexbuf); CASE }
+  | "char" { count (Lexing.lexeme lexbuf); CHAR }
+  | "const"  { count (Lexing.lexeme lexbuf); CONST }
+  | "continue" { count (Lexing.lexeme lexbuf); CONTINUE }
+  | "default" { count (Lexing.lexeme lexbuf); DEFAULT }
+  | "do" { count (Lexing.lexeme lexbuf); DO }
+  | "double" { count (Lexing.lexeme lexbuf); DOUBLE }
+  | "else" { count (Lexing.lexeme lexbuf); ELSE }
+  | "enum" { count (Lexing.lexeme lexbuf); ENUM }
+  | "extern" { count (Lexing.lexeme lexbuf); EXTERN }
+  | "float" { count (Lexing.lexeme lexbuf); FLOATING }
+  | "for" { count (Lexing.lexeme lexbuf); FOR }
+  | "goto" { count (Lexing.lexeme lexbuf); GOTO }
+  | "if" { count (Lexing.lexeme lexbuf); IF }
+  | "int" { count (Lexing.lexeme lexbuf); INTEGER }
+  | "long" { count (Lexing.lexeme lexbuf); LONG }
+  | "register" { count (Lexing.lexeme lexbuf); REGISTER }
+  | "return" { count (Lexing.lexeme lexbuf); RETURN }
+  | "short" { count (Lexing.lexeme lexbuf); SHORT }
+  | "signed" { count (Lexing.lexeme lexbuf); SIGNED }
+  | "sizeof" { count (Lexing.lexeme lexbuf); SIZEOF }
+  | "static" { count (Lexing.lexeme lexbuf); STATIC }
+  | "struct" { count (Lexing.lexeme lexbuf); STRUCT }
+  | "switch" { count (Lexing.lexeme lexbuf); SWITCH }
+  | "typedef" { count (Lexing.lexeme lexbuf); TYPEDEF }
+  | "union" { count (Lexing.lexeme lexbuf); UNION }
+  | "unsigned" { count (Lexing.lexeme lexbuf); UNSIGNED }
+  | "void" { count (Lexing.lexeme lexbuf); VOID }
+  | "volatile" { count (Lexing.lexeme lexbuf); VOLATILE }
+  | "while" { count (Lexing.lexeme lexbuf); WHILE }
+  | letter (letter | digit)* { count (Lexing.lexeme lexbuf);
+		let yytext = Lexing.lexeme lexbuf in
+		    IDENTIFIER yytext
+                    } 
+  | '0' ['x' 'X'] hex+ { count (Lexing.lexeme lexbuf);
+			CONSTANT (parse_hex (Lexing.lexeme lexbuf) 0) }
+  | '0' ['x' 'X'] hex+ ['u' 'U'] { count (Lexing.lexeme lexbuf);
+			CONSTANT (parse_hex (Lexing.lexeme lexbuf) 1) }
+  | '0' ['x' 'X'] hex+ ['l' 'L'] { count (Lexing.lexeme lexbuf);
+			CONSTANT (parse_hex (Lexing.lexeme lexbuf) 1) }
+  | '0' ['x' 'X'] hex+ ['u' 'U'] ['l' 'L'] { count (Lexing.lexeme lexbuf);
+			CONSTANT (parse_hex (Lexing.lexeme lexbuf) 2) }
+
+ | '0' ['x' 'X'] hex+ ['u' 'U'] ['l' 'L'] ['l' 'L'] { count (Lexing.lexeme lexbuf);
+			CONSTANT (parse_hex (Lexing.lexeme lexbuf) 3) }
+
+
+  | '0' ['0'-'7']+ { count (Lexing.lexeme lexbuf);
+			CONSTANT (parse_oct (Lexing.lexeme lexbuf) 1 0) }
+  | '0' ['0'-'7']+ ['u' 'U'] { count (Lexing.lexeme lexbuf);
+			CONSTANT (parse_oct (Lexing.lexeme lexbuf) 1 1) }
+  | '0' ['0'-'7']+ ['l' 'L'] { count (Lexing.lexeme lexbuf);
+			CONSTANT (parse_oct (Lexing.lexeme lexbuf) 1 1) }
+
+  | '0' ['0'-'7']+ ['u' 'U'] ['l' 'L'] { count (Lexing.lexeme lexbuf);
+			CONSTANT (parse_oct (Lexing.lexeme lexbuf) 1 2) }
+
+  | '0' ['0'-'7']+ ['u' 'U'] ['l' 'L'] ['l' 'L'] { count (Lexing.lexeme lexbuf);
+			CONSTANT (parse_oct (Lexing.lexeme lexbuf) 1 3) }
+
+  | digit+ { count (Lexing.lexeme lexbuf);
+			CONSTANT (parse_dec (Lexing.lexeme lexbuf) 0) }
+  | digit+ ['u' 'U'] { count (Lexing.lexeme lexbuf);
+			CONSTANT (parse_dec (Lexing.lexeme lexbuf) 1) }
+  | digit+ ['l' 'L'] { count (Lexing.lexeme lexbuf);
+			CONSTANT (parse_dec (Lexing.lexeme lexbuf) 1) }
+
+  | digit+ ['l' 'L' ] ['l' 'L' ] { count (Lexing.lexeme lexbuf);
+			CONSTANT (parse_dec (Lexing.lexeme lexbuf) 1) }
+
+  | digit+ ['u' 'U'] ['l' 'L'] { count (Lexing.lexeme lexbuf);
+			CONSTANT (parse_dec (Lexing.lexeme lexbuf) 2) }
+
+  | digit+ ['u' 'U'] ['l' 'L'] ['l' 'L'] { count (Lexing.lexeme lexbuf);
+			CONSTANT (parse_dec (Lexing.lexeme lexbuf) 3) }
+
+  | '\'' [^ '\'' '\\'] '\'' { count (Lexing.lexeme lexbuf);
+			CONSTANT (int_of_char (Lexing.lexeme_char lexbuf 1)) }
+  | '\'' '\\' ['0'-'7'] ['0'-'7']? ['0'-'7']? '\'' { count (Lexing.lexeme lexbuf);
+			CONSTANT (parse_oct (Lexing.lexeme lexbuf) 2 1) }
+  | '\'' '\\' 'a' '\'' { count (Lexing.lexeme lexbuf);
+			CONSTANT 7 (* bell, ^G *) }
+  | '\'' '\\' 'b' '\'' { count (Lexing.lexeme lexbuf);
+			CONSTANT (int_of_char '\b') }
+  | '\'' '\\' 'f' '\'' { count (Lexing.lexeme lexbuf);
+			CONSTANT 12 (* form feed, ^L *) }
+  | '\'' '\\' 'n' '\'' { count (Lexing.lexeme lexbuf);
+			CONSTANT (int_of_char '\n') }
+  | '\'' '\\' 'r' '\'' { count (Lexing.lexeme lexbuf);
+			CONSTANT (int_of_char '\r') }
+  | '\'' '\\' 't' '\'' { count (Lexing.lexeme lexbuf);
+			CONSTANT (int_of_char '\t')
+				 (* bell, ^G *) }
+  | '\'' '\\' 'v' '\'' { count (Lexing.lexeme lexbuf);
+			CONSTANT 11 (* vertical tab, ^K *) }
+  | '\'' '\\' _ '\'' { count (Lexing.lexeme lexbuf);
+			CONSTANT (int_of_char (Lexing.lexeme_char lexbuf 2)) }
+  | "\"" 
+      { 
+        count (Lexing.lexeme lexbuf); Buffer.reset string_buf;
+        string lexbuf;
+	STRING_LITERAL (Buffer.contents string_buf)
+      }
+  | "..." { count (Lexing.lexeme lexbuf); ELLIPSIS }
+  | ">>=" { count (Lexing.lexeme lexbuf); RIGHT_ASSIGN }
+  | "<<=" { count (Lexing.lexeme lexbuf); LEFT_ASSIGN }
+  | "+="  { count (Lexing.lexeme lexbuf); ADD_ASSIGN }
+  | "-="  { count (Lexing.lexeme lexbuf); SUB_ASSIGN }
+  | "*="  { count (Lexing.lexeme lexbuf); MUL_ASSIGN }
+  | "/="  { count (Lexing.lexeme lexbuf); DIV_ASSIGN }
+  | "%="  { count (Lexing.lexeme lexbuf); MOD_ASSIGN }
+  | "&="  { count (Lexing.lexeme lexbuf); AND_ASSIGN }
+  | "^="  { count (Lexing.lexeme lexbuf); XOR_ASSIGN }
+  | "|="  { count (Lexing.lexeme lexbuf); OR_ASSIGN }
+  | ">>"  { count (Lexing.lexeme lexbuf); RIGHT_OP }
+  | "<<"  { count (Lexing.lexeme lexbuf); LEFT_OP }
+  | "++"  { count (Lexing.lexeme lexbuf); INC_OP }
+  | "--"  { count (Lexing.lexeme lexbuf); DEC_OP }
+  | "->"  { count (Lexing.lexeme lexbuf); PTR_OP }
+  | "&&"  { count (Lexing.lexeme lexbuf); AND_OP }
+  | "||"  { count (Lexing.lexeme lexbuf); OR_OP }
+  | "<="  { count (Lexing.lexeme lexbuf); LE_OP }
+  | ">="  { count (Lexing.lexeme lexbuf); GE_OP }
+  | "=="  { count (Lexing.lexeme lexbuf); EQ_OP }
+  | "!="  { count (Lexing.lexeme lexbuf); NE_OP }
+  | ";"   { count (Lexing.lexeme lexbuf); SEMI_CHR }
+  | ("{" | "<%") { count (Lexing.lexeme lexbuf); OPEN_BRACE_CHR }
+  | ("}" | "%>") { count (Lexing.lexeme lexbuf); CLOSE_BRACE_CHR }
+  | "," { count (Lexing.lexeme lexbuf); COMMA_CHR }
+  | ":" { count (Lexing.lexeme lexbuf); COLON_CHR }
+  | "=" { count (Lexing.lexeme lexbuf); EQ_CHR }
+  | "(" { count (Lexing.lexeme lexbuf); OPEN_PAREN_CHR }
+  | ")" { count (Lexing.lexeme lexbuf); CLOSE_PAREN_CHR }
+  | ("[" | "<:") { count (Lexing.lexeme lexbuf); OPEN_BRACKET_CHR }
+  | ("]" | ":>") { count (Lexing.lexeme lexbuf); CLOSE_BRACKET_CHR }
+  | "." { count (Lexing.lexeme lexbuf); DOT_CHR }
+  | "&" { count (Lexing.lexeme lexbuf); AND_CHR }
+  | "|" { count (Lexing.lexeme lexbuf); OR_CHR }
+  | "^" { count (Lexing.lexeme lexbuf); XOR_CHR }
+  | "!" { count (Lexing.lexeme lexbuf); BANG_CHR }
+  | "~" { count (Lexing.lexeme lexbuf); TILDE_CHR }
+  | "+" { count (Lexing.lexeme lexbuf); ADD_CHR }
+  | "-" { count (Lexing.lexeme lexbuf); SUB_CHR }
+  | "*" { count (Lexing.lexeme lexbuf); STAR_CHR }
+  | "/" { count (Lexing.lexeme lexbuf); DIV_CHR }
+  | "%" { count (Lexing.lexeme lexbuf); MOD_CHR }
+  | "<" { count (Lexing.lexeme lexbuf); OPEN_ANGLE_CHR }
+  | ">" { count (Lexing.lexeme lexbuf); CLOSE_ANGLE_CHR }
+  | "?" { count (Lexing.lexeme lexbuf); QUES_CHR }
+  | '#' { count (Lexing.lexeme lexbuf); line lexbuf }
+  | [' ' '\t' '\012' '\013' '\n' '\014']+ { count (Lexing.lexeme lexbuf); ctoken lexbuf }
+  | _ { fatal (Some (!cfile, !cline, !ccol, !cline, !ccol+1))
+	 ("bad character '" ^ (Lexing.lexeme lexbuf) ^ "'") }
+  | eof { EOF }
+and comment = parse
+    "*/" { count (Lexing.lexeme lexbuf) }
+  | [^ '*']* { count (Lexing.lexeme lexbuf); comment lexbuf }
+  | eof { fatal (Some (!cfile, !cline, !ccol, !cline, !ccol)) "end of file reached inside comment" }
+and inlcomment = parse
+    "\n" { count (Lexing.lexeme lexbuf) }
+  | [^ '\n']* { count (Lexing.lexeme lexbuf); inlcomment lexbuf }
+and string = parse
+    '"' { () }
+  | '\n'+ { string lexbuf }
+  | '\\' ['0'-'7'] ['0'-'7']? ['0'-'7']? { Buffer.add_char string_buf (Char.chr (parse_oct (Lexing.lexeme lexbuf) 1 0)); string lexbuf }
+  | '\\' 'a' { Buffer.add_char string_buf '\007'; string lexbuf }
+  | '\\' 'b' { Buffer.add_char string_buf '\b'; string lexbuf }
+  | '\\' 'f' { Buffer.add_char string_buf '\014'; string lexbuf }
+  | '\\' 'n' { Buffer.add_char string_buf '\n'; string lexbuf }
+  | '\\' 'r' { Buffer.add_char string_buf '\r'; string lexbuf }
+  | '\\' 't' { Buffer.add_char string_buf '\t'; string lexbuf }
+  | '\\' 'v' { Buffer.add_char string_buf '\013'; string lexbuf }
+  | '\\' _ { Buffer.add_char string_buf (Lexing.lexeme_char lexbuf 1); string lexbuf }
+  | [^ '\\' '\n' '"']+ { Buffer.add_string string_buf (Lexing.lexeme lexbuf); string lexbuf }
+  | _ { Buffer.add_char string_buf (Lexing.lexeme_char lexbuf 0); string lexbuf }
+  | eof { fatal (Some (!cfile, !cline, !ccol, !cline, !ccol)) "end of file reached inside string literal" }
+and line = parse
+    ['0'-'9']+ { cline := parse_dec (Lexing.lexeme lexbuf) 0 - 1; line2 lexbuf }
+  | [' ' '\t']+ { count (Lexing.lexeme lexbuf); line lexbuf }
+  | '\n' { count (Lexing.lexeme lexbuf); ctoken lexbuf }
+  | "\"" { count (Lexing.lexeme lexbuf); Buffer.reset string_buf;
+        string lexbuf;
+	cfile := Buffer.contents string_buf;
+	ctoken lexbuf
+      }
+  | eof { fatal (Some (!cfile, !cline, !ccol, !cline, !ccol)) "end of file reached inside # directive" }
+and line2 = parse
+    [' ' '\t']+ { count (Lexing.lexeme lexbuf); line2 lexbuf }
+  | '\n' { count (Lexing.lexeme lexbuf); ctoken lexbuf }
+  | "\"" { count (Lexing.lexeme lexbuf); Buffer.reset string_buf;
+        string lexbuf;
+	cfile := Buffer.contents string_buf;
+	line3 lexbuf
+      }
+  | eof { fatal (Some (!cfile, !cline, !ccol, !cline, !ccol)) "end of file reached inside # directive" }
+and line3 = parse
+    '\n' { count (Lexing.lexeme lexbuf); ctoken lexbuf }
+  |  _ { count (Lexing.lexeme lexbuf); line3 lexbuf }
+  | eof  { fatal (Some (!cfile, !cline, !ccol, !cline, !ccol)) "end of file reached inside # directive" }

compile.ml

@@ -0,0 +1,399 @@
+open Cparse
+open Genlab
+
+let number_str s strings =
+    let rec aux n l = match l with
+    | [] -> n, [s]
+    | s' :: l' when s' = s -> n, l
+    | s' :: l' -> let n', l = aux (n + 1) l' in n', s' :: l
+    in aux 0 strings;;
+    
+
+(* Un dictionnaire est soit vide, soit un couple (clé, valeur) suivi de la suite du dictionnaire *)
+type ('a, 'b) dict = NIL | D of 'a * 'b * ('a, 'b) dict;; 
+
+let new_dict = NIL;;
+
+type env = Env of int * string list * string list * bool * bool * int * (string, int) dict * string list;; (* jumpcount, strings, string count, global variables, declaring parameters, in_function, variables dictionary, functions that return a 64bit output *)
+
+(* On recherche si une clé est présente dans le dictionnaire. Renvoie un booléen. *)
+let rec contains d key = match d with
+    | NIL -> false
+    | D(k, _, _) when k = key -> true
+    | D(_, _, d') -> contains d' key;;
+
+(* On récupère, si elle existe, la valeur associée à une clé dans un dictionnaire. Si ce n'est pas possible, on renvoie une erreur. Cas d'erreur : utilisation d'une variable locale non déclarée. *)
+let rec search d key = match d with
+    | NIL -> failwith ("Var " ^ key ^ " not found") 
+    | D(k, v, _) when k = key -> v
+    | D(_, _, d') -> search d' key;;
+
+(* On ajoute un couple (clé, valeur) dans un dictionnaire, et si la clé existe déjà, on se contente de remplacer la valeur. *)
+let rec append d key value = match d with
+    | NIL -> D(key, value, NIL)
+    | D(k, v, d') when k = key -> D(key, value, d')
+    | D(k, v, d') -> D(k, v, (append d' key value));;
+
+(* Tableau des registres d'arguments utiles lors d'un appel de fonction, trié dans l'ordre. *)
+let args = [|"%rdi"; "%rsi"; "%rdx"; "%rcx"; "%r8"; "%r9"|];;
+
+(* Tableau des fonctions systèmes disposant d'un retour sur 64 bits. *)
+let system_funs_64 = [|"malloc"; "calloc"; "realloc"; "exit"; "fopen"|];;
+
+(* Récupère le nom en assembleur d'une variable. Si la variable est déclarée, alors on renvoie -8n(%rbp) où n est le numéro de la variable, sinon on renvoie s(%rip) où s est le nom de la variable, en supposant que s est une variable globale préalablement déclarée (peut être une variable sytème comme stdout ou stderr *)
+let get_name_var vars key =
+    if contains vars key then (string_of_int (8 * (search vars key)) ^ "(%rbp)") else key ^ "(%rip)";;
+
+(* Écris le code assembleur d'une fonction. Se référer au README pour plus de détails. *)
+let compile out decl_list =
+    Printf.fprintf out ".section\t.text\n\t\t.global main\n\n";
+	(* Évalue une expression dans un certain environement. Le résultat de l'évaluation est placé dans %rax. On renvoie le nouvel environnement. *)
+    let rec evaluate e env = match env with Env(loopcount, strings, globals, decl_params, in_function, var_count, vars, funs) -> match e with
+    | VAR(s) -> begin
+                    Printf.fprintf out "\t\tMOVQ\t\t%s,\t%%rax\t\t# %s\n" (get_name_var vars s) s;
+                    env
+                end
+    | CST(i) -> begin
+                    Printf.fprintf out "\t\tMOVQ\t\t$%d,\t\t%%rax\n" i;
+                    env
+                end
+    | STRING(s) -> begin
+                       let n, l = number_str s strings in
+                       Printf.fprintf out "\t\tMOVQ\t\t$.str%d,\t\t%%rax\n" n;
+                       Env(loopcount, l, globals, decl_params, in_function, var_count, vars, funs)
+                   end;
+    | SET_VAR(s, e) -> begin
+                         let new_env = evaluate (e_of_expr e) env in
+                         Printf.fprintf out "\t\tMOVQ\t\t%%rax,\t\t%s\n" (get_name_var vars s);
+                         new_env
+                       end
+    | SET_ARRAY(s, e1, e2) -> begin
+                                let new_env = evaluate (e_of_expr e1) env in
+                                Printf.fprintf out "\t\tPUSHQ\t\t%%rax\n";
+                                let new_new_env = evaluate (e_of_expr e2) new_env in
+                                Printf.fprintf out "\t\tPOPQ\t\t%%rbx\n";
+                                Printf.fprintf out "\t\tMOVQ\t\t%s,\t%%rdx\n" (get_name_var vars s);
+                                Printf.fprintf out "\t\tLEAQ\t\t0(, %%rbx, 8),\t%%rbx\n";
+                                Printf.fprintf out "\t\tADDQ\t\t%%rbx,\t\t%%rdx\n";
+                                Printf.fprintf out "\t\tMOVQ\t\t%%rax,\t\t(%%rdx)\n";
+                                new_new_env
+                              end
+    | CALL(s, l) -> begin
+                      let rec empile_args env i = function
+                      | [] -> env
+                      | e :: l' -> begin
+                                     let new_env = empile_args env (i + 1) l' in
+                                     let new_new_env = evaluate (e_of_expr e) new_env in
+                                     Printf.fprintf out "\t\tPUSHQ\t\t%%rax\n";
+                                     new_new_env
+                                   end
+                      in let rec depile_args env i = function
+                      | [] -> env
+                      | e :: l' -> if i >= 6 then env else begin
+                                       Printf.fprintf out "\t\tPOPQ\t\t%s\n" args.(i);
+                                       depile_args env (i + 1) l'
+                                   end
+                      in let newenv = empile_args env 0 l in
+                      let new_env = depile_args newenv 0 l in
+                      Printf.fprintf out "\t\tMOVQ\t\t$0,\t\t%%rax\n";
+                      Printf.fprintf out "\t\tCALLQ\t\t%s\n" s;
+                      for i = 0 to (List.length l) - 7 do
+                          Printf.fprintf out "\t\tPOPQ\t\t%%rbx\n";
+                      done;
+                      if not (List.mem s funs) then
+                          Printf.fprintf out "\t\tCLTQ\n";
+                      new_env
+                    end
+    | OP1(mop, e) -> (match mop with
+                     | M_MINUS -> begin
+                                      let new_env = evaluate (e_of_expr e) env in
+                                      Printf.fprintf out "\t\tNEGQ\t\t%%rax\n";
+                                      new_env
+                                  end
+                     | M_NOT -> begin
+                                    let new_env = evaluate (e_of_expr e) env in
+                                    Printf.fprintf out "\t\tNOTQ\t\t%%rax\n";
+                                    new_env 
+                                end
+                     | M_POST_INC -> begin
+                                       let new_env = evaluate (e_of_expr e) env in
+                                       (match (e_of_expr e) with
+                                       | VAR(s) -> begin
+                                                       Printf.fprintf out "\t\tINCQ\t\t%s\n" (get_name_var vars s);
+                                                       new_env
+                                                   end
+                                       | OP2(S_INDEX, e1, e2) -> (match (e_of_expr e1) with
+                                                                 | VAR(s) -> begin
+                                                                               Printf.fprintf out "\t\tPUSHQ\t\t%%rax\n";
+                                                                               let new_new_env = evaluate (e_of_expr e2) env in
+                                                                               Printf.fprintf out "\t\tMOVQ\t\t%s,\t%%rdx\n" (get_name_var vars s);
+                                                                               Printf.fprintf out "\t\tLEAQ\t\t0(, %%rax, 8),\t%%rax\n";
+                                                                               Printf.fprintf out "\t\tADDQ\t\t%%rax,\t\t%%rdx\n";
+                                                                               Printf.fprintf out "\t\tINCQ\t\t(%%rdx)\n";
+                                                                               Printf.fprintf out "\t\tPOPQ\t\t%%rax\n";
+                                                                               new_new_env
+                                                                             end
+                                                                 | _ -> new_env)
+                                       | _ -> new_env)
+                                     end
+                     | M_POST_DEC -> begin
+                                         let new_env = evaluate (e_of_expr e) env in
+                                         match (e_of_expr e) with
+                                         | VAR(s) -> begin
+                                                         Printf.fprintf out "\t\tDECQ\t\t%s\n" (get_name_var vars s);
+                                                         new_env
+                                                     end
+                                         | OP2(S_INDEX, e1, e2) -> (match (e_of_expr e1) with
+                                                                   | VAR(s) -> begin
+                                                                                 Printf.fprintf out "\t\tPUSHQ\t\t%%rax\n";
+                                                                                 let new_new_env = evaluate (e_of_expr e2) env in
+                                                                                 Printf.fprintf out "\t\tMOVQ\t\t%s,\t%%rdx\n" (get_name_var vars s);
+                                                                                 Printf.fprintf out "\t\tLEAQ\t\t0(, %%rax, 8),\t%%rax\n";
+                                                                                 Printf.fprintf out "\t\tADDQ\t\t%%rax,\t\t%%rdx\n";
+                                                                                 Printf.fprintf out "\t\tDECQ\t\t(%%rdx)\n";
+                                                                                 Printf.fprintf out "\t\tPOPQ\t\t%%rax\n";
+                                                                                 new_new_env
+                                                                               end
+                                                                   | _ -> new_env)
+                                         | _ -> new_env
+                                     end
+                     | M_PRE_INC -> begin
+                                        let new_env = (match (e_of_expr e) with
+                                        | VAR(s) -> begin
+                                                        Printf.fprintf out "\t\tINCQ\t\t%s\n" (get_name_var vars s);
+                                                        env
+                                                      end
+                                        | OP2(S_INDEX, e1, e2) -> (match (e_of_expr e1) with
+                                                                 | VAR(s) -> begin
+                                                                                let new_new_env = evaluate (e_of_expr e2) env in
+                                                                                Printf.fprintf out "\t\tMOVQ\t\t%s,\t%%rdx\n" (get_name_var vars s);
+                                                                                Printf.fprintf out "\t\tLEAQ\t\t0(, %%rax, 8),\t%%rax\n";
+                                                                                Printf.fprintf out "\t\tADDQ\t\t%%rax,\t\t%%rdx\n";
+                                                                                Printf.fprintf out "\t\tINCQ\t\t(%%rdx)\n";
+                                                                                Printf.fprintf out "\t\tMOVQ\t\t(%%rdx),\t\t%%rax\n";
+                                                                                new_new_env
+                                                                             end
+                                                                 | _ -> env);
+                                        | _ -> env) in
+                                        evaluate (e_of_expr e) new_env
+                                      end
+                     | M_PRE_DEC -> begin
+                                        let new_env = (match (e_of_expr e) with
+                                        | VAR(s) -> begin
+                                                        Printf.fprintf out "\t\tDECQ\t\t%s\n" (get_name_var vars s);
+                                                        env
+                                                    end
+                                        | OP2(S_INDEX, e1, e2) -> (match (e_of_expr e1) with
+                                                                 | VAR(s) -> begin
+                                                                                 let new_new_env = evaluate (e_of_expr e2) env in
+                                                                                 Printf.fprintf out "\t\tMOVQ\t\t%s,\t%%rdx\n" (get_name_var vars s);
+                                                                                 Printf.fprintf out "\t\tLEAQ\t\t0(, %%rax, 8),\t%%rax\n";
+                                                                                 Printf.fprintf out "\t\tADDQ\t\t%%rax,\t\t%%rdx\n";
+                                                                                 Printf.fprintf out "\t\tDECQ\t\t(%%rdx)\n";
+                                                                                 Printf.fprintf out "\t\tMOVQ\t\t(%%rdx),\t\t%%rax\n";
+                                                                                 new_new_env
+                                                                             end
+                                                                 | _ -> env);
+                                        | _ -> env) in
+                                        evaluate (e_of_expr e) new_env
+                                    end)
+    | OP2(bop, e1, e2) -> begin
+                            let new_env = evaluate (e_of_expr e2) env in
+                            Printf.fprintf out "\t\tPUSHQ\t\t%%rax\n";
+                            let new_new_env = evaluate (e_of_expr e1) new_env in match new_new_env with Env(loopcount, strings, _, _, _, _, _, _) -> 
+                            Printf.fprintf out "\t\tPOPQ\t\t%%rbx\n";
+                            (match bop with
+                            | S_MUL -> begin
+                                           Printf.fprintf out "\t\tIMULQ\t\t%%rbx,\t\t%%rax\n";
+                                           new_new_env
+                                       end
+                            | S_DIV -> begin
+                                           Printf.fprintf out "\t\tCQO\n";
+                                           Printf.fprintf out "\t\tIDIVQ\t\t%%rbx\n";
+                                           Printf.fprintf out "\t\tMOVQ\t\t$0,\t\t%%rdx\n";
+                                           Env(loopcount + 2, strings, globals, decl_params, in_function, var_count, vars, funs)
+                                       end
+                            | S_MOD -> begin
+                                           Printf.fprintf out "\t\tCQO\n";
+                                           Printf.fprintf out "\t\tIDIVQ\t\t%%rbx\n";
+                                           Printf.fprintf out "\t\tMOVQ\t\t%%rdx,\t\t%%rax\n";
+                                           Printf.fprintf out "\t\tMOVQ\t\t$0,\t\t%%rdx\n";
+                                           Env(loopcount + 2, strings, globals, decl_params, in_function, var_count, vars, funs)
+                                       end
+                            | S_ADD -> begin
+                                           Printf.fprintf out "\t\tADDQ\t\t%%rbx,\t\t%%rax\n";
+                                           new_new_env
+                                       end
+                            | S_SUB -> begin
+                                           Printf.fprintf out "\t\tSUBQ\t\t%%rbx,\t\t%%rax\n";
+                                           new_new_env
+                                       end
+                            | S_INDEX -> begin
+                                             Printf.fprintf out "\t\tLEAQ\t\t0(,%%rbx,8),\t%%rbx\n";
+                                             Printf.fprintf out "\t\tADDQ\t\t%%rbx,\t\t%%rax\n";
+                                             Printf.fprintf out "\t\tMOVQ\t\t(%%rax),\t\t%%rax\n";
+                                             new_new_env
+                                         end)
+                        end
+    | CMP(cop, e1, e2) -> begin
+                            let new_env = evaluate (e_of_expr e1) env in
+                            Printf.fprintf out "\t\tPUSHQ\t\t%%rax\n";
+                            let new_new_env = evaluate (e_of_expr e2) new_env in match new_new_env with Env(loopcount, strings, _, _, _, _, _, _) ->
+                            Printf.fprintf out "\t\tPOPQ\t\t%%rbx\n";
+                            Printf.fprintf out "\t\tCMPQ\t\t%%rax,\t\t%%rbx\n";
+                            (match cop with
+                             | C_LT -> Printf.fprintf out "\t\tJL\t\t";
+                             | C_LE -> Printf.fprintf out "\t\tJLE\t\t";
+                             | C_EQ -> Printf.fprintf out "\t\tJE\t\t";);
+                            Printf.fprintf out ".destjump%d\n" (loopcount + 1);
+                            Printf.fprintf out "\t\tMOVQ\t\t$0,\t\t%%rax\n";
+                            Printf.fprintf out "\t\tJMP\t\t.destjump%d\n" (loopcount + 2);
+                            Printf.fprintf out "\t.destjump%d:\n" (loopcount + 1);
+                            Printf.fprintf out "\t\tMOVQ\t\t$1,\t\t%%rax\n";
+                            Printf.fprintf out "\t.destjump%d:\n" (loopcount + 2);
+                            Env(loopcount + 2, strings, globals, decl_params, in_function, var_count, vars, funs)
+                          end
+    | EIF(e1, e2, e3) -> begin
+                           let new_env = evaluate (e_of_expr e1) env in match new_env with Env(loopcount, strings, _, _, _, _, _, _) ->
+                           Printf.fprintf out "\t\tCMPQ\t\t$0,\t\t%%rax\n";
+                           let x = (loopcount + 1) in
+                           Printf.fprintf out "\t\tJE\t\t.destjump%d\n" x;
+                           let new_new_env = evaluate (e_of_expr e2) (Env(loopcount + 1, strings, globals, decl_params, in_function, var_count, vars, funs)) in match new_new_env with Env(loopcount2, strings2, _, _, _, _, _, _) ->
+                           let y = (loopcount2 + 1) in
+                           Printf.fprintf out "\t\tJMP\t\t.destjump%d\n" y;
+                           Printf.fprintf out "\t.destjump%d:\n" x;
+                           let new_new_env = evaluate (e_of_expr e3) (Env(loopcount2 + 1, strings2, globals, decl_params, in_function, var_count, vars, funs)) in
+                           Printf.fprintf out "\t.destjump%d:\n" y;
+                           new_new_env
+                         end
+    | ESEQ(l) -> begin
+                     let rec aux env l = match l with
+                     | [] -> env
+                     | e :: l' -> aux (evaluate (e_of_expr e) env) l'
+                     in aux env l
+                 end
+	(* Déclare une liste de variables ou de fonctions, en mettant bien à jour l'environnement. *)
+    in let rec compile_decl_list env = function 
+        | [] -> env
+        | h :: t -> let new_env = compile_decl env h in compile_decl_list new_env t
+	(* Compte la place nécessaire pour les variables au sein d'un bloc de code. *)
+    and count_vars (_, c) = match c with
+        | CBLOCK(vdl, lcl) -> let vars = (List.length vdl) in
+                              let rec aux lcl = match lcl with
+                              | [] -> 0, 0
+                              | c :: l -> let v, p = count_vars c in let v2, p2 = aux l in (v + v2), (max p p2)
+                              in let v, p = aux lcl in (v + vars), p
+        | CIF(_, c1, c2) -> let i1, j1 = (count_vars c1) in let i2, j2 = (count_vars c2) in (max i1 i2), (max j1 j2)
+        | CEXPR(_) -> 0, 0
+        | CWHILE(_, c) -> count_vars c
+        | CRETURN(_) -> 0, 0
+	(* Déclare une variable locale en distingant si c'est un paramètre ou non, ou une fonction. *)
+    and compile_decl env decl = match env with Env(loopcount, strings, globals, decl_params, in_function, var_count, vars, funs) -> match decl with 
+        | CDECL(l, s) -> begin
+                             if decl_params then begin
+                                 if var_count < 6 then begin
+                                     Printf.fprintf out "\t\tMOVQ\t\t%s,\t\t%d(%%rbp)\t# %s\n" args.(var_count) (-8 * (var_count + 1)) s;
+                                     Env(loopcount, strings, globals, decl_params, in_function, var_count + 1, (append vars s (-(var_count + 1))), funs)
+                                 end
+                                 else begin
+                                     Printf.fprintf out "\t\tMOVQ\t\t%d(%%rbp),\t%%rax\n" (8 * (var_count - 4));
+                                     Printf.fprintf out "\t\tMOVQ\t\t%%rax,\t\t%d(%%rbp)\t# %s\n" (-8 * (var_count + 1)) s;
+                                     Env(loopcount, strings, globals, decl_params, in_function, var_count + 1, (append vars s (-(var_count + 1))), funs)
+                                 end   
+                             end
+                             else begin
+                                 if in_function then begin
+                                     Env(loopcount, strings, globals, decl_params, in_function, var_count + 1, (append vars s (-(var_count + 1))), funs)
+                                 end
+                                 else begin
+                                     Env(loopcount, strings, (s :: globals), decl_params, in_function, var_count, vars, funs)
+                                 end
+                             end
+                         end
+        | CFUN (l, s, vdl, lc) -> begin
+                                      Printf.fprintf out "\n%s:\n" s;
+                                      let nb_decl = List.length vdl in
+                                      let total_vars, max_params = count_vars lc in
+                                      let size = total_vars + nb_decl + max_params in
+                                      let real_size = size + (size mod 2) in
+                                      Printf.fprintf out "\t\tENTERQ\t\t$%d,\t\t$0\n" (8 * real_size);
+                                      let new_env = compile_decl_list (Env(loopcount, strings, globals, true, true, 0, new_dict, funs)) vdl in match new_env with Env(_, _, _, _, _, var_count, vars, _) ->
+                                      let new_new_env = compile_code lc (Env(loopcount, strings, globals, false, true, var_count, vars, funs)) in match new_new_env with Env(loopcount2, strings2, globals2, _,  _, var_count2, vars2, _) ->
+                                      Printf.fprintf out "\t\tLEAVEQ\n";
+                                      Printf.fprintf out "\t\tRETQ\n";
+                                      Env(loopcount2, strings2, globals2, false, false, var_count2, vars2, funs)
+                                  end
+	(* Écris le code assembleur d'un bout de code. *)
+    and compile_code (_, c) env = match env with Env(loopcount, strings, globals, decl_params, in_function, var_count, vars, funs) -> match c with
+        | CBLOCK(vdl, lcl) -> begin
+                                  let new_env = compile_decl_list env vdl in
+                                  let rec aux lcl env = match lcl with
+                                  | [] -> env
+                                  | c :: l -> let new_env = (compile_code c env) in aux l new_env
+                                  in let new_env = aux lcl new_env in match new_env with Env(loopcount2, strings2, globals2, _, _, _, _, _) ->
+                                  Env(loopcount2, strings2, globals2, decl_params, in_function, var_count, vars, funs)
+                              end
+        | CEXPR(expr) -> begin
+                             evaluate (e_of_expr expr) env
+                         end
+        | CIF(expr, c1, c2) -> begin
+                                 let new_env = evaluate (e_of_expr expr) env in
+                                 match new_env with Env(loopcount2, strings2, _, _, _, _, _, _) ->
+                                 let x = (loopcount2 + 1) in
+                                 Printf.fprintf out "\t\tCMPQ\t\t$0,\t\t%%rax\n";
+                                 Printf.fprintf out "\t\tJE\t\t.destjump%d\n" x;
+                                 let new_new_env = compile_code c1 (Env(loopcount2 + 1, strings2, globals, decl_params, in_function, var_count, vars, funs)) in
+                                 match new_new_env with Env(loopcount3, strings3, _, _, _, _, _, _) ->
+                                 let y = (loopcount3 + 1) in
+                                 Printf.fprintf out "\t\tJMP\t\t.destjump%d\n" y;
+                                 Printf.fprintf out "\t.destjump%d:\n" x;
+                                 let new_new_new_env = compile_code c2 (Env(loopcount3 + 1, strings3, globals, decl_params, in_function, var_count, vars, funs)) in
+                                 Printf.fprintf out "\t.destjump%d:\n" y;
+                                 new_new_new_env
+                               end
+        | CWHILE(expr, c) -> begin
+                              let x = (loopcount + 1) in
+                              Printf.fprintf out "\t.whileloop%d:\n" x;
+                              let new_env = evaluate (e_of_expr expr) (Env(loopcount + 1, strings, globals, decl_params, in_function, var_count, vars, funs)) in
+                              Printf.fprintf out "\t\tCMPQ\t\t$0,\t\t%%rax\n";
+                              Printf.fprintf out "\t\tJE\t\t.endloop%d\n" x;
+                              let new_new_env = compile_code c new_env in
+                              Printf.fprintf out "\t\tJMP\t\t.whileloop%d\n" x;
+                              Printf.fprintf out "\t.endloop%d:\n" x;
+                              new_new_env
+                          end
+        | CRETURN(o) -> begin
+                          let new_env = match o with
+                          | Some(e) -> evaluate (e_of_expr e) env
+                          | None -> env
+                          in Printf.fprintf out "\t\tLEAVEQ\n";
+                          Printf.fprintf out "\t\tRETQ\n";
+                          new_env
+                        end
+	(* Récupère la liste des fonctions déclarées, afin de gérer quelles fonctions renvoient un entier sur 64 bits ou 32 bits. *)
+    in let rec get_functions = function
+    | [] -> []
+    | CFUN(_, s, _, _) :: l -> s :: get_functions l
+    | _ :: l -> get_functions l
+	(* Compile le code. *)
+    in let final_env = compile_decl_list (Env(0, [], [], false, false, 0, new_dict, (Array.to_list system_funs_64) @ (get_functions decl_list))) decl_list in match final_env with Env(_, strings, globals, _, _, _, _, _) ->
+	(* Déclare les chaînes de caractères présentes. *)
+    Printf.fprintf out "\n.section\t.data\n";
+    let rec add_string_globals n = function
+    | [] -> ();
+    | s :: l' -> begin
+                     Printf.fprintf out ".str%d:\n" n;
+                     Printf.fprintf out "\t\t.string\t\t\"%s\"\n" (String.escaped s);
+                     Printf.fprintf out "\t\t.text\n";
+                     add_string_globals (n + 1) l';
+                 end
+    in add_string_globals 0 strings;
+	(* Déclare les variables globales présentes. *)
+    let rec add_int_globals = function
+    | [] -> ()
+    | s :: l -> begin
+                    add_int_globals l;
+                    Printf.fprintf out ".comm\t\t%s,\t\t8,\t\t8\n" s;
+                end
+    in add_int_globals globals;;
+

compile.mli

@@ -0,0 +1,25 @@
+
+(*
+ *	Copyright (c) 2005 by Laboratoire Spécification et Vérification (LSV),
+ *	CNRS UMR 8643 & ENS Cachan.
+ *	Written by Jean Goubault-Larrecq.  Not derived from licensed software.
+ *
+ *	Permission is granted to anyone to use this software for any
+ *	purpose on any computer system, and to redistribute it freely,
+ *	subject to the following restrictions:
+ *
+ *	1. Neither the author nor its employer is responsible for the consequences of use of
+ *		this software, no matter how awful, even if they arise
+ *		from defects in it.
+ *
+ *	2. The origin of this software must not be misrepresented, either
+ *		by explicit claim or by omission.
+ *
+ *	3. Altered versions must be plainly marked as such, and must not
+ *		be misrepresented as being the original software.
+ *
+ *	4. This software is restricted to non-commercial use only.  Commercial
+ *		use is subject to a specific license, obtainable from LSV.
+ *)
+
+val compile : out_channel -> Cparse.var_declaration list -> unit;;

cparse.ml

@@ -0,0 +1,271 @@
+(*
+ *  Copyright (c) 2005 by Laboratoire Spécification et Vérification (LSV),
+ *  UMR 8643 CNRS & ENS Cachan.
+ *  Written by Jean Goubault-Larrecq.  Not derived from licensed software.
+ *
+ *  Permission is granted to anyone to use this software for any
+ *  purpose on any computer system, and to redistribute it freely,
+ *  subject to the following restrictions:
+ *
+ *  1. Neither the author nor its employer is responsible for the consequences
+ *     of use of this software, no matter how awful, even if they arise
+ *     from defects in it.
+ *
+ *  2. The origin of this software must not be misrepresented, either
+ *     by explicit claim or by omission.
+ *
+ *  3. Altered versions must be plainly marked as such, and must not
+ *     be misrepresented as being the original software.
+ *
+ *  4. This software is restricted to non-commercial use only.  Commercial
+ *     use is subject to a specific license, obtainable from LSV.
+ * 
+ *)
+
+open Error
+
+type mon_op = M_MINUS | M_NOT | M_POST_INC | M_POST_DEC | M_PRE_INC | M_PRE_DEC
+    (* Les opérations unaires:
+     M_MINUS: calcule l'opposé -e de e;
+     M_NOT: calcule la négation logique ~e de e;
+     M_POST_INC: post-incrémentation e++;
+     M_POST_DEC: post-décrémentation e--;
+     M_PRE_INC: pré-incrémentation ++e;
+     M_PRE_DEC: pré-décrémentation --e.
+     *)
+type bin_op = S_MUL | S_DIV | S_MOD | S_ADD | S_SUB | S_INDEX
+    (* Les opérations binaires:
+     S_MUL: multiplication entière;
+     S_DIV: division entière (quotient);
+     S_MOD: division entière (reste);
+     S_ADD: addition entière;
+     S_SUB: soustraction entière;
+     S_INDEX: accès à un élément de tableau a[i].
+     *)
+type cmp_op = C_LT | C_LE | C_EQ
+    (* Les opérations de comparaison:
+     C_LT (less than): <;
+     C_LE (less than or equal to): <=;
+     C_EQ (equal): ==.
+     *)
+
+type loc_expr = locator * expr
+and expr = VAR of string (* une variable --- toujours de type int. *)
+    | CST of int (* une constante entiere. *)
+    | STRING of string (* une constante chaine. *)
+    | SET_VAR of string * loc_expr (* affectation x=e. *)
+    | SET_ARRAY of string * loc_expr * loc_expr (* affectation x[e]=e'. *)
+    | CALL of string * loc_expr list (* appel de fonction f(e1,...,en) *)
+	(* operations arithmetiques: *)
+    | OP1 of mon_op * loc_expr (* OP1(mop, e) dénote -e, ~e, e++, e--, ++e, ou --e. *)
+    | OP2 of bin_op * loc_expr * loc_expr (* OP2(bop,e,e') dénote e*e', e/e', e%e',
+					   e+e', e-e', ou e[e']. *)
+    | CMP of cmp_op * loc_expr * loc_expr (* CMP(cop,e,e') vaut e<e', e<=e', ou e==e' *)
+    | EIF of loc_expr * loc_expr * loc_expr (* EIF(e1,e2,e3) est e1?e2:e3 *)
+    | ESEQ of loc_expr list (* e1, ..., en [sequence, analogue a e1;e2 au niveau code];
+			     si n=0, represente skip. *)
+
+type var_declaration =
+    CDECL of locator * string (* declaration de variable de type int. *)
+  | CFUN of locator * string * var_declaration list * loc_code
+    (* fonction avec ses arguments, et son code. *)
+and loc_code = locator * code
+and code =
+    CBLOCK of var_declaration list * loc_code list (* { declarations; code; } *)
+  | CEXPR of loc_expr (* une expression e; vue comme instruction. *)
+  | CIF of loc_expr * loc_code * loc_code (* if (e) c1; else c2; *)
+  | CWHILE of loc_expr * loc_code (* while (e) c1; *)
+  | CRETURN of loc_expr option (* return; ou return (e); *)
+
+
+let cline = ref 1
+let ccol = ref 0
+let oldcline = ref 1
+let oldccol = ref 0
+let cfile = ref ""
+
+let getloc () = (!cfile, !oldcline, !oldccol, !cline, !ccol)
+
+
+let loc_of_expr (loc, _) = loc
+let e_of_expr (_, e) = e
+
+let index_prec  = 15 (* a[i] *)
+let ptr_prec    = 15 (* a->f *)
+let dot_prec    = 15 (* a.f *)
+let bang_prec   = 14 (* !a *)
+let tilde_prec  = 14 (* ~a *)
+let incdec_prec = 14 (* ++a, a++, --a, a-- *)
+let cast_prec   = 14 (* (T)a *)
+let sizeof_prec = 14 (* sizeof T *)
+let uplus_prec  = 14 (* +a *)
+let uminus_prec = 14 (* -a *)
+let star_prec   = 14 (* *a *)
+let amper_prec  = 14 (* &a *)
+let mul_prec    = 13 (* a*b *)
+let div_prec    = 13 (* a/b *)
+let mod_prec    = 13 (* a%b *)
+let add_prec    = 12 (* a+b *)
+let sub_prec    = 12 (* a-b *)
+let shift_prec  = 11 (* a<<b, a>>b *)
+let cmp_prec    = 10 (* a<b, a<=b, a>b, a>=b *)
+let eq_prec     = 9 (* a==b, a!=b *)
+let binand_prec = 8 (* a & b *)
+let binxor_prec = 7 (* a ^ b *)
+let binor_prec  = 6 (* a | b *)
+let and_prec    = 5 (* a && b *)
+let or_prec     = 4 (* a || b *)
+let if_prec     = 3 (* a?b:c *)
+let setop_prec  = 2 (* a += b, a *= b, ... *)
+let comma_prec  = 1 (* a, b *)
+
+let bufout_delim buf pri newpri s =
+    if newpri<pri
+	then Buffer.add_string buf s
+    else ()
+
+let bufout_open buf pri newpri = bufout_delim buf pri newpri "("
+let bufout_close buf pri newpri = bufout_delim buf pri newpri ")"
+
+let setop_text setop =
+    match setop with
+        S_MUL -> "*="
+      | S_DIV -> "/="
+      | S_MOD -> "%="
+      | S_ADD -> "+="
+      | S_SUB -> "-="
+      | S_INDEX -> ""
+
+let mop_text mop =
+  match mop with
+    M_MINUS -> "-"
+  | M_NOT -> "~"
+  | M_POST_INC | M_PRE_INC -> "++"
+  | M_POST_DEC | M_PRE_DEC -> "--"
+
+let mop_prec mop =
+  match mop with
+    M_MINUS -> uminus_prec
+  | M_NOT -> tilde_prec
+  | M_POST_INC | M_POST_DEC | M_PRE_INC | M_PRE_DEC -> incdec_prec
+
+let op_text setop =
+    match setop with
+        S_MUL -> "*"
+      | S_DIV -> "/"
+      | S_MOD -> "%"
+      | S_ADD -> "+"
+      | S_SUB -> "-"
+      | S_INDEX -> "["
+
+let fin_op_text setop =
+    match setop with
+        S_MUL -> ""
+      | S_DIV -> ""
+      | S_MOD -> ""
+      | S_ADD -> ""
+      | S_SUB -> ""
+      | S_INDEX -> "]"
+
+let op_prec setop =
+    match setop with
+        S_MUL -> mul_prec
+      | S_DIV -> div_prec
+      | S_MOD -> mod_prec
+      | S_ADD -> add_prec
+      | S_SUB -> sub_prec
+      | S_INDEX -> index_prec
+
+let rec bufout_expr buf pri e =
+    match e with
+	VAR s -> Buffer.add_string buf s
+      | CST n -> Buffer.add_string buf (string_of_int n)
+      | STRING s ->
+	  begin
+	    Buffer.add_string buf "\"";
+	    Buffer.add_string buf (String.escaped s);
+	    Buffer.add_string buf "\""
+	  end
+      | SET_VAR (x, e) -> (bufout_open buf pri setop_prec;
+			      Buffer.add_string buf x;
+			      Buffer.add_string buf "=";
+			      bufout_loc_expr buf setop_prec e;
+			      bufout_close buf pri setop_prec)
+      | SET_ARRAY (x, e, e') -> (bufout_open buf pri setop_prec;
+				 Buffer.add_string buf x;
+				 Buffer.add_string buf "[";
+				 bufout_loc_expr buf index_prec e;
+				 Buffer.add_string buf "]=";
+				 bufout_loc_expr buf setop_prec e';
+				 bufout_close buf pri setop_prec)
+      | CALL (f, l) -> (bufout_open buf pri index_prec;
+			Buffer.add_string buf f;
+			Buffer.add_string buf "(";
+			bufout_loc_expr_list buf l;
+			Buffer.add_string buf ")";
+			bufout_close buf pri index_prec)
+      | OP1 (mop, e') ->
+	  let newpri = mop_prec mop in
+	  (bufout_open buf pri newpri;
+	   (match mop with
+	     M_MINUS | M_NOT | M_PRE_INC | M_PRE_DEC ->
+	       (Buffer.add_string buf (mop_text mop);
+		bufout_loc_expr buf newpri e')
+	   | _ ->
+	       (bufout_loc_expr buf newpri e';
+		Buffer.add_string buf (mop_text mop)));
+	   bufout_close buf pri newpri)
+      | OP2 (setop, e, e') -> let newpri = op_prec setop in
+	(bufout_open buf pri newpri;
+	 bufout_loc_expr buf newpri e;
+	 Buffer.add_string buf (op_text setop);
+	 bufout_loc_expr buf newpri e';
+	 Buffer.add_string buf (fin_op_text setop);
+	 bufout_close buf pri newpri)
+      | CMP (C_LT, e, e') -> (bufout_open buf pri cmp_prec;
+			      bufout_loc_expr buf cmp_prec e;
+			      Buffer.add_string buf "<";
+			      bufout_loc_expr buf cmp_prec e';
+			      bufout_close buf pri cmp_prec)
+      | CMP (C_LE, e, e') -> (bufout_open buf pri cmp_prec;
+			      bufout_loc_expr buf cmp_prec e;
+			      Buffer.add_string buf "<=";
+			      bufout_loc_expr buf cmp_prec e';
+			      bufout_close buf pri cmp_prec)
+      | CMP (C_EQ, e, e') -> (bufout_open buf pri eq_prec;
+			      bufout_loc_expr buf eq_prec e;
+			      Buffer.add_string buf "==";
+			      bufout_loc_expr buf eq_prec e';
+			      bufout_close buf pri eq_prec)
+      | EIF (eb, et, ee) -> (bufout_open buf pri if_prec;
+			     bufout_loc_expr buf if_prec eb;
+			     Buffer.add_string buf "?";
+			     bufout_loc_expr buf if_prec et;
+			     Buffer.add_string buf ":";
+			     bufout_loc_expr buf if_prec ee;
+			     bufout_close buf pri if_prec)
+      | ESEQ (e::l) -> (bufout_open buf pri comma_prec;
+			bufout_loc_expr buf comma_prec e;
+			List.iter (fun e' -> (Buffer.add_string buf ",";
+					      bufout_loc_expr buf comma_prec e')) l;
+			bufout_close buf pri comma_prec)
+      | ESEQ [] -> ()
+and bufout_loc_expr buf pri (_, e) =
+  bufout_expr buf pri e
+and bufout_loc_expr_list buf l =
+    match l with
+	[] -> ()
+      | [a] -> bufout_loc_expr buf comma_prec a
+      | a::l' -> (bufout_loc_expr buf comma_prec a;
+		  Buffer.add_string buf ",";
+		  bufout_loc_expr_list buf l')
+
+let rec string_of_expr e =
+  let buf = Buffer.create 128 in
+  bufout_loc_expr buf comma_prec e;
+  Buffer.contents buf
+
+let rec string_of_loc_expr e =
+  let buf = Buffer.create 128 in
+  bufout_expr buf comma_prec e;
+  Buffer.contents buf

cparse.mli

@@ -0,0 +1,73 @@
+type mon_op = M_MINUS | M_NOT | M_POST_INC | M_POST_DEC | M_PRE_INC | M_PRE_DEC
+(** Les opérations unaires:
+  M_MINUS: calcule l'opposé -e de e;
+  M_NOT: calcule la négation logique ~e de e;
+  M_POST_INC: post-incrémentation e++;
+  M_POST_DEC: post-décrémentation e--;
+  M_PRE_INC: pré-incrémentation ++e;
+  M_PRE_DEC: pré-décrémentation --e.
+  *)
+
+type bin_op = S_MUL | S_DIV | S_MOD | S_ADD | S_SUB | S_INDEX
+(** Les opérations binaires:
+  S_MUL: multiplication entière;
+  S_DIV: division entière (quotient);
+  S_MOD: division entière (reste);
+  S_ADD: addition entière;
+  S_SUB: soustraction entière;
+  S_INDEX: accès à un élément de tableau a[i].
+  *)
+
+type cmp_op = C_LT | C_LE | C_EQ
+(** Les opérations de comparaison:
+  C_LT (less than): <;
+  C_LE (less than or equal to): <=;
+  C_EQ (equal): ==.
+  *)
+
+type loc_expr = Error.locator * expr
+and expr =
+
+  | VAR of string (** une variable --- toujours de type int. *)
+  | CST of int (** une constante entiere. *)
+  | STRING of string (** une constante chaine. *)
+  | SET_VAR of string * loc_expr (** affectation x=e. *)
+  | SET_ARRAY of string * loc_expr * loc_expr (** affectation x[e]=e'. *)
+  | CALL of string * loc_expr list (** appel de fonction f(e1,...,en) *)
+
+  | OP1 of mon_op * loc_expr
+    (** OP1(mop, e) dénote -e, ~e, e++, e--, ++e, ou --e. *)
+  | OP2 of bin_op * loc_expr * loc_expr
+    (** OP2(bop,e,e') dénote e*e', e/e', e%e',
+                             e+e', e-e', ou e[e']. *)
+  | CMP of cmp_op * loc_expr * loc_expr
+    (** CMP(cop,e,e') vaut e<e', e<=e', ou e==e' *)
+  | EIF of loc_expr * loc_expr * loc_expr
+    (** EIF(e1,e2,e3) est e1?e2:e3 *)
+  | ESEQ of loc_expr list
+    (** e1, ..., en [sequence, analogue a e1;e2 au niveau code];
+      si n=0, represente skip. *)
+
+type var_declaration =
+  | CDECL of Error.locator * string
+    (** declaration de variable de type int. *)
+  | CFUN of Error.locator * string * var_declaration list * loc_code
+    (** fonction avec ses arguments, et son code. *)
+and loc_code = Error.locator * code
+and code =
+    CBLOCK of var_declaration list * loc_code list (** { declarations; code; } *)
+  | CEXPR of loc_expr (** une expression e; vue comme instruction. *)
+  | CIF of loc_expr * loc_code * loc_code (** if (e) c1; else c2; *)
+  | CWHILE of loc_expr * loc_code (** while (e) c1; *)
+  | CRETURN of loc_expr option (** return; ou return (e); *)
+
+val cline : int ref
+val ccol : int ref
+val oldcline : int ref
+val oldccol : int ref
+val cfile : string ref
+
+val getloc : unit -> string * int * int * int * int
+
+val loc_of_expr : Error.locator*'a -> Error.locator
+val e_of_expr : loc_expr -> expr

cprint.ml

@@ -0,0 +1,20 @@
+open Cparse
+
+let print_declarations out dec_list =
+    let rec print_dec_list = function
+    | [] -> ();
+    | h :: t -> print_dec h; print_dec_list t;
+    and print_dec = function
+    | CDECL(l, s) -> Printf.printf "Declare varaible %s\n" s;
+    | CFUN(l, s, vdl, lc) -> begin
+                                 Printf.printf "Starting function %s\n" s;
+                                 print_dec_list vdl;
+                             end
+    in print_dec_list dec_list;;
+
+let print_locator out nom fl fc ll lc = 
+  Printf.printf "%s %d %d %d %d\n" nom fl fc ll lc
+
+let print_ast out dec_list =
+    print_declarations out dec_list;
+    Printf.printf "Ended\n";;

cprint.mli

@@ -0,0 +1,5 @@
+val print_declarations : Format.formatter -> Cparse.var_declaration list -> unit
+
+val print_locator : Format.formatter -> string -> int -> int -> int -> int -> unit
+
+val print_ast : Format.formatter -> Cparse.var_declaration list -> unit

ctab.mli

@@ -0,0 +1,88 @@
+type token =
+  | IDENTIFIER of (string)
+  | TYPE_NAME of (string)
+  | CONSTANT of (int)
+  | STRING_LITERAL of (string)
+  | SIZEOF
+  | PTR_OP
+  | INC_OP
+  | DEC_OP
+  | LEFT_OP
+  | RIGHT_OP
+  | LE_OP
+  | GE_OP
+  | EQ_OP
+  | NE_OP
+  | AND_OP
+  | OR_OP
+  | MUL_ASSIGN
+  | DIV_ASSIGN
+  | MOD_ASSIGN
+  | ADD_ASSIGN
+  | SUB_ASSIGN
+  | LEFT_ASSIGN
+  | RIGHT_ASSIGN
+  | AND_ASSIGN
+  | XOR_ASSIGN
+  | OR_ASSIGN
+  | SEMI_CHR
+  | OPEN_BRACE_CHR
+  | CLOSE_BRACE_CHR
+  | COMMA_CHR
+  | COLON_CHR
+  | EQ_CHR
+  | OPEN_PAREN_CHR
+  | CLOSE_PAREN_CHR
+  | OPEN_BRACKET_CHR
+  | CLOSE_BRACKET_CHR
+  | DOT_CHR
+  | AND_CHR
+  | OR_CHR
+  | XOR_CHR
+  | BANG_CHR
+  | TILDE_CHR
+  | ADD_CHR
+  | SUB_CHR
+  | STAR_CHR
+  | DIV_CHR
+  | MOD_CHR
+  | OPEN_ANGLE_CHR
+  | CLOSE_ANGLE_CHR
+  | QUES_CHR
+  | TYPEDEF
+  | EXTERN
+  | STATIC
+  | AUTO
+  | REGISTER
+  | CHAR
+  | SHORT
+  | INTEGER
+  | LONG
+  | SIGNED
+  | UNSIGNED
+  | FLOATING
+  | DOUBLE
+  | CONST
+  | VOLATILE
+  | VOID
+  | STRUCT
+  | UNION
+  | ENUM
+  | ELLIPSIS
+  | EOF
+  | CASE
+  | DEFAULT
+  | IF
+  | ELSE
+  | SWITCH
+  | WHILE
+  | DO
+  | FOR
+  | GOTO
+  | CONTINUE
+  | BREAK
+  | RETURN
+  | ASM
+
+val translation_unit :
+  (Lexing.lexbuf  -> token) -> Lexing.lexbuf -> (Cparse.var_declaration list)

ctab.mly

@@ -0,0 +1,464 @@
+%{
+
+(*
+ * Copyright (c) 2005 by Laboratoire Spécification et Vérification
+ * (LSV), UMR 8643 CNRS & ENS Cachan.
+ * Written by Jean Goubault-Larrecq.  Derived from the csur project.
+ *
+ * Permission is granted to anyone to use this software for any
+ * purpose on any computer system, and to redistribute it freely,
+ * subject to the following restrictions:
+ *
+ * 1. Neither the author nor its employer is responsible for the
+ *    consequences of use of this software, no matter how awful, even if
+ *    they arise from defects in it.
+ *
+ * 2. The origin of this software must not be misrepresented, either
+ *    by explicit claim or by omission.
+ *
+ * 3. Altered versions must be plainly marked as such, and must not
+ *    be misrepresented as being the original software.
+ *
+ * 4. This software is restricted to non-commercial use only.  Commercial
+ *    use is subject to a specific license, obtainable from LSV.
+ * 
+ *)
+
+(* Analyse syntaxique d'un sous-ensemble (tres) reduit de C.
+ *)
+
+open Cparse
+open Error
+
+let parse_error msg =
+    fatal (Some (getloc ())) msg
+
+%}
+
+%token <string> IDENTIFIER TYPE_NAME
+%token <int> CONSTANT
+%token <string> STRING_LITERAL
+%token SIZEOF
+%token PTR_OP INC_OP DEC_OP LEFT_OP RIGHT_OP LE_OP GE_OP EQ_OP NE_OP
+%token AND_OP OR_OP MUL_ASSIGN DIV_ASSIGN MOD_ASSIGN ADD_ASSIGN
+%token SUB_ASSIGN LEFT_ASSIGN RIGHT_ASSIGN AND_ASSIGN
+%token XOR_ASSIGN OR_ASSIGN
+%token SEMI_CHR OPEN_BRACE_CHR CLOSE_BRACE_CHR COMMA_CHR COLON_CHR
+%token EQ_CHR OPEN_PAREN_CHR CLOSE_PAREN_CHR OPEN_BRACKET_CHR
+%token CLOSE_BRACKET_CHR DOT_CHR AND_CHR OR_CHR XOR_CHR BANG_CHR
+%token TILDE_CHR ADD_CHR SUB_CHR STAR_CHR DIV_CHR MOD_CHR
+%token OPEN_ANGLE_CHR CLOSE_ANGLE_CHR QUES_CHR
+%token TYPEDEF EXTERN STATIC AUTO REGISTER
+%token CHAR SHORT INTEGER LONG SIGNED UNSIGNED FLOATING DOUBLE CONST VOLATILE VOID
+%token STRUCT UNION ENUM ELLIPSIS EOF
+%token CASE DEFAULT IF ELSE SWITCH WHILE DO FOR GOTO CONTINUE BREAK RETURN
+%token ASM
+
+%type <(Cparse.var_declaration list)> translation_unit
+
+%start translation_unit
+%%
+
+primary_expression:
+          identifier { let loc, var = $1 in loc, VAR var }
+        | constant { let loc, cst = $1 in loc, CST cst }
+        | string_literal { let loc, s = $1 in loc, STRING s }
+        | OPEN_PAREN_CHR expression CLOSE_PAREN_CHR { $2 }
+        ;
+
+constant : CONSTANT { getloc (), $1 };
+
+identifier  : IDENTIFIER      { getloc (), $1 };
+open_brace  : OPEN_BRACE_CHR  { getloc () };
+close_brace : CLOSE_BRACE_CHR { getloc () };
+
+string_literal:
+          STRING_LITERAL { getloc (), $1 }
+        | STRING_LITERAL string_literal 
+            { 
+              let l, s = $2 in
+              let s2 = $1 in
+              (getloc (), s2^s)
+            } 
+
+inc_op : INC_OP { getloc () }
+dec_op : DEC_OP { getloc () }
+
+postfix_expression:
+          primary_expression { $1 }
+        | postfix_expression OPEN_BRACKET_CHR expression close_bracket
+	{ sup_locator (loc_of_expr $1) $4, OP2 (S_INDEX, $1, $3) }
+        | identifier OPEN_PAREN_CHR close_paren
+	{ let loc, var = $1 in
+	  let loc1 = sup_locator loc $3 in
+	    loc1, CALL (var, [])
+	}
+        | identifier OPEN_PAREN_CHR argument_expression_list close_paren
+	{ let loc, var = $1 in
+	  let loc1 = sup_locator loc $4 in
+	    loc1, CALL (var, List.rev $3)
+	}
+        | postfix_expression inc_op
+	{ sup_locator (loc_of_expr $1) $2, OP1 (M_POST_INC, $1) }
+        | postfix_expression dec_op
+	{ sup_locator (loc_of_expr $1) $2, OP1 (M_POST_DEC, $1) }
+        ;
+
+/* Les argument_expression_list sont des listes a l'envers */
+
+argument_expression_list:
+          assignment_expression { [$1] }
+        | argument_expression_list COMMA_CHR assignment_expression { 
+          $3 :: $1 }
+        ;
+
+unary_expression:
+          postfix_expression { $1 }
+        | inc_op unary_expression
+	{ sup_locator $1 (loc_of_expr $2), OP1 (M_PRE_INC, $2) }
+        | dec_op unary_expression
+	{ sup_locator $1 (loc_of_expr $2), OP1 (M_PRE_DEC, $2) }
+        | unary_operator cast_expression
+	{ 
+          let loc, c = $1 in
+          let loc' = sup_locator loc (loc_of_expr $2) in
+	  match c with
+	      ADD_CHR -> $2
+	    | SUB_CHR -> loc', OP1 (M_MINUS, $2)
+	    | BANG_CHR -> loc', EIF ($2, (loc', CST 0), (loc', CST 1))
+            | TILDE_CHR -> loc', OP1 (M_NOT, $2)
+	    | _ -> (Error.error (Some loc) "unknown unary operator";
+		     loc, CST 0) }
+        ;
+
+unary_operator:
+          add_chr   { $1 }
+        | sub_chr   { $1 }
+        | bang_chr  { $1 }
+        | tilde_chr { $1 }
+        ;
+
+add_chr     : ADD_CHR   { getloc (), ADD_CHR   }
+sub_chr     : SUB_CHR   { getloc (), SUB_CHR   }
+bang_chr    : BANG_CHR  { getloc (), BANG_CHR  }
+tilde_chr   : TILDE_CHR { getloc (), TILDE_CHR }
+
+close_paren : CLOSE_PAREN_CHR { getloc () }
+
+cast_expression:
+          unary_expression { $1 }
+        ;
+
+multiplicative_expression:
+          cast_expression { $1 }
+        | multiplicative_expression STAR_CHR cast_expression
+	{ sup_locator (loc_of_expr $1) (loc_of_expr $3),
+	  OP2 (S_MUL, $1, $3)
+	}
+        | multiplicative_expression DIV_CHR cast_expression
+	{ sup_locator (loc_of_expr $1) (loc_of_expr $3),
+	  OP2 (S_DIV, $1, $3)
+	}
+        | multiplicative_expression MOD_CHR cast_expression
+	{ sup_locator (loc_of_expr $1) (loc_of_expr $3),
+	  OP2 (S_MOD, $1, $3)
+	}
+        ;
+
+additive_expression:
+          multiplicative_expression 
+            { $1 }
+        | additive_expression ADD_CHR multiplicative_expression
+	{ sup_locator (loc_of_expr $1) (loc_of_expr $3),
+	  OP2 (S_ADD, $1, $3)
+	}
+        | additive_expression SUB_CHR multiplicative_expression
+	{ sup_locator (loc_of_expr $1) (loc_of_expr $3),
+	  OP2 (S_SUB, $1, $3)
+	}
+        ;
+
+shift_expression:
+          additive_expression { $1 }
+        ;
+
+relational_expression:
+          shift_expression { $1 }
+        | relational_expression OPEN_ANGLE_CHR shift_expression
+	{ sup_locator (loc_of_expr $1) (loc_of_expr $3),
+	  CMP (C_LT, $1, $3)
+	}
+        | relational_expression CLOSE_ANGLE_CHR shift_expression
+	{ sup_locator (loc_of_expr $1) (loc_of_expr $3),
+	  CMP (C_LT, $3, $1)
+	}
+        | relational_expression LE_OP shift_expression
+	{ sup_locator (loc_of_expr $1) (loc_of_expr $3),
+	  CMP (C_LE, $1, $3)
+	}
+        | relational_expression GE_OP shift_expression
+	{ sup_locator (loc_of_expr $1) (loc_of_expr $3),
+	  CMP (C_LE, $3, $1)
+	}
+        ;
+
+equality_expression:
+          relational_expression { $1 }
+        | equality_expression EQ_OP relational_expression
+	{ sup_locator (loc_of_expr $1) (loc_of_expr $3),
+	  CMP (C_EQ, $1, $3)
+	}
+        | equality_expression NE_OP relational_expression
+	{ 
+          let loc = sup_locator (loc_of_expr $1) (loc_of_expr $3) in
+	  loc, EIF ((loc, CMP (C_EQ, $1, $3)),
+		    (loc, CST 0),
+		    (loc, CST 1))
+	}
+        ;
+
+and_expression:
+          equality_expression { $1 }
+        ;
+
+exclusive_or_expression:
+          and_expression { $1 }
+        ;
+
+inclusive_or_expression:
+          exclusive_or_expression { $1 }
+        ;
+
+logical_and_expression:
+          inclusive_or_expression { $1 }
+        | logical_and_expression AND_OP inclusive_or_expression
+	{ let loc = sup_locator (loc_of_expr $1) (loc_of_expr $3) in
+	  loc, EIF ($1, $3, (loc, CST 0))
+	}
+        ;
+
+logical_or_expression:
+          logical_and_expression { $1 }
+        | logical_or_expression OR_OP logical_and_expression
+	{ let loc = sup_locator (loc_of_expr $1) (loc_of_expr $3) in
+	  loc, EIF ($1, (loc, CST 1), $3)
+	}
+        ;
+
+conditional_expression:
+          logical_or_expression { $1 }
+        | logical_or_expression QUES_CHR expression COLON_CHR conditional_expression
+	{ 
+	  sup_locator (loc_of_expr $1) (loc_of_expr $5),
+	  EIF ($1, $3, $5)
+	}
+        ;
+
+assignment_expression:
+          conditional_expression { $1 }
+	| unary_expression EQ_CHR assignment_expression
+	    {
+	     let locvar, left = $1 in
+	     let loc = sup_locator locvar (loc_of_expr $3) in
+	     match left with
+	       VAR x -> loc, SET_VAR (x, $3)
+	     | OP2 (S_INDEX, (_, VAR x), i) -> loc, SET_ARRAY (x, i, $3)
+	     | _ ->
+		 begin
+		   Error.error (Some loc)
+		     "Can only write assignments of the form x=e or x[e]=e'.\n";
+		   $3
+		 end
+	   }
+        ;
+
+expression:
+          assignment_expression { $1 }
+        | expression COMMA_CHR assignment_expression
+	{ 
+	  sup_locator (loc_of_expr $1) (loc_of_expr $3),
+	  ESEQ [$1; $3]
+	}
+        ;
+
+declaration:
+	type_specifier optional_init_declarator_list SEMI_CHR
+	{ List.rev $2 }
+        ;
+
+optional_init_declarator_list : 
+          { [] }
+	| init_declarator_list { $1 }
+	;
+
+/* Une init_declarator_list est une liste a l'envers de declarator. */
+init_declarator_list
+        : init_declarator 
+            { [$1] }
+        | init_declarator_list COMMA_CHR init_declarator 
+            { $3 :: $1 }
+        ;
+
+init_declarator: declarator { $1 };
+
+declarator:
+          identifier { let loc, x = $1 in CDECL (loc, x) }
+        ;
+
+type_specifier: INTEGER { () }
+	| CHAR STAR_CHR { () }
+	| type_specifier STAR_CHR { () };
+
+close_bracket : CLOSE_BRACKET_CHR { getloc () };
+
+statement: compound_statement   
+            { $1 }
+        | expression_statement 
+            { loc_of_expr $1, CEXPR $1 }
+        | selection_statement  
+            { $1 }
+        | iteration_statement  
+            { $1 }
+        | jump_statement       
+            { $1 }
+	    ;
+
+open_block : open_brace { $1 };
+close_block : close_brace { $1 };
+
+compound_statement: 
+          open_block close_block 
+        { sup_locator $1 $2, CBLOCK ([], []) }
+        | open_block statement_list close_block
+	{ sup_locator $1 $3, CBLOCK ([], List.rev $2) }
+        | open_block declaration_list close_block
+	{ sup_locator $1 $3, CBLOCK ($2, []) }
+        | open_block declaration_list statement_list close_block
+	{ sup_locator $1 $4, CBLOCK ($2, List.rev $3) }
+        ;
+
+/* Une declaration_list est une liste non inversee de declaration */
+declaration_list
+        : declaration 
+          { $1 }
+        | declaration_list declaration 
+          { $1 @ $2 }
+        ;
+
+/* Une statement_list est une liste inversee de statement */
+statement_list
+        : statement 
+          { [$1] }
+        | statement_list statement 
+          { $2 :: $1 }
+        ;
+
+expression_statement: 
+         semi_chr 
+            { $1, ESEQ [] }
+        | expression SEMI_CHR 
+            { $1 }
+        ;
+
+semi_chr : SEMI_CHR { getloc () }
+
+ifkw : IF { getloc () };
+
+selection_statement
+        : ifkw OPEN_PAREN_CHR expression CLOSE_PAREN_CHR statement
+	{ 
+          sup_locator $1 (fst $5), CIF ($3, $5,
+					(getloc (), CBLOCK ([], [])))
+	}
+        | ifkw OPEN_PAREN_CHR expression CLOSE_PAREN_CHR statement ELSE statement
+	{ 
+          sup_locator $1 (fst $7), CIF ($3, $5, $7)
+	}
+        ;
+
+whilekw : WHILE { getloc () };
+forkw : FOR { getloc () };
+
+iteration_statement: whilekw OPEN_PAREN_CHR expression close_paren statement
+	   {
+	    let loc = sup_locator $1 (fst $5) in
+	    loc, CWHILE ($3, $5)
+	   }
+        | forkw OPEN_PAREN_CHR expression_statement expression_statement close_paren statement
+	/* for (e0; e; ) c == e0; while (e) c; */
+	{ 
+          let loc = sup_locator $1 (fst $6) in
+	  loc, CBLOCK ([], [(loc_of_expr $3, CEXPR $3);
+			    loc, CWHILE ($4, $6)])
+	}
+        | forkw OPEN_PAREN_CHR expression_statement expression_statement expression close_paren statement
+	/* for (e0; e; e1) c == e0; while (e) { c; e1 } */
+	{ 
+          let loc = sup_locator $1 (fst $7) in
+	  loc, CBLOCK ([], [(loc_of_expr $3, CEXPR $3);
+			    loc, CWHILE ($4,
+					 (sup_locator (loc_of_expr $5) (loc_of_expr $7),
+					  CBLOCK ([], [$7; (loc_of_expr $5,
+							    CEXPR $5)])))])
+	}
+        ;
+
+return : RETURN { getloc () };
+
+jump_statement:
+          return SEMI_CHR 
+            { $1, CRETURN None }
+        | return expression SEMI_CHR 
+            { sup_locator $1 (loc_of_expr $2), CRETURN (Some $2) }
+        ;
+
+translation_unit:
+          external_declaration 
+          { $1 }
+        | translation_unit external_declaration 
+          { $1 @ $2 }
+        | EOF 
+          { [] }
+        ;
+
+external_declaration
+        : function_definition 
+            { [$1] }
+        | declaration 
+            { $1 }
+        ;
+
+parameter_declaration: type_specifier declarator { $2 };
+
+/*!!!should check no repeated param name! */
+/* Une parameter_list est une liste inversee de parameter_list. */
+parameter_list: parameter_declaration 
+          { [$1] }
+        | parameter_list COMMA_CHR parameter_declaration
+          { $3 :: $1 }
+        ;
+
+parameter_type_list
+        : parameter_list { List.rev $1}
+        | parameter_list COMMA_CHR ELLIPSIS { List.rev $1 }
+        ;
+
+parameter_declarator :
+	  OPEN_PAREN_CHR CLOSE_PAREN_CHR { [] }
+	| OPEN_PAREN_CHR parameter_type_list CLOSE_PAREN_CHR { $2 }
+	    ;
+
+function_declarator : type_specifier identifier parameter_declarator
+	{ $2, $3 }
+	    ;
+
+function_definition
+        : function_declarator compound_statement
+	{ 
+          let (loc, var), decls = $1 in
+	  CFUN (loc, var, decls, $2)
+	}
+	;
+
+
+%%

depend

@@ -0,0 +1,24 @@
+compile.cmi : cparse.cmi
+cparse.cmi : error.cmo
+cprint.cmi : cparse.cmi
+ctab.cmi : cparse.cmi
+clex.cmo : error.cmo ctab.cmi cparse.cmi
+clex.cmx : error.cmx ctab.cmx cparse.cmx
+compile.cmo : genlab.cmo cparse.cmi compile.cmi
+compile.cmx : genlab.cmx cparse.cmx compile.cmi
+cparse.cmo : error.cmo cparse.cmi
+cparse.cmx : error.cmx cparse.cmi
+cprint.cmo : cparse.cmi cprint.cmi
+cprint.cmx : cparse.cmx cprint.cmi
+ctab.cmo : error.cmo cparse.cmi ctab.cmi
+ctab.cmx : error.cmx cparse.cmx ctab.cmi
+error.cmo :
+error.cmx :
+genlab.cmo :
+genlab.cmx :
+main.cmo : verbose.cmo error.cmo ctab.cmi cprint.cmi cparse.cmi compile.cmi \
+    clex.cmo
+main.cmx : verbose.cmx error.cmx ctab.cmx cprint.cmx cparse.cmx compile.cmx \
+    clex.cmx
+verbose.cmo :
+verbose.cmx :

error.ml

@@ -0,0 +1,95 @@
+(*
+ *  Copyright (c) 2005 by Laboratoire Spécification et Vérification (LSV),
+ *  UMR 8643 CNRS & ENS Cachan.
+ *  Written by Jean Goubault-Larrecq.  Not derived from licensed software.
+ *
+ *  Permission is granted to anyone to use this software for any
+ *  purpose on any computer system, and to redistribute it freely,
+ *  subject to the following restrictions:
+ *
+ *  1. Neither the author nor its employer is responsible for the consequences
+ *     of use of this software, no matter how awful, even if they arise
+ *     from defects in it.
+ *
+ *  2. The origin of this software must not be misrepresented, either
+ *     by explicit claim or by omission.
+ *
+ *  3. Altered versions must be plainly marked as such, and must not
+ *     be misrepresented as being the original software.
+ *
+ *  4. This software is restricted to non-commercial use only.  Commercial
+ *     use is subject to a specific license, obtainable from LSV.
+ * 
+ *)
+
+type locator = string * int * int * int * int
+    (* nom du fichier, ou "";
+     premiere ligne,
+     premiere colonne,
+     derniere ligne,
+     derniere colonne.
+     *)
+
+let sup_locator (file, line1, col1, _, _) (file', _, _, line2, col2) =
+  (if file="" then file' else file),
+  line1, col1, line2, col2
+
+type hlocator = string * int * int
+
+let loc_start (file, line1, col1, _, _) = (file, line1, col1)
+let loc_end (file, _, _, line2, col2) = (file, line2, col2)
+
+let prerr_locator (file, line1, col1, line2, col2) =
+  if file<>"" then begin
+    prerr_string file;
+    prerr_string ", line";
+    if line1<>line2 then prerr_string "s";
+    prerr_string " ";
+    prerr_int line1;
+    if col1<>0 then begin
+      prerr_string "("; prerr_int col1; prerr_string ")"
+    end;
+    if line1<>line2 || col1<>col2 then begin
+      prerr_string "-";
+      prerr_int line2;
+      if col2<>0 then begin
+        prerr_string "(";
+        prerr_int col2;
+        prerr_string ")"
+      end
+    end
+  end
+
+let prerr_loc loc =
+  match loc with
+    | Some l ->
+        prerr_locator l;
+        prerr_string ": "
+    | _ -> ()
+
+let warning loc msg =
+  prerr_string "parser: ";
+  prerr_loc loc;
+  prerr_endline msg
+
+let error_count = ref 0
+let error_count_max = 10000
+
+let fatal loc msg =
+  warning loc msg; exit 10
+
+let flush_error () =
+  if !error_count>=error_count_max then
+    fatal None "Too many errors: quit"
+
+let error loc msg =
+  error_count := !error_count + 1;
+  warning loc msg;
+  if !error_count>=error_count_max then
+    fatal loc "Too many errors: quit"
+
+let gensym_count = ref 0
+let gensym prefix =
+  incr gensym_count;
+  let s = string_of_int (!gensym_count) in
+    prefix ^ s

genlab.ml

@@ -0,0 +1,31 @@
+
+(*
+ *	Copyright (c) 2005 by Laboratoire Spécification et Vérification (LSV),
+ *	CNRS UMR 8643 & ENS Cachan.
+ *	Written by Jean Goubault-Larrecq.  Not derived from licensed software.
+ *
+ *	Permission is granted to anyone to use this software for any
+ *	purpose on any computer system, and to redistribute it freely,
+ *	subject to the following restrictions:
+ *
+ *	1. Neither the author nor its employer is responsible for the consequences of use of
+ *		this software, no matter how awful, even if they arise
+ *		from defects in it.
+ *
+ *	2. The origin of this software must not be misrepresented, either
+ *		by explicit claim or by omission.
+ *
+ *	3. Altered versions must be plainly marked as such, and must not
+ *		be misrepresented as being the original software.
+ *
+ *	4. This software is restricted to non-commercial use only.  Commercial
+ *		use is subject to a specific license, obtainable from LSV.
+ *)
+
+open Printf
+
+let counter = ref 0
+
+let rec genlab func =
+  incr counter;
+  sprintf ".%s_%d" func (!counter)

main.ml

@@ -0,0 +1,82 @@
+
+(*
+ *	Copyright (c) 2005 by Laboratoire Spécification et Vérification (LSV),
+ *	CNRS UMR 8643 & ENS Cachan.
+ *	Written by Jean Goubault-Larrecq.  Derived from the csur project.
+ *
+ *	Permission is granted to anyone to use this software for any
+ *	purpose on any computer system, and to redistribute it freely,
+ *	subject to the following restrictions:
+ *
+ *	1. Neither the author nor its employer is responsible for the consequences of use of
+ *		this software, no matter how awful, even if they arise
+ *		from defects in it.
+ *
+ *	2. The origin of this software must not be misrepresented, either
+ *		by explicit claim or by omission.
+ *
+ *	3. Altered versions must be plainly marked as such, and must not
+ *		be misrepresented as being the original software.
+ *
+ *	4. This software is restricted to non-commercial use only.  Commercial
+ *		use is subject to a specific license, obtainable from LSV.
+ *)
+
+open Cparse
+open Verbose
+open Compile
+open Arg
+
+let input = ref stdin
+let c_prefix = ref "a.out"
+let c_E = ref false
+let c_A = ref false
+let c_D = ref false
+
+let basename s =
+  try String.sub s 0 (String.rindex s '.')
+  with Not_found -> s
+
+let () =
+  parse
+    [("-v", Unit (fun () -> verbose:=1), "reports stuff");
+     ("-v1", Unit (fun () -> verbose:=1), "reports stuff");
+     ("-v2", Unit (fun () -> verbose:=2), "reports stuff, and stuff");
+     ("-D", Unit (fun () -> c_D:=true), "print declarations");
+     ("-A", Unit (fun () -> c_A:=true), "print abstract syntax tree");
+     ("-E", Unit (fun () -> c_E:=true), "output assembler dump")]
+    (fun s ->
+       c_prefix := basename s;
+       input :=
+         Unix.open_process_in ("cpp -DMCC \"" ^ (String.escaped s) ^ "\""))
+    "compiles a C-- program"
+
+let () =
+  let lexbuf = Lexing.from_channel (!input) in
+  let c = Ctab.translation_unit Clex.ctoken lexbuf in
+  let out = if !c_E then stdout else open_out (!c_prefix ^ ".s") in
+    Error.flush_error ();
+
+    if !c_D then begin
+      Cprint.print_declarations Format.std_formatter c
+    end;
+    if !c_A then begin
+      Cprint.print_ast Format.std_formatter c
+    end;
+
+    if not (!c_D || !c_A) then begin
+      compile out c;
+      Error.flush_error ()
+    end;
+
+    if not (!c_D || !c_A || !c_E) then begin
+      flush out;
+      close_out_noerr out;
+      let command =
+        let prefix = String.escaped !c_prefix in
+          Printf.sprintf
+            "gcc -ggdb -o \"%s\" \"%s.s\" -lc -lm"
+            prefix prefix
+      in
+        ignore (Unix.system command)
+    end

verbose.ml

@@ -0,0 +1,25 @@
+(*
+ *  Copyright (c) 2005 by Laboratoire Spécification et Vérification (LSV),
+ *  UMR 8643 CNRS & ENS Cachan.
+ *  Written by Jean Goubault-Larrecq.  Not derived from licensed software.
+ *
+ *  Permission is granted to anyone to use this software for any
+ *  purpose on any computer system, and to redistribute it freely,
+ *  subject to the following restrictions:
+ *
+ *  1. Neither the author nor its employer is responsible for the consequences
+ *     of use of this software, no matter how awful, even if they arise
+ *     from defects in it.
+ *
+ *  2. The origin of this software must not be misrepresented, either
+ *     by explicit claim or by omission.
+ *
+ *  3. Altered versions must be plainly marked as such, and must not
+ *     be misrepresented as being the original software.
+ *
+ *  4. This software is restricted to non-commercial use only.  Commercial
+ *     use is subject to a specific license, obtainable from LSV.
+ * 
+ *)
+
+let verbose = ref 0