 
 
 
< code, env >
#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:
# externalprint_ws:'a->unit="print_ws";;external print_ws : 'a -> unit = "print_ws"
# typeadresse;;type adresse
# let(gensym,init_gensym)=leti=ref0in(function()->incri;"val_"^(string_of_int!i)),(function()->i:=0);;val gensym : unit -> string = <fun>val init_gensym : unit -> unit = <fun>
# typeoccurence=Une_fois|Plusieurs_fois|Deja_nommeofstring;;type occurence = | Une_fois | Plusieurs_fois | Deja_nomme of string
# lettable=Hashtbl.create17;;val table : ('_a, '_b) Hashtbl.t = <abstr>
# letajoute(adr:adresse)=trymatchHashtbl.findtableadrwithUne_fois->Hashtbl.removetableadr;Hashtbl.addtableadrPlusieurs_fois;true|_->truewithNot_found->Hashtbl.addtableadrUne_fois;false;;val ajoute : adresse -> bool = <fun>
# letmultiple_occadr=matchHashtbl.findtableadrwithUne_fois->false|_->true;;val multiple_occ : adresse -> bool = <fun>
# letdeja_nommeadr=matchHashtbl.findtableadrwithUne_fois->failwith"deja_nomme"|Plusieurs_fois->Hashtbl.removetableadr;Hashtbl.addtableadr(Deja_nomme(gensym()));false|_->true;;val deja_nomme : adresse -> bool = <fun>
# letnom_deadr=matchHashtbl.findtableadrwithDeja_nommes->s|_->raiseNot_found;;val nom_de : adresse -> string = <fun>
La partie C :
# Callback.register"add"ajoute;;- : unit = ()
# Callback.register"multiple?"multiple_occ;;- : unit = ()
# Callback.register"named?"deja_nomme;;- : unit = ()
# Callback.register"name"nom_de;;- : unit = ()
# externalexplore_value:'a->unit="explore";;external explore_value : 'a -> unit = "explore"
#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;
}
# externalprint_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;
}
externalprint_rec:'a->unit="print_gen";;
letv=Hashtbl.cleartable;init_gensym();explore_valuev;print_recv;;
# typefloat_matrix;;type float_matrix
typedef struct { int size_x , size_y ;
                 float * mat ;
               } 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 ;
}
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 ;
}
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;
}
# externalto_matrix:floatarrayarray->float_matrix="conversion_to_C";;
# externalof_matrix:float_matrix->floatarrayarray="conversion_to_Caml";;
# externalsomme:float_matrix->float_matrix->float_matrix="plus";;
# externalproduit:float_matrix->float_matrix->float_matrix="prod";;
#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;
}
# lettable=Hashtbl.create17;;val table : ('_a, '_b) Hashtbl.t = <abstr>
# letajoute_mot(m:string)=tryletp=Hashtbl.findtableminincrpwithNot_found->Hashtbl.addtablem(ref1);;val ajoute_mot : string -> unit = <fun>
# letnb_mots_repetes()=leti=ref0inHashtbl.iter(fun_n->if!n>1thenincri)table;!i;;val nb_mots_repetes : unit -> int = <fun>
# letnb_mots_differents()=leti=ref0inHashtbl.iter(fun__->incri)table;!i;;val nb_mots_differents : unit -> int = <fun>
# Callback.register"add word"ajoute_mot;Callback.register"rep words"nb_mots_repetes;Callback.register"diff words"nb_mots_differents;;- : unit = ()
#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) ;
}
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.oPour compiler en code-natif :
$ cc -c -I /usr/local/lib/ocaml/ wc.c $ ocamlopt mots.ml wc.o
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 -lcursesPour 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
 
 
