X-Git-Url: http://git.annexia.org/?a=blobdiff_plain;f=src%2Fparser.mly;h=c6f961d2e42285e3add102ed9bc12b0d0c060840;hb=7b7cd85810f18286a36215cc164b659bf7db142c;hp=afc9d18290cfde7487a7fa1abedf807c9710f435;hpb=98a2cfdd3bdf5641e268e7db7c7ea2d23656b296;p=goals.git diff --git a/src/parser.mly b/src/parser.mly index afc9d18..c6f961d 100644 --- a/src/parser.mly +++ b/src/parser.mly @@ -18,26 +18,36 @@ *) %{ +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 %} (* 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 RIGHT_ARRAY %token RIGHT_PAREN %token STRING +%token TACTIC +%token TACTIC_KEYWORD (* Start nonterminals. *) -%start file +%start file %start expr %% @@ -46,45 +56,72 @@ 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 + { + let env = $1 in + let filename = Ast.substitute env $loc $3 in + let rec find_on_include_path = + function + | [] -> filename + | inc :: incs -> + let path = inc // filename in + if Sys.file_exists path then path + else find_on_include_path incs + in + let filename = + if Filename.is_implicit filename then + find_on_include_path Cmdline.includes + else filename in + 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' } + | 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 +131,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 }