112 lines
4.1 KiB
OCaml
112 lines
4.1 KiB
OCaml
open Trace
|
|
open Parser_ligodity
|
|
module Parser = Parser_ligodity.Parser
|
|
module AST = Parser_ligodity.AST
|
|
|
|
let parse_file (source: string) : AST.t result =
|
|
(* let pp_input =
|
|
* let prefix = Filename.(source |> basename |> remove_extension)
|
|
* and suffix = ".pp.ligo"
|
|
* in prefix ^ suffix in *)
|
|
|
|
(* let cpp_cmd = Printf.sprintf "cpp -traditional-cpp %s > %s"
|
|
* source pp_input in
|
|
* let%bind () = sys_command cpp_cmd in *)
|
|
|
|
let pp_input =
|
|
source
|
|
in
|
|
let%bind channel =
|
|
generic_try (simple_error "error opening file") @@
|
|
(fun () -> open_in pp_input) in
|
|
let lexbuf = Lexing.from_channel channel in
|
|
let read = Lexer.get_token in
|
|
specific_try (function
|
|
| Parser.Error -> (
|
|
let start = Lexing.lexeme_start_p lexbuf in
|
|
let end_ = Lexing.lexeme_end_p lexbuf in
|
|
let str = Format.sprintf
|
|
"Parse error at \"%s\" from (%d, %d) to (%d, %d). In file \"%s|%s\"\n"
|
|
(Lexing.lexeme lexbuf)
|
|
start.pos_lnum (start.pos_cnum - start.pos_bol)
|
|
end_.pos_lnum (end_.pos_cnum - end_.pos_bol)
|
|
start.pos_fname source
|
|
in
|
|
simple_error str
|
|
)
|
|
| Lexer.Error err -> (
|
|
let start = Lexing.lexeme_start_p lexbuf in
|
|
let end_ = Lexing.lexeme_end_p lexbuf in
|
|
let str = Format.sprintf
|
|
"Lexer error (%s) at \"%s\" from (%d, %d) to (%d, %d). In file \"%s|%s\"\n"
|
|
(err.value)
|
|
(Lexing.lexeme lexbuf)
|
|
start.pos_lnum (start.pos_cnum - start.pos_bol)
|
|
end_.pos_lnum (end_.pos_cnum - end_.pos_bol)
|
|
start.pos_fname source
|
|
in
|
|
simple_error str
|
|
)
|
|
| exn ->
|
|
let start = Lexing.lexeme_start_p lexbuf in
|
|
let end_ = Lexing.lexeme_end_p lexbuf in
|
|
let str = Format.sprintf
|
|
"Unrecognized error (%s) at \"%s\" from (%d, %d) to (%d, %d). In file \"%s|%s\"\n"
|
|
(Printexc.to_string exn)
|
|
(Lexing.lexeme lexbuf)
|
|
start.pos_lnum (start.pos_cnum - start.pos_bol)
|
|
end_.pos_lnum (end_.pos_cnum - end_.pos_bol)
|
|
start.pos_fname source
|
|
in
|
|
simple_error str
|
|
) @@ (fun () -> Parser.program read lexbuf) >>? fun raw ->
|
|
ok raw
|
|
|
|
let parse_string (s:string) : AST.t result =
|
|
|
|
let lexbuf = Lexing.from_string s in
|
|
let read = Lexer.get_token in
|
|
specific_try (function
|
|
| Parser.Error -> (
|
|
let start = Lexing.lexeme_start_p lexbuf in
|
|
let end_ = Lexing.lexeme_end_p lexbuf in
|
|
let str = Format.sprintf
|
|
"Parse error at \"%s\" from (%d, %d) to (%d, %d)\n"
|
|
(Lexing.lexeme lexbuf)
|
|
start.pos_lnum (start.pos_cnum - start.pos_bol)
|
|
end_.pos_lnum (end_.pos_cnum - end_.pos_bol) in
|
|
simple_error str
|
|
)
|
|
| _ -> simple_error "unrecognized parse_ error"
|
|
) @@ (fun () -> Parser.program read lexbuf) >>? fun raw ->
|
|
ok raw
|
|
|
|
let parse_expression (s:string) : AST.expr result =
|
|
let lexbuf = Lexing.from_string s in
|
|
let read = Lexer.get_token in
|
|
specific_try (function
|
|
| Parser.Error -> (
|
|
let start = Lexing.lexeme_start_p lexbuf in
|
|
let end_ = Lexing.lexeme_end_p lexbuf in
|
|
let str = Format.sprintf
|
|
"Parse error at \"%s\" from (%d, %d) to (%d, %d)\n"
|
|
(Lexing.lexeme lexbuf)
|
|
start.pos_lnum (start.pos_cnum - start.pos_bol)
|
|
end_.pos_lnum (end_.pos_cnum - end_.pos_bol) in
|
|
simple_error str
|
|
)
|
|
| exn ->
|
|
let start = Lexing.lexeme_start_p lexbuf in
|
|
let end_ = Lexing.lexeme_end_p lexbuf in
|
|
let str = Format.sprintf
|
|
"Unrecognized error (%s) at \"%s\" from (%d, %d) to (%d, %d). In expression \"%s|%s\"\n"
|
|
(Printexc.to_string exn)
|
|
(Lexing.lexeme lexbuf)
|
|
start.pos_lnum (start.pos_cnum - start.pos_bol)
|
|
end_.pos_lnum (end_.pos_cnum - end_.pos_bol)
|
|
start.pos_fname s
|
|
in
|
|
simple_error str
|
|
) @@ (fun () -> Parser.interactive_expr read lexbuf) >>? fun raw ->
|
|
ok raw
|