99 bottles of beer

Voici un petit prog OCaml adapté de compile.ml, un des modules du compilo OCaml lui-même. Je vous laisse le soin de compiler ça avec tous les modules utilitaires du compilo Caml. Qu'est-ce que ça fait ? Ca définit un lambda-terme (au sens de lambda.mli) qui affiche la fameuse chanson des 99 bottles of beer, un exemple courant de programme, un peu plus compliqué qu'un simple Hello World. Le lambda-terme est compilé en bytecode caml dans newt.cmo puis linké, au final on obtient un exécutable thenewt qui exécute le fameux algorithme.

L'origine de cette expérience est dans le post précédent, il s'agit d'étudier la faisabilité d'un compilo qui utilise le backend de OCaml, en utilisant une syntaxe et un système de type différents. Je me suis dit qu'on peut faire mieux que boo :p

open Misc
open Config
open Format
open Lambda

let init_path () =
load_path := "" :: (Clflags.std_include_dir ());
Env.reset_cache ()

let initial_env () =
Ident.reinit () ;
try
Env.open_pers_signature "Pervasives" Env.initial
with Not_found ->
fatal_error "cannot open pervasives.cmi"

let print_if printer arg =
fprintf Format.err_formatter "%a@." printer arg ;
arg

let (++) x f = f x

let implementation =
let modulename = "Newt" in
let env = init_path () ; initial_env () in
let objfile = "newt.cmo" in
let binfile = "thenewt" in
let oc = open_out_bin objfile in

let print_string =
let lid = Longident.Lident "print_string" in
let (path,_) = Env.lookup_value lid env in
transl_path path
in
let printf =
let lid = Longident.Ldot ((Longident.Lident "Printf"),"printf") in
let (path,_) = Env.lookup_value lid env in
transl_path path
in
let int n = Lconst (Const_base (Asttypes.Const_int n)) in
let string s = Lconst (Const_base (Asttypes.Const_string s)) in

let lambda =
(* setglobal (persistent Newt) *)
Lapply
(print_string,
[string "They turned me into a newt !\n"])
(* makeblock 0 *)
in
let bottles =
let more,one,nomore =
"%2d bottles of beer on the wall. Take one down, pass it around.\n",
"One bottle of beer on the wall. Take it down, pass it around.\n",
"No more bottles of beer.\n"
in
let id = Ident.create "nn" in
let eqthenelse x n t e =
Lifthenelse
((Lprim ((Pintcomp Ceq),[Lvar x;int n])),t,e)
in
let body =
let x = Ident.create "x" in
Lfunction
(Curried,[x],
(eqthenelse x 0
(Lapply (printf,[string nomore]))
(Lsequence
((eqthenelse x 1
(Lapply (printf,[string one]))
(Lapply (printf,[string more;Lvar x]))),
(Lapply (Lvar id,[Lprim (Psubint,[Lvar x;int 1])]))))))
in
Lletrec
([id,body],
(Lapply ((Lvar id),[int 99])))
in
let lambda = Lsequence (bottles,lambda) in

try
lambda
++ Simplif.simplify_lambda
++ print_if Printlambda.lambda
++ Bytegen.compile_implementation modulename
++ print_if Printinstr.instrlist
++ Emitcode.to_file oc modulename ;
close_out oc ;
Bytelink.link [objfile] binfile
with x ->
close_out oc ;
(* TODO remove file *)
raise x


Voila. J'ai posté parceque c'est court. Mais l'air de rien ça m'a pris du temps et de la patience pour comprendre où trouver telle ou telle fonctionnalité.