haskal
/
utop
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

update optcomp 

Ignore-this: 524a25072a03d9507026255ae6189510

darcs-hash:20111223215332-c41ad-712fbfc49be95dd491957de824bbec079517be11
This commit is contained in:
Jeremie Dimino 2011-12-23 22:53:32 +01:00
parent b340d4292d
commit 516f2c4800
1 changed files with 297 additions and 131 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

428
syntax/pa_optcomp.ml
View File

@ -38,8 +38,8 @@ module Env = Map.Make(struct type t = ident let compare = compare end)
type env = value Env.t type env = value Env.t
type directive = type directive =
| Dir_let of ident * Ast.expr | Dir_let of Ast.patt * Ast.expr
| Dir_default of ident * Ast.expr | Dir_default of Ast.patt * Ast.expr
| Dir_if of Ast.expr | Dir_if of Ast.expr
| Dir_else | Dir_else
| Dir_elif of Ast.expr | Dir_elif of Ast.expr
@ -62,9 +62,9 @@ let next_quotation_id =
let r = ref 0 in let r = ref 0 in
fun _ -> incr r; !r fun _ -> incr r; !r
(* +-------------+ (* +-----------------------------------------------------------------+
| Environment | | Environment |
+-------------+ *) +-----------------------------------------------------------------+ *)
let env = ref Env.empty let env = ref Env.empty
let define id value = env := Env.add id value !env let define id value = env := Env.add id value !env
@ -75,9 +75,9 @@ let _ =
let dirs = ref [] let dirs = ref []
let add_include_dir dir = dirs := dir :: !dirs let add_include_dir dir = dirs := dir :: !dirs
(* +--------------+ (* +-----------------------------------------------------------------+
| Dependencies | | Dependencies |
+--------------+ *) +-----------------------------------------------------------------+ *)
module String_set = Set.Make(String) module String_set = Set.Make(String)
@ -108,9 +108,9 @@ let write_depencies () =
end; end;
close_out oc close_out oc
(* +----------------------------------------+ (* +-----------------------------------------------------------------+
| Value to expression/pattern conversion | | Value to expression/pattern conversion |
+----------------------------------------+ *) +-----------------------------------------------------------------+ *)
let rec expr_of_value _loc = function let rec expr_of_value _loc = function
| Bool true -> <:expr< true >> | Bool true -> <:expr< true >>
@ -132,9 +132,83 @@ let rec patt_of_value _loc = function
| Tuple [x] -> patt_of_value _loc x | Tuple [x] -> patt_of_value _loc x
| Tuple l -> <:patt< $tup:Ast.paCom_of_list (List.map (patt_of_value _loc) l)$ >> | Tuple l -> <:patt< $tup:Ast.paCom_of_list (List.map (patt_of_value _loc) l)$ >>
(* +-----------------------+ (* +-----------------------------------------------------------------+
| Expression evaluation | | Value printing |
+-----------------------+ *) +-----------------------------------------------------------------+ *)
let string_of_value string_of_bool v =
let buf = Buffer.create 128 in
let rec aux = function
| Bool b ->
Buffer.add_string buf (string_of_bool b)
| Int n ->
Buffer.add_string buf (string_of_int n)
| Char ch ->
Buffer.add_char buf '\'';
Buffer.add_string buf (Char.escaped ch);
Buffer.add_char buf '\''
| String s ->
Buffer.add_char buf '"';
Buffer.add_string buf (String.escaped s);
Buffer.add_char buf '"'
| Tuple [] ->
Buffer.add_string buf "()"
| Tuple (x :: l) ->
Buffer.add_char buf '(';
aux x;
List.iter
(fun x ->
Buffer.add_string buf ", ";
aux x)
l;
Buffer.add_char buf ')'
in
aux v;
Buffer.contents buf
let string_of_value_o v =
string_of_value
(function
| true -> "true"
| false -> "false")
v
let string_of_value_r v =
string_of_value
(function
| true -> "True"
| false -> "False")
v
let string_of_value_no_pretty v =
let buf = Buffer.create 128 in
let rec aux = function
| Bool b ->
Buffer.add_string buf (string_of_bool b)
| Int n ->
Buffer.add_string buf (string_of_int n)
| Char ch ->
Buffer.add_char buf ch
| String s ->
Buffer.add_string buf s;
| Tuple [] ->
Buffer.add_string buf "()"
| Tuple (x :: l) ->
Buffer.add_char buf '(';
aux x;
List.iter
(fun x ->
Buffer.add_string buf ", ";
aux x)
l;
Buffer.add_char buf ')'
in
aux v;
Buffer.contents buf
(* +-----------------------------------------------------------------+
| Expression evaluation |
+-----------------------------------------------------------------+ *)
let rec type_of_value = function let rec type_of_value = function
| Bool _ -> Tbool | Bool _ -> Tbool
@ -225,32 +299,101 @@ let rec eval env = function
| <:expr< fst $x$ >> -> fst (eval_pair env x) | <:expr< fst $x$ >> -> fst (eval_pair env x)
| <:expr< snd $x$ >> -> snd (eval_pair env x) | <:expr< snd $x$ >> -> snd (eval_pair env x)
(* Conversions *)
| <:expr@loc< to_string $x$ >> ->
String(string_of_value_no_pretty (eval env x))
| <:expr@loc< to_int $x$ >> ->
Int
(match eval env x with
| String x -> begin
try
int_of_string x
with exn ->
Loc.raise loc exn
end
| Int x ->
x
| Char x ->
int_of_char x
| Bool _ ->
Loc.raise loc (Failure "cannot convert a boolean to an integer")
| Tuple _ ->
Loc.raise loc (Failure "cannot convert a tuple to an integer"))
| <:expr@loc< to_bool $x$ >> ->
Bool
(match eval env x with
| String x -> begin
try
bool_of_string x
with exn ->
Loc.raise loc exn
end
| Int x ->
Loc.raise loc (Failure "cannot convert an integer to a boolean")
| Char x ->
Loc.raise loc (Failure "cannot convert a character to a boolean")
| Bool x ->
x
| Tuple _ ->
Loc.raise loc (Failure "cannot convert a tuple to a boolean"))
| <:expr@loc< to_char $x$ >> ->
Char
(match eval env x with
| String x ->
if String.length x = 1 then
x.[0]
else
Loc.raise loc (Failure (Printf.sprintf "cannot convert a string of length %d to a character" (String.length x)))
| Int x -> begin
try
char_of_int x
with exn ->
Loc.raise loc exn
end
| Char x ->
x
| Bool _ ->
Loc.raise loc (Failure "cannot convert a boolean to a character")
| Tuple _ ->
Loc.raise loc (Failure "cannot convert a tuple to a character"))
(* Pretty printing *)
| <:expr@loc< show $x$ >> ->
String(string_of_value_o (eval env x))
(* Let-binding *) (* Let-binding *)
| <:expr< let $p$ = $x$ in $y$ >> -> | <:expr< let $p$ = $x$ in $y$ >> ->
let vx = eval env x in let vx = eval env x in
let env = let env =
try try
bind env p vx bind true env p vx
with with Exit ->
Exit -> invalid_type (Ast.loc_of_expr x) (type_of_patt p) (type_of_value vx) invalid_type (Ast.loc_of_expr x) (type_of_patt p) (type_of_value vx)
in in
eval env y eval env y
| e -> Loc.raise (Ast.loc_of_expr e) (Stream.Error "expression not supported") | e -> Loc.raise (Ast.loc_of_expr e) (Stream.Error "expression not supported")
and bind env patt value = match patt with and bind override env patt value = match patt with
| <:patt< $lid:id$ >> -> | <:patt< $lid:id$ >>
Env.add id value env | <:patt< $uid:id$ >> ->
if override || not (Env.mem id env) then
Env.add id value env
else
env
| <:patt< $tup:patts$ >> -> | <:patt< $tup:patts$ >> ->
let patts = Ast.list_of_patt patts [] in let patts = Ast.list_of_patt patts [] in
begin match value with begin match value with
| Tuple values when List.length values = List.length patts -> | Tuple values when List.length values = List.length patts ->
List.fold_left2 bind env patts values List.fold_left2 (bind override) env patts values
| _ -> | _ ->
raise Exit raise Exit
end end
| <:patt< _ >> ->
env
| _ -> | _ ->
Loc.raise (Ast.loc_of_patt patt) (Stream.Error "pattern not supported") Loc.raise (Ast.loc_of_patt patt) (Stream.Error "pattern not supported")
@ -274,13 +417,17 @@ and eval_string env e = match eval env e with
| String x -> x | String x -> x
| v -> invalid_type (Ast.loc_of_expr e) Tstring (type_of_value v) | v -> invalid_type (Ast.loc_of_expr e) Tstring (type_of_value v)
and eval_char env e = match eval env e with
| Char x -> x
| v -> invalid_type (Ast.loc_of_expr e) Tchar (type_of_value v)
and eval_pair env e = match eval env e with and eval_pair env e = match eval env e with
| Tuple [x; y] -> (x, y) | Tuple [x; y] -> (x, y)
| v -> invalid_type (Ast.loc_of_expr e) (Ttuple [Tvar "a"; Tvar "b"]) (type_of_value v) | v -> invalid_type (Ast.loc_of_expr e) (Ttuple [Tvar "a"; Tvar "b"]) (type_of_value v)
(* +-----------------------+ (* +-----------------------------------------------------------------+
| Parsing of directives | | Parsing of directives |
+-----------------------+ *) +-----------------------------------------------------------------+ *)
let rec skip_space stream = match Stream.peek stream with let rec skip_space stream = match Stream.peek stream with
| Some((BLANKS _ | COMMENT _), _) -> | Some((BLANKS _ | COMMENT _), _) ->
@ -289,12 +436,6 @@ let rec skip_space stream = match Stream.peek stream with
| _ -> | _ ->
() ()
let parse_equal stream =
skip_space stream;
match Stream.next stream with
| KEYWORD "=", _ -> ()
| _, loc -> Loc.raise loc (Stream.Error "'=' expected")
let rec parse_eol stream = let rec parse_eol stream =
let tok, loc = Stream.next stream in let tok, loc = Stream.next stream in
match tok with match tok with
@ -324,37 +465,44 @@ let parse_ident stream =
let tok, loc = Stream.next stream in let tok, loc = Stream.next stream in
begin match tok with begin match tok with
| LIDENT id | UIDENT id -> | LIDENT id | UIDENT id ->
id (id, loc)
| KEYWORD kwd when keyword_is_id kwd -> | KEYWORD kwd when keyword_is_id kwd ->
kwd (kwd, loc)
| _ -> | _ ->
Loc.raise loc (Stream.Error "identifier expected") Loc.raise loc (Stream.Error "identifier expected")
end end
let parse_expr stream = let parse_until entry is_stop_token stream =
(* Lists of opened brackets *) (* Lists of opened brackets *)
let opened_brackets = ref [] in let opened_brackets = ref [] in
let end_loc = ref Loc.ghost in
(* Return the next token of [stream] until all opened parentheses (* Return the next token of [stream] until all opened parentheses
have been closed and a newline is reached *) have been closed and a newline is reached *)
let rec next_token _ = let rec next_token _ =
Some(match Stream.next stream, !opened_brackets with Some(match Stream.next stream, !opened_brackets with
| (NEWLINE, loc), [] -> | (tok, loc), [] when is_stop_token tok ->
EOI, loc end_loc := loc;
(EOI, loc)
| (KEYWORD("(" | "[" | "{" as b), _) as x, l -> | (EOI, loc), _ ->
end_loc := loc;
(EOI, loc)
| ((KEYWORD ("(" | "[" | "{" as b) | SYMBOL ("(" | "[" | "{" as b)), _) as x, l ->
opened_brackets := b :: l; opened_brackets := b :: l;
x x
| (KEYWORD ")", loc) as x, "(" :: l -> | ((KEYWORD ")" | SYMBOL ")"), loc) as x, "(" :: l ->
opened_brackets := l; opened_brackets := l;
x x
| (KEYWORD "]", loc) as x, "[" :: l -> | ((KEYWORD "]" | SYMBOL "]"), loc) as x, "[" :: l ->
opened_brackets := l; opened_brackets := l;
x x
| (KEYWORD "}", loc) as x, "{" :: l -> | ((KEYWORD "}" | SYMBOL "}"), loc) as x, "{" :: l ->
opened_brackets := l; opened_brackets := l;
x x
@ -362,81 +510,77 @@ let parse_expr stream =
x) x)
in in
Gram.parse_tokens_before_filter Syntax.expr_eoi let expr =
(not_filtered (Stream.from next_token)) Gram.parse_tokens_before_filter entry
(not_filtered (Stream.from next_token))
in
(expr, Loc.join !end_loc)
let parse_expr stream =
parse_until Syntax.expr_eoi (fun tok -> tok = NEWLINE) stream
let parse_patt stream =
parse_until Syntax.patt_eoi (function
| SYMBOL "=" | KEYWORD "=" -> true
| _ -> false) stream
let parse_directive stream = match Stream.peek stream with let parse_directive stream = match Stream.peek stream with
| Some(KEYWORD "#", loc) -> | Some((KEYWORD "#" | SYMBOL "#"), loc) -> begin
Stream.junk stream; Stream.junk stream;
(* Move the location to the beginning of the line *) let dir, loc_dir = parse_ident stream in
let (file_name,
start_line, start_bol, start_off,
stop_line, stop_bol, stop_off,
ghost) = Loc.to_tuple loc in
let loc = Loc.of_tuple (file_name,
start_line, start_bol, start_bol,
start_line, start_bol, start_bol,
ghost) in
begin match parse_ident stream with match dir with
| "let" -> | "let" ->
let id = parse_ident stream in let patt, _ = parse_patt stream in
parse_equal stream; let expr, end_loc = parse_expr stream in
let expr = parse_expr stream in Some(Dir_let(patt, expr), Loc.merge loc end_loc)
Some(Dir_let(id, expr), loc)
| "let_default" -> | "let_default" ->
let id = parse_ident stream in let patt, _ = parse_patt stream in
parse_equal stream; let expr, end_loc = parse_expr stream in
let expr = parse_expr stream in Some(Dir_default(patt, expr), Loc.merge loc end_loc)
Some(Dir_default(id, expr), loc)
(* For compatibility *)
| "define" ->
let id = parse_ident stream in
let expr = parse_expr stream in
Some(Dir_let(id, expr), loc)
(* For compatibility *)
| "default" ->
let id = parse_ident stream in
let expr = parse_expr stream in
Some(Dir_default(id, expr), loc)
| "if" -> | "if" ->
Some(Dir_if(parse_expr stream), loc) let expr, end_loc = parse_expr stream in
Some(Dir_if expr, Loc.merge loc end_loc)
| "else" -> | "else" ->
parse_eol stream; parse_eol stream;
Some(Dir_else, loc) Some(Dir_else, Loc.merge loc loc_dir)
| "elif" -> | "elif" ->
Some(Dir_elif(parse_expr stream), loc) let expr, end_loc = parse_expr stream in
Some(Dir_elif expr, Loc.merge loc end_loc)
| "endif" -> | "endif" ->
parse_eol stream; parse_eol stream;
Some(Dir_endif, loc) Some(Dir_endif, Loc.merge loc loc_dir)
| "include" -> | "include" ->
Some(Dir_include(parse_expr stream), loc) let expr, end_loc = parse_expr stream in
Some(Dir_include expr, Loc.merge loc end_loc)
| "directory" -> | "directory" ->
Some(Dir_directory(parse_expr stream), loc) let expr, end_loc = parse_expr stream in
Some(Dir_directory expr, Loc.merge loc end_loc)
| "error" -> | "error" ->
Some(Dir_error(parse_expr stream), loc) let expr, end_loc = parse_expr stream in
Some(Dir_error expr, Loc.merge loc end_loc)
| "warning" -> | "warning" ->
Some(Dir_warning(parse_expr stream), loc) let expr, end_loc = parse_expr stream in
Some(Dir_warning expr, Loc.merge loc end_loc)
| "default_quotation" -> | "default_quotation" ->
Some(Dir_default_quotation(parse_expr stream), loc) let expr, end_loc = parse_expr stream in
Some(Dir_default_quotation expr, Loc.merge loc end_loc)
| dir -> | _ ->
Loc.raise loc (Stream.Error (Printf.sprintf "bad directive ``%s''" dir)) Loc.raise loc_dir (Stream.Error (Printf.sprintf "unknown directive ``%s''" dir))
end end
| _ -> | _ ->
None None
@ -447,9 +591,9 @@ let parse_command_line_define str =
| <:expr< $uid:id$ = $e$ >> -> define id (eval !env e) | <:expr< $uid:id$ = $e$ >> -> define id (eval !env e)
| _ -> invalid_arg str | _ -> invalid_arg str
(* +----------------+ (* +-----------------------------------------------------------------+
| BLock skipping | | Block skipping |
+----------------+ *) +-----------------------------------------------------------------+ *)
let rec skip_line stream = let rec skip_line stream =
match Stream.next stream with match Stream.next stream with
@ -507,9 +651,9 @@ and skip_else stream =
| _ -> | _ ->
skip_else stream skip_else stream
(* +-----------------+ (* +-----------------------------------------------------------------+
| Token filtering | | Token filtering |
+-----------------+ *) +-----------------------------------------------------------------+ *)
type context = Ctx_if | Ctx_else type context = Ctx_if | Ctx_else
@ -555,7 +699,7 @@ let really_read state =
(tok, loc) (tok, loc)
(* Return the next token from a stream, interpreting directives. *) (* Return the next token from a stream, interpreting directives. *)
let rec next_token state_ref = let rec next_token lexer state_ref =
let state = !state_ref in let state = !state_ref in
if state.bol then if state.bol then
match parse_directive state.stream, state.stack with match parse_directive state.stream, state.stack with
@ -563,18 +707,18 @@ let rec next_token state_ref =
let rec aux e = let rec aux e =
if eval_bool !env e then begin if eval_bool !env e then begin
state.stack <- Ctx_if :: state.stack; state.stack <- Ctx_if :: state.stack;
next_token state_ref next_token lexer state_ref
end else end else
match next_endif state.stream with match next_endif state.stream with
| Dir_else -> | Dir_else ->
state.stack <- Ctx_else :: state.stack; state.stack <- Ctx_else :: state.stack;
next_token state_ref next_token lexer state_ref
| Dir_elif e -> | Dir_elif e ->
aux e aux e
| Dir_endif -> | Dir_endif ->
next_token state_ref next_token lexer state_ref
| _ -> | _ ->
assert false assert false
@ -593,25 +737,36 @@ let rec next_token state_ref =
| Some(Dir_else, loc), Ctx_if :: l -> | Some(Dir_else, loc), Ctx_if :: l ->
skip_else state.stream; skip_else state.stream;
state.stack <- l; state.stack <- l;
next_token state_ref next_token lexer state_ref
| Some(Dir_elif _, loc), Ctx_if :: l -> | Some(Dir_elif _, loc), Ctx_if :: l ->
skip_if state.stream; skip_if state.stream;
state.stack <- l; state.stack <- l;
next_token state_ref next_token lexer state_ref
| Some(Dir_endif, loc), _ :: l -> | Some(Dir_endif, loc), _ :: l ->
state.stack <- l; state.stack <- l;
next_token state_ref next_token lexer state_ref
| Some(Dir_let(id, e), _), _ -> | Some(Dir_let(patt, expr), _), _ ->
define id (eval !env e); let value = eval !env expr in
next_token state_ref env := (
try
bind true !env patt value;
with Exit ->
invalid_type (Ast.loc_of_expr expr) (type_of_patt patt) (type_of_value value)
);
next_token lexer state_ref
| Some(Dir_default(id, e), _), _ -> | Some(Dir_default(patt, expr), _), _ ->
if not (Env.mem id !env) then let value = eval !env expr in
define id (eval !env e); env := (
next_token state_ref try
bind false !env patt value;
with Exit ->
invalid_type (Ast.loc_of_expr expr) (type_of_patt patt) (type_of_value value)
);
next_token lexer state_ref
| Some(Dir_include e, _), _ -> | Some(Dir_include e, _), _ ->
let fname = eval_string !env e in let fname = eval_string !env e in
@ -626,7 +781,7 @@ let rec next_token state_ref =
dependencies := String_set.add fname !dependencies; dependencies := String_set.add fname !dependencies;
let ic = open_in fname in let ic = open_in fname in
let nested_state = { let nested_state = {
stream = Gram.Token.Filter.filter (Gram.get_filter ()) (filter (Gram.lex (Loc.mk fname) (Stream.of_channel ic))); stream = lexer fname ic;
bol = true; bol = true;
stack = []; stack = [];
on_eoi = (fun _ -> on_eoi = (fun _ ->
@ -634,27 +789,27 @@ let rec next_token state_ref =
eoi *) eoi *)
state_ref := state; state_ref := state;
close_in ic; close_in ic;
next_token state_ref) next_token lexer state_ref)
} in } in
(* Replace current state with the new one *) (* Replace current state with the new one *)
state_ref := nested_state; state_ref := nested_state;
next_token state_ref next_token lexer state_ref
| Some(Dir_directory e, loc), _ -> | Some(Dir_directory e, loc), _ ->
let dir = eval_string !env e in let dir = eval_string !env e in
add_include_dir dir; add_include_dir dir;
next_token state_ref next_token lexer state_ref
| Some(Dir_error e, loc), _ -> | Some(Dir_error e, loc), _ ->
Loc.raise loc (Failure (eval_string !env e)) Loc.raise loc (Failure (eval_string !env e))
| Some(Dir_warning e, loc), _ -> | Some(Dir_warning e, loc), _ ->
Syntax.print_warning loc (eval_string !env e); Syntax.print_warning loc (eval_string !env e);
next_token state_ref next_token lexer state_ref
| Some(Dir_default_quotation e, loc), _ -> | Some(Dir_default_quotation e, loc), _ ->
Syntax.Quotation.default := eval_string !env e; Syntax.Quotation.default := eval_string !env e;
next_token state_ref next_token lexer state_ref
| None, _ -> | None, _ ->
really_read state really_read state
@ -662,41 +817,52 @@ let rec next_token state_ref =
else else
really_read state really_read state
let stream_filter filter stream = let default_lexer fname ic =
Token.Filter.filter (Gram.get_filter ()) (filter (Gram.lex (Loc.mk fname) (Stream.of_channel ic)))
let stream_filter lexer filter stream =
(* Set the source filename *) (* Set the source filename *)
begin match !source_filename with begin
| Some _ -> match !source_filename with
() | Some _ ->
| None -> ()
match Stream.peek stream with | None ->
| None -> match Stream.peek stream with
() | None ->
| Some(tok, loc) -> ()
source_filename := Some(Loc.file_name loc) | Some(tok, loc) ->
source_filename := Some(Loc.file_name loc)
end; end;
let state_ref = ref { stream = stream; let state_ref = ref { stream = stream;
bol = true; bol = true;
stack = []; stack = [];
on_eoi = (fun x -> x) } in on_eoi = (fun x -> x) } in
filter (Stream.from (fun _ -> Some(next_token state_ref))) filter (Stream.from (fun _ -> Some(next_token lexer state_ref)))
(* +----------------------+ let filter ?(lexer=default_lexer) stream = stream_filter lexer (fun x -> x) stream
| Quotations expansion |
+----------------------+ *) (* +-----------------------------------------------------------------+
| Quotations expansion |
+-----------------------------------------------------------------+ *)
let get_quotation_value str =
Hashtbl.find quotations (int_of_string str)
let expand f loc _ contents = let expand f loc _ contents =
try try
f loc (Hashtbl.find quotations (int_of_string contents)) f loc (get_quotation_value contents)
with with exn ->
exn -> Loc.raise loc (Failure "fatal error in optcomp!") Loc.raise loc (Failure "fatal error in optcomp!")
(* +--------------+ (* +-----------------------------------------------------------------+
| Registration | | Registration |
+--------------+ *) +-----------------------------------------------------------------+ *)
let _ = let _ =
Camlp4.Options.add "-let" (Arg.String parse_command_line_define) Camlp4.Options.add "-let" (Arg.String parse_command_line_define)
"<string> Binding for a #let directive."; "<string> Binding for a #let directive.";
Camlp4.Options.add "-I" (Arg.String add_include_dir)
"<string> Add a directory to #include search path.";
Camlp4.Options.add "-depend" Camlp4.Options.add "-depend"
(Arg.String (fun filename -> dependency_filename := Some filename)) (Arg.String (fun filename -> dependency_filename := Some filename))
"<file> Write dependencies to <file>."; "<file> Write dependencies to <file>.";
@ -706,4 +872,4 @@ let _ =
Syntax.Quotation.add "optcomp" Syntax.Quotation.DynAst.expr_tag (expand expr_of_value); Syntax.Quotation.add "optcomp" Syntax.Quotation.DynAst.expr_tag (expand expr_of_value);
Syntax.Quotation.add "optcomp" Syntax.Quotation.DynAst.patt_tag (expand patt_of_value); Syntax.Quotation.add "optcomp" Syntax.Quotation.DynAst.patt_tag (expand patt_of_value);
Gram.Token.Filter.define_filter (Gram.get_filter ()) stream_filter Gram.Token.Filter.define_filter (Gram.get_filter ()) (stream_filter default_lexer)