|
@@ -1,36 +1,27 @@
|
|
|
open Lexing
|
|
open Lexing
|
|
|
-open Printf
|
|
|
|
|
open Ast
|
|
open Ast
|
|
|
|
|
|
|
|
let get_loc lexbuf =
|
|
let get_loc lexbuf =
|
|
|
Util.loc_from_lexpos lexbuf.lex_curr_p lexbuf.lex_curr_p
|
|
Util.loc_from_lexpos lexbuf.lex_curr_p lexbuf.lex_curr_p
|
|
|
|
|
|
|
|
|
|
+let shift_loc (fname, ystart, yend, xstart, xend) yshift xshift =
|
|
|
|
|
+ (fname, ystart + yshift, yend + yshift, xstart + xshift, xend + xshift)
|
|
|
|
|
+
|
|
|
let parse_with_error lexbuf =
|
|
let parse_with_error lexbuf =
|
|
|
try Some (Parser.program Lexer.token lexbuf) with
|
|
try Some (Parser.program Lexer.token lexbuf) with
|
|
|
| Lexer.SyntaxError msg ->
|
|
| Lexer.SyntaxError msg ->
|
|
|
- raise (LocError (get_loc lexbuf, msg))
|
|
|
|
|
|
|
+ raise (LocError (shift_loc (get_loc lexbuf) 0 (-1), msg))
|
|
|
| Parser.Error ->
|
|
| Parser.Error ->
|
|
|
raise (LocError (get_loc lexbuf, "syntax error"))
|
|
raise (LocError (get_loc lexbuf, "syntax error"))
|
|
|
|
|
|
|
|
let phase input =
|
|
let phase input =
|
|
|
- print_endline "- Parse input";
|
|
|
|
|
|
|
+ prerr_endline "- Parse input";
|
|
|
match input with
|
|
match input with
|
|
|
- | Args args ->
|
|
|
|
|
- let infile = match args.filename with
|
|
|
|
|
- | Some value -> open_in value
|
|
|
|
|
- | None -> stdin
|
|
|
|
|
- in
|
|
|
|
|
- let display_name = match args.filename with
|
|
|
|
|
- | Some value -> value
|
|
|
|
|
- | None -> "stdin"
|
|
|
|
|
- in
|
|
|
|
|
-
|
|
|
|
|
- let lexbuf = Lexing.from_channel infile in
|
|
|
|
|
|
|
+ | FileContent (display_name, content, args) ->
|
|
|
|
|
+ let lexbuf = Lexing.from_string content in
|
|
|
lexbuf.lex_curr_p <- { lexbuf.lex_curr_p with pos_fname = display_name };
|
|
lexbuf.lex_curr_p <- { lexbuf.lex_curr_p with pos_fname = display_name };
|
|
|
let ast = parse_with_error lexbuf in
|
|
let ast = parse_with_error lexbuf in
|
|
|
- close_in infile;
|
|
|
|
|
-
|
|
|
|
|
(match ast with
|
|
(match ast with
|
|
|
- | None -> raise (CompileError "error during parsing")
|
|
|
|
|
- | Some ast -> Ast (ast, args))
|
|
|
|
|
|
|
+ | None -> raise (CompileError "no syntax tree was constructed")
|
|
|
|
|
+ | Some node -> Ast (node, args))
|
|
|
| _ -> raise (InvalidInput "parse")
|
|
| _ -> raise (InvalidInput "parse")
|