add cameligo to the cli
This commit is contained in:
parent
9059c3c2f1
commit
009b0331e9
@ -11,95 +11,76 @@ let main =
|
||||
let term = Term.(const print_endline $ const "Ligo needs a command. Do ligo --help") in
|
||||
(term , Term.info "ligo")
|
||||
|
||||
let source =
|
||||
let open Arg in
|
||||
let info =
|
||||
let docv = "SOURCE_FILE" in
|
||||
let doc = "$(docv) is the path to the .ligo file of the contract." in
|
||||
info ~docv ~doc [] in
|
||||
required @@ pos 0 (some string) None info
|
||||
|
||||
let entry_point =
|
||||
let open Arg in
|
||||
let info =
|
||||
let docv = "ENTRY_POINT" in
|
||||
let doc = "$(docv) is entry-point that will be compiled." in
|
||||
info ~docv ~doc [] in
|
||||
value @@ pos 1 string "main" info
|
||||
|
||||
let expression =
|
||||
let open Arg in
|
||||
let docv = "EXPRESSION" in
|
||||
let doc = "$(docv) is the expression that will be compiled." in
|
||||
let info = info ~docv ~doc [] in
|
||||
required @@ pos 2 (some string) None info
|
||||
|
||||
let syntax =
|
||||
let open Arg in
|
||||
let info =
|
||||
let docv = "SYNTAX" in
|
||||
let doc = "$(docv) is the syntax that will be used. Currently supported syntaxes are \"pascaligo\" and \"cameligo\". \"pascaligo\" is the default." in
|
||||
info ~docv ~doc [] in
|
||||
value @@ opt string "pascaligo" info
|
||||
|
||||
let compile_file =
|
||||
let f source entry_point =
|
||||
let f source entry_point syntax =
|
||||
toplevel @@
|
||||
let%bind contract =
|
||||
trace (simple_error "compile michelson") @@
|
||||
Ligo.Contract.compile_contract_file source entry_point in
|
||||
Ligo.Contract.compile_contract_file source entry_point syntax in
|
||||
Format.printf "Contract:\n%s\n" contract ;
|
||||
ok ()
|
||||
in
|
||||
let term =
|
||||
let source =
|
||||
let open Arg in
|
||||
let info =
|
||||
let docv = "SOURCE_FILE" in
|
||||
let doc = "$(docv) is the path to the .ligo file of the contract." in
|
||||
info ~docv ~doc [] in
|
||||
required @@ pos 0 (some string) None info in
|
||||
let entry_point =
|
||||
let open Arg in
|
||||
let info =
|
||||
let docv = "ENTRY_POINT" in
|
||||
let doc = "$(docv) is entry-point that will be compiled." in
|
||||
info ~docv ~doc [] in
|
||||
value @@ pos 1 string "main" info in
|
||||
Term.(const f $ source $ entry_point) in
|
||||
Term.(const f $ source $ entry_point $ syntax) in
|
||||
let docs = "Compile contracts." in
|
||||
(term , Term.info ~docs "compile-contract")
|
||||
|
||||
let compile_parameter =
|
||||
let f source entry_point expression =
|
||||
let f source entry_point expression syntax =
|
||||
toplevel @@
|
||||
let%bind value =
|
||||
trace (simple_error "compile-input") @@
|
||||
Ligo.Contract.compile_contract_parameter source entry_point expression in
|
||||
Ligo.Contract.compile_contract_parameter source entry_point expression syntax in
|
||||
Format.printf "Input:\n%s\n" value;
|
||||
ok ()
|
||||
in
|
||||
let term =
|
||||
let source =
|
||||
let open Arg in
|
||||
let docv = "SOURCE_FILE" in
|
||||
let doc = "$(docv) is the path to the .ligo file of the contract." in
|
||||
let info = info ~docv ~doc [] in
|
||||
required @@ pos 0 (some string) None info in
|
||||
let entry_point =
|
||||
let open Arg in
|
||||
let docv = "ENTRY_POINT" in
|
||||
let doc = "$(docv) is the entry-point of the contract." in
|
||||
let info = info ~docv ~doc [] in
|
||||
required @@ pos 1 (some string) None info in
|
||||
let expression =
|
||||
let open Arg in
|
||||
let docv = "EXPRESSION" in
|
||||
let doc = "$(docv) is the expression that will be compiled." in
|
||||
let info = info ~docv ~doc [] in
|
||||
required @@ pos 2 (some string) None info in
|
||||
Term.(const f $ source $ entry_point $ expression) in
|
||||
Term.(const f $ source $ entry_point $ expression $ syntax) in
|
||||
let docs = "Compile contracts parameters." in
|
||||
(term , Term.info ~docs "compile-parameter")
|
||||
|
||||
let compile_storage =
|
||||
let f source entry_point expression =
|
||||
let f source entry_point expression syntax =
|
||||
toplevel @@
|
||||
let%bind value =
|
||||
trace (simple_error "compile-storage") @@
|
||||
Ligo.Contract.compile_contract_storage source entry_point expression in
|
||||
Ligo.Contract.compile_contract_storage source entry_point expression syntax in
|
||||
Format.printf "Storage:\n%s\n" value;
|
||||
ok ()
|
||||
in
|
||||
let term =
|
||||
let source =
|
||||
let open Arg in
|
||||
let docv = "SOURCE_FILE" in
|
||||
let doc = "$(docv) is the path to the .ligo file of the contract." in
|
||||
let info = info ~docv ~doc [] in
|
||||
required @@ pos 0 (some string) None info in
|
||||
let entry_point =
|
||||
let open Arg in
|
||||
let docv = "ENTRY_POINT" in
|
||||
let doc = "$(docv) is the entry-point of the contract." in
|
||||
let info = info ~docv ~doc [] in
|
||||
required @@ pos 1 (some string) None info in
|
||||
let expression =
|
||||
let open Arg in
|
||||
let docv = "EXPRESSION" in
|
||||
let doc = "$(docv) is the expression that will be compiled." in
|
||||
let info = info ~docv ~doc [] in
|
||||
required @@ pos 2 (some string) None info in
|
||||
Term.(const f $ source $ entry_point $ expression) in
|
||||
Term.(const f $ source $ entry_point $ expression $ syntax) in
|
||||
let docs = "Compile contracts storage." in
|
||||
(term , Term.info ~docs "compile-storage")
|
||||
|
||||
|
@ -59,13 +59,60 @@ let transpile_value
|
||||
let%bind r = Run_mini_c.run_entry f input in
|
||||
ok r
|
||||
|
||||
let compile_contract_file : string -> string -> string result = fun source entry_point ->
|
||||
let parsify_pascaligo = fun source ->
|
||||
let%bind raw =
|
||||
trace (simple_error "parsing") @@
|
||||
Parser.parse_file source in
|
||||
Parser.Pascaligo.parse_file source in
|
||||
let%bind simplified =
|
||||
trace (simple_error "simplifying") @@
|
||||
Simplify.Pascaligo.simpl_program raw in
|
||||
ok simplified
|
||||
|
||||
let parsify_expression_pascaligo = fun source ->
|
||||
let%bind raw =
|
||||
trace (simple_error "parsing expression") @@
|
||||
Parser.Pascaligo.parse_expression source in
|
||||
let%bind simplified =
|
||||
trace (simple_error "simplifying expression") @@
|
||||
Simplify.Pascaligo.simpl_expression raw in
|
||||
ok simplified
|
||||
|
||||
let parsify_ligodity = fun source ->
|
||||
let%bind raw =
|
||||
trace (simple_error "parsing") @@
|
||||
Parser.Ligodity.parse_file source in
|
||||
let%bind simplified =
|
||||
trace (simple_error "simplifying") @@
|
||||
Simplify.Ligodity.simpl_program raw in
|
||||
ok simplified
|
||||
|
||||
let parsify_expression_ligodity = fun source ->
|
||||
let%bind raw =
|
||||
trace (simple_error "parsing expression") @@
|
||||
Parser.Ligodity.parse_expression source in
|
||||
let%bind simplified =
|
||||
trace (simple_error "simplifying expression") @@
|
||||
Simplify.Ligodity.simpl_expression raw in
|
||||
ok simplified
|
||||
|
||||
let parsify = fun syntax source ->
|
||||
let%bind parsify = match syntax with
|
||||
| "pascaligo" -> ok parsify_pascaligo
|
||||
| "cameligo"
|
||||
| _ -> simple_fail "unrecognized parser"
|
||||
in
|
||||
parsify source
|
||||
|
||||
let parsify_expression = fun syntax source ->
|
||||
let%bind parsify = match syntax with
|
||||
| "pascaligo" -> ok parsify_expression_pascaligo
|
||||
| "cameligo"
|
||||
| _ -> simple_fail "unrecognized parser"
|
||||
in
|
||||
parsify source
|
||||
|
||||
let compile_contract_file : string -> string -> string -> string result = fun source entry_point syntax ->
|
||||
let%bind simplified = parsify syntax source in
|
||||
let%bind () =
|
||||
assert_entry_point_defined simplified entry_point in
|
||||
let%bind typed =
|
||||
@ -81,14 +128,9 @@ let compile_contract_file : string -> string -> string result = fun source entry
|
||||
Format.asprintf "%a" Michelson.pp_stripped michelson in
|
||||
ok str
|
||||
|
||||
let compile_contract_parameter : string -> string -> string -> string result = fun source entry_point expression ->
|
||||
let compile_contract_parameter : string -> string -> string -> string -> string result = fun source entry_point expression syntax ->
|
||||
let%bind (program , parameter_tv) =
|
||||
let%bind raw =
|
||||
trace (simple_error "parsing file") @@
|
||||
Parser.parse_file source in
|
||||
let%bind simplified =
|
||||
trace (simple_error "simplifying file") @@
|
||||
Simplify.Pascaligo.simpl_program raw in
|
||||
let%bind simplified = parsify syntax source in
|
||||
let%bind () =
|
||||
assert_entry_point_defined simplified entry_point in
|
||||
let%bind typed =
|
||||
@ -99,13 +141,8 @@ let compile_contract_parameter : string -> string -> string -> string result = f
|
||||
ok (typed , param_ty)
|
||||
in
|
||||
let%bind expr =
|
||||
let%bind raw =
|
||||
trace (simple_error "parsing expression") @@
|
||||
Parser.parse_expression expression in
|
||||
let%bind simplified =
|
||||
trace (simple_error "simplifying expression") @@
|
||||
Simplify.Pascaligo.simpl_expression raw in
|
||||
let%bind typed =
|
||||
let%bind simplified = parsify_expression syntax expression in
|
||||
let env =
|
||||
let last_declaration = Location.unwrap List.(hd @@ rev program) in
|
||||
match last_declaration with
|
||||
@ -129,14 +166,9 @@ let compile_contract_parameter : string -> string -> string -> string result = f
|
||||
ok expr
|
||||
|
||||
|
||||
let compile_contract_storage : string -> string -> string -> string result = fun source entry_point expression ->
|
||||
let compile_contract_storage : string -> string -> string -> string -> string result = fun source entry_point expression syntax ->
|
||||
let%bind (program , storage_tv) =
|
||||
let%bind raw =
|
||||
trace (simple_error "parsing file") @@
|
||||
Parser.parse_file source in
|
||||
let%bind simplified =
|
||||
trace (simple_error "simplifying file") @@
|
||||
Simplify.Pascaligo.simpl_program raw in
|
||||
let%bind simplified = parsify syntax source in
|
||||
let%bind () =
|
||||
assert_entry_point_defined simplified entry_point in
|
||||
let%bind typed =
|
||||
@ -147,12 +179,7 @@ let compile_contract_storage : string -> string -> string -> string result = fun
|
||||
ok (typed , storage_ty)
|
||||
in
|
||||
let%bind expr =
|
||||
let%bind raw =
|
||||
trace (simple_error "parsing expression") @@
|
||||
Parser.parse_expression expression in
|
||||
let%bind simplified =
|
||||
trace (simple_error "simplifying expression") @@
|
||||
Simplify.Pascaligo.simpl_expression raw in
|
||||
let%bind simplified = parsify_expression syntax expression in
|
||||
let%bind typed =
|
||||
let env =
|
||||
let last_declaration = Location.unwrap List.(hd @@ rev program) in
|
||||
|
@ -46,7 +46,7 @@ let compile : Mini_c.program -> string -> Compiler.Program.compiled_program resu
|
||||
|
||||
let type_file ?(debug_simplify = false) ?(debug_typed = false)
|
||||
(path:string) : AST_Typed.program result =
|
||||
let%bind raw = Parser.parse_file path in
|
||||
let%bind raw = Parser.Pascaligo.parse_file path in
|
||||
let%bind simpl =
|
||||
trace (simple_error "simplifying") @@
|
||||
simplify raw in
|
||||
@ -162,35 +162,5 @@ let easy_run_typed_simplified
|
||||
let%bind annotated_result = untype_expression typed_result in
|
||||
ok annotated_result
|
||||
|
||||
let easy_run_main_typed
|
||||
?(debug_mini_c = false)
|
||||
(program:AST_Typed.program) (input:AST_Typed.annotated_expression) : AST_Typed.annotated_expression result =
|
||||
easy_run_typed ~debug_mini_c "main" program input
|
||||
|
||||
let easy_run_main (path:string) (input:string) : AST_Typed.annotated_expression result =
|
||||
let%bind typed = type_file path in
|
||||
|
||||
let%bind raw_expr = Parser.parse_expression input in
|
||||
let%bind simpl_expr = simplify_expr raw_expr in
|
||||
let%bind typed_expr = type_expression simpl_expr in
|
||||
easy_run_main_typed typed typed_expr
|
||||
|
||||
let compile_file (source: string) (entry_point:string) : Michelson.t result =
|
||||
let%bind raw =
|
||||
trace (simple_error "parsing") @@
|
||||
Parser.parse_file source in
|
||||
let%bind simplified =
|
||||
trace (simple_error "simplifying") @@
|
||||
simplify raw in
|
||||
let%bind typed =
|
||||
trace (simple_error "typing") @@
|
||||
type_ simplified in
|
||||
let%bind mini_c =
|
||||
trace (simple_error "transpiling") @@
|
||||
transpile typed in
|
||||
let%bind {body = michelson} =
|
||||
trace (simple_error "compiling") @@
|
||||
compile mini_c entry_point in
|
||||
ok michelson
|
||||
|
||||
module Contract = Contract
|
||||
|
95
src/parser/ligodity.ml
Normal file
95
src/parser/ligodity.ml
Normal file
@ -0,0 +1,95 @@
|
||||
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%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
|
||||
)
|
||||
| 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.expr read lexbuf) >>? fun raw ->
|
||||
ok raw
|
@ -184,8 +184,9 @@ let norm_fun_expr patterns expr =
|
||||
|
||||
(* Entry points *)
|
||||
|
||||
%start program
|
||||
%start program expr
|
||||
%type <AST.t> program
|
||||
%type <AST.expr> expr
|
||||
|
||||
%%
|
||||
|
||||
|
@ -1,117 +1,5 @@
|
||||
open Trace
|
||||
|
||||
module Pascaligo = Parser_pascaligo
|
||||
module Pascaligo = Pascaligo
|
||||
module Camligo = Parser_camligo
|
||||
module Ligodity = Parser_ligodity
|
||||
|
||||
open Parser_pascaligo
|
||||
module AST_Raw = Parser_pascaligo.AST
|
||||
module Ligodity = Ligodity
|
||||
|
||||
|
||||
let parse_file (source: string) : AST_Raw.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%bind channel =
|
||||
generic_try (simple_error "error opening file") @@
|
||||
(fun () -> open_in pp_input) in
|
||||
let lexbuf = Lexing.from_channel channel in
|
||||
let module Lexer = Lexer.Make(LexToken) in
|
||||
let Lexer.{read ; close ; _} =
|
||||
Lexer.open_token_stream None 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
|
||||
)
|
||||
| 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 () ->
|
||||
let raw = Parser.contract read lexbuf in
|
||||
close () ;
|
||||
raw
|
||||
) >>? fun raw ->
|
||||
ok raw
|
||||
|
||||
let parse_string (s:string) : AST_Raw.t result =
|
||||
let lexbuf = Lexing.from_string s in
|
||||
let module Lexer = Lexer.Make(LexToken) in
|
||||
let Lexer.{read ; close ; _} =
|
||||
Lexer.open_token_stream None 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 () ->
|
||||
let raw = Parser.contract read lexbuf in
|
||||
close () ;
|
||||
raw
|
||||
) >>? fun raw ->
|
||||
ok raw
|
||||
|
||||
let parse_expression (s:string) : AST_Raw.expr result =
|
||||
let lexbuf = Lexing.from_string s in
|
||||
let module Lexer = Lexer.Make(LexToken) in
|
||||
let Lexer.{read ; close; _} =
|
||||
Lexer.open_token_stream None 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 () ->
|
||||
let raw = Parser.interactive_expr read lexbuf in
|
||||
close () ;
|
||||
raw
|
||||
) >>? fun raw ->
|
||||
ok raw
|
||||
|
114
src/parser/pascaligo.ml
Normal file
114
src/parser/pascaligo.ml
Normal file
@ -0,0 +1,114 @@
|
||||
open Trace
|
||||
open Parser_pascaligo
|
||||
module Parser = Parser_pascaligo.Parser
|
||||
module AST = Parser_pascaligo.AST
|
||||
module ParserLog = Parser_pascaligo.ParserLog
|
||||
|
||||
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%bind channel =
|
||||
generic_try (simple_error "error opening file") @@
|
||||
(fun () -> open_in pp_input) in
|
||||
let lexbuf = Lexing.from_channel channel in
|
||||
let module Lexer = Lexer.Make(LexToken) in
|
||||
let Lexer.{read ; close ; _} =
|
||||
Lexer.open_token_stream None 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
|
||||
)
|
||||
| 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 () ->
|
||||
let raw = Parser.contract read lexbuf in
|
||||
close () ;
|
||||
raw
|
||||
) >>? fun raw ->
|
||||
ok raw
|
||||
|
||||
let parse_string (s:string) : AST.t result =
|
||||
|
||||
let lexbuf = Lexing.from_string s in
|
||||
let module Lexer = Lexer.Make(LexToken) in
|
||||
let Lexer.{read ; close ; _} =
|
||||
Lexer.open_token_stream None 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 () ->
|
||||
let raw = Parser.contract read lexbuf in
|
||||
close () ;
|
||||
raw
|
||||
) >>? fun raw ->
|
||||
ok raw
|
||||
|
||||
let parse_expression (s:string) : AST.expr result =
|
||||
let lexbuf = Lexing.from_string s in
|
||||
let module Lexer = Lexer.Make(LexToken) in
|
||||
let Lexer.{read ; close; _} =
|
||||
Lexer.open_token_stream None 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 () ->
|
||||
let raw = Parser.interactive_expr read lexbuf in
|
||||
close () ;
|
||||
raw
|
||||
) >>? fun raw ->
|
||||
ok raw
|
@ -1,3 +1,3 @@
|
||||
module Pascaligo = Pascaligo
|
||||
module Camligo = Camligo
|
||||
(*module Ligodity = Ligodity*)
|
||||
module Ligodity = Ligodity
|
||||
|
@ -4,7 +4,7 @@ open Test_helpers
|
||||
|
||||
let compile_contract_basic () : unit result =
|
||||
let%bind _ =
|
||||
Contract.compile_contract_file "./contracts/dispatch-counter.ligo" "main"
|
||||
Contract.compile_contract_file "./contracts/dispatch-counter.ligo" "main" "pascaligo"
|
||||
in
|
||||
ok ()
|
||||
|
||||
|
Loading…
Reference in New Issue
Block a user