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
|
let term = Term.(const print_endline $ const "Ligo needs a command. Do ligo --help") in
|
||||||
(term , Term.info "ligo")
|
(term , Term.info "ligo")
|
||||||
|
|
||||||
let compile_file =
|
let source =
|
||||||
let f source entry_point =
|
|
||||||
toplevel @@
|
|
||||||
let%bind contract =
|
|
||||||
trace (simple_error "compile michelson") @@
|
|
||||||
Ligo.Contract.compile_contract_file source entry_point in
|
|
||||||
Format.printf "Contract:\n%s\n" contract ;
|
|
||||||
ok ()
|
|
||||||
in
|
|
||||||
let term =
|
|
||||||
let source =
|
|
||||||
let open Arg in
|
let open Arg in
|
||||||
let info =
|
let info =
|
||||||
let docv = "SOURCE_FILE" in
|
let docv = "SOURCE_FILE" in
|
||||||
let doc = "$(docv) is the path to the .ligo file of the contract." in
|
let doc = "$(docv) is the path to the .ligo file of the contract." in
|
||||||
info ~docv ~doc [] in
|
info ~docv ~doc [] in
|
||||||
required @@ pos 0 (some string) None info in
|
required @@ pos 0 (some string) None info
|
||||||
let entry_point =
|
|
||||||
|
let entry_point =
|
||||||
let open Arg in
|
let open Arg in
|
||||||
let info =
|
let info =
|
||||||
let docv = "ENTRY_POINT" in
|
let docv = "ENTRY_POINT" in
|
||||||
let doc = "$(docv) is entry-point that will be compiled." in
|
let doc = "$(docv) is entry-point that will be compiled." in
|
||||||
info ~docv ~doc [] in
|
info ~docv ~doc [] in
|
||||||
value @@ pos 1 string "main" info in
|
value @@ pos 1 string "main" info
|
||||||
Term.(const f $ source $ entry_point) 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
|
||||||
|
|
||||||
|
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 syntax =
|
||||||
|
toplevel @@
|
||||||
|
let%bind contract =
|
||||||
|
trace (simple_error "compile michelson") @@
|
||||||
|
Ligo.Contract.compile_contract_file source entry_point syntax in
|
||||||
|
Format.printf "Contract:\n%s\n" contract ;
|
||||||
|
ok ()
|
||||||
|
in
|
||||||
|
let term =
|
||||||
|
Term.(const f $ source $ entry_point $ syntax) in
|
||||||
let docs = "Compile contracts." in
|
let docs = "Compile contracts." in
|
||||||
(term , Term.info ~docs "compile-contract")
|
(term , Term.info ~docs "compile-contract")
|
||||||
|
|
||||||
let compile_parameter =
|
let compile_parameter =
|
||||||
let f source entry_point expression =
|
let f source entry_point expression syntax =
|
||||||
toplevel @@
|
toplevel @@
|
||||||
let%bind value =
|
let%bind value =
|
||||||
trace (simple_error "compile-input") @@
|
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;
|
Format.printf "Input:\n%s\n" value;
|
||||||
ok ()
|
ok ()
|
||||||
in
|
in
|
||||||
let term =
|
let term =
|
||||||
let source =
|
Term.(const f $ source $ entry_point $ expression $ syntax) in
|
||||||
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
|
|
||||||
let docs = "Compile contracts parameters." in
|
let docs = "Compile contracts parameters." in
|
||||||
(term , Term.info ~docs "compile-parameter")
|
(term , Term.info ~docs "compile-parameter")
|
||||||
|
|
||||||
let compile_storage =
|
let compile_storage =
|
||||||
let f source entry_point expression =
|
let f source entry_point expression syntax =
|
||||||
toplevel @@
|
toplevel @@
|
||||||
let%bind value =
|
let%bind value =
|
||||||
trace (simple_error "compile-storage") @@
|
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;
|
Format.printf "Storage:\n%s\n" value;
|
||||||
ok ()
|
ok ()
|
||||||
in
|
in
|
||||||
let term =
|
let term =
|
||||||
let source =
|
Term.(const f $ source $ entry_point $ expression $ syntax) in
|
||||||
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
|
|
||||||
let docs = "Compile contracts storage." in
|
let docs = "Compile contracts storage." in
|
||||||
(term , Term.info ~docs "compile-storage")
|
(term , Term.info ~docs "compile-storage")
|
||||||
|
|
||||||
|
@ -59,13 +59,60 @@ let transpile_value
|
|||||||
let%bind r = Run_mini_c.run_entry f input in
|
let%bind r = Run_mini_c.run_entry f input in
|
||||||
ok r
|
ok r
|
||||||
|
|
||||||
let compile_contract_file : string -> string -> string result = fun source entry_point ->
|
let parsify_pascaligo = fun source ->
|
||||||
let%bind raw =
|
let%bind raw =
|
||||||
trace (simple_error "parsing") @@
|
trace (simple_error "parsing") @@
|
||||||
Parser.parse_file source in
|
Parser.Pascaligo.parse_file source in
|
||||||
let%bind simplified =
|
let%bind simplified =
|
||||||
trace (simple_error "simplifying") @@
|
trace (simple_error "simplifying") @@
|
||||||
Simplify.Pascaligo.simpl_program raw in
|
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 () =
|
let%bind () =
|
||||||
assert_entry_point_defined simplified entry_point in
|
assert_entry_point_defined simplified entry_point in
|
||||||
let%bind typed =
|
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
|
Format.asprintf "%a" Michelson.pp_stripped michelson in
|
||||||
ok str
|
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 (program , parameter_tv) =
|
||||||
let%bind raw =
|
let%bind simplified = parsify syntax source in
|
||||||
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 () =
|
let%bind () =
|
||||||
assert_entry_point_defined simplified entry_point in
|
assert_entry_point_defined simplified entry_point in
|
||||||
let%bind typed =
|
let%bind typed =
|
||||||
@ -99,13 +141,8 @@ let compile_contract_parameter : string -> string -> string -> string result = f
|
|||||||
ok (typed , param_ty)
|
ok (typed , param_ty)
|
||||||
in
|
in
|
||||||
let%bind expr =
|
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 typed =
|
||||||
|
let%bind simplified = parsify_expression syntax expression in
|
||||||
let env =
|
let env =
|
||||||
let last_declaration = Location.unwrap List.(hd @@ rev program) in
|
let last_declaration = Location.unwrap List.(hd @@ rev program) in
|
||||||
match last_declaration with
|
match last_declaration with
|
||||||
@ -129,14 +166,9 @@ let compile_contract_parameter : string -> string -> string -> string result = f
|
|||||||
ok expr
|
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 (program , storage_tv) =
|
||||||
let%bind raw =
|
let%bind simplified = parsify syntax source in
|
||||||
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 () =
|
let%bind () =
|
||||||
assert_entry_point_defined simplified entry_point in
|
assert_entry_point_defined simplified entry_point in
|
||||||
let%bind typed =
|
let%bind typed =
|
||||||
@ -147,12 +179,7 @@ let compile_contract_storage : string -> string -> string -> string result = fun
|
|||||||
ok (typed , storage_ty)
|
ok (typed , storage_ty)
|
||||||
in
|
in
|
||||||
let%bind expr =
|
let%bind expr =
|
||||||
let%bind raw =
|
let%bind simplified = parsify_expression syntax expression in
|
||||||
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 typed =
|
||||||
let env =
|
let env =
|
||||||
let last_declaration = Location.unwrap List.(hd @@ rev program) in
|
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)
|
let type_file ?(debug_simplify = false) ?(debug_typed = false)
|
||||||
(path:string) : AST_Typed.program result =
|
(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 =
|
let%bind simpl =
|
||||||
trace (simple_error "simplifying") @@
|
trace (simple_error "simplifying") @@
|
||||||
simplify raw in
|
simplify raw in
|
||||||
@ -162,35 +162,5 @@ let easy_run_typed_simplified
|
|||||||
let%bind annotated_result = untype_expression typed_result in
|
let%bind annotated_result = untype_expression typed_result in
|
||||||
ok annotated_result
|
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
|
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 *)
|
(* Entry points *)
|
||||||
|
|
||||||
%start program
|
%start program expr
|
||||||
%type <AST.t> program
|
%type <AST.t> program
|
||||||
|
%type <AST.expr> expr
|
||||||
|
|
||||||
%%
|
%%
|
||||||
|
|
||||||
|
@ -1,117 +1,5 @@
|
|||||||
open Trace
|
module Pascaligo = Pascaligo
|
||||||
|
|
||||||
module Pascaligo = Parser_pascaligo
|
|
||||||
module Camligo = Parser_camligo
|
module Camligo = Parser_camligo
|
||||||
module Ligodity = Parser_ligodity
|
module Ligodity = Ligodity
|
||||||
|
|
||||||
open Parser_pascaligo
|
|
||||||
module AST_Raw = Parser_pascaligo.AST
|
|
||||||
|
|
||||||
|
|
||||||
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 Pascaligo = Pascaligo
|
||||||
module Camligo = Camligo
|
module Camligo = Camligo
|
||||||
(*module Ligodity = Ligodity*)
|
module Ligodity = Ligodity
|
||||||
|
@ -4,7 +4,7 @@ open Test_helpers
|
|||||||
|
|
||||||
let compile_contract_basic () : unit result =
|
let compile_contract_basic () : unit result =
|
||||||
let%bind _ =
|
let%bind _ =
|
||||||
Contract.compile_contract_file "./contracts/dispatch-counter.ligo" "main"
|
Contract.compile_contract_file "./contracts/dispatch-counter.ligo" "main" "pascaligo"
|
||||||
in
|
in
|
||||||
ok ()
|
ok ()
|
||||||
|
|
||||||
|
Loading…
Reference in New Issue
Block a user