bnf7.ml

bnf7.ml

type 'a e = I of int | X of string | L of 'a e list | V of 'a
let rec bind f v = match v with
  | None -> None
  | Some v -> Some (f v)

let rec map2M f es gs = match es,gs with
  | e::es,g::gs ->
    begin match f e g with
    | None -> None
    | Some x ->
      match map2M f es gs with
      | None -> None
      | Some xs -> Some (x::xs)
    end
  | [],[] -> Some []
  | _,_ -> None
let showM = function
  | None -> "None"
  | Some v -> Printf.sprintf "Some(%s)" v
let rec f2 ls = L(List.map (fun x -> V x) ls)
let addf f gs = List.map (fun g-> g,f) gs
let rec existsM f = function
  | [] -> None
  | x::xs ->
    match f x with
    | None -> existsM f xs
    | a -> a
let idM (V v) = v
let ck bnf e g =
  let rec ck e g =
    match e,g with
    | L(o2::es),(L(o::gs),f) when o=o2 -> bind f (bind f2 (map2M ck es (addf idM gs)))
    | I i,(X"i",f) -> Some(f (I i))
    | _, (X g,f) when List.mem_assoc g bnf -> bind (fun x-> f (V x)) (existsM (ck e) (List.assoc g bnf))
    | _,_ -> None
  in ck e g

type m = Int of int | Add of m * m | Mul of m * m

let rec show = function
  | Int i -> Printf.sprintf "Int(%d)" i
  | Add(a,b) -> Printf.sprintf "Add(%s,%s)" (show a) (show b)
  | Mul(a,b) -> Printf.sprintf "Mul(%s,%s)" (show a) (show b)
let bnf = [
  "e",[
    X"i",             (fun(I i)->Int i);
    L[X"+";X"e";X"e"],(fun(L[V e1;V e2])->Add(e1,e2));
    L[X"*";X"e";X"e"],(fun(L[V e1;V e2])->Mul(e1,e2));
  ]
]
let _ = Printf.printf "%s\n" (showM (bind show (ck bnf (L[X"*";L[X"+";I 1;I 2];L[X"+";I 3;I 4]]) (X"e",idM))))