Re: Compilers in ML or Caml

Jon Harrop <jon@ffconsultancy.com>
Thu, 21 Jun 2007 12:54:51 +0100

          From comp.compilers

Related articles
Compilers in ML or Caml sgillespie@bisonofborg.com (bison) (2007-06-19)
Re: Compilers in ML or Caml blume@hanabi.local (Matthias Blume) (2007-06-19)
Re: Compilers in ML or Caml ang.usenet@gmail.com (Aaron Gray) (2007-06-19)
Re: Compilers in ML or Caml torbenm@app-7.diku.dk (2007-06-20)
Re: Compilers in ML or Caml Colin_Paul_Gloster@ACM.org (Colin Paul Gloster) (2007-06-21)
Re: Compilers in ML or Caml jon@ffconsultancy.com (Jon Harrop) (2007-06-21)
| List of all articles for this month |

From: Jon Harrop <jon@ffconsultancy.com>
Newsgroups: comp.compilers
Date: Thu, 21 Jun 2007 12:54:51 +0100
Organization: Flying Frog Consultancy Ltd.
References: 07-06-037
Keywords: functional

bison wrote:
> I'm sure there are plenty of compilers written in ML, but I'd like to
> find some smaller (ish) compilers written in ML for a good examples in
> compiler writing in ML.


If you're interested in something tiny and written in OCaml then look at
this minimal term-level interpreter for a tiny functional language:


    http://www.ffconsultancy.com/ocaml/benefits/interpreter.html


Here is the source code:


type expr =
        | EAdd of expr * expr
        | EApply of expr * expr
        | EEqual of expr * expr
        | EIf of expr * expr * expr
        | EInt of int
        | ELetRec of string * string * expr * expr
        | EMul of expr * expr
        | EVar of string;;


type value =
        | VInt of int
        | VBool of bool
        | VClosure of string * (string * value) list * expr;;


(* Lexer *)
open Genlex;;


let keywords =
    ["("; ")"; "+"; "-"; "=";
      "if"; "then"; "else";
      "let"; "rec"; "in"];;


(* Parser *)
let rec parse_atom = parser
    | [< 'Int n >] -> EInt n
    | [< 'Ident v >] -> EVar v
    | [< 'Kwd "("; e=parse_expr; 'Kwd ")" >] -> e


and parse_apply = parser
    | [< e1=parse_atom; stream >] ->
            (parser
              | [< e2=parse_atom >] -> EApply(e1, e2)
              | [< e2=parse_apply >] ->
                      (match e2 with
                        | EApply(e2, e3) -> EApply(EApply(e1, e2), e3)
                        | e2 -> EApply(e1, e2))
              | [< >] -> e1) stream


and parse_arith = parser
    | [< e1=parse_apply; stream >] ->
            (parser
              | [< 'Kwd "+"; e2=parse_arith >] -> EAdd(e1, e2)
              | [< 'Kwd "-"; e2=parse_arith >] -> EAdd(e1, EMul(EInt(-1), e2))
              | [< >] -> e1) stream


and parse_expr : 'a Stream.t -> expr = parser
    | [< e1=parse_arith; stream >] ->
            (parser
              | [< 'Kwd "="; e2=parse_expr >] -> EEqual(e1, e2)
              | [< >] -> e1) stream
    | [< 'Kwd "if"; p=parse_expr; 'Kwd "then"; t=parse_expr;
              'Kwd "else"; f=parse_expr >] ->
            EIf(p, t, f)
    | [< 'Kwd "let"; 'Kwd "rec"; 'Ident f; 'Ident x; 'Kwd "=";
body=parse_expr;
              'Kwd "in"; rest=parse_expr >] ->
            ELetRec(f, x, body, rest);;


(* Evaluator *)
let int = function VInt n -> n | _ -> invalid_arg "int";;
let bool = function VBool b -> b | _ -> invalid_arg "bool";;


let rec eval vars = function
    | EApply(func, arg) -> apply (eval vars func) (eval vars arg)
    | EAdd(e1, e2) -> VInt (int(eval vars e1) + int(eval vars e2))
    | EMul(e1, e2) -> VInt (int(eval vars e1) * int(eval vars e2))
    | EEqual(e1, e2) -> VBool (eval vars e1 = eval vars e2)
    | EIf(p, t, f) -> eval vars (if bool (eval vars p) then t else f)
    | EInt i -> VInt i
    | ELetRec(var, arg, body, rest) ->
            let rec vars' = (var, VClosure(arg, vars', body)) :: vars in
            eval vars' rest
    | EVar s -> List.assoc s vars
and apply func arg = match func with
    | VClosure(var, vars, body) -> eval ((var, arg) :: vars) body
    | _ -> invalid_arg "Attempt to apply a non-function value";;


(* Top level *)
let string_of_value = function
    | VInt n -> string_of_int n
    | VBool b -> if b then "true" else "false"
    | VClosure _ -> "<fun>";;


let () =
    let program = parse_expr(make_lexer keywords (Stream.of_channel stdin)) in
    print_endline(string_of_value(eval [] program));;


Compile with:


    ocamlopt -dtypes -p -pp camlp4o tinyml.ml -o tinyml


You might also like to alter this program to make a staged interpreter in
MetaOCaml.


--
Dr Jon D Harrop, Flying Frog Consultancy
The OCaml Journal
http://www.ffconsultancy.com/products/ocaml_journal/?usenet


Post a followup to this message

Return to the comp.compilers page.
Search the comp.compilers archives again.