(* AST *)
(* $Id: ast.ml,v 1.3 2004/07/25 20:40:23 berke Exp $ *)

type ident = string

type ('a,'b) boolean =
| And of ('a,'b) boolean * ('a,'b) boolean
| Or of ('a,'b) boolean * ('a,'b) boolean
| Not of ('a,'b) boolean
| True
| False
| Atom of 'a
| Meta of 'b * ('a,'b) boolean
and 'a relational =
| Identity
| Union of 'a relational * 'a relational
| Intersection of 'a relational * 'a relational
| Complement of 'a relational
| Star of 'a relational
| Plus of 'a relational
| Compose of 'a relational * 'a relational
| Reverse of 'a relational
| Relation of 'a

type regexp_option =
| Case_insensitive
| Word_boundary

type statement =
| Assign of ident * int * int * set_query
| Display of set_query
and relation =
| Field_link of field_spec
and atomic_set =
| Matches of field_spec * pattern
| Reference of ident
and pattern =
| Exact of string
| Lexicographic_le of string
| Lexicographic_lt of string
| Lexicographic_ge of string
| Lexicographic_gt of string
| Regular of string * regexp_option list
and field_spec =
| Current_field
| Some_field of pattern
| This_field of string
| Either_field of field_spec * field_spec
and meta =
| With_field of field_spec
| Apply_relation of relation relational
and set_query = (atomic_set, meta) boolean

let string_of_regexp_option = function
| Case_insensitive -> "Case_insensitive"
| Word_boundary -> "Word_boundary"

let rec dump_set_query f = function
| Matches(fd,pat) ->
    Format.fprintf f "Matches(@[";
    dump_field f fd;
    Format.fprintf f ",@,";
    dump_pattern f pat;
    Format.fprintf f "@])"
| Reference(id) -> Format.fprintf f "Reference(%s)" id
and dump_set_query_boolean f = function
| And(qb1,qb2) -> 
    Format.fprintf f "And(@[";
    dump_set_query_boolean f qb1;
    Format.fprintf f ",@,";
    dump_set_query_boolean f qb2;
    Format.fprintf f "@])"
| Or(qb1,qb2) -> 
    Format.fprintf f "Or(@[";
    dump_set_query_boolean f qb1;
    Format.fprintf f ",@,";
    dump_set_query_boolean f qb2;
    Format.fprintf f "@])"
| Not(qb) -> 
    Format.fprintf f "Not(@[";
    dump_set_query_boolean f qb;
    Format.fprintf f "@])"
| Atom(q) ->
    Format.fprintf f "Atom(@[";
    dump_set_query f q;
    Format.fprintf f "@])"
| True -> Format.fprintf f "True"
| False -> Format.fprintf f "False"
| Meta(With_field(fs),qb) ->
    Format.fprintf f "With_field(@[";
    dump_field f fs;
    Format.fprintf f ",@,";
    dump_set_query_boolean f qb;
    Format.fprintf f "@])"
| Meta(Apply_relation(r),qb) ->
  Format.fprintf f "Meta(Apply_relation(@[..., ";
  dump_set_query_boolean f qb;
  Format.fprintf f "@])"
and dump_statement f = function
| Display(qb) ->
    Format.fprintf f "Display(@[";
    dump_set_query_boolean f qb;
    Format.fprintf f "@])"
| Assign(id,i1,i2,qb) ->
    Format.fprintf f "Assign(@[%s, %d, %d, " id i1 i2;
    dump_set_query_boolean f qb;
    Format.fprintf f "@])"
and dump_field f = function
| Either_field(f1,f2) ->
    Format.fprintf f "Either_field(@[";
    dump_field f f1;
    Format.fprintf f ",@,";
    dump_field f f2;
    Format.fprintf f "@])"
| Some_field(pat) -> Format.fprintf f "Some_field(@["; dump_pattern f pat; Format.fprintf f "@])"
| This_field(x) -> Format.fprintf f "This_field(%S)" x
| Current_field -> Format.fprintf f "Current_field"
and dump_pattern f = function
| Exact(x) -> Format.fprintf f "Exact(%S)" x
| Lexicographic_le(x) -> Format.fprintf f "Lexicographic_le(%S)" x
| Lexicographic_lt(x) -> Format.fprintf f "Lexicographic_lt(%S)" x
| Lexicographic_ge(x) -> Format.fprintf f "Lexicographic_ge(%S)" x
| Lexicographic_gt(x) -> Format.fprintf f "Lexicographic_gt(%S)" x
| Regular(x,y) -> Format.fprintf f "Regular(%S,[%s])" x
    (String.concat ";" (List.map string_of_regexp_option y))

let dump f s =
  dump_statement f s;
  Format.fprintf f "@."
