Source

ocaml-lib / syndesc / ex_expr.ml

#load "monad.cmo"
#load "iso.cmo"
#load "syndesc.cmo"

(* example from the paper of Rendel and Ostermann *)

open Monad

type op =
  | AddOp
  | MulOp

let mulOp : (unit, op) Iso.t = Iso.elt MulOp
let addOp : (unit, op) Iso.t = Iso.elt AddOp

type expr =
  | Variable of string
  | Literal of int
  | BinOp of expr * op * expr
  | IfZero of expr * expr * expr

let variable : (string,expr) Iso.t =
  object
    method apply v = Some (Variable v)
    method unapply = function Variable v -> Some v | _ -> None
  end

let literal : (int,expr) Iso.t =
  object
    method apply i = Some (Literal i)
    method unapply = function Literal i -> Some i | _ -> None
  end

let binOp : (expr * (op * expr), expr) Iso.t =
  object
    method apply (e1,(op,e2)) = Some (BinOp (e1,op,e2))
    method unapply = function BinOp (e1,op,e2) -> Some (e1, (op, e2)) | _ -> None
  end

let ifZero : (expr * (expr * expr), expr) Iso.t =
  object
    method apply (e0, (e1,e2)) = Some (IfZero (e0,e1,e2))
    method unapply = function IfZero (e0,e1,e2) -> Some (e0, (e1,e2)) | _ -> None
  end

let keywords = ["ifzero"; "else"]

let is_letter = function 'a'..'z' | 'A'..'Z' -> true | _ -> false
let is_digit = function '0'..'9' -> true | _ -> false

open Syndesc.Lazy

let letter : char t = map token (Iso.subset is_letter)
let digit : char t = map token (Iso.subset is_digit)

let identifier : string t =
  map
    (seq letter (many (alt letter digit)))
    (Iso.seq Iso.cons (Iso.seq Iso.string_of_list (Iso.subset (fun id -> not (List.mem id keywords)))))

let keyword (kwd : string) : unit t =
  map
    (either identifier (text kwd))
    (Iso.inverse Iso.right)

let integer : int t =
  map
    (some digit)
    (Iso.seq Iso.string_of_list Iso.int_of_string)

let parens (p : 'a t) : 'a t = between (text "(") p (text ")")

let ops =
  alt
    (map (text "*") mulOp)
    (map (text "+") addOp)

let spaced_ops = between opt_space ops opt_space

let priority = function
  | MulOp -> 1
  | AddOp -> 2

let binOpPrio n =
  Iso.seq
    (Iso.subset (fun (x, (op, y)) -> priority op = n))
    binOp

let rec exp0 = lazy (
  Syndesc.alt (map integer literal)
    (alt (map identifier variable)
       (alt (map ifzero ifZero)
	  (parens (between skip_space exp2 skip_space)))))
and exp1 = lazy (
  Syndesc.chainl1 exp0 spaced_ops (binOpPrio 1))
and exp2 = lazy (
  Syndesc.chainl1 exp1 spaced_ops (binOpPrio 2))
and ifzero = lazy (
  Syndesc.prefix (keyword "ifzero")
    (prefix opt_space
       (seq (parens exp2)
	  (prefix opt_space
	     (seq (parens exp2)
		(prefix opt_space
		   (prefix (keyword "else")
		      (prefix opt_space
			 (parens exp2)))))))))


let expression =
  Lazy.force (close exp2)

let _ =
  List.iter
    (fun e ->
      match expression#print e with
      | Some s -> print_endline s
      | None -> ())
    (expression#parse "2 + x*y")

(* custom syntax: sequential *)
(*

let mulOp n = iso [ CONSTR MulOp 0 -> op when priority op = 2 ]
let addOp n = iso [ CONSTR AddOp 0 -> op when priority op = 1 ]
let variable = iso [ CONSTR Variable 1 ]
let literal = iso [ CONSTR Literal 1 ]
let binOp = iso [ CONSTR BinOp 3 ]
let ifZero = iso [ CONSTR IfZero 3 ]

let rec exp2 = syndesc 
   [ LIST1 exp1 SEP spaced_ops 2 ISO binOp ]
and exp1 = syndesc
   [ LIST1 exp0 SEP spaced_ops 1 ISO binOp ]
and exp0 = syndesc
   [ integer -> literal
   | identifier -> variable
   | !keyword "ifzero"; !opt_space; parens exp2; !opt_space; parens exp2; !opt_space;
     !keyword "else"; !opt_space; parens exp2 -> ifZero ]
   | parens [ !skip_space; exp2; !skip_space ] ]
and integer = syndesc
   [ SOME digit -> string_of_list; int_of_string ]
and identifier = syndesc
   [ letter :: MANY [ letter | digit ] -> string_of_list; id when not (List.mem id keywords) ]
and keyword kwd = syndesc
   [ 'kwd -> w when List.mem w keywords ]
and parens p = syndesc
   [ !"("; p; !")" ]
and ops n = syndesc
   [ "*" -> mulOp n
   | "+" -> addOp n ]
and spaced_ops n = syndesc
   [ !opt_space; ops n; !opt_space ]
and letter = syndesc
   [ token -> when is_letter ]
and digit = syndesc
   [ token -> when is_digit ]

let expression = Lazy.force (close exp2)

*)

(* custom syntax: functional *)
(*

let mulOp n = iso [ subset (fun op -> priority op = 2) of CONSTR MulOp 0]
let addOp n = iso [ subset (fun op -> priority op = 1) of CONSTR AddOp 0]
let variable = iso [ CONSTR Variable 1 ]
let literal = iso [ CONSTR Literal 1 ]
let binOp = iso [ CONSTR BinOp 3 ]
let ifZero = iso [ CONSTR IfZero 3 ]
(*let binOpPrio n = iso [ binOp of subset (fun (x, (op, y)) -> priority op = n) ] *)

let rec exp2 = syndesc 
   [ LIST1 exp1 SEP spaced_ops 2 ISO binOp ]
and exp1 = syndesc
   [ LIST1 exp0 SEP spaced_ops 1 ISO binOp ]
and exp0 = syndesc
   [ literal of integer
   | variable of identifier
   | ifZero of [ !keyword "ifzero"; !opt_space; parens exp2; !opt_space; parens exp2; !opt_space;
     !keyword "else"; !opt_space; parens exp2 ]
   | parens [ !skip_space; exp2; !skip_space ] ]
and integer = syndesc
   [ int_of_string of string_of_list of SOME digit ]
and identifier = syndesc
   [ subset (fun id -> not (List.mem id keywords)) of
       string_of_list of letter :: MANY [ letter | digit ] ]
and keyword kwd = syndesc
   [ subset (fun w -> List.mem w keywords) of 'kwd ]
and parens p = syndesc
   [ !"("; p; !")" ]
and ops n = syndesc
   [ mulOp n of "*"
   | addOp n of "+" ]
and spaced_ops n = syndesc
   [ !opt_space; ops n; !opt_space ]
and letter = syndesc
   [ subset is_letter of token ]
and digit = syndesc
   [ subset is_digit of token ]

let expression = Lazy.force (close exp2)

*)

(* custom syntax (old) *)
(*

let mulOp = iso [ 'MulOp ] = iso [ CONSTR MulOp 0 ]
let addOp = iso [ 'AddOp ]
let variable = iso [ CONSTR Variable 1 ]
let literal = iso [ CONSTR Literal 1 ]
let binOp = iso [ CONSTR BinOp 3 ]
let ifZero = iso [ CONSTR IfZero 3 ]
let binOpPrio n = iso [ subset (fun (x, (op, y)) -> priority op = n); binOp ]

let rec exp2 = syndesc 
   [ LIST1 exp1 SEP spaced_ops ISO binOpPrio 2 ]
and exp1 = syndesc
   [ LIST1 exp0 SEP spaced_ops ISO binOpPrio 1 ]
and exp0 = syndesc
   [ integer -> literal
   | identifier -> variable
   | !keyword "ifzero"; !opt_space; parens exp2; !opt_space; parens exp2; !opt_space; 
     !keyword "else"; !opt_space; parens exp2 -> ifZero
   | parens [ !skip_space; exp2; !skip_space ] ]
and integer = syndesc
   [ SOME digit -> string_of_list; int_of_string ]
and identifier = syndesc
   [ letter; MANY [ letter | digit ] -> cons; string_of_list; subset (fun id -> not (List.mem id keywords)) ]
and keyword kwd = syndesc
   [ 'kwd -> subset (fun w -> List.mem w keywords) ]
and parens p = syndesc
   [ "("; p; ")" ]
and ops = syndesc
   [ "*" -> mulOp
   | "+" -> addOp ]
and spaced_ops = syndesc
   [ !opt_space; ops; !opt_space ]
and letter = syndesc
   [ token -> subset is_letter ]
and digit = syndesc
   [ token -> subset is_digit ]

let expression = Lazy.force (close exp2)

*)