balsoft/ligo
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

Merge branch 'feature/initial_req_serokell' into 'dev'

Browse Source 
get-scope command

See merge request ligolang/ligo!690
This commit is contained in:
Rémi Lesenechal 2020-07-03 11:57:53 +00:00
commit 567515a5ce
46 changed files with 806 additions and 61 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

21
src/bin/cli.ml
View File

@ -96,6 +96,13 @@ let disable_michelson_typechecking =
info ~doc ["disable-michelson-typechecking"] in
value @@ flag info
let with_types =
let open Arg in
let info =
let doc = "tries to infer types for all named expressions" in
info ~doc ["with-types"] in
value @@ flag info
let predecessor_timestamp =
let open Arg in
let info =
@ -484,6 +491,17 @@ let transpile_expression =
(Term.ret term , Term.info ~doc cmdname)
let get_scope =
let f source_file syntax display_format with_types =
return_result ~display_format Ligo.Scopes.Formatter.scope_format @@
Ligo.Scopes.scopes ~with_types source_file syntax
in
let term =
Term.(const f $ source_file 0 $ syntax $ display_format $ with_types) in
let cmdname = "get-scope" in
let doc = "Subcommand: Return the JSON encoded environment for a given file." in
(Term.ret term , Term.info ~doc cmdname)
let run ?argv () =
Term.eval_choice ?argv main [
temp_ligo_interpreter ;
@ -507,5 +525,6 @@ let run ?argv () =
print_mini_c ;
list_declarations ;
preprocess;
pretty_print
pretty_print;
get_scope;
]

2
src/bin/cli_helpers.ml
View File

@ -13,7 +13,7 @@ let toplevel : display_format:ex_display_format -> displayable -> (unit -> unit
match t with
| Human_readable -> convert ~display_format:t disp ;
| Dev -> convert ~display_format:t disp ;
| Json -> Yojson.Basic.to_string @@ convert ~display_format:t disp in
| Json -> Yojson.to_string @@ convert ~display_format:t disp in
Format.printf "%s\n" as_str ;
return ()

276
src/bin/expect_tests/get_scope.ml Normal file
View File

@ -0,0 +1,276 @@
open Cli_expect
let gs s = "../../test/contracts/get_scope_tests/"^s
let%expect_test _ =
run_ligo_good [ "get-scope" ; gs "lambda_letin.mligo" ; "--format=dev" ] ;
[%expect {|
Scopes:
[ f#5 a#0 ] in file "lambda_letin.mligo", line 9, characters 6-7
[ f#5 a#0 ] in file "lambda_letin.mligo", line 9, characters 4-5
[ f#5 a#0 ] in file "lambda_letin.mligo", line 9, characters 2-3
[ k#4 j#2 i#1 g#3 a#0 ] in file "lambda_letin.mligo", line 7, characters 20-21
[ k#4 j#2 i#1 g#3 a#0 ] in file "lambda_letin.mligo", line 7, characters 16-17
[ k#4 j#2 i#1 g#3 a#0 ] in file "lambda_letin.mligo", line 7, characters 12-13
[ k#4 j#2 i#1 g#3 a#0 ] in file "lambda_letin.mligo", line 7, characters 8-9
[ k#4 j#2 i#1 g#3 a#0 ] in file "lambda_letin.mligo", line 7, characters 4-5
[ j#2 i#1 g#3 a#0 ] in file "lambda_letin.mligo", line 6, characters 24-25
[ j#2 i#1 g#3 a#0 ] in file "lambda_letin.mligo", line 6, characters 20-21
[ j#2 i#1 g#3 a#0 ] in file "lambda_letin.mligo", line 6, characters 16-17
[ j#2 i#1 g#3 a#0 ] in file "lambda_letin.mligo", line 6, characters 12-13
[ j#2 i#1 a#0 ] in file "lambda_letin.mligo", line 5, characters 20-21
[ j#2 i#1 a#0 ] in file "lambda_letin.mligo", line 5, characters 16-17
[ j#2 i#1 a#0 ] in file "lambda_letin.mligo", line 5, characters 12-13
[ ] in file "lambda_letin.mligo", line 1, characters 0-9
Variable definitions:
(k#4 -> k) in file "lambda_letin.mligo", line 6, characters 8-9
(j#2 -> j) in file "lambda_letin.mligo", line 4, characters 47-48
(i#1 -> i) in file "lambda_letin.mligo", line 4, characters 37-38
(g#3 -> g) in file "lambda_letin.mligo", line 5, characters 8-9
(f#5 -> f) in file "lambda_letin.mligo", line 4, characters 6-7
(b#6 -> b) in file "lambda_letin.mligo", line 3, characters 4-5
(a#0 -> a) in file "lambda_letin.mligo", line 1, characters 4-5
Type definitions: |} ];
run_ligo_good [ "get-scope" ; gs "letin.mligo" ; "--format=dev" ] ;
[%expect {|
Scopes:
[ d#4 c#1 a#0 ] in file "letin.mligo", line 10, characters 10-11
[ d#4 c#1 a#0 ] in file "letin.mligo", line 10, characters 6-7
[ d#4 c#1 a#0 ] in file "letin.mligo", line 10, characters 2-3
[ f#3 e#2 c#1 a#0 ] in file "letin.mligo", line 8, characters 16-17
[ f#3 e#2 c#1 a#0 ] in file "letin.mligo", line 8, characters 12-13
[ f#3 e#2 c#1 a#0 ] in file "letin.mligo", line 8, characters 8-9
[ f#3 e#2 c#1 a#0 ] in file "letin.mligo", line 8, characters 4-5
[ e#2 c#1 a#0 ] in file "letin.mligo", line 7, characters 20-21
[ e#2 c#1 a#0 ] in file "letin.mligo", line 7, characters 16-17
[ e#2 c#1 a#0 ] in file "letin.mligo", line 7, characters 12-13
[ c#1 a#0 ] in file "letin.mligo", line 6, characters 16-17
[ c#1 a#0 ] in file "letin.mligo", line 6, characters 12-13
[ a#0 ] in file "letin.mligo", line 4, characters 14-15
[ a#0 ] in file "letin.mligo", line 4, characters 10-11
[ ] in file "letin.mligo", line 1, characters 0-9
Variable definitions:
(f#3 -> f) in file "letin.mligo", line 7, characters 8-9
(e#2 -> e) in file "letin.mligo", line 6, characters 8-9
(d#4 -> d) in file "letin.mligo", line 5, characters 6-7
(c#1 -> c) in file "letin.mligo", line 4, characters 6-7
(b#5 -> b) in file "letin.mligo", line 3, characters 4-5
(a#0 -> a) in file "letin.mligo", line 1, characters 4-5
Type definitions: |} ] ;
run_ligo_good [ "get-scope" ; gs "lambda.mligo" ; "--format=dev" ] ;
[%expect {|
Scopes:
[ f#3 a#0 ] in file "lambda.mligo", line 5, characters 6-7
[ f#3 a#0 ] in file "lambda.mligo", line 5, characters 4-5
[ f#3 a#0 ] in file "lambda.mligo", line 5, characters 2-3
[ j#2 i#1 a#0 ] in file "lambda.mligo", line 4, characters 62-63
[ j#2 i#1 a#0 ] in file "lambda.mligo", line 4, characters 58-59
[ ] in file "lambda.mligo", line 1, characters 0-9
Variable definitions:
(j#2 -> j) in file "lambda.mligo", line 4, characters 46-47
(i#1 -> i) in file "lambda.mligo", line 4, characters 36-37
(f#3 -> f) in file "lambda.mligo", line 4, characters 6-7
(b#4 -> b) in file "lambda.mligo", line 3, characters 4-5
(a#0 -> a) in file "lambda.mligo", line 1, characters 4-5
Type definitions: |} ] ;
run_ligo_good [ "get-scope" ; gs "match.mligo" ; "--format=dev" ] ;
[%expect {|
Scopes:
[ s#11 mytype#0 c#9 b#5 a#1 ] in file "match.mligo", line 19, characters 20-21
[ s#11 mytype#0 c#9 b#5 a#1 ] in file "match.mligo", line 19, characters 16-17
[ mytype#0 c#9 b#5 a#1 ] in file "match.mligo", line 20, characters 12-13
[ mytype#0 d#10 c#9 b#5 a#1 ] in file "match.mligo", line 18, characters 30-31
[ mytype#0 d#10 c#9 b#5 a#1 ] in file "match.mligo", line 18, characters 28-29
[ mytype#0 c#9 b#5 a#1 ] in file "match.mligo", line 18, characters 9-32
[ tl#8 mytype#0 hd#7 b#5 a#1 ] in file "match.mligo", line 15, characters 14-15
[ mytype#0 c#6 b#5 a#1 ] in file "match.mligo", line 14, characters 4-5
[ mytype#0 b#5 a#1 ] in file "match.mligo", line 13, character 4 to line 14, character 5
[ mytype#0 b#5 a#1 ] in file "match.mligo", line 11, characters 18-19
[ mytype#0 b#5 a#1 ] in file "match.mligo", line 11, characters 15-16
[ mytype#0 b#5 a#1 ] in file "match.mligo", line 11, characters 11-12
[ y#4 mytype#0 a#1 ] in file "match.mligo", line 8, characters 17-18
[ y#4 mytype#0 a#1 ] in file "match.mligo", line 8, characters 13-14
[ x#3 mytype#0 a#1 ] in file "match.mligo", line 7, characters 17-18
[ x#3 mytype#0 a#1 ] in file "match.mligo", line 7, characters 13-14
[ mytype#0 c#2 a#1 ] in file "match.mligo", line 6, characters 26-27
[ mytype#0 a#1 ] in file "match.mligo", line 6, characters 9-27
[ mytype#0 ] in file "match.mligo", line 3, characters 0-9
Variable definitions:
(y#4 -> y) in file "match.mligo", line 8, characters 8-9
(x#3 -> x) in file "match.mligo", line 7, characters 8-9
(tl#8 -> tl) in file "match.mligo", line 15, characters 8-10
(s#11 -> s) in file "match.mligo", line 19, characters 10-11
(hd#7 -> hd) in file "match.mligo", line 15, characters 4-6
(d#12 -> d) in file "match.mligo", line 17, characters 4-5
(d#10 -> d) in file "match.mligo", line 18, characters 13-14
(c#9 -> c) in file "match.mligo", line 10, characters 4-5
(c#6 -> c) in file "match.mligo", line 13, characters 8-9
(c#2 -> c) in file "match.mligo", line 6, characters 13-14
(b#5 -> b) in file "match.mligo", line 5, characters 4-5
(a#1 -> a) in file "match.mligo", line 3, characters 4-5
Type definitions:
(mytype#0 -> mytype) in file "match.mligo", line 1, characters 0-40 |} ] ;
run_ligo_good [ "get-scope" ; gs "rec.mligo" ; "--format=dev" ] ;
[%expect {|
Scopes:
[ c#5 b#6 a#0 ] in file "rec.mligo", line 9, characters 5-6
[ c#5 b#6 a#0 ] in file "rec.mligo", line 9, characters 8-9
[ c#5 b#6 a#0 ] in file "rec.mligo", line 9, characters 2-3
[ c#5 a#0 ] in file "rec.mligo", line 8, character 2 to line 9, character 10
[ k#4 j#3 i#2 c#1 a#0 ] in file "rec.mligo", line 6, characters 7-8
[ k#4 j#3 i#2 c#1 a#0 ] in file "rec.mligo", line 6, characters 9-10
[ k#4 j#3 i#2 c#1 a#0 ] in file "rec.mligo", line 6, characters 4-5
[ j#3 i#2 c#1 a#0 ] in file "rec.mligo", line 5, characters 20-21
[ j#3 i#2 c#1 a#0 ] in file "rec.mligo", line 5, characters 16-17
[ j#3 i#2 c#1 a#0 ] in file "rec.mligo", line 5, characters 12-13
[ i#2 c#1 a#0 ] in file "rec.mligo", line 4, characters 36-49
[ c#1 a#0 ] in file "rec.mligo", line 4, characters 36-49
[ c#1 a#0 ]
[ ] in file "rec.mligo", line 1, characters 0-9
Variable definitions:
(k#4 -> k) in file "rec.mligo", line 5, characters 8-9
(j#3 -> j) in file "rec.mligo", line 4, characters 39-40
(i#2 -> i) in file "rec.mligo", line 4, characters 37-38
(c#5 -> c) in file "rec.mligo", line 4, characters 10-11
(c#1 -> c) in file "rec.mligo", line 4, characters 10-11
(b#7 -> b) in file "rec.mligo", line 3, characters 4-5
(b#6 -> b) in file "rec.mligo", line 8, characters 6-7
(a#0 -> a) in file "rec.mligo", line 1, characters 4-5
Type definitions: |} ] ;
run_ligo_good [ "get-scope" ; gs "shadowing.mligo" ; "--format=dev" ] ;
[%expect {|
Scopes:
[ d#4 c#1 a#0 ] in file "shadowing.mligo", line 10, characters 10-11
[ d#4 c#1 a#0 ] in file "shadowing.mligo", line 10, characters 6-7
[ d#4 c#1 a#0 ] in file "shadowing.mligo", line 10, characters 2-3
[ e#2 c#1 a#3 ] in file "shadowing.mligo", line 8, characters 12-13
[ e#2 c#1 a#3 ] in file "shadowing.mligo", line 8, characters 8-9
[ e#2 c#1 a#3 ] in file "shadowing.mligo", line 8, characters 4-5
[ e#2 c#1 a#0 ] in file "shadowing.mligo", line 7, characters 20-21
[ e#2 c#1 a#0 ] in file "shadowing.mligo", line 7, characters 16-17
[ e#2 c#1 a#0 ] in file "shadowing.mligo", line 7, characters 12-13
[ c#1 a#0 ] in file "shadowing.mligo", line 6, characters 16-17
[ c#1 a#0 ] in file "shadowing.mligo", line 6, characters 12-13
[ a#0 ] in file "shadowing.mligo", line 4, characters 14-15
[ a#0 ] in file "shadowing.mligo", line 4, characters 10-11
[ ] in file "shadowing.mligo", line 1, characters 0-9
Variable definitions:
(e#2 -> e) in file "shadowing.mligo", line 6, characters 8-9
(d#4 -> d) in file "shadowing.mligo", line 5, characters 6-7
(c#1 -> c) in file "shadowing.mligo", line 4, characters 6-7
(b#5 -> b) in file "shadowing.mligo", line 3, characters 4-5
(a#3 -> a) in file "shadowing.mligo", line 7, characters 8-9
(a#0 -> a) in file "shadowing.mligo", line 1, characters 4-5
Type definitions: |} ] ;
run_ligo_good [ "get-scope" ; gs "records.mligo" ; "--format=dev" ] ;
[%expect {|
Scopes:
[ myrec#0 g#5 b#4 a#1 ] in file "records.mligo", line 16, characters 40-41
[ myrec#0 g#5 b#4 a#1 ] in file "records.mligo", line 16, characters 32-37
[ myrec#0 g#5 b#4 a#1 ] in file "records.mligo", line 16, characters 28-29
[ myrec#0 b#4 a#1 ] in file "records.mligo", line 16, characters 15-41
[ myrec#0 b#4 a#1 ]
[ myrec#0 a#1 ] in file "records.mligo", line 6, characters 53-55
[ myrec#0 j#3 i#2 a#1 ] in file "records.mligo", line 6, characters 44-45
[ myrec#0 j#3 i#2 a#1 ] in file "records.mligo", line 6, characters 42-43
[ myrec#0 j#3 i#2 a#1 ] in file "records.mligo", line 6, characters 40-41
[ myrec#0 i#2 a#1 ] in file "records.mligo", line 6, characters 27-45
[ myrec#0 a#1 ] in file "records.mligo", line 6, characters 14-45
[ myrec#0 ] in file "records.mligo", line 3, characters 0-9
Variable definitions:
(j#3 -> j) in file "records.mligo", line 6, characters 31-32
(i#2 -> i) in file "records.mligo", line 6, characters 18-19
(g#5 -> g) in file "records.mligo", line 16, characters 19-20
(e#6 -> e) in file "records.mligo", line 15, characters 4-5
(b#4 -> b) in file "records.mligo", line 6, characters 4-5
(a#1 -> a) in file "records.mligo", line 3, characters 4-5
Type definitions:
(myrec#0 -> myrec) in file "records.mligo", line 1, characters 0-36 |} ] ;
run_ligo_good [ "get-scope" ; gs "constant.mligo" ; "--format=dev" ] ;
[%expect {|
Scopes:
[ e#3 a#0 ] in file "constant.mligo", line 6, characters 29-30
[ e#3 a#0 ] in file "constant.mligo", line 6, characters 27-28
[ e#3 a#0 ] in file "constant.mligo", line 6, characters 22-23
[ e#3 a#0 ] in file "constant.mligo", line 6, characters 20-21
[ a#0 ] in file "constant.mligo", line 6, characters 5-32
[ d#2 c#1 a#0 ] in file "constant.mligo", line 5, characters 43-44
[ d#2 c#1 a#0 ] in file "constant.mligo", line 5, characters 39-40
[ d#2 c#1 a#0 ] in file "constant.mligo", line 5, characters 35-36
[ c#1 a#0 ] in file "constant.mligo", line 5, characters 22-44
[ ] in file "constant.mligo", line 1, characters 0-9
Variable definitions:
(e#3 -> e) in file "constant.mligo", line 6, characters 9-10
(d#2 -> d) in file "constant.mligo", line 5, characters 26-27
(c#1 -> c) in file "constant.mligo", line 5, characters 10-11
(b#4 -> b) in file "constant.mligo", line 3, characters 4-5
(a#0 -> a) in file "constant.mligo", line 1, characters 4-5
Type definitions: |} ] ;
run_ligo_good [ "get-scope" ; gs "application.mligo" ; "--format=dev" ] ;
[%expect {|
Scopes:
[ f#2 c#4 ] in file "application.mligo", line 3, characters 35-36
[ f#2 ] in file "application.mligo", line 3, characters 22-36
[ f#2 b#3 ] in file "application.mligo", line 3, characters 18-19
[ f#2 b#3 ] in file "application.mligo", line 3, characters 16-17
[ f#2 ] in file "application.mligo", line 3, characters 3-19
[ j#1 i#0 ] in file "application.mligo", line 2, characters 62-63
[ j#1 i#0 ] in file "application.mligo", line 2, characters 58-59
Variable definitions:
(j#1 -> j) in file "application.mligo", line 2, characters 46-47
(i#0 -> i) in file "application.mligo", line 2, characters 36-37
(f#2 -> f) in file "application.mligo", line 2, characters 6-7
(c#4 -> c) in file "application.mligo", line 3, characters 26-27
(b#3 -> b) in file "application.mligo", line 3, characters 7-8
(a#5 -> a) in file "application.mligo", line 1, characters 4-5
Type definitions: |} ] ;
run_ligo_good [ "get-scope" ; gs "include.mligo" ; "--format=dev" ] ;
[%expect {|
Scopes:
[ x#6 b#5 a#0 ] in file "include.mligo", line 5, characters 12-13
[ x#6 b#5 a#0 ] in file "include.mligo", line 5, characters 8-9
[ b#5 a#0 ] in file "include.mligo", line 3, characters 0-9
[ d#4 c#1 a#0 ] in file "letin.mligo", line 10, characters 10-11
[ d#4 c#1 a#0 ] in file "letin.mligo", line 10, characters 6-7
[ d#4 c#1 a#0 ] in file "letin.mligo", line 10, characters 2-3
[ f#3 e#2 c#1 a#0 ] in file "letin.mligo", line 8, characters 16-17
[ f#3 e#2 c#1 a#0 ] in file "letin.mligo", line 8, characters 12-13
[ f#3 e#2 c#1 a#0 ] in file "letin.mligo", line 8, characters 8-9
[ f#3 e#2 c#1 a#0 ] in file "letin.mligo", line 8, characters 4-5
[ e#2 c#1 a#0 ] in file "letin.mligo", line 7, characters 20-21
[ e#2 c#1 a#0 ] in file "letin.mligo", line 7, characters 16-17
[ e#2 c#1 a#0 ] in file "letin.mligo", line 7, characters 12-13
[ c#1 a#0 ] in file "letin.mligo", line 6, characters 16-17
[ c#1 a#0 ] in file "letin.mligo", line 6, characters 12-13
[ a#0 ] in file "letin.mligo", line 4, characters 14-15
[ a#0 ] in file "letin.mligo", line 4, characters 10-11
[ ] in file "letin.mligo", line 1, characters 0-9
Variable definitions:
(y#7 -> y) in file "include.mligo", line 5, characters 4-5
(x#6 -> x) in file "include.mligo", line 3, characters 4-5
(f#3 -> f) in file "letin.mligo", line 7, characters 8-9
(e#2 -> e) in file "letin.mligo", line 6, characters 8-9
(d#4 -> d) in file "letin.mligo", line 5, characters 6-7
(c#1 -> c) in file "letin.mligo", line 4, characters 6-7
(b#5 -> b) in file "letin.mligo", line 3, characters 4-5
(a#0 -> a) in file "letin.mligo", line 1, characters 4-5
Type definitions: |} ] ;

6
src/bin/expect_tests/help_tests.ml
View File

@ -40,6 +40,9 @@ let%expect_test _ =
evaluate-value
Subcommand: Evaluate a given definition.
get-scope
Subcommand: Return the JSON encoded environment for a given file.
interpret
Subcommand: Interpret the expression in the context initialized by
the provided source file.
@ -140,6 +143,9 @@ let%expect_test _ =
evaluate-value
Subcommand: Evaluate a given definition.
get-scope
Subcommand: Return the JSON encoded environment for a given file.
interpret
Subcommand: Interpret the expression in the context initialized by
the provided source file.

2
src/main/compile/of_core.ml
View File

@ -42,3 +42,5 @@ let list_declarations (program : Ast_core.program) : string list =
| Declaration_constant (var,_,_,_) -> (Var.to_name var.wrap_content)::prev
| _ -> prev)
[] program
let evaluate_type (env : Ast_typed.Environment.t) (t: Ast_core.type_expression) = trace typer_tracer @@ Typer.evaluate_type env t

50
src/main/compile/utils.ml
View File

@ -14,9 +14,9 @@ let to_core f stx =
let%bind core = Of_sugar.compile sugar in
ok @@ core
let type_file f stx env : (Ast_typed.program * Typesystem.Solver_types.typer_state, _) result =
let type_file f stx form : (Ast_typed.program * Typesystem.Solver_types.typer_state, _) result =
let%bind core = to_core f stx in
let%bind typed,state = Of_core.compile env core in
let%bind typed,state = Of_core.compile form core in
ok @@ (typed,state)
let to_mini_c f stx env =
@ -32,34 +32,34 @@ let compile_file f stx ep : (Michelson.michelson, _) result =
ok @@ contract
let type_expression source_file syntax expression env state =
let%bind v_syntax = Helpers.syntax_to_variant (Syntax_name syntax) source_file in
let%bind imperative_exp = Of_source.compile_expression v_syntax expression in
let%bind sugar_exp = Of_imperative.compile_expression imperative_exp in
let%bind core_exp = Of_sugar.compile_expression sugar_exp in
let%bind (typed_exp,state) = Of_core.compile_expression ~env ~state core_exp in
ok @@ (typed_exp,state)
let%bind v_syntax = Helpers.syntax_to_variant (Syntax_name syntax) source_file in
let%bind imperative_exp = Of_source.compile_expression v_syntax expression in
let%bind sugar_exp = Of_imperative.compile_expression imperative_exp in
let%bind core_exp = Of_sugar.compile_expression sugar_exp in
let%bind (typed_exp,state) = Of_core.compile_expression ~env ~state core_exp in
ok @@ (typed_exp,state)
let expression_to_mini_c source_file syntax expression env state =
let%bind (typed_exp,_) = type_expression source_file syntax expression env state in
let%bind mini_c_exp = Of_typed.compile_expression typed_exp in
ok @@ mini_c_exp
let%bind (typed_exp,_) = type_expression source_file syntax expression env state in
let%bind mini_c_exp = Of_typed.compile_expression typed_exp in
ok @@ mini_c_exp
let compile_expression source_file syntax expression env state =
let%bind mini_c_exp = expression_to_mini_c source_file syntax expression env state in
let%bind compiled = Of_mini_c.compile_expression mini_c_exp in
ok @@ compiled
let%bind mini_c_exp = expression_to_mini_c source_file syntax expression env state in
let%bind compiled = Of_mini_c.compile_expression mini_c_exp in
ok @@ compiled
let compile_and_aggregate_expression source_file syntax expression env state mini_c_prg =
let%bind mini_c_exp = expression_to_mini_c source_file syntax expression env state in
let%bind compiled = Of_mini_c.aggregate_and_compile_expression mini_c_prg mini_c_exp in
ok @@ compiled
let%bind mini_c_exp = expression_to_mini_c source_file syntax expression env state in
let%bind compiled = Of_mini_c.aggregate_and_compile_expression mini_c_prg mini_c_exp in
ok @@ compiled
let compile_storage storage input source_file syntax env state mini_c_prg =
let%bind v_syntax = Helpers.syntax_to_variant (Syntax_name syntax) (Some source_file) in
let%bind imperative = Of_source.compile_contract_input storage input v_syntax in
let%bind sugar = Of_imperative.compile_expression imperative in
let%bind core = Of_sugar.compile_expression sugar in
let%bind typed,_ = Of_core.compile_expression ~env ~state core in
let%bind mini_c = Of_typed.compile_expression typed in
let%bind compiled = Of_mini_c.aggregate_and_compile_expression mini_c_prg mini_c in
ok @@ compiled
let%bind v_syntax = Helpers.syntax_to_variant (Syntax_name syntax) (Some source_file) in
let%bind imperative = Of_source.compile_contract_input storage input v_syntax in
let%bind sugar = Of_imperative.compile_expression imperative in
let%bind core = Of_sugar.compile_expression sugar in
let%bind typed,_ = Of_core.compile_expression ~env ~state core in
let%bind mini_c = Of_typed.compile_expression typed in
let%bind compiled = Of_mini_c.aggregate_and_compile_expression mini_c_prg mini_c in
ok @@ compiled

1
src/main/dune
View File

@ -6,6 +6,7 @@
compile
decompile
main_errors
scopes
)
(preprocess
(pps ppx_let bisect_ppx --conditional)

1
src/main/main.ml
View File

@ -3,3 +3,4 @@ module Compile = Compile
module Decompile = Decompile
module Display = Display
module Formatter = Main_errors.Formatter
module Scopes = Scopes

3
src/main/main_errors/formatter.ml
View File

@ -1,4 +1,3 @@
open Trace
open Display
let error_suggest: string = "\n
@ -147,7 +146,7 @@ let error_ppformat : display_format:string display_format ->
(error_ppformat' ~display_format) a
error_suggest
let rec error_jsonformat : Types.all -> J.t = fun a ->
let rec error_jsonformat : Types.all -> Yojson.t = fun a ->
let json_error ~stage ~content =
`Assoc [
("status", `String "error") ;

57
src/main/scopes/PP.ml Normal file
View File

@ -0,0 +1,57 @@
open Types
let scopes : Format.formatter -> scopes -> unit = fun f s ->
let pp_scope f (s:scope) =
let pp_list f = List.iter (fun (k,_) -> Format.fprintf f "%s " k ) in
let a = Def_map.to_kv_list s.env in
Format.fprintf f "[ %a] %a" pp_list a Location.pp s.range
in
let pp_scopes f = List.iter (Format.fprintf f "@[<v>%a@ @]" pp_scope) in
Format.fprintf f "@[<v>Scopes:@ %a@]" pp_scopes s
let definitions : Format.formatter -> def_map -> unit = fun f dm ->
let kvl = Def_map.to_kv_list dm in
let (variables,types) = List.partition (fun (_,def) -> match def with Type _ -> false | Variable _ -> true) kvl in
let pp_def f = List.iter (fun (k,v) -> Format.fprintf f "(%s -> %s) %a@ " k (get_def_name v) Location.pp (get_range v)) in
Format.fprintf f "@[<v>Variable definitions:@ %aType definitions:@ %a@]" pp_def variables pp_def types
let def_to_json : def -> Yojson.t = function
| Variable { name ; range ; body_range ; t ; references=_ } ->
`Assoc [
("name", `String name);
("range", Location.pp_json range);
("body_range", Location.pp_json body_range);
("t", match t with None -> `Null | Some t -> Ast_typed.PP_json.Yojson.type_expression t );
("references", `Null);
]
| Type { name ; range ; body_range ; content=_ } ->
`Assoc [
("name", `String name);
("range", Location.pp_json range);
("body_range", Location.pp_json body_range);
("content", `String "TODO" );
]
let defs_json d : Yojson.t =
let get_defs d =
let (v,tv) = List.partition (fun (_,def) -> match def with Variable _ -> true | Type _ -> false) (Def_map.to_kv_list d) in
[
("variables", `Assoc (List.map (fun (def_id,def) -> (def_id,def_to_json def)) v));
("types", `Assoc (List.map (fun (def_id,def) -> (def_id,def_to_json def)) tv))
]
in
`Assoc (get_defs d)
let scopes_json s : Yojson.t = `List (
List.map
(fun scope ->
let sd = Def_map.to_kv_list scope.env in
let (variables,types) = List.partition (fun (_,def) -> match def with Type _ -> false | Variable _ -> true) sd in
let v = List.map (fun (k,_) -> `String k) variables in
let t = List.map (fun (k,_) -> `String k) types in
(`Assoc [("range", Location.pp_json scope.range) ; ("expression_environment", `List v) ; ("type_environment", `List t)])
)
s
)
let to_json (d,s) = `Assoc [("definitions", (defs_json d)) ; ("scopes", (scopes_json s))]

16
src/main/scopes/dune Normal file
View File

@ -0,0 +1,16 @@
(library
(name scopes)
(public_name ligo.scopes)
(libraries
main_errors
compile
simple-utils
self_ast_core
typer
ast_typed
)
(preprocess
(pps ppx_let bisect_ppx --conditional)
)
(flags (:standard -w +1..62-4-9-44-40-42-48-30@39@33 -open Simple_utils -open Tezos_utils ))
)

14
src/main/scopes/formatter.ml Normal file
View File

@ -0,0 +1,14 @@
open Display
let scope_ppformat ~display_format f ((d,s),_) =
match display_format with
| Human_readable ->
Format.fprintf f "there is to human-readable pretty printer for you, use --format=json"
| Dev -> Format.fprintf f "@[<v>%a@ %a@]" PP.scopes s PP.definitions d
let scope_jsonformat (defscopes,_) : json = PP.to_json defscopes
let scope_format : 'a format = {
pp = scope_ppformat;
to_json = scope_jsonformat;
}

62
src/main/scopes/misc.ml Normal file
View File

@ -0,0 +1,62 @@
open Trace
open Types
let get_binder_name : 'a Var.t -> string = fun (v: _ Var.t) ->
if Var.is_generated v
then "generated"
else Var.to_name v
let make_def_id name i =
(name ^ "#" ^ (string_of_int i), i+1)
let add_shadowing_def : (int * _ Var.t) -> def -> def_map -> (int * def_map) = fun (i,var) def env ->
if Var.is_generated var then (i,env)
else
let name = get_binder_name var in
let (definition_id,i) = make_def_id name i in
let shadow = Def_map.filter
(fun _ s_def -> match def, s_def with
| Variable _ , Variable _ | Type _ , Type _ ->
not @@ String.equal (get_def_name s_def) name
| _ -> true )
env in
let env = Def_map.add definition_id def shadow in
(i,env)
let make_v_def_from_core : with_types:bool -> string -> string -> ('a Var.t) -> Ast_core.expression -> Location.t -> Location.t -> def =
fun ~with_types source_file syntax name exp range body_range ->
let name = get_binder_name name in
let t = to_option @@
let%bind typed_prg,state = Compile.Utils.type_file source_file syntax Env in
let env = Ast_typed.program_environment Environment.default typed_prg in
let%bind (e,_) = Compile.Of_core.compile_expression ~env ~state exp in
ok e.type_expression
in
(* TODO : the source_file is given here but it should only be the declarations seen so far,
otherwise nothing will be typed if an error occurs later in the file *)
make_v_def ~with_types name t range body_range
let make_v_def_option_type : with_types:bool -> string -> string -> ('a Var.t) -> Ast_core.type_expression option -> Location.t -> Location.t -> def =
fun ~with_types source_file syntax name maybe_typed range body_range ->
let name = get_binder_name name in
match maybe_typed with
| Some t ->
let t' = to_option @@
let%bind typed_prg,_ = Compile.Utils.type_file source_file syntax Env in
let env = Ast_typed.program_environment Environment.default typed_prg in
Compile.Of_core.evaluate_type env t in
make_v_def ~with_types name t' range body_range
| None -> make_v_def ~with_types name None range body_range
let make_v_def_ppx_type :
with_types:bool -> string -> string -> ('a Var.t) -> (Ast_typed.type_expression -> Ast_typed.type_expression) ->
Ast_core.expression -> Location.t -> Location.t -> def =
fun ~with_types source_file syntax name f exp range body_range ->
let name = get_binder_name name in
let t = to_option @@
let%bind typed_prg,state = Compile.Utils.type_file source_file syntax Env in
let env = Ast_typed.program_environment Environment.default typed_prg in
let%bind (e,_) = Compile.Of_core.compile_expression ~env ~state exp in
let v = f e.type_expression in ok v
in
make_v_def ~with_types name t range body_range

136
src/main/scopes/scopes.ml Normal file
View File

@ -0,0 +1,136 @@
open Trace
open Types
open Misc
module Formatter = Formatter
let scopes : with_types:bool -> string -> string -> ((def_map * scopes), Main_errors.all) result = fun ~with_types source_file syntax ->
let make_v_def_from_core = make_v_def_from_core ~with_types source_file syntax in
let make_v_def_option_type = make_v_def_option_type ~with_types source_file syntax in
let make_v_def_ppx_type = make_v_def_ppx_type ~with_types source_file syntax in
let rec find_scopes' = fun (i,all_defs,env,scopes,lastloc) (e : Ast_core.expression) ->
match e.content with
| E_let_in { let_binder = ({wrap_content=fn;location=fn_loc},_) ; rhs ; let_result } -> (
let (i,all_defs,_, scopes) = find_scopes' (i,all_defs,env,scopes,e.location) rhs in
let (i,env) = add_shadowing_def (i,fn) (make_v_def_from_core fn rhs fn_loc rhs.location) env in
let all_defs = merge_defs env all_defs in
find_scopes' (i,all_defs,env,scopes,let_result.location) let_result
)
| E_recursive { fun_name={wrap_content=fn;location=fn_loc} ; fun_type ; lambda = { result;_ } } -> (
(* Note:
It is not entirely true that 'fun_name' is in 'result' scope; because only tail calls are allowed
*)
let def = make_v_def_option_type fn (Some fun_type) fn_loc result.location in
let (i,env) = add_shadowing_def (i,fn) def env in
find_scopes' (i,all_defs,env,scopes,result.location) result
)
| E_lambda { binder={wrap_content=fun_name;location=fn_loc} ; input_type ; output_type = _ ; result } -> (
let (i,env) = add_shadowing_def (i,fun_name) (make_v_def_option_type fun_name input_type fn_loc result.location) env in
let all_defs = merge_defs env all_defs in
find_scopes' (i,all_defs,env,scopes,result.location) result
)
| E_matching {matchee; cases} -> (
let (i,all_defs,_,scopes) = find_scopes' (i,all_defs,env,scopes,matchee.location) matchee in
match cases with
| Match_list { match_nil ; match_cons = ({wrap_content=hd;location=hd_loc} , {wrap_content=tl;location=tl_loc} , match_cons) } -> (
let (i,all_defs,_,scopes) = find_scopes' (i,all_defs,env,scopes,match_nil.location) match_nil in
let all_defs = merge_defs env all_defs in
let list_f = fun (t:Ast_typed.type_expression) -> match Ast_typed.get_t_list t with
| None -> failwith "Could not get the type of a list"
| Some t -> t in
let hd_def = make_v_def_ppx_type hd list_f matchee hd_loc hd_loc in
let tl_def = make_v_def_from_core tl matchee tl_loc tl_loc in
let (i,env) = add_shadowing_def (i,hd) hd_def env in
let (i,env) = add_shadowing_def (i,tl) tl_def env in
let (i,all_defs,_,scopes) = find_scopes' (i,all_defs,env,scopes,match_cons.location) match_cons in
let all_defs = merge_defs env all_defs in
(i,all_defs,env,scopes)
)
| Match_option { match_none ; match_some = ({wrap_content=some;location=some_loc} , match_some) } -> (
let (i,all_defs,_,scopes) = find_scopes' (i,all_defs,env,scopes,match_none.location) match_none in
let all_defs = merge_defs env all_defs in
let tl_def = make_v_def_from_core some matchee some_loc some_loc in
let (i,env) = add_shadowing_def (i,some) tl_def env in
let (i,all_defs,_,scopes) = find_scopes' (i,all_defs,env,scopes,match_some.location) match_some in
let all_defs = merge_defs env all_defs in
(i,all_defs,env,scopes)
)
| Match_variant lst -> (
let aux = fun (i,all_defs,scopes) ((c,(proj:Ast_core.expression_variable)),(match_variant:Ast_core.expression)) ->
let proj_f = fun (t:Ast_typed.type_expression) -> match Ast_typed.get_t_sum t with
| Some t -> (Ast_typed.CMap.find (Ast_typed.Environment.convert_constructor' c) t).ctor_type
| None -> failwith "Could not get the inner type of a constructor" in
let proj_def = make_v_def_ppx_type proj.wrap_content proj_f matchee proj.location proj.location in
let (i,env) = add_shadowing_def (i,proj.wrap_content) proj_def env in
let (i,all_defs,_,scopes) = find_scopes' (i,all_defs,env,scopes,match_variant.location) match_variant in
let all_defs = merge_defs env all_defs in
(i,all_defs,scopes)
in
let (i,all_defs,scopes) = List.fold_left aux (i,all_defs,scopes) lst in
(i,all_defs,env,scopes)
)
)
| E_record emap -> (
let aux = fun (i,all_defs,scopes) (exp:Ast_core.expression) ->
let (i,all_defs,_,scopes) = find_scopes' (i,all_defs,env,scopes,exp.location) exp in
(i,all_defs,scopes)
in
let (i,all_defs,scopes) = List.fold_left aux (i,all_defs,scopes) (Ast_core.LMap.to_list emap) in
(i,all_defs,env,scopes)
)
| E_record_update { record ; update ; _ } -> (
(*TODO: here record has a virtual location, check this out.. not normal *)
let (i,all_defs,_,scopes) = find_scopes' (i,all_defs,env,scopes,record.location) record in
find_scopes' (i,all_defs,env,scopes,update.location) update
)
| E_constant { arguments ; _ } -> (
let aux = fun (i,all_defs,scopes) (exp:Ast_core.expression) ->
let (i,all_defs,_,scopes) = find_scopes' (i,all_defs,env,scopes,exp.location) exp in
(i,all_defs,scopes)
in
let (i,all_defs,scopes) = List.fold_left aux (i,all_defs,scopes) arguments in
(i,all_defs,env,scopes)
)
| E_application { lamb ; args } -> (
let (i,all_defs,_,scopes) = find_scopes' (i,all_defs,env,scopes,lamb.location) lamb in
find_scopes' (i,all_defs,env,scopes,args.location) args
)
| E_ascription { anno_expr=e;_ } | E_record_accessor { record=e;_ } | E_constructor { element=e;_ } -> (
find_scopes' (i,all_defs,env,scopes,e.location) e
)
| E_literal _ | E_raw_code _ | E_variable _ -> (
let scopes = add_scope (lastloc, env) scopes in
(i,all_defs,env,scopes)
)
in
let find_scopes (i,top_lvl_defs,scopes,loc) e =
let (i,defs,_,scopes) = find_scopes' (i,top_lvl_defs,top_lvl_defs,scopes,loc) e in
(i,defs,scopes) in
let aux = fun (i,top_def_map,inner_def_map,scopes) (x : Ast_core.declaration Location.wrap) ->
match x.wrap_content with
| Declaration_constant ({wrap_content=v;location=v_loc} , _o , _i, e) ->
let (i,new_inner_def_map,scopes) = find_scopes (i,top_def_map,scopes,x.location) e in
let inner_def_map = merge_defs new_inner_def_map inner_def_map in
let def = make_v_def_from_core v e v_loc e.location in
let (i,top_def_map) = add_shadowing_def (i,v) def top_def_map in
( i, top_def_map, inner_def_map, scopes )
| Declaration_type (tv, te) ->
let def = make_t_def (get_binder_name tv) x te in
let (i,top_def_map) = add_shadowing_def (i,tv) def top_def_map in
( i, top_def_map, inner_def_map, scopes )
in
let%bind (core_prg : Ast_core.program) = Compile.Utils.to_core source_file syntax in
let (_,top_d,inner_d,s) = List.fold_left aux (0, Def_map.empty ,Def_map.empty, []) core_prg in
let d = Def_map.union (fun _ outter _ -> Some outter) top_d inner_d in
ok (d,s)

46
src/main/scopes/types.ml Normal file
View File

@ -0,0 +1,46 @@
module Definitions = struct
module Def_map = Map.Make( struct type t = string let compare = String.compare end)
type vdef = {
name : string ;
range : Location.t ;
body_range : Location.t ;
t : Ast_typed.type_expression option ;
references : (Location.t list) option
}
type tdef = {
name : string ;
range : Location.t ;
body_range : Location.t ;
content : Ast_core.type_expression
}
type def = Variable of vdef | Type of tdef
type def_map = def Def_map.t
let merge_defs a b = Def_map.union (fun _ a _ -> Some a) a b
let get_def_name = function
| Variable d -> d.name
| Type d -> d.name
let get_range = function
| Type t -> t.range
| Variable v -> v.range
let make_v_def : with_types:bool -> string -> Ast_typed.type_expression option -> Location.t -> Location.t -> def =
fun ~with_types name t range body_range ->
let t = if with_types then t else None in
Variable { name ; range ; body_range ; t ; references = None }
let make_t_def : string -> Ast_core.declaration Location.wrap -> Ast_core.type_expression -> def =
fun name decl te ->
Type { name ; range = decl.location ; body_range = te.location ; content = te }
end
include Definitions
type scope = { range : Location.t ; env : def_map }
type scopes = scope list
let add_scope (range,env) scopes = { range ; env } :: scopes

3
src/passes/01-parsing/errors.ml
View File

@ -1,4 +1,3 @@
open Trace
open Simple_utils.Display
module CST = Cst.Cameligo
@ -49,7 +48,7 @@ let error_ppformat : display_format:string display_format ->
Format.pp_print_string f s ;
)
let error_jsonformat : parser_error -> J.t = fun a ->
let error_jsonformat : parser_error -> Yojson.t = fun a ->
let json_error ~stage ~content =
`Assoc [
("status", `String "error") ;

3
src/passes/03-tree_abstraction/cameligo/errors.ml
View File

@ -1,4 +1,3 @@
open Trace
open Simple_utils.Display
module Raw = Cst.Cameligo
@ -147,7 +146,7 @@ let rec error_ppformat : display_format:string display_format ->
)
let rec error_jsonformat : abs_error -> J.t = fun a ->
let rec error_jsonformat : abs_error -> Yojson.t = fun a ->
let json_error ~stage ~content =
`Assoc [
("status", `String "error") ;

3
src/passes/03-tree_abstraction/pascaligo/errors.ml
View File

@ -1,4 +1,3 @@
open Trace
open Simple_utils.Display
module Raw = Cst.Pascaligo
@ -126,7 +125,7 @@ let rec error_ppformat : display_format:string display_format ->
)
let rec error_jsonformat : abs_error -> J.t = fun a ->
let rec error_jsonformat : abs_error -> Yojson.t = fun a ->
let json_error ~stage ~content =
`Assoc [
("status", `String "error") ;

3
src/passes/04-self_ast_imperative/errors.ml
View File

@ -1,6 +1,5 @@
open Simple_utils.Display
open Ast_imperative
open Trace
let stage = "self_ast_imperative"
@ -67,7 +66,7 @@ let error_ppformat : display_format:string display_format ->
Location.pp e.location
)
let error_jsonformat : self_ast_imperative_error -> J.t = fun a ->
let error_jsonformat : self_ast_imperative_error -> Yojson.t = fun a ->
let json_error ~stage ~content =
`Assoc [
("status", `String "error") ;

3
src/passes/05-purification/errors.ml
View File

@ -1,4 +1,3 @@
open Trace
open Simple_utils.Display
let stage = "purification"
@ -21,7 +20,7 @@ let error_ppformat : display_format:string display_format ->
s
)
let error_jsonformat : purification_error -> J.t = fun a ->
let error_jsonformat : purification_error -> Yojson.t = fun a ->
let json_error ~stage ~content =
`Assoc [
("status", `String "error") ;

3
src/passes/09-typing/08-typer-common/errors.ml
View File

@ -1,4 +1,3 @@
open Trace
open Simple_utils.Display
@ -580,7 +579,7 @@ let rec error_ppformat : display_format:string display_format ->
error_ppformat ~display_format f err
)
let rec error_jsonformat : typer_error -> J.t = fun a ->
let rec error_jsonformat : typer_error -> Yojson.t = fun a ->
let json_error ~stage ~content =
`Assoc [
("status", `String "error") ;

2
src/passes/09-typing/typer.ml
View File

@ -15,5 +15,7 @@ type environment = Environment.t
let type_program = Typer_old.type_program
let type_expression_subst = if use_new_typer then Typer_new.type_expression_subst else Typer_old.type_expression (* the old typer does not have unification variables that would need substitution, so no need to "subst" anything. *)
let untype_expression = if use_new_typer then Typer_new.untype_expression else Typer_old.untype_expression
let evaluate_type = if use_new_typer then Typer_new.evaluate_type else Typer_old.evaluate_type
let assert_type_expression_eq = Typer_common.Helpers.assert_type_expression_eq

1
src/passes/09-typing/typer.mli
View File

@ -15,5 +15,6 @@ type environment = Environment.t
val type_program : I.program -> (O.program * O'.typer_state, Errors.typer_error) result
val type_expression_subst : environment -> O'.typer_state -> ?tv_opt:O.type_expression -> I.expression -> (O.expression * O'.typer_state , Errors.typer_error) result
val untype_expression : O.expression -> (I.expression , Errors.typer_error) result
val evaluate_type : environment -> O.ast_core_type_expression -> (O.type_expression, Errors.typer_error) result
val assert_type_expression_eq : O.type_expression * O.type_expression -> (unit, Errors.typer_error) result

3
src/passes/10-self_ast_typed/errors.ml
View File

@ -1,5 +1,4 @@
open Simple_utils.Display
open Trace
let stage = "self_ast_typed"
@ -104,7 +103,7 @@ let error_ppformat : display_format:string display_format ->
Location.pp loc
)
let error_jsonformat : self_ast_typed_error -> J.t = fun a ->
let error_jsonformat : self_ast_typed_error -> Yojson.t = fun a ->
let json_error ~stage ~content =
`Assoc [
("status", `String "error") ;

3
src/passes/11-spilling/errors.ml
View File

@ -1,4 +1,3 @@
open Trace
open Simple_utils.Display
type spilling_error = [
@ -77,7 +76,7 @@ let rec error_ppformat : display_format:string display_format ->
Format.pp_print_string f s
)
let rec error_jsonformat : spilling_error -> J.t = fun a ->
let rec error_jsonformat : spilling_error -> Yojson.t = fun a ->
let json_error ~stage ~content =
`Assoc [
("status", `String "error") ;

3
src/passes/12-self_mini_c/errors.ml
View File

@ -1,5 +1,4 @@
open Simple_utils.Display
open Trace
let stage = "self_mini_c"
@ -27,7 +26,7 @@ let error_ppformat : display_format:string display_format ->
| `Self_mini_c_aggregation -> Format.fprintf f "could not aggregate"
)
let error_jsonformat : self_mini_c_error -> J.t = fun a ->
let error_jsonformat : self_mini_c_error -> Yojson.t = fun a ->
let json_error ~stage ~content =
`Assoc [
("status", `String "error") ;

3
src/passes/13-stacking/errors.ml
View File

@ -1,4 +1,3 @@
open Trace
open Simple_utils.Display
open Stage_common.Types
@ -92,7 +91,7 @@ let rec error_ppformat : display_format:string display_format ->
Mini_c.PP.constant c
)
let rec error_jsonformat : stacking_error -> J.t = fun a ->
let rec error_jsonformat : stacking_error -> Yojson.t = fun a ->
let json_error ~stage ~content =
`Assoc [
("status", `String "error") ;

6
src/stages/5-ast_typed/PP_json.ml
View File

@ -2,7 +2,7 @@ open Types
open Fold
open Format
type json = Yojson.Basic.t
type json = Yojson.t
module M = struct
type no_state = NoState
@ -33,7 +33,7 @@ module M = struct
packed_internal_operation = (fun _visitor NoState _op -> `String "Operation(...bytes)") ;
expression_variable = (fun _visitor NoState ev -> `Assoc ["exp-var", `String (asprintf "%a" Var.pp ev.wrap_content)] ) ;
constructor' = (fun _visitor NoState (Constructor c) -> `Assoc ["constructor", `String c] ) ;
location = (fun _visitor NoState loc -> `String (asprintf "%a" Location.pp loc) ) ; (*TODO*)
location = (fun _visitor NoState loc -> Location.pp_json loc) ;
label = (fun _visitor NoState (Label lbl) -> `Assoc ["label" , `String lbl] ) ;
ast_core_type_expression = (fun _visitor NoState te -> `String (asprintf "%a" (Ast_core.PP.type_expression) te) ) ; (*TODO*)
constructor_map = (fun _visitor continue NoState cmap ->
@ -80,7 +80,7 @@ module M = struct
fold to_json NoState v
let print : ((no_state, json) fold_config -> no_state -> 'a -> json) -> formatter -> 'a -> unit = fun fold ppf v ->
fprintf ppf "%a" Yojson.Basic.pp (to_json fold v)
fprintf ppf "%a" Yojson.pp (to_json fold v)
end
module Yojson = Fold.Folds(struct

1
src/stages/5-ast_typed/environment.mli
View File

@ -10,6 +10,7 @@ val add_type : type_variable -> type_expression -> t -> t
val get_opt : expression_variable -> t -> element option
val get_type_opt : type_variable -> t -> type_expression option
val get_constructor : Ast_core.constructor' -> t -> (type_expression * type_expression) option
val convert_constructor' : S.constructor' -> constructor'
val add_ez_sum_type : ?env:environment -> ?type_name:type_variable -> (constructor' * ctor_content) list -> environment
module PP : sig

2
src/test/adt_generator/use_a_fold.ml
View File

@ -9,7 +9,7 @@ let (|>) v f = f v
(* TODO: how should we plug these into our test framework? *)
let test (x : (unit,_) result) : unit = match x with
| Ok (() , _annotation_thunk) -> ()
(* | Error err -> failwith (Yojson.Basic.to_string @@ err ()) *)
(* | Error err -> failwith (Yojson.to_string @@ err ()) *)
| Error _err -> failwith ("TODO")
let () =

3
src/test/contracts/get_scope_tests/application.mligo Normal file
View File

@ -0,0 +1,3 @@
let a =
let f : (int-> int -> int) = fun (i : int) (j : int) -> j + i in
(let b = 1 in f 1) (let c = 2 in c)

6
src/test/contracts/get_scope_tests/constant.mligo Normal file
View File

@ -0,0 +1,6 @@
let a = 1
let b =
List.map
(fun (c : int) -> let d = 1 in d + c + a)
(let e = 1 in [ e+a ; e+a ])

5
src/test/contracts/get_scope_tests/include.mligo Normal file
View File

@ -0,0 +1,5 @@
#include "./letin.mligo"
let x = 1
let y = x + 1

5
src/test/contracts/get_scope_tests/lambda.mligo Normal file
View File

@ -0,0 +1,5 @@
let a = 1
let b =
let f : (int-> int -> int) = fun (i : int) (j : int) -> j + i in
f 2 3

9
src/test/contracts/get_scope_tests/lambda_letin.mligo Normal file
View File

@ -0,0 +1,9 @@
let a = 1
let b =
let f : (int -> int -> int) = fun (i : int) (j : int) ->
let g = j + i + a in
let k = j + i + a + g in
j + i + a + g + k
in
f 2 a

10
src/test/contracts/get_scope_tests/letin.mligo Normal file
View File

@ -0,0 +1,10 @@
let a = 1
let b =
let c = 0 + a in
let d =
let e = a + c in
let f = a + c + e in
a + c + e + f
in
a + c + d

20
src/test/contracts/get_scope_tests/match.mligo Normal file
View File

@ -0,0 +1,20 @@
type mytype = Foo of int | Bar of string
let a = 1
let b =
match (let c = a in Foo c) with
| Foo x -> x + a
| Bar y -> 1 + a
let c =
match ([ 1 ; 2 ;3 ]) with
| [] ->
let c = 2 in
a
| hd::tl -> 2
let d =
match (let d = 1 in Some (a+d)) with
| Some (s) -> s + a
| None -> a

9
src/test/contracts/get_scope_tests/rec.mligo Normal file
View File

@ -0,0 +1,9 @@
let a = 1
let b =
let rec c : int*int -> int = fun ((i,j):int*int) ->
let k = i + j + a in
c (k,1)
in
let b = 2 in
c (a, b)

16
src/test/contracts/get_scope_tests/records.mligo Normal file
View File

@ -0,0 +1,16 @@
type myrec = {foo : int ; bar : int}
let a = 1
// record
let b = {foo=(let i = 1 in let j = 2 in a+i+j) ; bar=24}
// record accessor
// let c = (let d = 1 in b).bar
// record update
// let e =
// {(let f = 2 in b) with bar=(let g = a in g);}
let e =
{b with bar=(let g = a in g + b.bar + a);}

10
src/test/contracts/get_scope_tests/shadowing.mligo Normal file
View File

@ -0,0 +1,10 @@
let a = 1
let b =
let c = 0 + a in
let d =
let e = a + c in
let a = a + c + e in
a + c + e
in
a + c + d

2
vendors/ligo-utils/simple-utils/display.ml vendored
View File

@ -1,4 +1,4 @@
type json = Yojson.Basic.t
type json = Yojson.t
type 'a display_format =
| Human_readable : string display_format

2
vendors/ligo-utils/simple-utils/display.mli vendored
View File

@ -1,4 +1,4 @@
type json = Yojson.Basic.t
type json = Yojson.t
type 'a display_format =
| Human_readable : string display_format

12
vendors/ligo-utils/simple-utils/location.ml vendored
View File

@ -17,6 +17,18 @@ let pp = fun ppf t ->
| Virtual _s -> Format.fprintf ppf ""
| File f -> Format.fprintf ppf "%s" (f#to_string `Point)
let pp_json = fun t ->
match t with
| Virtual s -> `Assoc ["virtual" , `String s]
| File f ->
`Assoc [
("file", `String f#file) ;
("from_row", `Int f#start#line) ;
("from_col", `Int (f#start#column `Point)) ;
("to_row", `Int f#stop#line) ;
("to_col", `Int (f#stop#column `Point)) ;
]
let compare a b = match a,b with
| (File a, File b) -> Region.compare a b
| (File _, Virtual _) -> -1

16
vendors/ligo-utils/simple-utils/trace.ml vendored
View File

@ -212,15 +212,12 @@ module Trace_tutorial = struct
end (* end Trace_tutorial. *)
module J = Yojson.Basic
(* Annotations should be used in debug mode to aggregate information
about some value history. Where it was produced, when it was
modified, etc. It is currently not being used. *)
type 'a thunk = unit -> 'a
type annotation = J.t
type annotation = Yojson.t
(* Even in debug mode, building annotations can be quite
resource-intensive. Instead, a thunk is passed, that is computed
@ -323,6 +320,14 @@ let to_option = function
| Ok (o, annotations) -> ignore annotations; Some o
| Error _ -> None
(**
Convert a result to a json, if res in an error, the produces JSON will be
empty, otherwise the provided to_json function will be used
*)
let to_json to_json = function
| Ok (v,_) -> to_json v
| Error _ -> `Null
(**
Convert an option to a result, with a given error if the parameter is None.
*)
@ -334,6 +339,7 @@ let trace_assert_fail_option error = function
None -> ok ()
| Some _s -> fail error
(** Utilities to interact with other data-structure. [bind_t] takes
an ['a result t] and makes a ['a t result] out of it. It "lifts" the
error out of the type. The most common context is when mapping a
@ -554,5 +560,3 @@ module Assert = struct
assert_true err List.(length lsta = length lstb)
end
let json_of_error = J.to_string

5
vendors/ligo-utils/simple-utils/var.ml vendored
View File

@ -49,3 +49,8 @@ let fresh_like v =
fresh ~name:v.name ()
let debug v = match v.counter with Some c -> Printf.sprintf "%s(%d)" v.name c | None -> Printf.sprintf "%s(None)" v.name
let is_generated var =
match var.counter with
| None -> false
| Some _ -> true

2
vendors/ligo-utils/simple-utils/var.mli vendored
View File

@ -45,3 +45,5 @@ val fresh_like : 'a t -> 'b t
val reset_counter : unit -> unit
val debug : 'a t -> string
val is_generated : 'a t -> bool