Merge branch 'feature/initial_req_serokell' into 'dev'
get-scope command See merge request ligolang/ligo!690
This commit is contained in:
Rémi Lesenechal
commit
567515a5ce
@ -96,6 +96,13 @@ let disable_michelson_typechecking =
|
|||||||
info ~doc ["disable-michelson-typechecking"] in
|
info ~doc ["disable-michelson-typechecking"] in
|
||||||
value @@ flag info
|
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 predecessor_timestamp =
|
||||||
let open Arg in
|
let open Arg in
|
||||||
let info =
|
let info =
|
||||||
@ -484,6 +491,17 @@ let transpile_expression =
|
|||||||
(Term.ret term , Term.info ~doc cmdname)
|
(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 () =
|
let run ?argv () =
|
||||||
Term.eval_choice ?argv main [
|
Term.eval_choice ?argv main [
|
||||||
temp_ligo_interpreter ;
|
temp_ligo_interpreter ;
|
||||||
@ -507,5 +525,6 @@ let run ?argv () =
|
|||||||
print_mini_c ;
|
print_mini_c ;
|
||||||
list_declarations ;
|
list_declarations ;
|
||||||
preprocess;
|
preprocess;
|
||||||
pretty_print
|
pretty_print;
|
||||||
|
get_scope;
|
||||||
]
|
]
|
||||||
|
|||||||
@ -13,7 +13,7 @@ let toplevel : display_format:ex_display_format -> displayable -> (unit -> unit
|
|||||||
match t with
|
match t with
|
||||||
| Human_readable -> convert ~display_format:t disp ;
|
| Human_readable -> convert ~display_format:t disp ;
|
||||||
| Dev -> 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 ;
|
Format.printf "%s\n" as_str ;
|
||||||
return ()
|
return ()
|
||||||
|
|
||||||
|
|||||||
276
src/bin/expect_tests/get_scope.ml
Normal file
276
src/bin/expect_tests/get_scope.ml
Normal 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: |} ] ;
|
||||||
@ -40,6 +40,9 @@ let%expect_test _ =
|
|||||||
evaluate-value
|
evaluate-value
|
||||||
Subcommand: Evaluate a given definition.
|
Subcommand: Evaluate a given definition.
|
||||||
|
|
||||||
|
get-scope
|
||||||
|
Subcommand: Return the JSON encoded environment for a given file.
|
||||||
|
|
||||||
interpret
|
interpret
|
||||||
Subcommand: Interpret the expression in the context initialized by
|
Subcommand: Interpret the expression in the context initialized by
|
||||||
the provided source file.
|
the provided source file.
|
||||||
@ -140,6 +143,9 @@ let%expect_test _ =
|
|||||||
evaluate-value
|
evaluate-value
|
||||||
Subcommand: Evaluate a given definition.
|
Subcommand: Evaluate a given definition.
|
||||||
|
|
||||||
|
get-scope
|
||||||
|
Subcommand: Return the JSON encoded environment for a given file.
|
||||||
|
|
||||||
interpret
|
interpret
|
||||||
Subcommand: Interpret the expression in the context initialized by
|
Subcommand: Interpret the expression in the context initialized by
|
||||||
the provided source file.
|
the provided source file.
|
||||||
|
|||||||
@ -42,3 +42,5 @@ let list_declarations (program : Ast_core.program) : string list =
|
|||||||
| Declaration_constant (var,_,_,_) -> (Var.to_name var.wrap_content)::prev
|
| Declaration_constant (var,_,_,_) -> (Var.to_name var.wrap_content)::prev
|
||||||
| _ -> prev)
|
| _ -> prev)
|
||||||
[] program
|
[] program
|
||||||
|
|
||||||
|
let evaluate_type (env : Ast_typed.Environment.t) (t: Ast_core.type_expression) = trace typer_tracer @@ Typer.evaluate_type env t
|
||||||
@ -14,9 +14,9 @@ let to_core f stx =
|
|||||||
let%bind core = Of_sugar.compile sugar in
|
let%bind core = Of_sugar.compile sugar in
|
||||||
ok @@ core
|
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 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)
|
ok @@ (typed,state)
|
||||||
|
|
||||||
let to_mini_c f stx env =
|
let to_mini_c f stx env =
|
||||||
@ -32,34 +32,34 @@ let compile_file f stx ep : (Michelson.michelson, _) result =
|
|||||||
ok @@ contract
|
ok @@ contract
|
||||||
|
|
||||||
let type_expression source_file syntax expression env state =
|
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 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 imperative_exp = Of_source.compile_expression v_syntax expression in
|
||||||
let%bind sugar_exp = Of_imperative.compile_expression imperative_exp 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 core_exp = Of_sugar.compile_expression sugar_exp in
|
||||||
let%bind (typed_exp,state) = Of_core.compile_expression ~env ~state core_exp in
|
let%bind (typed_exp,state) = Of_core.compile_expression ~env ~state core_exp in
|
||||||
ok @@ (typed_exp,state)
|
ok @@ (typed_exp,state)
|
||||||
|
|
||||||
let expression_to_mini_c source_file syntax expression env 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 (typed_exp,_) = type_expression source_file syntax expression env state in
|
||||||
let%bind mini_c_exp = Of_typed.compile_expression typed_exp in
|
let%bind mini_c_exp = Of_typed.compile_expression typed_exp in
|
||||||
ok @@ mini_c_exp
|
ok @@ mini_c_exp
|
||||||
|
|
||||||
let compile_expression source_file syntax expression env state =
|
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 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
|
let%bind compiled = Of_mini_c.compile_expression mini_c_exp in
|
||||||
ok @@ compiled
|
ok @@ compiled
|
||||||
|
|
||||||
let compile_and_aggregate_expression source_file syntax expression env state mini_c_prg =
|
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 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
|
let%bind compiled = Of_mini_c.aggregate_and_compile_expression mini_c_prg mini_c_exp in
|
||||||
ok @@ compiled
|
ok @@ compiled
|
||||||
|
|
||||||
let compile_storage storage input source_file syntax env state mini_c_prg =
|
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 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 imperative = Of_source.compile_contract_input storage input v_syntax in
|
||||||
let%bind sugar = Of_imperative.compile_expression imperative in
|
let%bind sugar = Of_imperative.compile_expression imperative in
|
||||||
let%bind core = Of_sugar.compile_expression sugar in
|
let%bind core = Of_sugar.compile_expression sugar in
|
||||||
let%bind typed,_ = Of_core.compile_expression ~env ~state core in
|
let%bind typed,_ = Of_core.compile_expression ~env ~state core in
|
||||||
let%bind mini_c = Of_typed.compile_expression typed 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
|
let%bind compiled = Of_mini_c.aggregate_and_compile_expression mini_c_prg mini_c in
|
||||||
ok @@ compiled
|
ok @@ compiled
|
||||||
|
|||||||
@ -6,6 +6,7 @@
|
|||||||
compile
|
compile
|
||||||
decompile
|
decompile
|
||||||
main_errors
|
main_errors
|
||||||
|
scopes
|
||||||
)
|
)
|
||||||
(preprocess
|
(preprocess
|
||||||
(pps ppx_let bisect_ppx --conditional)
|
(pps ppx_let bisect_ppx --conditional)
|
||||||
|
|||||||
@ -3,3 +3,4 @@ module Compile = Compile
|
|||||||
module Decompile = Decompile
|
module Decompile = Decompile
|
||||||
module Display = Display
|
module Display = Display
|
||||||
module Formatter = Main_errors.Formatter
|
module Formatter = Main_errors.Formatter
|
||||||
|
module Scopes = Scopes
|
||||||
@ -1,4 +1,3 @@
|
|||||||
open Trace
|
|
||||||
open Display
|
open Display
|
||||||
|
|
||||||
let error_suggest: string = "\n
|
let error_suggest: string = "\n
|
||||||
@ -147,7 +146,7 @@ let error_ppformat : display_format:string display_format ->
|
|||||||
(error_ppformat' ~display_format) a
|
(error_ppformat' ~display_format) a
|
||||||
error_suggest
|
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 =
|
let json_error ~stage ~content =
|
||||||
`Assoc [
|
`Assoc [
|
||||||
("status", `String "error") ;
|
("status", `String "error") ;
|
||||||
|
|||||||
57
src/main/scopes/PP.ml
Normal file
57
src/main/scopes/PP.ml
Normal 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
16
src/main/scopes/dune
Normal 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
14
src/main/scopes/formatter.ml
Normal 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
62
src/main/scopes/misc.ml
Normal 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
136
src/main/scopes/scopes.ml
Normal 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
46
src/main/scopes/types.ml
Normal 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
|
||||||
@ -1,4 +1,3 @@
|
|||||||
open Trace
|
|
||||||
open Simple_utils.Display
|
open Simple_utils.Display
|
||||||
|
|
||||||
module CST = Cst.Cameligo
|
module CST = Cst.Cameligo
|
||||||
@ -49,7 +48,7 @@ let error_ppformat : display_format:string display_format ->
|
|||||||
Format.pp_print_string f s ;
|
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 =
|
let json_error ~stage ~content =
|
||||||
`Assoc [
|
`Assoc [
|
||||||
("status", `String "error") ;
|
("status", `String "error") ;
|
||||||
|
|||||||
@ -1,4 +1,3 @@
|
|||||||
open Trace
|
|
||||||
open Simple_utils.Display
|
open Simple_utils.Display
|
||||||
|
|
||||||
module Raw = Cst.Cameligo
|
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 =
|
let json_error ~stage ~content =
|
||||||
`Assoc [
|
`Assoc [
|
||||||
("status", `String "error") ;
|
("status", `String "error") ;
|
||||||
|
|||||||
@ -1,4 +1,3 @@
|
|||||||
open Trace
|
|
||||||
open Simple_utils.Display
|
open Simple_utils.Display
|
||||||
|
|
||||||
module Raw = Cst.Pascaligo
|
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 =
|
let json_error ~stage ~content =
|
||||||
`Assoc [
|
`Assoc [
|
||||||
("status", `String "error") ;
|
("status", `String "error") ;
|
||||||
|
|||||||
@ -1,6 +1,5 @@
|
|||||||
open Simple_utils.Display
|
open Simple_utils.Display
|
||||||
open Ast_imperative
|
open Ast_imperative
|
||||||
open Trace
|
|
||||||
|
|
||||||
let stage = "self_ast_imperative"
|
let stage = "self_ast_imperative"
|
||||||
|
|
||||||
@ -67,7 +66,7 @@ let error_ppformat : display_format:string display_format ->
|
|||||||
Location.pp e.location
|
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 =
|
let json_error ~stage ~content =
|
||||||
`Assoc [
|
`Assoc [
|
||||||
("status", `String "error") ;
|
("status", `String "error") ;
|
||||||
|
|||||||
@ -1,4 +1,3 @@
|
|||||||
open Trace
|
|
||||||
open Simple_utils.Display
|
open Simple_utils.Display
|
||||||
|
|
||||||
let stage = "purification"
|
let stage = "purification"
|
||||||
@ -21,7 +20,7 @@ let error_ppformat : display_format:string display_format ->
|
|||||||
s
|
s
|
||||||
)
|
)
|
||||||
|
|
||||||
let error_jsonformat : purification_error -> J.t = fun a ->
|
let error_jsonformat : purification_error -> Yojson.t = fun a ->
|
||||||
let json_error ~stage ~content =
|
let json_error ~stage ~content =
|
||||||
`Assoc [
|
`Assoc [
|
||||||
("status", `String "error") ;
|
("status", `String "error") ;
|
||||||
|
|||||||
@ -1,4 +1,3 @@
|
|||||||
open Trace
|
|
||||||
open Simple_utils.Display
|
open Simple_utils.Display
|
||||||
|
|
||||||
|
|
||||||
@ -580,7 +579,7 @@ let rec error_ppformat : display_format:string display_format ->
|
|||||||
error_ppformat ~display_format f err
|
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 =
|
let json_error ~stage ~content =
|
||||||
`Assoc [
|
`Assoc [
|
||||||
("status", `String "error") ;
|
("status", `String "error") ;
|
||||||
|
|||||||
@ -15,5 +15,7 @@ type environment = Environment.t
|
|||||||
let type_program = Typer_old.type_program
|
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 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 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
|
let assert_type_expression_eq = Typer_common.Helpers.assert_type_expression_eq
|
||||||
|
|||||||
@ -15,5 +15,6 @@ type environment = Environment.t
|
|||||||
val type_program : I.program -> (O.program * O'.typer_state, Errors.typer_error) result
|
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 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 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
|
val assert_type_expression_eq : O.type_expression * O.type_expression -> (unit, Errors.typer_error) result
|
||||||
@ -1,5 +1,4 @@
|
|||||||
open Simple_utils.Display
|
open Simple_utils.Display
|
||||||
open Trace
|
|
||||||
|
|
||||||
let stage = "self_ast_typed"
|
let stage = "self_ast_typed"
|
||||||
|
|
||||||
@ -104,7 +103,7 @@ let error_ppformat : display_format:string display_format ->
|
|||||||
Location.pp loc
|
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 =
|
let json_error ~stage ~content =
|
||||||
`Assoc [
|
`Assoc [
|
||||||
("status", `String "error") ;
|
("status", `String "error") ;
|
||||||
|
|||||||
@ -1,4 +1,3 @@
|
|||||||
open Trace
|
|
||||||
open Simple_utils.Display
|
open Simple_utils.Display
|
||||||
|
|
||||||
type spilling_error = [
|
type spilling_error = [
|
||||||
@ -77,7 +76,7 @@ let rec error_ppformat : display_format:string display_format ->
|
|||||||
Format.pp_print_string f s
|
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 =
|
let json_error ~stage ~content =
|
||||||
`Assoc [
|
`Assoc [
|
||||||
("status", `String "error") ;
|
("status", `String "error") ;
|
||||||
|
|||||||
@ -1,5 +1,4 @@
|
|||||||
open Simple_utils.Display
|
open Simple_utils.Display
|
||||||
open Trace
|
|
||||||
|
|
||||||
let stage = "self_mini_c"
|
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"
|
| `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 =
|
let json_error ~stage ~content =
|
||||||
`Assoc [
|
`Assoc [
|
||||||
("status", `String "error") ;
|
("status", `String "error") ;
|
||||||
|
|||||||
@ -1,4 +1,3 @@
|
|||||||
open Trace
|
|
||||||
open Simple_utils.Display
|
open Simple_utils.Display
|
||||||
open Stage_common.Types
|
open Stage_common.Types
|
||||||
|
|
||||||
@ -92,7 +91,7 @@ let rec error_ppformat : display_format:string display_format ->
|
|||||||
Mini_c.PP.constant c
|
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 =
|
let json_error ~stage ~content =
|
||||||
`Assoc [
|
`Assoc [
|
||||||
("status", `String "error") ;
|
("status", `String "error") ;
|
||||||
|
|||||||
@ -2,7 +2,7 @@ open Types
|
|||||||
open Fold
|
open Fold
|
||||||
open Format
|
open Format
|
||||||
|
|
||||||
type json = Yojson.Basic.t
|
type json = Yojson.t
|
||||||
|
|
||||||
module M = struct
|
module M = struct
|
||||||
type no_state = NoState
|
type no_state = NoState
|
||||||
@ -33,7 +33,7 @@ module M = struct
|
|||||||
packed_internal_operation = (fun _visitor NoState _op -> `String "Operation(...bytes)") ;
|
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)] ) ;
|
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] ) ;
|
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] ) ;
|
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*)
|
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 ->
|
constructor_map = (fun _visitor continue NoState cmap ->
|
||||||
@ -80,7 +80,7 @@ module M = struct
|
|||||||
fold to_json NoState v
|
fold to_json NoState v
|
||||||
|
|
||||||
let print : ((no_state, json) fold_config -> no_state -> 'a -> json) -> formatter -> 'a -> unit = fun fold ppf 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
|
end
|
||||||
|
|
||||||
module Yojson = Fold.Folds(struct
|
module Yojson = Fold.Folds(struct
|
||||||
|
|||||||
@ -10,6 +10,7 @@ val add_type : type_variable -> type_expression -> t -> t
|
|||||||
val get_opt : expression_variable -> t -> element option
|
val get_opt : expression_variable -> t -> element option
|
||||||
val get_type_opt : type_variable -> t -> type_expression option
|
val get_type_opt : type_variable -> t -> type_expression option
|
||||||
val get_constructor : Ast_core.constructor' -> t -> (type_expression * 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
|
val add_ez_sum_type : ?env:environment -> ?type_name:type_variable -> (constructor' * ctor_content) list -> environment
|
||||||
module PP : sig
|
module PP : sig
|
||||||
|
|||||||
@ -9,7 +9,7 @@ let (|>) v f = f v
|
|||||||
(* TODO: how should we plug these into our test framework? *)
|
(* TODO: how should we plug these into our test framework? *)
|
||||||
let test (x : (unit,_) result) : unit = match x with
|
let test (x : (unit,_) result) : unit = match x with
|
||||||
| Ok (() , _annotation_thunk) -> ()
|
| Ok (() , _annotation_thunk) -> ()
|
||||||
(* | Error err -> failwith (Yojson.Basic.to_string @@ err ()) *)
|
(* | Error err -> failwith (Yojson.to_string @@ err ()) *)
|
||||||
| Error _err -> failwith ("TODO")
|
| Error _err -> failwith ("TODO")
|
||||||
|
|
||||||
let () =
|
let () =
|
||||||
|
|||||||
3
src/test/contracts/get_scope_tests/application.mligo
Normal file
3
src/test/contracts/get_scope_tests/application.mligo
Normal 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
6
src/test/contracts/get_scope_tests/constant.mligo
Normal 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
5
src/test/contracts/get_scope_tests/include.mligo
Normal 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
5
src/test/contracts/get_scope_tests/lambda.mligo
Normal 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
9
src/test/contracts/get_scope_tests/lambda_letin.mligo
Normal 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
10
src/test/contracts/get_scope_tests/letin.mligo
Normal 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
20
src/test/contracts/get_scope_tests/match.mligo
Normal 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
9
src/test/contracts/get_scope_tests/rec.mligo
Normal 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
16
src/test/contracts/get_scope_tests/records.mligo
Normal 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
10
src/test/contracts/get_scope_tests/shadowing.mligo
Normal 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
2
vendors/ligo-utils/simple-utils/display.ml
vendored
@ -1,4 +1,4 @@
|
|||||||
type json = Yojson.Basic.t
|
type json = Yojson.t
|
||||||
|
|
||||||
type 'a display_format =
|
type 'a display_format =
|
||||||
| Human_readable : string display_format
|
| Human_readable : string display_format
|
||||||
|
|||||||
2
vendors/ligo-utils/simple-utils/display.mli
vendored
2
vendors/ligo-utils/simple-utils/display.mli
vendored
@ -1,4 +1,4 @@
|
|||||||
type json = Yojson.Basic.t
|
type json = Yojson.t
|
||||||
|
|
||||||
type 'a display_format =
|
type 'a display_format =
|
||||||
| Human_readable : string display_format
|
| Human_readable : string display_format
|
||||||
|
|||||||
12
vendors/ligo-utils/simple-utils/location.ml
vendored
12
vendors/ligo-utils/simple-utils/location.ml
vendored
@ -17,6 +17,18 @@ let pp = fun ppf t ->
|
|||||||
| Virtual _s -> Format.fprintf ppf ""
|
| Virtual _s -> Format.fprintf ppf ""
|
||||||
| File f -> Format.fprintf ppf "%s" (f#to_string `Point)
|
| 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
|
let compare a b = match a,b with
|
||||||
| (File a, File b) -> Region.compare a b
|
| (File a, File b) -> Region.compare a b
|
||||||
| (File _, Virtual _) -> -1
|
| (File _, Virtual _) -> -1
|
||||||
|
|||||||
16
vendors/ligo-utils/simple-utils/trace.ml
vendored
16
vendors/ligo-utils/simple-utils/trace.ml
vendored
@ -212,15 +212,12 @@ module Trace_tutorial = struct
|
|||||||
|
|
||||||
end (* end Trace_tutorial. *)
|
end (* end Trace_tutorial. *)
|
||||||
|
|
||||||
module J = Yojson.Basic
|
|
||||||
|
|
||||||
|
|
||||||
(* Annotations should be used in debug mode to aggregate information
|
(* Annotations should be used in debug mode to aggregate information
|
||||||
about some value history. Where it was produced, when it was
|
about some value history. Where it was produced, when it was
|
||||||
modified, etc. It is currently not being used. *)
|
modified, etc. It is currently not being used. *)
|
||||||
|
|
||||||
type 'a thunk = unit -> 'a
|
type 'a thunk = unit -> 'a
|
||||||
type annotation = J.t
|
type annotation = Yojson.t
|
||||||
|
|
||||||
(* Even in debug mode, building annotations can be quite
|
(* Even in debug mode, building annotations can be quite
|
||||||
resource-intensive. Instead, a thunk is passed, that is computed
|
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
|
| Ok (o, annotations) -> ignore annotations; Some o
|
||||||
| Error _ -> None
|
| 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.
|
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 ()
|
None -> ok ()
|
||||||
| Some _s -> fail error
|
| Some _s -> fail error
|
||||||
|
|
||||||
|
|
||||||
(** Utilities to interact with other data-structure. [bind_t] takes
|
(** 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
|
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
|
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)
|
assert_true err List.(length lsta = length lstb)
|
||||||
|
|
||||||
end
|
end
|
||||||
|
|
||||||
let json_of_error = J.to_string
|
|
||||||
|
|||||||
5
vendors/ligo-utils/simple-utils/var.ml
vendored
5
vendors/ligo-utils/simple-utils/var.ml
vendored
@ -49,3 +49,8 @@ let fresh_like v =
|
|||||||
fresh ~name:v.name ()
|
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 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
2
vendors/ligo-utils/simple-utils/var.mli
vendored
@ -45,3 +45,5 @@ val fresh_like : 'a t -> 'b t
|
|||||||
val reset_counter : unit -> unit
|
val reset_counter : unit -> unit
|
||||||
|
|
||||||
val debug : 'a t -> string
|
val debug : 'a t -> string
|
||||||
|
|
||||||
|
val is_generated : 'a t -> bool
|
||||||
Loading…
Reference in New Issue
Block a user