X-Git-Url: http://git.annexia.org/?a=blobdiff_plain;f=src%2Fparser.mly;h=347c0723b210229e3685f3b89d051798e40608f0;hb=5c8290d1d50fdda7b69641242aced87eea0c267b;hp=3a1712438ea132af989ef8ab2b3b727ba73e8e1c;hpb=214f84c3b07227767fef90934895a167b15113a1;p=goals.git diff --git a/src/parser.mly b/src/parser.mly index 3a17124..347c072 100644 --- a/src/parser.mly +++ b/src/parser.mly @@ -18,7 +18,41 @@ *) %{ +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. *) @@ -29,9 +63,11 @@ open Printf %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 @@ -39,7 +75,7 @@ open Printf %token TACTIC_KEYWORD (* Start nonterminals. *) -%start file +%start file %start expr %% @@ -48,12 +84,14 @@ file: ; stmts: - | list(stmt) - { List.fold_left ( - fun env (name, expr) -> Ast.Env.add name expr env - ) Ast.Env.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 = @@ -61,16 +99,16 @@ stmt: | None -> sprintf "_goal@%d" $startpos.pos_lnum, [] | Some x -> x in - name, Ast.EGoal ($loc, (params, $2, $4, $5)) + name, Ast.EGoalDefn ($loc, (params, $2, $4, $5)) } | goal_stmt CODE { let name, params = $1 in - name, Ast.EGoal ($loc, (params, [], [], Some $2)) + name, Ast.EGoalDefn ($loc, (params, [], [], Some $2)) } | TACTIC_KEYWORD TACTIC params_decl EQUALS CODE { - $2, Ast.ETactic ($loc, ($3, $5)) + $2, Ast.ETacticDefn ($loc, ($3, $5)) } | LET ID EQUALS expr { $2, $4 } ; @@ -102,7 +140,7 @@ pattern_param: expr: | ID params { Ast.ECallGoal ($loc, $1, $2) } | ID { Ast.EVar ($loc, $1) } - | TACTIC params { Ast.ECallTactic ($loc, $1, $2) } + | TACTIC params { Ast.ETacticConstructor ($loc, $1, $2) } | STRING { Ast.ESubsts ($loc, $1) } | LEFT_ARRAY barelist RIGHT_ARRAY { Ast.EList ($loc, $2) } ;