Version française
Home     About     Download     Resources     Contact us    
Browse thread
Encoding an extensible parse tree and subtyping within OCaml
[ Home ] [ Index: by date | by threads ]
[ Search: ]

[ Message by date: previous | next ] [ Message in thread: previous | next ] [ Thread: previous | next ]
Date: -- (:)
From: ocaml@o...
Subject: Encoding an extensible parse tree and subtyping within 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')
;;