From mboxrd@z Thu Jan  1 00:00:00 1970
Return-Path: <jon@ffconsultancy.com>
X-Spam-Checker-Version: SpamAssassin 3.1.3 (2006-06-01) on yquem.inria.fr
X-Spam-Level: 
X-Spam-Status: No, score=0.0 required=5.0 tests=AWL autolearn=disabled 
	version=3.1.3
Received: from discorde.inria.fr (discorde.inria.fr [192.93.2.38])
	by yquem.inria.fr (Postfix) with ESMTP id 62511BC6B
	for <caml-list@yquem.inria.fr>; Fri, 17 Aug 2007 11:47:31 +0200 (CEST)
Received: from pih-relay05.plus.net (pih-relay05.plus.net [212.159.14.132])
	by discorde.inria.fr (8.13.6/8.13.6) with ESMTP id l7H9lU4s010648
	(version=TLSv1/SSLv3 cipher=AES256-SHA bits=256 verify=NO)
	for <caml-list@inria.fr>; Fri, 17 Aug 2007 11:47:31 +0200
Received: from [80.229.56.224] (helo=beast.local)
	 by pih-relay05.plus.net with esmtp (Exim) id 1ILyQS-0006tN-Qh
	for caml-list@inria.fr; Fri, 17 Aug 2007 10:47:29 +0100
From: Jon Harrop <jon@ffconsultancy.com>
Organization: Flying Frog Consultancy Ltd.
To: "caml-list" <caml-list@inria.fr>
Subject: Minim compiler as a camlp4 macro
Date: Fri, 17 Aug 2007 10:36:16 +0100
User-Agent: KMail/1.9.7
MIME-Version: 1.0
Content-Type: text/plain;
  charset="us-ascii"
Content-Transfer-Encoding: 7bit
Content-Disposition: inline
Message-Id: <200708171036.16956.jon@ffconsultancy.com>
X-Miltered: at discorde with ID 46C56EB2.002 by Joe's j-chkmail (http://j-chkmail . ensmp . fr)!
X-Spam: no; 0.00; compiler:01 camlp:01 compiler:01 ocaml:01 camlp:01 syntax:01 expr:01 expr:01 decr:01 stdin:01 lident:01 ocaml:01 translated:01 feat:98 frog:98 


Mark Tarver posted an open challenge for people to write programs to evaluate 
Minim programs, a simple imperative language.

The following is my attempt at writing a Minim compiler in OCaml using the new 
Camlp4. The result is remarkably short, IMHO:

open Camlp4.PreCast;;
open Camlp4.PreCast.Syntax;;

let mmstatement = Gram.Entry.mk "mmstatement";;
let mmvalue = Gram.Entry.mk "mmvalue";;
let mmtest = Gram.Entry.mk "mmtest";;
let mmident = Gram.Entry.mk "mmident";;

let rec compile _loc tag e = function
  | [] -> <:binding< $lid:tag$ = fun () -> $e$ >>
  | `TL e'::`T tag'::t ->
      let bs = compile _loc tag' <:expr< () >> t in
      <:binding< $lid:tag$ = fun () -> $e$; $e'$ and $bs$ >>
  | (`TL e' | `E e')::t -> compile _loc tag <:expr< $e$; $e'$ >> t
  | `T tag'::t ->
      let bs = compile _loc tag' <:expr< () >> t in
      <:binding< $lid:tag$ = fun () -> $e$; $lid:tag'$() and $bs$ >>;;

let compile _loc ss = compile _loc "entry" <:expr< () >> ss;;

EXTEND Gram
  str_item: LEVEL "top"
  [ [ "MINIM"; "("; ss=LIST1 mmstatement; ")" ->
        <:str_item< let rec $compile _loc ss$ >>
    ] ];
  mmstatement:
  [ [ "("; x=mmident; "is"; y=mmvalue; ")" -> `E <:expr< $lid:x$ := $y$ >>
    | "("; "++"; x=mmident; ")" -> `E <:expr< incr $lid:x$ >>
    | "("; "--"; x=mmident; ")" -> `E <:expr< decr $lid:x$ >>
    | "("; "if"; p=mmtest; "then"; t=mmstatement; "else";
f=mmstatement; ")" ->
        (match t, f with
         | `TL t, `TL f -> `TL <:expr< if $p$ then $t$ else $f$ >>
         | (`TL t | `E t), (`TL f | `E f) ->
             `E <:expr< if $p$ then $t$ else $f$ >>
         | _ -> invalid_arg "Tag in 'if' expression")
    | "("; "goto"; t=mmident; ")" -> `TL <:expr< $lid:t$() >>
    | "("; "print"; s=STRING; ")" ->
        let s = String.escaped s in
        `E <:expr< print_string $str:s$ >>
    | "("; "print"; x=mmvalue; ")" -> `E <:expr< print_int $x$ >>
    | "nl" -> `E <:expr< print_newline() >>
    | "("; "input"; x=mmident; ")" ->
        `E <:expr< $lid:x$ := int_of_string(input_line stdin) >>
    | tag=mmident -> `T tag ] ];
  mmvalue:
  [ [ x=mmident -> <:expr< ! $lid:x$ >>
    | n=INT -> <:expr< $int:n$ >> ] ];
  mmtest:
  [ [ "("; f=mmvalue; "<"; g=mmvalue; ")" -> <:expr< $f$ < $g$ >>
    | "("; f=mmvalue; "="; g=mmvalue; ")" -> <:expr< $f$ = $g$ >>
    | "("; f=mmvalue; ">"; g=mmvalue; ")" -> <:expr< $f$ > $g$ >>
    | "("; f=mmtest; "and"; g=mmtest; ")" -> <:expr< $f$ && $g$ >>
    | "("; f=mmtest; "or"; g=mmtest; ")" -> <:expr< $f$ || $g$ >>
    | "("; "not"; f=mmtest; ")" -> <:expr< not $f$ >> ] ];
  mmident:
  [ [ x=LIDENT -> "_"^x
    | x=UIDENT -> "_"^x
    | "end" -> "_end" ] ];
END;;

Evaluating that in an OCaml top level lets you embed MINIM code in your OCaml:

let _x, _y = ref 0, ref 0;;

MINIM(
(print "Add x and y (what a feat!)")
 nl 
 (print "Input x: ") 
 (input x) 
 nl 
 (print "Input y: ") 
 (input y) 
main 
 (if (x = 0) then (goto end) else (goto sub1x)) 
 
sub1x 
 (-- x) 
 (++ y) 
 (goto main) 
 
end 
 nl 
 (print "The total of x and y is ") 
 (print y) 
 nl 
);;

The MINIM code is translated into OCaml ASTs on-the-fly and evaluated, giving 
a high-performance Minim environment.

-- 
Dr Jon D Harrop, Flying Frog Consultancy Ltd.
OCaml for Scientists
http://www.ffconsultancy.com/products/ocaml_for_scientists/?e