Author: Christian.Queinnec@lip6.fr

## Exercices

### Affichage polymorphe

On cherche à définir une fonction d'affichage `print` de type 'a -> unit pouvant afficher n'importe quelle valeur Objective CAML. Pour cela on reprend la fonction `inspecte` pour l'améliorer.

1. Écrire en C la fonction `print_ws` qui affiche les valeurs Objective CAML de la manière suivante :
   - valeurs immédiates : comme des entiers C
   - chaînes : entre `""`
   - flottants : habituels
   - tableau de flottants : entre `[| |]`
   - les fermetures : `< code, env >`
   - tout le reste comme un n-uplet, entre `( )`
   La fonction parcourt les valeurs de manière récursive.
   Une fonction C :

       #include <stdio.h>
       #include <caml/mlvalues.h>
       #include <caml/memory.h>

       value print_ws (value v) {
         CAMLparam1(v);
         int taille,i ;
         if (Is_long(v)) printf("%d", Long_val(v));
         else {
           taille=Wosize_val(v);
           switch (Tag_val(v))
             {
             case String_tag :
        printf("\"%s\"", String_val(v));
        break;
             case Double_tag:
        printf("%g", Double_val(v));
        break;
             case Double_array_tag :
        printf ("[|");
               if (taille>0) printf("%g", Double_field(v,0));
        for (i=1;i<(taille/2);i++)  printf("; %g", Double_field(v,i));
        printf("|]");
        break;
             case Abstract_tag :
             case Final_tag :
        printf("<abstract>");
        break;
             case Closure_tag :
        printf("<%d, ",Code_val(v)) ;
        if (taille>1) print_ws(Field(v,1)) ;
        for (i=2;i<taille;i++) {
          printf("; ") ;
          print_ws(Field(v,i));
        }
        printf(">");
        break;
             default:
        if (Tag_val(v)>=No_scan_tag) printf("?");
        else {
          printf("(");
          if (taille>0) print_ws(Field(v,0));
          for (i=1;i<taille;i++) {
            printf(", ");
            print_ws(Field(v,i));
          }
          printf(")");
        }
             }
         }
         fflush(stdout);
         return Val_unit;
       }

   appelée depuis Objective CAML:

       # external print_ws : 'a -> unit = "print_ws"  ;;
       external print_ws : 'a -> unit = "print_ws"

2. Pour éviter de boucler sur une valeur circulaire et pour montrer le partage, modifier cette fonction pour tenir compte des adresses déjà rencontrées. Si une adresse apparaît plusieurs fois, alors lui donner un nom au premier affichage ( v = nom) et utiliser ce nom par la suite quand vous la rencontrez de nouveau.

       # type adresse ;;
       type adresse

   1. Définir une structure de données pour stocker les adresses, indiquer quand elles occurrent plusieurs fois et leur associer un nom.

          # let (gensym,init_gensym) =
             let i = ref 0 in
               (function () -> incr i ; "val_" ^ (string_of_int !i))
             , (function () -> i:=0) ;;
          val gensym : unit -> string = <fun>
          val init_gensym : unit -> unit = <fun>

          # type occurence =
               Une_fois
             | Plusieurs_fois
             | Deja_nomme of string ;;
          type occurence = | Une_fois | Plusieurs_fois | Deja_nomme of string

          # let table = Hashtbl.create 17 ;;
          val table : ('_a, '_b) Hashtbl.t = <abstr>

          # let ajoute (adr : adresse) =
             try
               match Hashtbl.find table adr with
                 Une_fois -> Hashtbl.remove table adr ;
                             Hashtbl.add table adr Plusieurs_fois ;
                             true
               | _ -> true
             with
               Not_found -> Hashtbl.add table adr Une_fois ; false ;;
          val ajoute : adresse -> bool = <fun>

          # let multiple_occ adr =
             match Hashtbl.find table adr with
               Une_fois -> false
             | _ -> true ;;
          val multiple_occ : adresse -> bool = <fun>

          # let deja_nomme adr =
             match Hashtbl.find table adr with
               Une_fois -> failwith "deja_nomme"
             | Plusieurs_fois -> Hashtbl.remove table adr ;
                                 Hashtbl.add table adr (Deja_nomme (gensym ())) ;
                                 false
             | _ -> true ;;
          val deja_nomme : adresse -> bool = <fun>

          # let nom_de adr =
             match Hashtbl.find table adr with
               Deja_nomme s -> s
             | _ -> raise Not_found ;;
          val nom_de : adresse -> string = <fun>

   2. La valeur est parcourue une première fois pour explorer toutes les adresses et les enregistrer dans la table.
      La partie Objective CAML:

          # Callback.register "add" ajoute ;;
          - : unit = ()
          # Callback.register "multiple?" multiple_occ ;;
          - : unit = ()
          # Callback.register "named?" deja_nomme ;;
          - : unit = ()
          # Callback.register "name" nom_de ;;
          - : unit = ()

          # external explore_value : 'a -> unit = "explore"  ;;
          external explore_value : 'a -> unit = "explore"

      La partie C :

          #include <caml/callback.h>

          value explore (value v) {
            CAMLparam1(v);
            int taille,i ;
            if (Is_long(v))  return Val_unit;
            if (Bool_val(callback(*caml_named_value("add"),v))) return Val_unit;
            taille=Wosize_val(v);
            switch (Tag_val(v))
              {
                case String_tag :
                case Double_tag:
                case Double_array_tag :
                case Abstract_tag :
                case Final_tag :
                  break;
                case Closure_tag :
                  for (i=1;i<taille;i++) explore(Field(v,i));
                  break;
                default:
                  if (Tag_val(v)>=No_scan_tag) break ;
                  for (i=1;i<taille;i++) explore(Field(v,i));
              }
            return Val_unit;
          }

   3. Le second parcours réalise l'affichage proprement dit en nommant les adresses à la première de leurs occurrences.

          # external print_rec : 'a -> unit = "print_gen" ;;
          external print_rec : 'a -> unit = "print_gen"

          value print_gen (value v)
          {
            CAMLparam1(v);
            int taille,i ;
            if (Is_long(v))  return print_ws(v) ;
            if (Bool_val(callback(*caml_named_value("multiple?"),v))) {
              if (Bool_val(callback(*caml_named_value("named?"),v))) {
                printf("%s",String_val(callback(*caml_named_value("name"),v))) ;
                return Val_unit ;
              }
              printf("%s = { ",String_val(callback(*caml_named_value("name"),v))) ;
            }
            taille=Wosize_val(v);
            switch (Tag_val(v))
              {
                case String_tag :
                case Double_tag:
                case Double_array_tag :
                case Abstract_tag :
                case Final_tag :
           print_ws(v);
           break;
                case Closure_tag :
           printf("<%d, ",Code_val(v)) ;
           if (taille>1) print_gen(Field(v,1)) ;
           for (i=2;i<taille;i++) {
             printf("; ") ;
             print_gen(Field(v,i));
           }
           printf(">");
           break;
                default:
           if (Tag_val(v)>=No_scan_tag) printf("?");
           else {
             printf("(");
             if (taille>0) print_gen(Field(v,0));
             for (i=1;i<taille;i++) {
               printf(", ");
               print_gen(Field(v,i));
             }
             printf(")");
           }
              }
            if (Bool_val(callback(*caml_named_value("multiple?"),v)))  printf(" }") ;
            fflush(stdout);
            return Val_unit;
          }

   4. Définir la fonction `print` réunissant le tout.

          external print_rec : 'a -> unit = "print_gen" ;;
          let print v =
            Hashtbl.clear table ;
            init_gensym () ;
            explore_value v ;
            print_rec v ;;

### Produit de matrices : partage ou copie

1. Définir un type abstrait float_matrix pour des matrices de flottants.

       # type float_matrix ;;
       type float_matrix

2. Définir un type C pour de telles matrices.

       typedef struct { int size_x , size_y ;
                        float * mat ;
                      } Matrix ;

3. Écrire une fonction en C de conversion de valeur de type float array array vers une valeur de type float_matrix.

       value conversion_to_C (value faa) {
         CAMLparam1(faa) ;
         CAMLlocal1(vres) ;
         Matrix * res ;
         int size_x, size_y ;

         /* taille du vecteur de vecteur */
         size_x = Wosize_val(faa) ;
         if (size_x>0) size_y = Wosize_val(Field(faa,0))/2 ;

         /* allocation de la valeur float_matrix */
         vres=alloc(sizeof(Matrix),Abstract_tag) ;
         res=(Matrix *) vres ;
         res->size_x = size_x ;
         res->size_y = size_y ;
         if (size_x*size_y==0) res->mat=0 ;
         else {
           int i,j ;
           float * tab ;
           value vect ;
           res->mat=tab=(float *) alloc(sizeof(float)*size_x*size_y,Abstract_tag) ;
           for (i=0;i<size_x;i++) {
             vect = Field(faa,i) ;
             for (j=0;j<size_y;j++) *(tab++) = Double_field(vect,j) ;
           }
         }
         CAMLreturn vres ;
       }

4. Écrire la fonction en C effectuant la conversion inverse.

       value conversion_to_Caml (value matrix) {
         CAMLparam1(matrix) ;
         CAMLlocal2(res,aux) ;
         Matrix* mat = (Matrix *) matrix ;
         float * tab = mat->mat ;
         int size = mat->size_x*mat->size_y ;
         int i,j ;
         res=alloc(mat->size_x,0);
         for (i=0;i<mat->size_x;i++) {
           aux = alloc(2*mat->size_y,Double_array_tag) ;
           Field(res,i) = aux ;
           for (j=0;j<mat->size_y;j++) Store_double_field(aux,j,*(tab++)) ;
         }
         CAMLreturn res ;
       }

5. Ajouter en C les fonctions pour la somme et le produit de telles matrices.

       value plus (value arg1,value arg2) {
         CAMLparam2(arg1,arg2) ;
         CAMLlocal1(vres) ;
         Matrix *m1=(Matrix*) arg1, *m2=(Matrix*) arg2,*res;
         float *tab;
         int i,size=m1->size_x*m1->size_y ;
         vres=alloc(sizeof(Matrix),Abstract_tag) ;
         res =(Matrix*) vres;
         res->size_x=m1->size_x;
         res->size_y=m1->size_y;
         res->mat=tab=(float *) alloc(sizeof(float)*size,Abstract_tag) ;
         for (i=0;i<size;i++) tab[i]=m1->mat[i]+m2->mat[i] ;
         CAMLreturn vres;
       }

       value prod (value arg1,value arg2) {
         CAMLparam2(arg1,arg2) ;
         CAMLlocal1(vres) ;
         Matrix *m1=(Matrix*) arg1, *m2=(Matrix*) arg2,*res;
         float *tab;
         int i,j,k;
         vres=alloc(sizeof(Matrix),Abstract_tag) ;
         res =(Matrix*) vres;
         res->size_x=m1->size_x;
         res->size_y=m2->size_y;
         res->mat=tab=(float *) alloc(sizeof(float)*res->size_x*res->size_y,
                                      Abstract_tag) ;
         for (i=0;i<res->size_x;i++)
           for (j=0;j<res->size_y;j++) {
             float acc=0 ;
             for (k=0;k<m1->size_y;k++)
        acc += m1->mat[i*m1->size_x+k] * m1->mat[k*m2->size_x+j] ;
             tab[i*m1->size_x+j]=acc ;
           }
         CAMLreturn vres;
       }

6. Les interfacer avec Objective CAML et les utiliser.

       # external to_matrix : float array array -> float_matrix = "conversion_to_C" ;;
       # external of_matrix : float_matrix -> float array array = "conversion_to_Caml";;
       # external somme : float_matrix -> float_matrix -> float_matrix = "plus" ;;
       # external produit : float_matrix -> float_matrix -> float_matrix = "prod" ;;

### Compter les mots : programme principal en C

La commande Unix `wc` compte le nombre de caractères, de mots et de lignes d'un fichier. Cet exercice a pour but de réaliser cette commande en ne comptant qu'une fois les mots qui sont répétés plusieurs fois.

1. Écrire le programme `wc` en C comptant simplement les mots, les lignes et les caractères d'un fichier dont le nom est passé en argument.
   Le fichier `wc.c` :

       #include <stdio.h>

       void read_file (char *path) {
         FILE *fd=fopen(path,"r");
         int car=0;
         char buffer[80], *buff;
         int nb_car=0, nb_mots=0, nb_lignes=0;

         buff=buffer; *buff=0;
         if (!fd) exit(-1) ;
         while ((car=getc(fd))!=EOF) {
           nb_car++ ;
           if (car=='\n') nb_lignes++ ;
           if (car==' ' || car=='\n' ||(buff-buffer)>=80) {
             if (buff!=buffer) { nb_mots++; buff=0; buff=buffer; }
           }
           else *(buff++)=car;
         }
         printf(" %d - %d - %d : %s\n",nb_lignes,nb_mots,nb_car,path) ;
       }

       int main (int argc,char **argv)
       {
         if (argc>1) read_file(argv[1]);
         return 0;
       }

2. Écrire en Objective CAML une fonction `ajoute_mot` qui à l'aide d'une table de hachage conserve le nombre de fois où la fonction a été invoquée avec pour argument une même chaîne de caractères.

       # let table = Hashtbl.create 17 ;;
       val table : ('_a, '_b) Hashtbl.t = <abstr>

       # let ajoute_mot (m:string) =
          try let p = Hashtbl.find table m in incr p
          with Not_found -> Hashtbl.add table m (ref 1) ;;
       val ajoute_mot : string -> unit = <fun>

3. Écrire deux fonctions `nb_mots_repetes` et `nb_mots_differents` comptant respectivement les mots répétés et les mots différents à partir de la table construite par `ajoute_mot`.

       # let nb_mots_repetes () =
          let i =ref 0 in
          Hashtbl.iter (fun _ n  -> if !n>1 then incr i) table ;
          !i ;;
       val nb_mots_repetes : unit -> int = <fun>

       # let nb_mots_differents () =
          let i =ref 0 in
          Hashtbl.iter (fun _ _  -> incr i) table ;
          !i ;;
       val nb_mots_differents : unit -> int = <fun>

4. Enregistrer les trois fonctions précédentes de sorte qu'elles puissent être utilisées depuis un programme C.

       # Callback.register "add word" ajoute_mot ;
        Callback.register "rep words" nb_mots_repetes ;
        Callback.register "diff words" nb_mots_differents ;;
       - : unit = ()

5. Réécrire la fonction principale du programme `wc` pour que soit affiché le nombre de mots différents en lieu et place du nombre de mots.
   Il est nécessaire d'inclure les interfaces suivantes :

       #include <caml/mlvalues.h>
       #include <caml/callback.h>

       void read_file (char *path) {
         FILE *fd = fopen(path,"r") ;
         int car=0 ;
         char buffer[80],*buff ;
         int nb_car=0, nb_mots, nb_lignes=0;

         buff=buffer; *buff=0;
         if (!fd) exit(-1) ;
         while ((car=getc(fd))!=EOF) {
           nb_car++ ;
           if (car=='\n') nb_lignes++ ;
           if (car==' ' || car=='\n' ||(buff-buffer)>=80) {
             if (buff!=buffer) {
               nb_mots++;
        *buff=0;
        buff=buffer;
        callback(*caml_named_value("add word"),copy_string(buffer));
             }
           }
           else *(buff++)=car;
         }
         nb_mots=Int_val(callback(*caml_named_value("diff words"),Val_unit));
         printf(" %d - %d - %d\n",nb_lignes,nb_mots,nb_car) ;
       }

6. Donner la fonction `main` et les commandes nécessaires pour compiler ce programme comme un programme Objective CAML.

       int main (int argc,char **argv)
       {
         caml_main(argv);
         if (argc>1) read_file(argv[1]);
         return 0;
       }

   Pour compiler en code-octet :

       $ cc -c -I /usr/local/lib/ocaml/ wc.c
       $ ocamlc -custom mots.ml wc.o

   Pour compiler en code-natif :

       $ cc -c -I /usr/local/lib/ocaml/ wc.c
       $ ocamlopt mots.ml wc.o

7. Donner la fonction `main` et les commandes nécessaires pour compiler ce programme comme un programme C.

       int main (int argc,char **argv)
       {
         caml_startup(argv);
         if (argc>1) read_file(argv[1]);
         return 0;
       }

   Pour compiler en code-octet :

       $ ocamlc -output-obj mots.ml -o mots.o
       $ gcc -c -I /usr/local/lib/ocaml/ wc.c
       $ gcc mots.o wc.o -L /usr/local/lib/ocaml/ -lcamlrun -lcurses

   Pour compiler en code-natif :

       $ ocamlopt -output-obj mots.ml -o motsprog.o
       $ gcc -c -I /usr/local/lib/ocaml/ wc.c
       $ gcc motsprog.o wc.o -L /usr/local/lib/ocaml/ -lasmrun