Encoding an extensible parse tree and subtyping within OCaml

Encoding an extensible parse tree and subtyping within OCaml

[ocaml]

Hi,
     Is there a good way to encode a parse tree in OCaml where the terms
     in the parse tree can be extended later?  Essentially, it would be
     nice not to represent the trees for different grammars separately
     so that code for type checking, evaluation, or pretty printing can
     be reused.  I'm including one possible solution below that seems to
     work reasonably well, but I'm interested in whether this can be
     done better.  The two things that would be nice to improve upon the
     example are preventing statements such as "bad" where improper
     trees are created.  It would also be nice to have the OCaml type
     system flag an error on the line with "`Junk". Though, it does give
     a warning now.  

Joe

type base = [`Int of int];;
type 'a basic= [base | `Add of 'a*'a | `Sub of 'a*'a ];;
type 'a ext= ['a basic | `Mul of 'a*'a];;

type basic'=('a basic as 'a) basic;;
type ext'=('a ext as 'a) ext;;

let (x:'a basic)=`Add (`Int 1,`Int 2);;
let (y:'a ext)=`Mul (x,`Int 3);;
let (z:'a basic)=`Add (`Int 3,x);;
let w=`Add (`Mul (`Int 1,`Int 2),`Int 3);;
let (bad:'a basic)=`Add (1,2);;


let pp x=
    let rec pp (x:ext') =
        match x with
        | `Int x-> Printf.printf "%d" x
        | `Add (x,y) ->
            pp x; Printf.printf "+"; pp y
        | `Sub (x,y) ->
            pp x; Printf.printf "-"; pp y
        | `Mul (x,y) ->
            pp x; Printf.printf "*"; pp y
        | `Junk -> Printf.printf "BAD!"
    in
    pp (x :> ext');Printf.printf "\n"
;;

let eval x=
    let rec eval (x:basic')=
        match x with
        | `Int x -> x
        | `Add (x,y) -> (eval x) + (eval y)
        | `Sub (x,y) -> (eval x) - (eval y)
    in
    eval (x:>basic')
;;

Re: [Caml-list] Encoding an extensible parse tree and subtyping within OCaml

[Markus Mottl]

On Wed, Mar 3, 2010 at 12:11,  <ocaml@optimojoe.com> wrote:
> type basic'=('a basic as 'a) basic;;
> type ext'=('a ext as 'a) ext;;

This could also be written as:

  type basic' = basic' basic
  type ext' = ext' ext

Cyclic types are acceptable to the compiler if the cycle is on
polymorphic variants.

> let (x:'a basic)=`Add (`Int 1,`Int 2);;
> let (y:'a ext)=`Mul (x,`Int 3);;
> let (z:'a basic)=`Add (`Int 3,x);;
> let w=`Add (`Mul (`Int 1,`Int 2),`Int 3);;
> let (bad:'a basic)=`Add (1,2);;

When solving the problem with "bad", type constraints are your friend.
 Just define type 'basic" as e.g.:

  type 'a basic= [base | `Add of 'a*'a | `Sub of 'a*'a ] constraint 'a
= [> base];;

To fix the "Junk" problem, you may need to specify the type for one of
the patterns, e.g.:

       match x with
       | (`Int x : ext')-> Printf.printf "%d" x
       ...

But the function itself is not extensible.  To achieve this, you'll
have to define it in a similar way as we did for the type by
introducing another parameter to "tie the recursive knot".  E.g.
(ignore incorrect printing of arithmetic expressions):

  let pp_base (`Int n) = Printf.printf "%d" n

  let pp_basic pp = function
    | #base as base -> pp_base base
    | `Add (l, r) -> pp l; Printf.printf "+"; pp r
    | `Sub (l, r) -> pp l; Printf.printf "-"; pp r

  let pp_ext pp = function
    | #basic as basic -> pp_basic pp basic
    | `Mul (l, r) -> pp l; Printf.printf "*"; pp r

  let rec pp_basic' basic' = pp_basic pp_basic' basic'
  let rec pp_ext' ext' = pp_ext pp_ext' ext'

You will need to constrain a pattern with a type again if you want to
make sure that the pattern match fails in the right place (match case)
if unsupported tags are added.  You could also turn warnings into
errors, which should also fail on the "unused match case" then.

IMHO, these features of polymorphic variants are the best thing since
sliced bread, since they allow for elegant extensibility of e.g.
recursive DSLs.

Regards,
Markus

-- 
Markus Mottl        http://www.ocaml.info        markus.mottl@gmail.com