Commit 49ded779 authored by POTTIER Francois's avatar POTTIER Francois

Notes on Unicon's grammar.

parent b7bb1be0
/***********************************************************************/
/* */
/* Objective Caml */
/* OCaml */
/* */
/* Xavier Leroy, projet Cristal, INRIA Rocquencourt */
/* */
......@@ -10,8 +10,6 @@
/* */
/***********************************************************************/
/* $Id: parser.mly,v 1.121 2004/10/06 13:06:11 garrigue Exp $ */
/* The parser definition */
%{
......@@ -19,40 +17,41 @@ open Location
open Asttypes
open Longident
open Parsetree
let mktyp d =
{ ptyp_desc = d; ptyp_loc = symbol_rloc() }
let mkpat d =
{ ppat_desc = d; ppat_loc = symbol_rloc() }
let mkexp d =
{ pexp_desc = d; pexp_loc = symbol_rloc() }
let mkmty d =
{ pmty_desc = d; pmty_loc = symbol_rloc() }
let mksig d =
{ psig_desc = d; psig_loc = symbol_rloc() }
let mkmod d =
{ pmod_desc = d; pmod_loc = symbol_rloc() }
let mkstr d =
{ pstr_desc = d; pstr_loc = symbol_rloc() }
let mkfield d =
{ pfield_desc = d; pfield_loc = symbol_rloc() }
let mkclass d =
{ pcl_desc = d; pcl_loc = symbol_rloc() }
let mkcty d =
{ pcty_desc = d; pcty_loc = symbol_rloc() }
open Ast_helper
open Docstrings
let mktyp d = Typ.mk ~loc:(symbol_rloc()) d
let mkpat d = Pat.mk ~loc:(symbol_rloc()) d
let mkexp d = Exp.mk ~loc:(symbol_rloc()) d
let mkmty d = Mty.mk ~loc:(symbol_rloc()) d
let mksig d = Sig.mk ~loc:(symbol_rloc()) d
let mkmod d = Mod.mk ~loc:(symbol_rloc()) d
let mkstr d = Str.mk ~loc:(symbol_rloc()) d
let mkclass d = Cl.mk ~loc:(symbol_rloc()) d
let mkcty d = Cty.mk ~loc:(symbol_rloc()) d
let mkctf ?attrs ?docs d =
Ctf.mk ~loc:(symbol_rloc()) ?attrs ?docs d
let mkcf ?attrs ?docs d =
Cf.mk ~loc:(symbol_rloc()) ?attrs ?docs d
let mkrhs rhs pos = mkloc rhs (rhs_loc pos)
let reloc_pat x = { x with ppat_loc = symbol_rloc () };;
let reloc_exp x = { x with pexp_loc = symbol_rloc () };;
let mkoperator name pos =
{ pexp_desc = Pexp_ident(Lident name); pexp_loc = rhs_loc pos }
let loc = rhs_loc pos in
Exp.mk ~loc (Pexp_ident(mkloc (Lident name) loc))
let mkpatvar name pos =
Pat.mk ~loc:(rhs_loc pos) (Ppat_var (mkrhs name pos))
(*
Ghost expressions and patterns:
expressions and patterns that do not appear explicitely in the
expressions and patterns that do not appear explicitly in the
source file they have the loc_ghost flag set to true.
Then the profiler will not try to instrument them and the
-stypes option will not try to display their type.
-annot option will not try to display their type.
Every grammar rule that generates an element with a location must
make at most one non-ghost element, the topmost one.
......@@ -64,19 +63,17 @@ let mkoperator name pos =
AST node, then the location must be real; in all other cases,
it must be ghost.
*)
let ghexp d = { pexp_desc = d; pexp_loc = symbol_gloc () };;
let ghpat d = { ppat_desc = d; ppat_loc = symbol_gloc () };;
let ghtyp d = { ptyp_desc = d; ptyp_loc = symbol_gloc () };;
let ghexp d = Exp.mk ~loc:(symbol_gloc ()) d
let ghpat d = Pat.mk ~loc:(symbol_gloc ()) d
let ghtyp d = Typ.mk ~loc:(symbol_gloc ()) d
let ghloc d = { txt = d; loc = symbol_gloc () }
let ghstr d = Str.mk ~loc:(symbol_gloc()) d
let mkassert e =
match e with
| {pexp_desc = Pexp_construct (Lident "false", None, false) } ->
mkexp (Pexp_assertfalse)
| _ -> mkexp (Pexp_assert (e))
;;
let ghunit () =
ghexp (Pexp_construct (mknoloc (Lident "()"), None))
let mkinfix arg1 name arg2 =
mkexp(Pexp_apply(mkoperator name 2, ["", arg1; "", arg2]))
mkexp(Pexp_apply(mkoperator name 2, [Nolabel, arg1; Nolabel, arg2]))
let neg_float_string f =
if String.length f > 0 && f.[0] = '-'
......@@ -93,50 +90,68 @@ let mkuminus name arg =
mkexp(Pexp_constant(Const_int64(Int64.neg n)))
| "-", Pexp_constant(Const_nativeint n) ->
mkexp(Pexp_constant(Const_nativeint(Nativeint.neg n)))
| _, Pexp_constant(Const_float f) ->
| ("-" | "-."), Pexp_constant(Const_float f) ->
mkexp(Pexp_constant(Const_float(neg_float_string f)))
| _ ->
mkexp(Pexp_apply(mkoperator ("~" ^ name) 1, ["", arg]))
mkexp(Pexp_apply(mkoperator ("~" ^ name) 1, [Nolabel, arg]))
let mkuplus name arg =
let desc = arg.pexp_desc in
match name, desc with
| "+", Pexp_constant(Const_int _)
| "+", Pexp_constant(Const_int32 _)
| "+", Pexp_constant(Const_int64 _)
| "+", Pexp_constant(Const_nativeint _)
| ("+" | "+."), Pexp_constant(Const_float _) -> mkexp desc
| _ ->
mkexp(Pexp_apply(mkoperator ("~" ^ name) 1, [Nolabel, arg]))
let rec mktailexp = function
let mkexp_cons consloc args loc =
Exp.mk ~loc (Pexp_construct(mkloc (Lident "::") consloc, Some args))
let mkpat_cons consloc args loc =
Pat.mk ~loc (Ppat_construct(mkloc (Lident "::") consloc, Some args))
let rec mktailexp nilloc = function
[] ->
ghexp(Pexp_construct(Lident "[]", None, false))
let loc = { nilloc with loc_ghost = true } in
let nil = { txt = Lident "[]"; loc = loc } in
Exp.mk ~loc (Pexp_construct (nil, None))
| e1 :: el ->
let exp_el = mktailexp el in
let l = {loc_start = e1.pexp_loc.loc_start;
let exp_el = mktailexp nilloc el in
let loc = {loc_start = e1.pexp_loc.loc_start;
loc_end = exp_el.pexp_loc.loc_end;
loc_ghost = true}
in
let arg = {pexp_desc = Pexp_tuple [e1; exp_el]; pexp_loc = l} in
{pexp_desc = Pexp_construct(Lident "::", Some arg, false); pexp_loc = l}
let arg = Exp.mk ~loc (Pexp_tuple [e1; exp_el]) in
mkexp_cons {loc with loc_ghost = true} arg loc
let rec mktailpat = function
let rec mktailpat nilloc = function
[] ->
ghpat(Ppat_construct(Lident "[]", None, false))
let loc = { nilloc with loc_ghost = true } in
let nil = { txt = Lident "[]"; loc = loc } in
Pat.mk ~loc (Ppat_construct (nil, None))
| p1 :: pl ->
let pat_pl = mktailpat pl in
let l = {loc_start = p1.ppat_loc.loc_start;
let pat_pl = mktailpat nilloc pl in
let loc = {loc_start = p1.ppat_loc.loc_start;
loc_end = pat_pl.ppat_loc.loc_end;
loc_ghost = true}
in
let arg = {ppat_desc = Ppat_tuple [p1; pat_pl]; ppat_loc = l} in
{ppat_desc = Ppat_construct(Lident "::", Some arg, false); ppat_loc = l}
let arg = Pat.mk ~loc (Ppat_tuple [p1; pat_pl]) in
mkpat_cons {loc with loc_ghost = true} arg loc
let ghstrexp e =
{ pstr_desc = Pstr_eval e; pstr_loc = {e.pexp_loc with loc_ghost = true} }
let mkstrexp e attrs =
{ pstr_desc = Pstr_eval (e, attrs); pstr_loc = e.pexp_loc }
let array_function str name =
Ldot(Lident str, (if !Clflags.fast then "unsafe_" ^ name else name))
let mkexp_constraint e (t1, t2) =
match t1, t2 with
| Some t, None -> ghexp(Pexp_constraint(e, t))
| _, Some t -> ghexp(Pexp_coerce(e, t1, t))
| None, None -> assert false
let rec deep_mkrangepat c1 c2 =
if c1 = c2 then ghpat(Ppat_constant(Const_char c1)) else
ghpat(Ppat_or(ghpat(Ppat_constant(Const_char c1)),
deep_mkrangepat (Char.chr(Char.code c1 + 1)) c2))
let rec mkrangepat c1 c2 =
if c1 > c2 then mkrangepat c2 c1 else
if c1 = c2 then mkpat(Ppat_constant(Const_char c1)) else
reloc_pat (deep_mkrangepat c1 c2)
let array_function par assign=
let op = if assign then par^"<-" else par in
ghloc ( Lident op )
let syntax_error () =
raise Syntaxerr.Escape_error
......@@ -145,44 +160,244 @@ let unclosed opening_name opening_num closing_name closing_num =
raise(Syntaxerr.Error(Syntaxerr.Unclosed(rhs_loc opening_num, opening_name,
rhs_loc closing_num, closing_name)))
let bigarray_function str name =
Ldot(Ldot(Lident "Bigarray", str), name)
let expecting pos nonterm =
raise Syntaxerr.(Error(Expecting(rhs_loc pos, nonterm)))
let not_expecting pos nonterm =
raise Syntaxerr.(Error(Not_expecting(rhs_loc pos, nonterm)))
let bigarray_function order assign =
let op =
match order with
| 1 -> ".{}"
| 2 -> ".{,}"
| 3 -> ".{,,}"
| _ -> ".{,..,}"
in
let op= if assign then op^"<-" else op in
ghloc ( Lident op )
let bigarray_untuplify = function
{ pexp_desc = Pexp_tuple explist} -> explist
{ pexp_desc = Pexp_tuple explist; pexp_loc = _ } -> explist
| exp -> [exp]
let bigarray_get arr arg =
let get order = bigarray_function order false in
match bigarray_untuplify arg with
[c1] ->
mkexp(Pexp_apply(ghexp(Pexp_ident(bigarray_function "Array1" "get")),
["", arr; "", c1]))
mkexp(Pexp_apply(ghexp(Pexp_ident(get 1)),
[Nolabel, arr; Nolabel, c1]))
| [c1;c2] ->
mkexp(Pexp_apply(ghexp(Pexp_ident(bigarray_function "Array2" "get")),
["", arr; "", c1; "", c2]))
mkexp(Pexp_apply(ghexp(Pexp_ident(get 2)),
[Nolabel, arr; Nolabel, c1; Nolabel, c2]))
| [c1;c2;c3] ->
mkexp(Pexp_apply(ghexp(Pexp_ident(bigarray_function "Array3" "get")),
["", arr; "", c1; "", c2; "", c3]))
mkexp(Pexp_apply(ghexp(Pexp_ident(get 3)),
[Nolabel, arr; Nolabel, c1; Nolabel, c2; Nolabel, c3]))
| coords ->
mkexp(Pexp_apply(ghexp(Pexp_ident(bigarray_function "Genarray" "get")),
["", arr; "", ghexp(Pexp_array coords)]))
mkexp(Pexp_apply(ghexp(Pexp_ident(get 0)),
[Nolabel, arr; Nolabel, ghexp(Pexp_array coords)]))
let bigarray_set arr arg newval =
let set order = bigarray_function order true in
match bigarray_untuplify arg with
[c1] ->
mkexp(Pexp_apply(ghexp(Pexp_ident(bigarray_function "Array1" "set")),
["", arr; "", c1; "", newval]))
mkexp(Pexp_apply(ghexp(Pexp_ident(set 1)),
[Nolabel, arr; Nolabel, c1; Nolabel, newval]))
| [c1;c2] ->
mkexp(Pexp_apply(ghexp(Pexp_ident(bigarray_function "Array2" "set")),
["", arr; "", c1; "", c2; "", newval]))
mkexp(Pexp_apply(ghexp(Pexp_ident(set 2)),
[Nolabel, arr; Nolabel, c1; Nolabel, c2;
Nolabel, newval]))
| [c1;c2;c3] ->
mkexp(Pexp_apply(ghexp(Pexp_ident(bigarray_function "Array3" "set")),
["", arr; "", c1; "", c2; "", c3; "", newval]))
mkexp(Pexp_apply(ghexp(Pexp_ident(set 3)),
[Nolabel, arr; Nolabel, c1; Nolabel, c2; Nolabel, c3;
Nolabel, newval]))
| coords ->
mkexp(Pexp_apply(ghexp(Pexp_ident(bigarray_function "Genarray" "set")),
["", arr;
"", ghexp(Pexp_array coords);
"", newval]))
mkexp(Pexp_apply(ghexp(Pexp_ident(set 0)),
[Nolabel, arr;
Nolabel, ghexp(Pexp_array coords);
Nolabel, newval]))
let lapply p1 p2 =
if !Clflags.applicative_functors
then Lapply(p1, p2)
else raise (Syntaxerr.Error(Syntaxerr.Applicative_path (symbol_rloc())))
let exp_of_label lbl pos =
mkexp (Pexp_ident(mkrhs (Lident(Longident.last lbl)) pos))
let pat_of_label lbl pos =
mkpat (Ppat_var (mkrhs (Longident.last lbl) pos))
let check_variable vl loc v =
if List.mem v vl then
raise Syntaxerr.(Error(Variable_in_scope(loc,v)))
let varify_constructors var_names t =
let rec loop t =
let desc =
match t.ptyp_desc with
| Ptyp_any -> Ptyp_any
| Ptyp_var x ->
check_variable var_names t.ptyp_loc x;
Ptyp_var x
| Ptyp_arrow (label,core_type,core_type') ->
Ptyp_arrow(label, loop core_type, loop core_type')
| Ptyp_tuple lst -> Ptyp_tuple (List.map loop lst)
| Ptyp_constr( { txt = Lident s }, []) when List.mem s var_names ->
Ptyp_var s
| Ptyp_constr(longident, lst) ->
Ptyp_constr(longident, List.map loop lst)
| Ptyp_object (lst, o) ->
Ptyp_object
(List.map (fun (s, attrs, t) -> (s, attrs, loop t)) lst, o)
| Ptyp_class (longident, lst) ->
Ptyp_class (longident, List.map loop lst)
| Ptyp_alias(core_type, string) ->
check_variable var_names t.ptyp_loc string;
Ptyp_alias(loop core_type, string)
| Ptyp_variant(row_field_list, flag, lbl_lst_option) ->
Ptyp_variant(List.map loop_row_field row_field_list,
flag, lbl_lst_option)
| Ptyp_poly(string_lst, core_type) ->
List.iter (check_variable var_names t.ptyp_loc) string_lst;
Ptyp_poly(string_lst, loop core_type)
| Ptyp_package(longident,lst) ->
Ptyp_package(longident,List.map (fun (n,typ) -> (n,loop typ) ) lst)
| Ptyp_extension (s, arg) ->
Ptyp_extension (s, arg)
in
{t with ptyp_desc = desc}
and loop_row_field =
function
| Rtag(label,attrs,flag,lst) ->
Rtag(label,attrs,flag,List.map loop lst)
| Rinherit t ->
Rinherit (loop t)
in
loop t
let mk_newtypes newtypes exp =
List.fold_right (fun newtype exp -> mkexp (Pexp_newtype (newtype, exp)))
newtypes exp
let wrap_type_annotation newtypes core_type body =
let exp = mkexp(Pexp_constraint(body,core_type)) in
let exp = mk_newtypes newtypes exp in
(exp, ghtyp(Ptyp_poly(newtypes,varify_constructors newtypes core_type)))
let wrap_exp_attrs body (ext, attrs) =
(* todo: keep exact location for the entire attribute *)
let body = {body with pexp_attributes = attrs @ body.pexp_attributes} in
match ext with
| None -> body
| Some id -> ghexp(Pexp_extension (id, PStr [mkstrexp body []]))
let mkexp_attrs d attrs =
wrap_exp_attrs (mkexp d) attrs
let text_str pos = Str.text (rhs_text pos)
let text_sig pos = Sig.text (rhs_text pos)
let text_cstr pos = Cf.text (rhs_text pos)
let text_csig pos = Ctf.text (rhs_text pos)
let text_def pos = [Ptop_def (Str.text (rhs_text pos))]
let extra_text text pos items =
let pre_extras = rhs_pre_extra_text pos in
let post_extras = rhs_post_extra_text pos in
text pre_extras @ items @ text post_extras
let extra_str pos items = extra_text Str.text pos items
let extra_sig pos items = extra_text Sig.text pos items
let extra_cstr pos items = extra_text Cf.text pos items
let extra_csig pos items = extra_text Ctf.text pos items
let extra_def pos items =
extra_text (fun txt -> [Ptop_def (Str.text txt)]) pos items
type let_binding =
{ lb_pattern: pattern;
lb_expression: expression;
lb_attributes: attributes;
lb_docs: docs Lazy.t;
lb_text: text Lazy.t;
lb_loc: Location.t; }
type let_bindings =
{ lbs_bindings: let_binding list;
lbs_rec: rec_flag;
lbs_extension: string Asttypes.loc option;
lbs_attributes: attributes;
lbs_loc: Location.t }
let mklb (p, e) attrs =
{ lb_pattern = p;
lb_expression = e;
lb_attributes = attrs;
lb_docs = symbol_docs_lazy ();
lb_text = symbol_text_lazy ();
lb_loc = symbol_rloc (); }
let mklbs (ext, attrs) rf lb =
{ lbs_bindings = [lb];
lbs_rec = rf;
lbs_extension = ext ;
lbs_attributes = attrs;
lbs_loc = symbol_rloc (); }
let addlb lbs lb =
{ lbs with lbs_bindings = lb :: lbs.lbs_bindings }
let val_of_let_bindings lbs =
let str =
match lbs.lbs_bindings with
| [ {lb_pattern = { ppat_desc = Ppat_any; ppat_loc = _ }; _} as lb ] ->
let exp = wrap_exp_attrs lb.lb_expression
(None, lbs.lbs_attributes) in
mkstr (Pstr_eval (exp, lb.lb_attributes))
| bindings ->
if lbs.lbs_attributes <> [] then
raise Syntaxerr.(Error(Not_expecting(lbs.lbs_loc, "attributes")));
let bindings =
List.map
(fun lb ->
Vb.mk ~loc:lb.lb_loc ~attrs:lb.lb_attributes
~docs:(Lazy.force lb.lb_docs)
~text:(Lazy.force lb.lb_text)
lb.lb_pattern lb.lb_expression)
bindings
in
mkstr(Pstr_value(lbs.lbs_rec, List.rev bindings))
in
match lbs.lbs_extension with
| None -> str
| Some id -> ghstr (Pstr_extension((id, PStr [str]), []))
let expr_of_let_bindings lbs body =
let bindings =
List.map
(fun lb ->
if lb.lb_attributes <> [] then
raise Syntaxerr.(Error(Not_expecting(lb.lb_loc, "item attribute")));
Vb.mk ~loc:lb.lb_loc lb.lb_pattern lb.lb_expression)
lbs.lbs_bindings
in
mkexp_attrs (Pexp_let(lbs.lbs_rec, List.rev bindings, body))
(lbs.lbs_extension, lbs.lbs_attributes)
let class_of_let_bindings lbs body =
let bindings =
List.map
(fun lb ->
if lb.lb_attributes <> [] then
raise Syntaxerr.(Error(Not_expecting(lb.lb_loc, "item attribute")));
Vb.mk ~loc:lb.lb_loc lb.lb_pattern lb.lb_expression)
lbs.lbs_bindings
in
if lbs.lbs_extension <> None then
raise Syntaxerr.(Error(Not_expecting(lbs.lbs_loc, "extension")));
if lbs.lbs_attributes <> [] then
raise Syntaxerr.(Error(Not_expecting(lbs.lbs_loc, "attributes")));
mkclass(Pcl_let (lbs.lbs_rec, List.rev bindings, body))
%}
/* Tokens */
......@@ -193,6 +408,7 @@ let bigarray_set arr arg newval =
%token AS
%token ASSERT
%token BACKQUOTE
%token BANG
%token BAR
%token BARBAR
%token BARRBRACKET
......@@ -246,11 +462,16 @@ let bigarray_set arr arg newval =
%token LBRACKETBAR
%token LBRACKETLESS
%token LBRACKETGREATER
%token LBRACKETPERCENT
%token LBRACKETPERCENTPERCENT
%token LESS
%token LESSMINUS
%token LET
%token <string> LIDENT
%token LPAREN
%token LBRACKETAT
%token LBRACKETATAT
%token LBRACKETATATAT
%token MATCH
%token METHOD
%token MINUS
......@@ -260,17 +481,20 @@ let bigarray_set arr arg newval =
%token MUTABLE
%token <nativeint> NATIVEINT
%token NEW
%token NONREC
%token OBJECT
%token OF
%token OPEN
%token <string> OPTLABEL
%token OR
/* %token PARSER */
%token PERCENT
%token PLUS
%token PLUSDOT
%token PLUSEQ
%token <string> PREFIXOP
%token PRIVATE
%token QUESTION
%token QUESTIONQUESTION
%token QUOTE
%token RBRACE
%token RBRACKET
......@@ -279,9 +503,10 @@ let bigarray_set arr arg newval =
%token SEMI
%token SEMISEMI
%token SHARP
%token <string> SHARPOP
%token SIG
%token STAR
%token <string> STRING
%token <string * string option> STRING
%token STRUCT
%token THEN
%token TILDE
......@@ -296,6 +521,10 @@ let bigarray_set arr arg newval =
%token WHEN
%token WHILE
%token WITH
%token <string * Location.t> COMMENT
%token <Docstrings.docstring> DOCSTRING
%token EOL
/* Precedences and associativities.
......@@ -341,21 +570,26 @@ The precedences must be listed from low to high.
%nonassoc below_EQUAL
%left INFIXOP0 EQUAL LESS GREATER /* expr (e OP e OP e) */
%right INFIXOP1 /* expr (e OP e OP e) */
%nonassoc below_LBRACKETAT
%nonassoc LBRACKETAT
%nonassoc LBRACKETATAT
%right COLONCOLON /* expr (e :: e :: e) */
%left INFIXOP2 PLUS MINUS MINUSDOT /* expr (e OP e OP e) */
%left INFIXOP3 STAR /* expr (e OP e OP e) */
%left INFIXOP2 PLUS PLUSDOT MINUS MINUSDOT PLUSEQ /* expr (e OP e OP e) */
%left PERCENT INFIXOP3 STAR /* expr (e OP e OP e) */
%right INFIXOP4 /* expr (e OP e OP e) */
%nonassoc prec_unary_minus /* unary - */
%nonassoc prec_unary_minus prec_unary_plus /* unary - */
%nonassoc prec_constant_constructor /* cf. simple_expr (C versus C x) */
%nonassoc prec_constr_appl /* above AS BAR COLONCOLON COMMA */
%nonassoc below_SHARP
%nonassoc SHARP /* simple_expr/toplevel_directive */
%left SHARPOP
%nonassoc below_DOT
%nonassoc DOT
/* Finally, the first tokens of simple_expr are above everything else. */
%nonassoc BACKQUOTE BEGIN CHAR FALSE FLOAT INT INT32 INT64
%nonassoc BACKQUOTE BANG BEGIN CHAR FALSE FLOAT INT INT32 INT64
LBRACE LBRACELESS LBRACKET LBRACKETBAR LIDENT LPAREN
NEW NATIVEINT PREFIXOP STRING TRUE UIDENT
LBRACKETPERCENT LBRACKETPERCENTPERCENT
/* Entry points */
......@@ -368,54 +602,109 @@ The precedences must be listed from low to high.
%type <Parsetree.toplevel_phrase> toplevel_phrase
%start use_file /* for the #use directive */
%type <Parsetree.toplevel_phrase list> use_file
%start parse_core_type
%type <Parsetree.core_type> parse_core_type
%start parse_expression
%type <Parsetree.expression> parse_expression
%start parse_pattern
%type <Parsetree.pattern> parse_pattern
%%
/* Entry points */
implementation:
structure EOF { $1 }
structure EOF { extra_str 1 $1 }
;
interface:
signature EOF { List.rev $1 }
signature EOF { extra_sig 1 $1 }
;
toplevel_phrase:
top_structure SEMISEMI { Ptop_def $1 }
| seq_expr SEMISEMI { Ptop_def[ghstrexp $1] }
top_structure SEMISEMI { Ptop_def (extra_str 1 $1) }
| toplevel_directive SEMISEMI { $1 }
| EOF { raise End_of_file }
;
top_structure:
structure_item { [$1] }
| structure_item top_structure { $1 :: $2 }
seq_expr post_item_attributes
{ (text_str 1) @ [mkstrexp $1 $2] }
| top_structure_tail
{ $1 }
;
top_structure_tail:
/* empty */ { [] }
| structure_item top_structure_tail { (text_str 1) @ $1 :: $2 }
;
use_file:
use_file_body { extra_def 1 $1 }
;
use_file_body:
use_file_tail { $1 }
| seq_expr use_file_tail { Ptop_def[ghstrexp $1] :: $2 }
| seq_expr post_item_attributes use_file_tail
{ (text_def 1) @ Ptop_def[mkstrexp $1 $2] :: $3 }
;