(*
#load "camlp4o.cma";;
#load "pa_extend.cmo";;
#load "q_MLast.cmo";;
#load "str.cma";;
*)

open Genlex ;;
type stype = Prop | Symbol of string | Lid of string;;

Grammar.error_verbose := true ;;
let expr_term = Grammar.Entry.create Pcaml.gram "expr_term";;

let create_obj l = (Grammar.Entry.obj (Grammar.Entry.create Pcaml.gram l));;

let make_token rt = function
  |Lid(s) when rt = s -> Gramext.Sself
  |Lid(s) -> Gramext.Snterm (create_obj s)
  |Symbol(s) -> Gramext.Stoken ("", s)
  |Prop -> Gramext.Stoken ("UIDENT", "")
;;

let make_entry rt (token_list,action) =
    let _loc = Token.dummy_loc in
    let el = List.map (make_token rt) token_list in
    let a = (fun _ _ -> <:expr< "dummy_action" >>) in
    (el,Gramext.action (Obj.repr a))
;;

let add_rule label entrylist =
    let lobj =
        match label with
        |"expr" -> Grammar.Entry.obj expr_term
        | _ -> create_obj label
    in
    Grammar.extend
    [
        (lobj, None, [None, None, (List.map (make_entry label) entrylist) ])
    ]
;;

let extgram grams =
    List.iter (fun (id,rules) -> add_rule id rules) grams
;;

let lidtab = Hashtbl.create 17 ;;

let symbol strm =
    match Stream.peek strm with
    |Some("","|") | Some("",";") -> raise Stream.Failure
    |Some("",s) -> Stream.junk strm; Symbol(s)
    |Some("LIDENT",s) when not(Hashtbl.mem lidtab s) -> Stream.junk strm; Symbol(s) 
    |Some("LIDENT",s) -> Stream.junk strm; Lid(s) 
    |Some("UIDENT",s) -> Stream.junk strm; Symbol(s) 
    |_ -> raise Stream.Failure
;;
let symbol = Grammar.Entry.of_parser Pcaml.gram "symbol" symbol ;;

EXTEND GLOBAL: Pcaml.expr Pcaml.str_item;

Pcaml.str_item: [[
    "GRAMMAR"; grams = LIST1 gram; "END" ->
        extgram grams ;
        (* Grammar.print_entry Format.std_formatter (Grammar.Entry.obj expr_term) ;
        print_newline (); *)
        <:str_item< "" >>
]];

gram: [[ p = label; ":="; rules = LIST1 rule SEP "|" ; ";" -> (p,rules) ]];

rule: [[ psl = LIST1 psymbol -> (psl, 1) ]];

psymbol: [[ 
    "VAR" -> Prop
    | e = symbol -> e
]];

label: [[ p = LIDENT -> Hashtbl.add lidtab p () ; p ]];

Pcaml.expr: [[
    "term"; "("; e = expr_term; ")" -> print_endline "ffff" ; e
]];

END
;;

(*
let apply s = Grammar.Entry.parse gram_list (Stream.of_string s);;
(apply "l := VAR");;
(apply "l := l & VAR");;
*)



(* (apply "l := VAR U VAR");; *)

(*
let lexer = Genlex.make_lexer [
    "+";"-";"*";"/";"=";
    "[";"]";"<";">";
    "%";"&";"*";"?";"~"
];;  
let getkwd = function Kwd s -> s | _ -> failwith "aa" ;;
let rec glexer = parser
    [< 'Kwd ("+" | "-" | "*" | "/" 
            |"=" | "[" | "]" | "<"
            |">" | "%" | "&" | "?" | "~" ) as s >] -> ("", getkwd s)
    | [< 'Ident s >] -> ("LIDENT",s)
    | [< >] -> ("EOI","")
;;
let lexer_gmake () = {
    Token.tok_func =
    Token.lexer_func_of_parser (fun s -> (glexer (lexer s), Token.dummy_loc));
    Token.tok_using = (fun _ -> ());
    Token.tok_removing = (fun _ -> ());
    Token.tok_match = Token.default_match;
    Token.tok_text = Token.lexer_text;
    Token.tok_comm = None
}
;;

let symbgrammar = Grammar.Unsafe.gram_reinit grammar (lexer_gmake ());; 
*)