Obj.t : Illegal instruction (and camlp4)

[Pietro Abate <Pietro.Abate@anu.edu.au>]

[-- Attachment #1: Type: text/plain, Size: 2226 bytes --]

Hi all,

I hope somebody can answer this one... I'm trying to write a small proof
of concept pre-processor that modifies the grammar on the fly giving an
initial specification and the parse the rest of the file by using this
extended grammar. I've managed to extend the grammar and to parse an
instruction by using this extended grammar, but now I'm stuck when
trying to applying a camlp4 action (Gramext.action). I think that
the problem is related to the fact that Gramext.action is of type Obj.t
and I'm not really experience with this kind of problems. Briefly, this
is the incriminated piece of code (the entire file is attached).

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) ])
    ]
;;

add_rule basically extend the grammar (EXTEND statement in camlp4) by
calling make_entry, that for each rule creates a list of entry of type
Gramext.g_symbol and an action of type Gramext.g_action . The action
should be a function ('a -> MLast.expr) where 'a is related to the
number of arguments associated with the specific rule (I think).

To compile the extension:
camlp4o pa_extend.cmo q_MLast.cmo pr_o.cmo extbnf.ml > pa_extbnf.ml
ocamlfind ocamlc -package camlp4 camlp4.cma str.cma pa_extbnf.ml

this is my test file:
------ testfile.ml -----
GRAMMAR
expr := expr & expr | VAR ;
END
let a = term ( A & B ) ;;
-------------------------

If I try to use the pre-processor on this file:

camlp4o -I . q_MLast.cmo pr_o.cmo pa_extbnf.cmo testfile.ml

I simply get "Illegal instruction"

Help :)
p

ps: I hope not to answer myself again in a few hours :)

-- 
++ Blog: http://blog.rsise.anu.edu.au/?q=pietro
++ 
++ "All great truths begin as blasphemies." -George Bernard Shaw
++ Please avoid sending me Word or PowerPoint attachments.
   See http://www.fsf.org/philosophy/no-word-attachments.html

[-- Attachment #2: extbnf.ml --]
[-- Type: text/plain, Size: 3137 bytes --]


(*
#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 ());; 
*)



[-- Attachment #3: testfile.ml --]
[-- Type: text/plain, Size: 136 bytes --]

(*pp camlp4o -I . pa_extend.cmo q_MLast.cmo *)

GRAMMAR
(* l := l & l  *)
expr := expr & expr | VAR ;
END


let a = term ( A & B ) ;;