X-Git-Url: http://git.annexia.org/?a=blobdiff_plain;f=src%2Fparser.mly;h=e45e90b27502bcffd6d5c063d9e86fa24f5df2f5;hb=091e4a356a31c64e0f1e943e20badb5613f1b21f;hp=afc9d18290cfde7487a7fa1abedf807c9710f435;hpb=98a2cfdd3bdf5641e268e7db7c7ea2d23656b296;p=goals.git diff --git a/src/parser.mly b/src/parser.mly index afc9d18..e45e90b 100644 --- a/src/parser.mly +++ b/src/parser.mly @@ -18,26 +18,64 @@ *) %{ +open Utils open Printf + +(* This is initialized with Lexer.read once the program + * starts. Doing this avoids a circular dependency caused + * by include files. + *) +let lexer_read = ref None + +let find_on_include_path filename = + if not (Filename.is_implicit filename) then filename + else ( + let rec loop = function + | [] -> filename + | inc :: incs -> + let path = inc // filename in + if Sys.file_exists path then path else loop incs + in + loop Cmdline.includes + ) + +let do_include env loc filename optflag file = + let filename = Ast.substitute env loc filename in + let filename = find_on_include_path filename in + if optflag && not (Sys.file_exists filename) then env + else ( + let fp = open_in filename in + let lexbuf = Lexing.from_channel fp in + lexbuf.lex_curr_p <- { lexbuf.lex_curr_p with pos_fname = filename }; + let reader = + match !lexer_read with None -> assert false | Some r -> r in + let env' = file reader lexbuf in + close_in fp; + Ast.Env.merge env env' + ) %} (* Tokens. *) %token CODE %token COLON %token COMMA -%token ID %token EQUALS %token EOF %token GOAL +%token ID +%token INCLUDE %token LEFT_ARRAY %token LEFT_PAREN %token LET +%token OPTINCLUDE %token RIGHT_ARRAY %token RIGHT_PAREN %token STRING +%token TACTIC +%token TACTIC_KEYWORD (* Start nonterminals. *) -%start file +%start file %start expr %% @@ -46,45 +84,51 @@ file: ; stmts: - | list(stmt) - { List.fold_left ( - fun env (name, expr) -> Ast.StringMap.add name expr env - ) Ast.StringMap.empty $1 - } + | (* none *) { Ast.Env.empty } + | stmts INCLUDE STRING + { do_include $1 $loc $3 false file } + | stmts OPTINCLUDE STRING + { do_include $1 $loc $3 true file } + | stmts stmt { let name, expr = $2 in Ast.Env.add name expr $1 } ; + stmt: | option(goal_stmt) patterns COLON barelist option(CODE) { let name, params = match $1 with | None -> - let pos = $startpos in - sprintf "_goal@%d" pos.pos_lnum, [] + sprintf "_goal@%d" $startpos.pos_lnum, [] | Some x -> x in - name, Ast.EGoal (params, $2, $4, $5) + name, Ast.EGoal ($loc, (params, $2, $4, $5)) } | goal_stmt CODE { let name, params = $1 in - name, Ast.EGoal (params, [], [], Some $2) + name, Ast.EGoal ($loc, (params, [], [], Some $2)) + } + | TACTIC_KEYWORD TACTIC params_decl EQUALS CODE + { + $2, Ast.ETactic ($loc, ($3, $5)) } | LET ID EQUALS expr { $2, $4 } ; goal_stmt: - | GOAL ID option(param_decl) EQUALS + | GOAL ID option(params_decl) EQUALS { $2, match $3 with None -> [] | Some ps -> ps } ; -param_decl: - | LEFT_PAREN separated_list(COMMA, ID) RIGHT_PAREN { $2 } +params_decl: + | LEFT_PAREN separated_list(COMMA, param_decl) RIGHT_PAREN { $2 } ; +param_decl: + | ID { $1 } patterns: | separated_list(COMMA, pattern) { $1 } ; pattern: - | STRING { Ast.PTactic ("file", [$1]) } - | ID pattern_params { Ast.PTactic ($1, $2) } - | ID { Ast.PVar $1 } + | STRING { Ast.PTactic ($loc, "*file", [$1]) } + | ID pattern_params { Ast.PTactic ($loc, $1, $2) } ; pattern_params: | LEFT_PAREN separated_list(COMMA, pattern_param) RIGHT_PAREN { $2 } @@ -94,10 +138,11 @@ pattern_param: ; expr: - | ID params { Ast.ECall ($1, $2) } - | ID { Ast.EVar $1 (* This might be replaced with ECall later. *) } - | STRING { Ast.ESubsts $1 } - | LEFT_ARRAY barelist RIGHT_ARRAY { Ast.EList $2 } + | ID params { Ast.ECallGoal ($loc, $1, $2) } + | ID { Ast.EVar ($loc, $1) } + | TACTIC params { Ast.ECallTactic ($loc, $1, $2) } + | STRING { Ast.ESubsts ($loc, $1) } + | LEFT_ARRAY barelist RIGHT_ARRAY { Ast.EList ($loc, $2) } ; barelist: | separated_list(COMMA, expr) { $1 }