From cb1aa44ff4558a9b2af006fd41a091dcf8aa1d42 Mon Sep 17 00:00:00 2001 From: galfour Date: Sun, 8 Sep 2019 12:17:24 +0200 Subject: [PATCH 01/18] moving stuff around --- src/{ => passes}/operators/dune | 0 src/{ => passes}/operators/helpers.ml | 0 src/{ => passes}/operators/operators.ml | 0 src/{ => passes}/parser/camligo/.gitignore | 0 src/{ => passes}/parser/camligo/ast.ml | 0 src/{ => passes}/parser/camligo/dune | 0 src/{ => passes}/parser/camligo/generator.ml | 0 src/{ => passes}/parser/camligo/lex/dune | 0 .../parser/camligo/lex/generator.ml | 0 src/{ => passes}/parser/camligo/location.ml | 0 .../parser/camligo/parser_camligo.ml | 0 .../parser/camligo/pre_parser.mly | 0 src/{ => passes}/parser/camligo/user.ml | 0 src/{ => passes}/parser/dune | 0 .../parser/generator/doc/essai.ml | 0 .../parser/generator/doc/mini_ml.bnf | 0 .../parser/generator/doc/mini_ml2.bnf | 0 .../parser/generator/doc/mini_ml3.bnf | 0 .../parser/generator/doc/mini_ml4.bnf | 0 src/{ => passes}/parser/ligodity.ml | 0 src/{ => passes}/parser/ligodity/.AST.ml.tag | 0 src/{ => passes}/parser/ligodity/.Eval.ml.tag | 0 .../parser/ligodity/.EvalMain.ml.tag | 0 .../parser/ligodity/.Lexer.ml.tag | 0 .../parser/ligodity/.LexerMain.tag | 0 .../parser/ligodity/.Parser.ml.tag | 0 .../parser/ligodity/.Parser.mly.tag | 0 .../parser/ligodity/.ParserMain.tag | 0 src/{ => passes}/parser/ligodity/.links | 0 src/{ => passes}/parser/ligodity/AST.ml | 0 src/{ => passes}/parser/ligodity/AST.mli | 0 src/{ => passes}/parser/ligodity/EvalOpt.ml | 0 src/{ => passes}/parser/ligodity/EvalOpt.mli | 0 src/{ => passes}/parser/ligodity/Lexer.mli | 0 src/{ => passes}/parser/ligodity/Lexer.mll | 0 src/{ => passes}/parser/ligodity/LexerMain.ml | 0 src/{ => passes}/parser/ligodity/ParToken.mly | 0 src/{ => passes}/parser/ligodity/Parser.mly | 0 .../parser/ligodity/ParserMain.ml | 0 .../parser/ligodity/Stubs/Simple_utils.ml | 0 .../parser/ligodity/Tests/match.mml | 0 src/{ => passes}/parser/ligodity/Token.ml | 0 src/{ => passes}/parser/ligodity/Token.mli | 0 src/{ => passes}/parser/ligodity/Utils.ml | 0 src/{ => passes}/parser/ligodity/Utils.mli | 0 .../parser/ligodity/check_dot_git_is_dir.sh | 0 src/{ => passes}/parser/ligodity/dune | 0 src/{ => passes}/parser/ligodity/ligodity.ml | 0 src/{ => passes}/parser/parser.ml | 0 src/{ => passes}/parser/pascaligo.ml | 0 .../parser/pascaligo/.Lexer.ml.tag | 0 .../parser/pascaligo/.LexerMain.tag | 0 .../parser/pascaligo/.Parser.mly.tag | 0 .../parser/pascaligo/.ParserMain.tag | 0 src/{ => passes}/parser/pascaligo/.gitignore | 0 src/{ => passes}/parser/pascaligo/.links | 0 src/{ => passes}/parser/pascaligo/AST.ml | 0 src/{ => passes}/parser/pascaligo/AST.mli | 0 .../parser/pascaligo/Doc/pascaligo.txt | 0 .../parser/pascaligo/Doc/pascaligo_01.bnf | 0 .../parser/pascaligo/Doc/pascaligo_02.bnf | 0 .../parser/pascaligo/Doc/pascaligo_03.bnf | 0 .../parser/pascaligo/Doc/pascaligo_04.bnf | 0 .../parser/pascaligo/Doc/pascaligo_05.bnf | 0 .../parser/pascaligo/Doc/pascaligo_06.bnf | 0 .../parser/pascaligo/Doc/pascaligo_07.bnf | 0 .../parser/pascaligo/Doc/pascaligo_08.bnf | 0 .../parser/pascaligo/Doc/pascaligo_09.bnf | 0 .../parser/pascaligo/Doc/pascaligo_10.bnf | 0 .../parser/pascaligo/Doc/pascaligo_11.bnf | 0 .../parser/pascaligo/Doc/pascaligo_12.bnf | 0 .../parser/pascaligo/LexToken.mli | 0 .../parser/pascaligo/LexToken.mll | 0 .../parser/pascaligo/LexerMain.ml | 0 .../parser/pascaligo/ParToken.mly | 0 src/{ => passes}/parser/pascaligo/Parser.mly | 0 .../parser/pascaligo/ParserLog.ml | 0 .../parser/pascaligo/ParserLog.mli | 0 .../parser/pascaligo/ParserMain.ml | 0 .../parser/pascaligo/Stubs/Simple_utils.ml | 0 .../parser/pascaligo/Tests/a.ligo | 0 .../parser/pascaligo/Tests/crowdfunding.ligo | 0 .../parser/pascaligo/check_dot_git_is_dir.sh | 0 src/{ => passes}/parser/pascaligo/dune | 0 .../parser/pascaligo/pascaligo.ml | 0 src/{ => passes}/parser/shared/.links | 0 src/{ => passes}/parser/shared/Doc/shared.txt | 0 src/{ => passes}/parser/shared/Error.mli | 0 src/{ => passes}/parser/shared/EvalOpt.ml | 0 src/{ => passes}/parser/shared/EvalOpt.mli | 0 src/{ => passes}/parser/shared/FQueue.ml | 0 src/{ => passes}/parser/shared/FQueue.mli | 0 src/{ => passes}/parser/shared/Lexer.mli | 0 src/{ => passes}/parser/shared/Lexer.mll | 0 src/{ => passes}/parser/shared/LexerLog.ml | 0 src/{ => passes}/parser/shared/LexerLog.mli | 0 src/{ => passes}/parser/shared/Markup.ml | 0 src/{ => passes}/parser/shared/Markup.mli | 0 src/{ => passes}/parser/shared/Utils.ml | 0 src/{ => passes}/parser/shared/Utils.mli | 0 src/{ => passes}/parser/shared/dune | 0 src/{ => passes}/simplify/camligo.ml.old | 0 src/{ => passes}/simplify/dune | 0 src/{ => passes}/simplify/ligodity.ml | 0 src/{ => passes}/simplify/pascaligo.ml | 0 src/{ => passes}/simplify/simplify.ml | 0 src/{ => passes}/typer/dune | 0 src/{ => passes}/typer/typer.ml | 0 src/{ => run}/main/display.ml | 0 src/{ => run}/main/dune | 0 src/{ => run}/main/main.ml | 0 src/{ => run}/main/run_mini_c.ml | 0 src/{ => run}/main/run_simplified.ml | 0 src/{ => run}/main/run_source.ml | 0 src/{ => run}/main/run_typed.ml | 0 src/{ => stages}/ast_simplified/PP.ml | 0 .../ast_simplified/ast_simplified.ml | 0 .../ast_simplified/combinators.ml | 0 src/{ => stages}/ast_simplified/dune | 0 src/{ => stages}/ast_simplified/misc.ml | 0 src/{ => stages}/ast_simplified/types.ml | 0 src/{ => stages}/ast_typed/PP.ml | 0 src/{ => stages}/ast_typed/ast_typed.ml | 0 src/{ => stages}/ast_typed/combinators.ml | 0 .../ast_typed/combinators_environment.ml | 0 src/{ => stages}/ast_typed/dune | 0 src/{ => stages}/ast_typed/environment.ml | 0 src/{ => stages}/ast_typed/misc.ml | 0 src/{ => stages}/ast_typed/misc_smart.ml | 0 src/{ => stages}/ast_typed/types.ml | 0 src/{ => stages}/compiler/compiler.ml | 0 .../compiler/compiler_environment.ml | 0 src/{ => stages}/compiler/compiler_program.ml | 0 src/{ => stages}/compiler/compiler_type.ml | 0 src/{ => stages}/compiler/dune | 0 src/{ => stages}/compiler/uncompiler.ml | 0 src/{ => stages}/mini_c/PP.ml | 0 src/{ => stages}/mini_c/combinators.ml | 0 src/{ => stages}/mini_c/combinators_smart.ml | 0 src/{ => stages}/mini_c/dune | 0 src/{ => stages}/mini_c/environment.ml | 0 src/{ => stages}/mini_c/mini_c.ml | 0 src/{ => stages}/mini_c/types.ml | 0 src/{ => stages}/transpiler/dune | 0 src/{ => stages}/transpiler/transpiler.ml | 0 {src/test => test}/.gitignore | 0 test/.merlin | 187 ++++++++++++++++++ {src/test => test}/bin_tests.ml | 0 {src/test => test}/coase_tests.ml | 0 {src/test => test}/compiler_tests.ml | 0 {src/test => test}/dune | 0 {src/test => test}/heap_tests.ml | 0 {src/test => test}/integration_tests.ml | 0 {src/test => test}/manual_test.ml | 0 {src/test => test}/multifix_tests.ml | 0 {src/test => test}/test.ml | 0 {src/test => test}/test_helpers.ml | 0 {src/test => test}/transpiler_tests.ml | 0 {src/test => test}/typer_tests.ml | 0 {src/test => test}/vote_tests.ml | 0 {src => vendors}/rope/rope.ml | 0 {src => vendors}/rope/rope.mli | 0 {src => vendors}/rope/rope_implementation.ml | 0 {src => vendors}/rope/rope_implementation.mli | 0 {src => vendors}/rope/rope_test.ml | 0 {src => vendors}/rope/rope_top_level_open.ml | 0 {src => vendors}/rope/rope_top_level_open.mli | 0 167 files changed, 187 insertions(+) rename src/{ => passes}/operators/dune (100%) rename src/{ => passes}/operators/helpers.ml (100%) rename src/{ => passes}/operators/operators.ml (100%) rename src/{ => passes}/parser/camligo/.gitignore (100%) rename src/{ => passes}/parser/camligo/ast.ml (100%) rename src/{ => passes}/parser/camligo/dune (100%) rename src/{ => passes}/parser/camligo/generator.ml (100%) rename src/{ => passes}/parser/camligo/lex/dune (100%) rename src/{ => passes}/parser/camligo/lex/generator.ml (100%) rename src/{ => passes}/parser/camligo/location.ml (100%) rename src/{ => passes}/parser/camligo/parser_camligo.ml (100%) rename src/{ => passes}/parser/camligo/pre_parser.mly (100%) rename src/{ => passes}/parser/camligo/user.ml (100%) rename src/{ => passes}/parser/dune (100%) rename src/{ => passes}/parser/generator/doc/essai.ml (100%) rename src/{ => passes}/parser/generator/doc/mini_ml.bnf (100%) rename src/{ => passes}/parser/generator/doc/mini_ml2.bnf (100%) rename src/{ => passes}/parser/generator/doc/mini_ml3.bnf (100%) rename src/{ => passes}/parser/generator/doc/mini_ml4.bnf (100%) rename src/{ => passes}/parser/ligodity.ml (100%) rename src/{ => passes}/parser/ligodity/.AST.ml.tag (100%) rename src/{ => passes}/parser/ligodity/.Eval.ml.tag (100%) rename src/{ => passes}/parser/ligodity/.EvalMain.ml.tag (100%) rename src/{ => passes}/parser/ligodity/.Lexer.ml.tag (100%) rename src/{ => passes}/parser/ligodity/.LexerMain.tag (100%) rename src/{ => passes}/parser/ligodity/.Parser.ml.tag (100%) rename src/{ => passes}/parser/ligodity/.Parser.mly.tag (100%) rename src/{ => passes}/parser/ligodity/.ParserMain.tag (100%) rename src/{ => passes}/parser/ligodity/.links (100%) rename src/{ => passes}/parser/ligodity/AST.ml (100%) rename src/{ => passes}/parser/ligodity/AST.mli (100%) rename src/{ => passes}/parser/ligodity/EvalOpt.ml (100%) rename src/{ => passes}/parser/ligodity/EvalOpt.mli (100%) rename src/{ => passes}/parser/ligodity/Lexer.mli (100%) rename src/{ => passes}/parser/ligodity/Lexer.mll (100%) rename src/{ => passes}/parser/ligodity/LexerMain.ml (100%) rename src/{ => passes}/parser/ligodity/ParToken.mly (100%) rename src/{ => passes}/parser/ligodity/Parser.mly (100%) rename src/{ => passes}/parser/ligodity/ParserMain.ml (100%) rename src/{ => passes}/parser/ligodity/Stubs/Simple_utils.ml (100%) rename src/{ => passes}/parser/ligodity/Tests/match.mml (100%) rename src/{ => passes}/parser/ligodity/Token.ml (100%) rename src/{ => passes}/parser/ligodity/Token.mli (100%) rename src/{ => passes}/parser/ligodity/Utils.ml (100%) rename src/{ => passes}/parser/ligodity/Utils.mli (100%) rename src/{ => passes}/parser/ligodity/check_dot_git_is_dir.sh (100%) rename src/{ => passes}/parser/ligodity/dune (100%) rename src/{ => passes}/parser/ligodity/ligodity.ml (100%) rename src/{ => passes}/parser/parser.ml (100%) rename src/{ => passes}/parser/pascaligo.ml (100%) rename src/{ => passes}/parser/pascaligo/.Lexer.ml.tag (100%) rename src/{ => passes}/parser/pascaligo/.LexerMain.tag (100%) rename src/{ => passes}/parser/pascaligo/.Parser.mly.tag (100%) rename src/{ => passes}/parser/pascaligo/.ParserMain.tag (100%) rename src/{ => passes}/parser/pascaligo/.gitignore (100%) rename src/{ => passes}/parser/pascaligo/.links (100%) rename src/{ => passes}/parser/pascaligo/AST.ml (100%) rename src/{ => passes}/parser/pascaligo/AST.mli (100%) rename src/{ => passes}/parser/pascaligo/Doc/pascaligo.txt (100%) rename src/{ => passes}/parser/pascaligo/Doc/pascaligo_01.bnf (100%) rename src/{ => passes}/parser/pascaligo/Doc/pascaligo_02.bnf (100%) rename src/{ => passes}/parser/pascaligo/Doc/pascaligo_03.bnf (100%) rename src/{ => passes}/parser/pascaligo/Doc/pascaligo_04.bnf (100%) rename src/{ => passes}/parser/pascaligo/Doc/pascaligo_05.bnf (100%) rename src/{ => passes}/parser/pascaligo/Doc/pascaligo_06.bnf (100%) rename src/{ => passes}/parser/pascaligo/Doc/pascaligo_07.bnf (100%) rename src/{ => passes}/parser/pascaligo/Doc/pascaligo_08.bnf (100%) rename src/{ => passes}/parser/pascaligo/Doc/pascaligo_09.bnf (100%) rename src/{ => passes}/parser/pascaligo/Doc/pascaligo_10.bnf (100%) rename src/{ => passes}/parser/pascaligo/Doc/pascaligo_11.bnf (100%) rename src/{ => passes}/parser/pascaligo/Doc/pascaligo_12.bnf (100%) rename src/{ => passes}/parser/pascaligo/LexToken.mli (100%) rename src/{ => passes}/parser/pascaligo/LexToken.mll (100%) rename src/{ => passes}/parser/pascaligo/LexerMain.ml (100%) rename src/{ => passes}/parser/pascaligo/ParToken.mly (100%) rename src/{ => passes}/parser/pascaligo/Parser.mly (100%) rename src/{ => passes}/parser/pascaligo/ParserLog.ml (100%) rename src/{ => passes}/parser/pascaligo/ParserLog.mli (100%) rename src/{ => passes}/parser/pascaligo/ParserMain.ml (100%) rename src/{ => passes}/parser/pascaligo/Stubs/Simple_utils.ml (100%) rename src/{ => passes}/parser/pascaligo/Tests/a.ligo (100%) rename src/{ => passes}/parser/pascaligo/Tests/crowdfunding.ligo (100%) rename src/{ => passes}/parser/pascaligo/check_dot_git_is_dir.sh (100%) rename src/{ => passes}/parser/pascaligo/dune (100%) rename src/{ => passes}/parser/pascaligo/pascaligo.ml (100%) rename src/{ => passes}/parser/shared/.links (100%) rename src/{ => passes}/parser/shared/Doc/shared.txt (100%) rename src/{ => passes}/parser/shared/Error.mli (100%) rename src/{ => passes}/parser/shared/EvalOpt.ml (100%) rename src/{ => passes}/parser/shared/EvalOpt.mli (100%) rename src/{ => passes}/parser/shared/FQueue.ml (100%) rename src/{ => passes}/parser/shared/FQueue.mli (100%) rename src/{ => passes}/parser/shared/Lexer.mli (100%) rename src/{ => passes}/parser/shared/Lexer.mll (100%) rename src/{ => passes}/parser/shared/LexerLog.ml (100%) rename src/{ => passes}/parser/shared/LexerLog.mli (100%) rename src/{ => passes}/parser/shared/Markup.ml (100%) rename src/{ => passes}/parser/shared/Markup.mli (100%) rename src/{ => passes}/parser/shared/Utils.ml (100%) rename src/{ => passes}/parser/shared/Utils.mli (100%) rename src/{ => passes}/parser/shared/dune (100%) rename src/{ => passes}/simplify/camligo.ml.old (100%) rename src/{ => passes}/simplify/dune (100%) rename src/{ => passes}/simplify/ligodity.ml (100%) rename src/{ => passes}/simplify/pascaligo.ml (100%) rename src/{ => passes}/simplify/simplify.ml (100%) rename src/{ => passes}/typer/dune (100%) rename src/{ => passes}/typer/typer.ml (100%) rename src/{ => run}/main/display.ml (100%) rename src/{ => run}/main/dune (100%) rename src/{ => run}/main/main.ml (100%) rename src/{ => run}/main/run_mini_c.ml (100%) rename src/{ => run}/main/run_simplified.ml (100%) rename src/{ => run}/main/run_source.ml (100%) rename src/{ => run}/main/run_typed.ml (100%) rename src/{ => stages}/ast_simplified/PP.ml (100%) rename src/{ => stages}/ast_simplified/ast_simplified.ml (100%) rename src/{ => stages}/ast_simplified/combinators.ml (100%) rename src/{ => stages}/ast_simplified/dune (100%) rename src/{ => stages}/ast_simplified/misc.ml (100%) rename src/{ => stages}/ast_simplified/types.ml (100%) rename src/{ => stages}/ast_typed/PP.ml (100%) rename src/{ => stages}/ast_typed/ast_typed.ml (100%) rename src/{ => stages}/ast_typed/combinators.ml (100%) rename src/{ => stages}/ast_typed/combinators_environment.ml (100%) rename src/{ => stages}/ast_typed/dune (100%) rename src/{ => stages}/ast_typed/environment.ml (100%) rename src/{ => stages}/ast_typed/misc.ml (100%) rename src/{ => stages}/ast_typed/misc_smart.ml (100%) rename src/{ => stages}/ast_typed/types.ml (100%) rename src/{ => stages}/compiler/compiler.ml (100%) rename src/{ => stages}/compiler/compiler_environment.ml (100%) rename src/{ => stages}/compiler/compiler_program.ml (100%) rename src/{ => stages}/compiler/compiler_type.ml (100%) rename src/{ => stages}/compiler/dune (100%) rename src/{ => stages}/compiler/uncompiler.ml (100%) rename src/{ => stages}/mini_c/PP.ml (100%) rename src/{ => stages}/mini_c/combinators.ml (100%) rename src/{ => stages}/mini_c/combinators_smart.ml (100%) rename src/{ => stages}/mini_c/dune (100%) rename src/{ => stages}/mini_c/environment.ml (100%) rename src/{ => stages}/mini_c/mini_c.ml (100%) rename src/{ => stages}/mini_c/types.ml (100%) rename src/{ => stages}/transpiler/dune (100%) rename src/{ => stages}/transpiler/transpiler.ml (100%) rename {src/test => test}/.gitignore (100%) create mode 100644 test/.merlin rename {src/test => test}/bin_tests.ml (100%) rename {src/test => test}/coase_tests.ml (100%) rename {src/test => test}/compiler_tests.ml (100%) rename {src/test => test}/dune (100%) rename {src/test => test}/heap_tests.ml (100%) rename {src/test => test}/integration_tests.ml (100%) rename {src/test => test}/manual_test.ml (100%) rename {src/test => test}/multifix_tests.ml (100%) rename {src/test => test}/test.ml (100%) rename {src/test => test}/test_helpers.ml (100%) rename {src/test => test}/transpiler_tests.ml (100%) rename {src/test => test}/typer_tests.ml (100%) rename {src/test => test}/vote_tests.ml (100%) rename {src => vendors}/rope/rope.ml (100%) rename {src => vendors}/rope/rope.mli (100%) rename {src => vendors}/rope/rope_implementation.ml (100%) rename {src => vendors}/rope/rope_implementation.mli (100%) rename {src => vendors}/rope/rope_test.ml (100%) rename {src => vendors}/rope/rope_top_level_open.ml (100%) rename {src => vendors}/rope/rope_top_level_open.mli (100%) diff --git a/src/operators/dune b/src/passes/operators/dune similarity index 100% rename from src/operators/dune rename to src/passes/operators/dune diff --git a/src/operators/helpers.ml b/src/passes/operators/helpers.ml similarity index 100% rename from src/operators/helpers.ml rename to src/passes/operators/helpers.ml diff --git a/src/operators/operators.ml b/src/passes/operators/operators.ml similarity index 100% rename from src/operators/operators.ml rename to src/passes/operators/operators.ml diff --git a/src/parser/camligo/.gitignore b/src/passes/parser/camligo/.gitignore similarity index 100% rename from src/parser/camligo/.gitignore rename to src/passes/parser/camligo/.gitignore diff --git a/src/parser/camligo/ast.ml b/src/passes/parser/camligo/ast.ml similarity index 100% rename from src/parser/camligo/ast.ml rename to src/passes/parser/camligo/ast.ml diff --git a/src/parser/camligo/dune b/src/passes/parser/camligo/dune similarity index 100% rename from src/parser/camligo/dune rename to src/passes/parser/camligo/dune diff --git a/src/parser/camligo/generator.ml b/src/passes/parser/camligo/generator.ml similarity index 100% rename from src/parser/camligo/generator.ml rename to src/passes/parser/camligo/generator.ml diff --git a/src/parser/camligo/lex/dune b/src/passes/parser/camligo/lex/dune similarity index 100% rename from src/parser/camligo/lex/dune rename to src/passes/parser/camligo/lex/dune diff --git a/src/parser/camligo/lex/generator.ml b/src/passes/parser/camligo/lex/generator.ml similarity index 100% rename from src/parser/camligo/lex/generator.ml rename to src/passes/parser/camligo/lex/generator.ml diff --git a/src/parser/camligo/location.ml b/src/passes/parser/camligo/location.ml similarity index 100% rename from src/parser/camligo/location.ml rename to src/passes/parser/camligo/location.ml diff --git a/src/parser/camligo/parser_camligo.ml b/src/passes/parser/camligo/parser_camligo.ml similarity index 100% rename from src/parser/camligo/parser_camligo.ml rename to src/passes/parser/camligo/parser_camligo.ml diff --git a/src/parser/camligo/pre_parser.mly b/src/passes/parser/camligo/pre_parser.mly similarity index 100% rename from src/parser/camligo/pre_parser.mly rename to src/passes/parser/camligo/pre_parser.mly diff --git a/src/parser/camligo/user.ml b/src/passes/parser/camligo/user.ml similarity index 100% rename from src/parser/camligo/user.ml rename to src/passes/parser/camligo/user.ml diff --git a/src/parser/dune b/src/passes/parser/dune similarity index 100% rename from src/parser/dune rename to src/passes/parser/dune diff --git a/src/parser/generator/doc/essai.ml b/src/passes/parser/generator/doc/essai.ml similarity index 100% rename from src/parser/generator/doc/essai.ml rename to src/passes/parser/generator/doc/essai.ml diff --git a/src/parser/generator/doc/mini_ml.bnf b/src/passes/parser/generator/doc/mini_ml.bnf similarity index 100% rename from src/parser/generator/doc/mini_ml.bnf rename to src/passes/parser/generator/doc/mini_ml.bnf diff --git a/src/parser/generator/doc/mini_ml2.bnf b/src/passes/parser/generator/doc/mini_ml2.bnf similarity index 100% rename from src/parser/generator/doc/mini_ml2.bnf rename to src/passes/parser/generator/doc/mini_ml2.bnf diff --git a/src/parser/generator/doc/mini_ml3.bnf b/src/passes/parser/generator/doc/mini_ml3.bnf similarity index 100% rename from src/parser/generator/doc/mini_ml3.bnf rename to src/passes/parser/generator/doc/mini_ml3.bnf diff --git a/src/parser/generator/doc/mini_ml4.bnf b/src/passes/parser/generator/doc/mini_ml4.bnf similarity index 100% rename from src/parser/generator/doc/mini_ml4.bnf rename to src/passes/parser/generator/doc/mini_ml4.bnf diff --git a/src/parser/ligodity.ml b/src/passes/parser/ligodity.ml similarity index 100% rename from src/parser/ligodity.ml rename to src/passes/parser/ligodity.ml diff --git a/src/parser/ligodity/.AST.ml.tag b/src/passes/parser/ligodity/.AST.ml.tag similarity index 100% rename from src/parser/ligodity/.AST.ml.tag rename to src/passes/parser/ligodity/.AST.ml.tag diff --git a/src/parser/ligodity/.Eval.ml.tag b/src/passes/parser/ligodity/.Eval.ml.tag similarity index 100% rename from src/parser/ligodity/.Eval.ml.tag rename to src/passes/parser/ligodity/.Eval.ml.tag diff --git a/src/parser/ligodity/.EvalMain.ml.tag b/src/passes/parser/ligodity/.EvalMain.ml.tag similarity index 100% rename from src/parser/ligodity/.EvalMain.ml.tag rename to src/passes/parser/ligodity/.EvalMain.ml.tag diff --git a/src/parser/ligodity/.Lexer.ml.tag b/src/passes/parser/ligodity/.Lexer.ml.tag similarity index 100% rename from src/parser/ligodity/.Lexer.ml.tag rename to src/passes/parser/ligodity/.Lexer.ml.tag diff --git a/src/parser/ligodity/.LexerMain.tag b/src/passes/parser/ligodity/.LexerMain.tag similarity index 100% rename from src/parser/ligodity/.LexerMain.tag rename to src/passes/parser/ligodity/.LexerMain.tag diff --git a/src/parser/ligodity/.Parser.ml.tag b/src/passes/parser/ligodity/.Parser.ml.tag similarity index 100% rename from src/parser/ligodity/.Parser.ml.tag rename to src/passes/parser/ligodity/.Parser.ml.tag diff --git a/src/parser/ligodity/.Parser.mly.tag b/src/passes/parser/ligodity/.Parser.mly.tag similarity index 100% rename from src/parser/ligodity/.Parser.mly.tag rename to src/passes/parser/ligodity/.Parser.mly.tag diff --git a/src/parser/ligodity/.ParserMain.tag b/src/passes/parser/ligodity/.ParserMain.tag similarity index 100% rename from src/parser/ligodity/.ParserMain.tag rename to src/passes/parser/ligodity/.ParserMain.tag diff --git a/src/parser/ligodity/.links b/src/passes/parser/ligodity/.links similarity index 100% rename from src/parser/ligodity/.links rename to src/passes/parser/ligodity/.links diff --git a/src/parser/ligodity/AST.ml b/src/passes/parser/ligodity/AST.ml similarity index 100% rename from src/parser/ligodity/AST.ml rename to src/passes/parser/ligodity/AST.ml diff --git a/src/parser/ligodity/AST.mli b/src/passes/parser/ligodity/AST.mli similarity index 100% rename from src/parser/ligodity/AST.mli rename to src/passes/parser/ligodity/AST.mli diff --git a/src/parser/ligodity/EvalOpt.ml b/src/passes/parser/ligodity/EvalOpt.ml similarity index 100% rename from src/parser/ligodity/EvalOpt.ml rename to src/passes/parser/ligodity/EvalOpt.ml diff --git a/src/parser/ligodity/EvalOpt.mli b/src/passes/parser/ligodity/EvalOpt.mli similarity index 100% rename from src/parser/ligodity/EvalOpt.mli rename to src/passes/parser/ligodity/EvalOpt.mli diff --git a/src/parser/ligodity/Lexer.mli b/src/passes/parser/ligodity/Lexer.mli similarity index 100% rename from src/parser/ligodity/Lexer.mli rename to src/passes/parser/ligodity/Lexer.mli diff --git a/src/parser/ligodity/Lexer.mll b/src/passes/parser/ligodity/Lexer.mll similarity index 100% rename from src/parser/ligodity/Lexer.mll rename to src/passes/parser/ligodity/Lexer.mll diff --git a/src/parser/ligodity/LexerMain.ml b/src/passes/parser/ligodity/LexerMain.ml similarity index 100% rename from src/parser/ligodity/LexerMain.ml rename to src/passes/parser/ligodity/LexerMain.ml diff --git a/src/parser/ligodity/ParToken.mly b/src/passes/parser/ligodity/ParToken.mly similarity index 100% rename from src/parser/ligodity/ParToken.mly rename to src/passes/parser/ligodity/ParToken.mly diff --git a/src/parser/ligodity/Parser.mly b/src/passes/parser/ligodity/Parser.mly similarity index 100% rename from src/parser/ligodity/Parser.mly rename to src/passes/parser/ligodity/Parser.mly diff --git a/src/parser/ligodity/ParserMain.ml b/src/passes/parser/ligodity/ParserMain.ml similarity index 100% rename from src/parser/ligodity/ParserMain.ml rename to src/passes/parser/ligodity/ParserMain.ml diff --git a/src/parser/ligodity/Stubs/Simple_utils.ml b/src/passes/parser/ligodity/Stubs/Simple_utils.ml similarity index 100% rename from src/parser/ligodity/Stubs/Simple_utils.ml rename to src/passes/parser/ligodity/Stubs/Simple_utils.ml diff --git a/src/parser/ligodity/Tests/match.mml b/src/passes/parser/ligodity/Tests/match.mml similarity index 100% rename from src/parser/ligodity/Tests/match.mml rename to src/passes/parser/ligodity/Tests/match.mml diff --git a/src/parser/ligodity/Token.ml b/src/passes/parser/ligodity/Token.ml similarity index 100% rename from src/parser/ligodity/Token.ml rename to src/passes/parser/ligodity/Token.ml diff --git a/src/parser/ligodity/Token.mli b/src/passes/parser/ligodity/Token.mli similarity index 100% rename from src/parser/ligodity/Token.mli rename to src/passes/parser/ligodity/Token.mli diff --git a/src/parser/ligodity/Utils.ml b/src/passes/parser/ligodity/Utils.ml similarity index 100% rename from src/parser/ligodity/Utils.ml rename to src/passes/parser/ligodity/Utils.ml diff --git a/src/parser/ligodity/Utils.mli b/src/passes/parser/ligodity/Utils.mli similarity index 100% rename from src/parser/ligodity/Utils.mli rename to src/passes/parser/ligodity/Utils.mli diff --git a/src/parser/ligodity/check_dot_git_is_dir.sh b/src/passes/parser/ligodity/check_dot_git_is_dir.sh similarity index 100% rename from src/parser/ligodity/check_dot_git_is_dir.sh rename to src/passes/parser/ligodity/check_dot_git_is_dir.sh diff --git a/src/parser/ligodity/dune b/src/passes/parser/ligodity/dune similarity index 100% rename from src/parser/ligodity/dune rename to src/passes/parser/ligodity/dune diff --git a/src/parser/ligodity/ligodity.ml b/src/passes/parser/ligodity/ligodity.ml similarity index 100% rename from src/parser/ligodity/ligodity.ml rename to src/passes/parser/ligodity/ligodity.ml diff --git a/src/parser/parser.ml b/src/passes/parser/parser.ml similarity index 100% rename from src/parser/parser.ml rename to src/passes/parser/parser.ml diff --git a/src/parser/pascaligo.ml b/src/passes/parser/pascaligo.ml similarity index 100% rename from src/parser/pascaligo.ml rename to src/passes/parser/pascaligo.ml diff --git a/src/parser/pascaligo/.Lexer.ml.tag b/src/passes/parser/pascaligo/.Lexer.ml.tag similarity index 100% rename from src/parser/pascaligo/.Lexer.ml.tag rename to src/passes/parser/pascaligo/.Lexer.ml.tag diff --git a/src/parser/pascaligo/.LexerMain.tag b/src/passes/parser/pascaligo/.LexerMain.tag similarity index 100% rename from src/parser/pascaligo/.LexerMain.tag rename to src/passes/parser/pascaligo/.LexerMain.tag diff --git a/src/parser/pascaligo/.Parser.mly.tag b/src/passes/parser/pascaligo/.Parser.mly.tag similarity index 100% rename from src/parser/pascaligo/.Parser.mly.tag rename to src/passes/parser/pascaligo/.Parser.mly.tag diff --git a/src/parser/pascaligo/.ParserMain.tag b/src/passes/parser/pascaligo/.ParserMain.tag similarity index 100% rename from src/parser/pascaligo/.ParserMain.tag rename to src/passes/parser/pascaligo/.ParserMain.tag diff --git a/src/parser/pascaligo/.gitignore b/src/passes/parser/pascaligo/.gitignore similarity index 100% rename from src/parser/pascaligo/.gitignore rename to src/passes/parser/pascaligo/.gitignore diff --git a/src/parser/pascaligo/.links b/src/passes/parser/pascaligo/.links similarity index 100% rename from src/parser/pascaligo/.links rename to src/passes/parser/pascaligo/.links diff --git a/src/parser/pascaligo/AST.ml b/src/passes/parser/pascaligo/AST.ml similarity index 100% rename from src/parser/pascaligo/AST.ml rename to src/passes/parser/pascaligo/AST.ml diff --git a/src/parser/pascaligo/AST.mli b/src/passes/parser/pascaligo/AST.mli similarity index 100% rename from src/parser/pascaligo/AST.mli rename to src/passes/parser/pascaligo/AST.mli diff --git a/src/parser/pascaligo/Doc/pascaligo.txt b/src/passes/parser/pascaligo/Doc/pascaligo.txt similarity index 100% rename from src/parser/pascaligo/Doc/pascaligo.txt rename to src/passes/parser/pascaligo/Doc/pascaligo.txt diff --git a/src/parser/pascaligo/Doc/pascaligo_01.bnf b/src/passes/parser/pascaligo/Doc/pascaligo_01.bnf similarity index 100% rename from src/parser/pascaligo/Doc/pascaligo_01.bnf rename to src/passes/parser/pascaligo/Doc/pascaligo_01.bnf diff --git a/src/parser/pascaligo/Doc/pascaligo_02.bnf b/src/passes/parser/pascaligo/Doc/pascaligo_02.bnf similarity index 100% rename from src/parser/pascaligo/Doc/pascaligo_02.bnf rename to src/passes/parser/pascaligo/Doc/pascaligo_02.bnf diff --git a/src/parser/pascaligo/Doc/pascaligo_03.bnf b/src/passes/parser/pascaligo/Doc/pascaligo_03.bnf similarity index 100% rename from src/parser/pascaligo/Doc/pascaligo_03.bnf rename to src/passes/parser/pascaligo/Doc/pascaligo_03.bnf diff --git a/src/parser/pascaligo/Doc/pascaligo_04.bnf b/src/passes/parser/pascaligo/Doc/pascaligo_04.bnf similarity index 100% rename from src/parser/pascaligo/Doc/pascaligo_04.bnf rename to src/passes/parser/pascaligo/Doc/pascaligo_04.bnf diff --git a/src/parser/pascaligo/Doc/pascaligo_05.bnf b/src/passes/parser/pascaligo/Doc/pascaligo_05.bnf similarity index 100% rename from src/parser/pascaligo/Doc/pascaligo_05.bnf rename to src/passes/parser/pascaligo/Doc/pascaligo_05.bnf diff --git a/src/parser/pascaligo/Doc/pascaligo_06.bnf b/src/passes/parser/pascaligo/Doc/pascaligo_06.bnf similarity index 100% rename from src/parser/pascaligo/Doc/pascaligo_06.bnf rename to src/passes/parser/pascaligo/Doc/pascaligo_06.bnf diff --git a/src/parser/pascaligo/Doc/pascaligo_07.bnf b/src/passes/parser/pascaligo/Doc/pascaligo_07.bnf similarity index 100% rename from src/parser/pascaligo/Doc/pascaligo_07.bnf rename to src/passes/parser/pascaligo/Doc/pascaligo_07.bnf diff --git a/src/parser/pascaligo/Doc/pascaligo_08.bnf b/src/passes/parser/pascaligo/Doc/pascaligo_08.bnf similarity index 100% rename from src/parser/pascaligo/Doc/pascaligo_08.bnf rename to src/passes/parser/pascaligo/Doc/pascaligo_08.bnf diff --git a/src/parser/pascaligo/Doc/pascaligo_09.bnf b/src/passes/parser/pascaligo/Doc/pascaligo_09.bnf similarity index 100% rename from src/parser/pascaligo/Doc/pascaligo_09.bnf rename to src/passes/parser/pascaligo/Doc/pascaligo_09.bnf diff --git a/src/parser/pascaligo/Doc/pascaligo_10.bnf b/src/passes/parser/pascaligo/Doc/pascaligo_10.bnf similarity index 100% rename from src/parser/pascaligo/Doc/pascaligo_10.bnf rename to src/passes/parser/pascaligo/Doc/pascaligo_10.bnf diff --git a/src/parser/pascaligo/Doc/pascaligo_11.bnf b/src/passes/parser/pascaligo/Doc/pascaligo_11.bnf similarity index 100% rename from src/parser/pascaligo/Doc/pascaligo_11.bnf rename to src/passes/parser/pascaligo/Doc/pascaligo_11.bnf diff --git a/src/parser/pascaligo/Doc/pascaligo_12.bnf b/src/passes/parser/pascaligo/Doc/pascaligo_12.bnf similarity index 100% rename from src/parser/pascaligo/Doc/pascaligo_12.bnf rename to src/passes/parser/pascaligo/Doc/pascaligo_12.bnf diff --git a/src/parser/pascaligo/LexToken.mli b/src/passes/parser/pascaligo/LexToken.mli similarity index 100% rename from src/parser/pascaligo/LexToken.mli rename to src/passes/parser/pascaligo/LexToken.mli diff --git a/src/parser/pascaligo/LexToken.mll b/src/passes/parser/pascaligo/LexToken.mll similarity index 100% rename from src/parser/pascaligo/LexToken.mll rename to src/passes/parser/pascaligo/LexToken.mll diff --git a/src/parser/pascaligo/LexerMain.ml b/src/passes/parser/pascaligo/LexerMain.ml similarity index 100% rename from src/parser/pascaligo/LexerMain.ml rename to src/passes/parser/pascaligo/LexerMain.ml diff --git a/src/parser/pascaligo/ParToken.mly b/src/passes/parser/pascaligo/ParToken.mly similarity index 100% rename from src/parser/pascaligo/ParToken.mly rename to src/passes/parser/pascaligo/ParToken.mly diff --git a/src/parser/pascaligo/Parser.mly b/src/passes/parser/pascaligo/Parser.mly similarity index 100% rename from src/parser/pascaligo/Parser.mly rename to src/passes/parser/pascaligo/Parser.mly diff --git a/src/parser/pascaligo/ParserLog.ml b/src/passes/parser/pascaligo/ParserLog.ml similarity index 100% rename from src/parser/pascaligo/ParserLog.ml rename to src/passes/parser/pascaligo/ParserLog.ml diff --git a/src/parser/pascaligo/ParserLog.mli b/src/passes/parser/pascaligo/ParserLog.mli similarity index 100% rename from src/parser/pascaligo/ParserLog.mli rename to src/passes/parser/pascaligo/ParserLog.mli diff --git a/src/parser/pascaligo/ParserMain.ml b/src/passes/parser/pascaligo/ParserMain.ml similarity index 100% rename from src/parser/pascaligo/ParserMain.ml rename to src/passes/parser/pascaligo/ParserMain.ml diff --git a/src/parser/pascaligo/Stubs/Simple_utils.ml b/src/passes/parser/pascaligo/Stubs/Simple_utils.ml similarity index 100% rename from src/parser/pascaligo/Stubs/Simple_utils.ml rename to src/passes/parser/pascaligo/Stubs/Simple_utils.ml diff --git a/src/parser/pascaligo/Tests/a.ligo b/src/passes/parser/pascaligo/Tests/a.ligo similarity index 100% rename from src/parser/pascaligo/Tests/a.ligo rename to src/passes/parser/pascaligo/Tests/a.ligo diff --git a/src/parser/pascaligo/Tests/crowdfunding.ligo b/src/passes/parser/pascaligo/Tests/crowdfunding.ligo similarity index 100% rename from src/parser/pascaligo/Tests/crowdfunding.ligo rename to src/passes/parser/pascaligo/Tests/crowdfunding.ligo diff --git a/src/parser/pascaligo/check_dot_git_is_dir.sh b/src/passes/parser/pascaligo/check_dot_git_is_dir.sh similarity index 100% rename from src/parser/pascaligo/check_dot_git_is_dir.sh rename to src/passes/parser/pascaligo/check_dot_git_is_dir.sh diff --git a/src/parser/pascaligo/dune b/src/passes/parser/pascaligo/dune similarity index 100% rename from src/parser/pascaligo/dune rename to src/passes/parser/pascaligo/dune diff --git a/src/parser/pascaligo/pascaligo.ml b/src/passes/parser/pascaligo/pascaligo.ml similarity index 100% rename from src/parser/pascaligo/pascaligo.ml rename to src/passes/parser/pascaligo/pascaligo.ml diff --git a/src/parser/shared/.links b/src/passes/parser/shared/.links similarity index 100% rename from src/parser/shared/.links rename to src/passes/parser/shared/.links diff --git a/src/parser/shared/Doc/shared.txt b/src/passes/parser/shared/Doc/shared.txt similarity index 100% rename from src/parser/shared/Doc/shared.txt rename to src/passes/parser/shared/Doc/shared.txt diff --git a/src/parser/shared/Error.mli b/src/passes/parser/shared/Error.mli similarity index 100% rename from src/parser/shared/Error.mli rename to src/passes/parser/shared/Error.mli diff --git a/src/parser/shared/EvalOpt.ml b/src/passes/parser/shared/EvalOpt.ml similarity index 100% rename from src/parser/shared/EvalOpt.ml rename to src/passes/parser/shared/EvalOpt.ml diff --git a/src/parser/shared/EvalOpt.mli b/src/passes/parser/shared/EvalOpt.mli similarity index 100% rename from src/parser/shared/EvalOpt.mli rename to src/passes/parser/shared/EvalOpt.mli diff --git a/src/parser/shared/FQueue.ml b/src/passes/parser/shared/FQueue.ml similarity index 100% rename from src/parser/shared/FQueue.ml rename to src/passes/parser/shared/FQueue.ml diff --git a/src/parser/shared/FQueue.mli b/src/passes/parser/shared/FQueue.mli similarity index 100% rename from src/parser/shared/FQueue.mli rename to src/passes/parser/shared/FQueue.mli diff --git a/src/parser/shared/Lexer.mli b/src/passes/parser/shared/Lexer.mli similarity index 100% rename from src/parser/shared/Lexer.mli rename to src/passes/parser/shared/Lexer.mli diff --git a/src/parser/shared/Lexer.mll b/src/passes/parser/shared/Lexer.mll similarity index 100% rename from src/parser/shared/Lexer.mll rename to src/passes/parser/shared/Lexer.mll diff --git a/src/parser/shared/LexerLog.ml b/src/passes/parser/shared/LexerLog.ml similarity index 100% rename from src/parser/shared/LexerLog.ml rename to src/passes/parser/shared/LexerLog.ml diff --git a/src/parser/shared/LexerLog.mli b/src/passes/parser/shared/LexerLog.mli similarity index 100% rename from src/parser/shared/LexerLog.mli rename to src/passes/parser/shared/LexerLog.mli diff --git a/src/parser/shared/Markup.ml b/src/passes/parser/shared/Markup.ml similarity index 100% rename from src/parser/shared/Markup.ml rename to src/passes/parser/shared/Markup.ml diff --git a/src/parser/shared/Markup.mli b/src/passes/parser/shared/Markup.mli similarity index 100% rename from src/parser/shared/Markup.mli rename to src/passes/parser/shared/Markup.mli diff --git a/src/parser/shared/Utils.ml b/src/passes/parser/shared/Utils.ml similarity index 100% rename from src/parser/shared/Utils.ml rename to src/passes/parser/shared/Utils.ml diff --git a/src/parser/shared/Utils.mli b/src/passes/parser/shared/Utils.mli similarity index 100% rename from src/parser/shared/Utils.mli rename to src/passes/parser/shared/Utils.mli diff --git a/src/parser/shared/dune b/src/passes/parser/shared/dune similarity index 100% rename from src/parser/shared/dune rename to src/passes/parser/shared/dune diff --git a/src/simplify/camligo.ml.old b/src/passes/simplify/camligo.ml.old similarity index 100% rename from src/simplify/camligo.ml.old rename to src/passes/simplify/camligo.ml.old diff --git a/src/simplify/dune b/src/passes/simplify/dune similarity index 100% rename from src/simplify/dune rename to src/passes/simplify/dune diff --git a/src/simplify/ligodity.ml b/src/passes/simplify/ligodity.ml similarity index 100% rename from src/simplify/ligodity.ml rename to src/passes/simplify/ligodity.ml diff --git a/src/simplify/pascaligo.ml b/src/passes/simplify/pascaligo.ml similarity index 100% rename from src/simplify/pascaligo.ml rename to src/passes/simplify/pascaligo.ml diff --git a/src/simplify/simplify.ml b/src/passes/simplify/simplify.ml similarity index 100% rename from src/simplify/simplify.ml rename to src/passes/simplify/simplify.ml diff --git a/src/typer/dune b/src/passes/typer/dune similarity index 100% rename from src/typer/dune rename to src/passes/typer/dune diff --git a/src/typer/typer.ml b/src/passes/typer/typer.ml similarity index 100% rename from src/typer/typer.ml rename to src/passes/typer/typer.ml diff --git a/src/main/display.ml b/src/run/main/display.ml similarity index 100% rename from src/main/display.ml rename to src/run/main/display.ml diff --git a/src/main/dune b/src/run/main/dune similarity index 100% rename from src/main/dune rename to src/run/main/dune diff --git a/src/main/main.ml b/src/run/main/main.ml similarity index 100% rename from src/main/main.ml rename to src/run/main/main.ml diff --git a/src/main/run_mini_c.ml b/src/run/main/run_mini_c.ml similarity index 100% rename from src/main/run_mini_c.ml rename to src/run/main/run_mini_c.ml diff --git a/src/main/run_simplified.ml b/src/run/main/run_simplified.ml similarity index 100% rename from src/main/run_simplified.ml rename to src/run/main/run_simplified.ml diff --git a/src/main/run_source.ml b/src/run/main/run_source.ml similarity index 100% rename from src/main/run_source.ml rename to src/run/main/run_source.ml diff --git a/src/main/run_typed.ml b/src/run/main/run_typed.ml similarity index 100% rename from src/main/run_typed.ml rename to src/run/main/run_typed.ml diff --git a/src/ast_simplified/PP.ml b/src/stages/ast_simplified/PP.ml similarity index 100% rename from src/ast_simplified/PP.ml rename to src/stages/ast_simplified/PP.ml diff --git a/src/ast_simplified/ast_simplified.ml b/src/stages/ast_simplified/ast_simplified.ml similarity index 100% rename from src/ast_simplified/ast_simplified.ml rename to src/stages/ast_simplified/ast_simplified.ml diff --git a/src/ast_simplified/combinators.ml b/src/stages/ast_simplified/combinators.ml similarity index 100% rename from src/ast_simplified/combinators.ml rename to src/stages/ast_simplified/combinators.ml diff --git a/src/ast_simplified/dune b/src/stages/ast_simplified/dune similarity index 100% rename from src/ast_simplified/dune rename to src/stages/ast_simplified/dune diff --git a/src/ast_simplified/misc.ml b/src/stages/ast_simplified/misc.ml similarity index 100% rename from src/ast_simplified/misc.ml rename to src/stages/ast_simplified/misc.ml diff --git a/src/ast_simplified/types.ml b/src/stages/ast_simplified/types.ml similarity index 100% rename from src/ast_simplified/types.ml rename to src/stages/ast_simplified/types.ml diff --git a/src/ast_typed/PP.ml b/src/stages/ast_typed/PP.ml similarity index 100% rename from src/ast_typed/PP.ml rename to src/stages/ast_typed/PP.ml diff --git a/src/ast_typed/ast_typed.ml b/src/stages/ast_typed/ast_typed.ml similarity index 100% rename from src/ast_typed/ast_typed.ml rename to src/stages/ast_typed/ast_typed.ml diff --git a/src/ast_typed/combinators.ml b/src/stages/ast_typed/combinators.ml similarity index 100% rename from src/ast_typed/combinators.ml rename to src/stages/ast_typed/combinators.ml diff --git a/src/ast_typed/combinators_environment.ml b/src/stages/ast_typed/combinators_environment.ml similarity index 100% rename from src/ast_typed/combinators_environment.ml rename to src/stages/ast_typed/combinators_environment.ml diff --git a/src/ast_typed/dune b/src/stages/ast_typed/dune similarity index 100% rename from src/ast_typed/dune rename to src/stages/ast_typed/dune diff --git a/src/ast_typed/environment.ml b/src/stages/ast_typed/environment.ml similarity index 100% rename from src/ast_typed/environment.ml rename to src/stages/ast_typed/environment.ml diff --git a/src/ast_typed/misc.ml b/src/stages/ast_typed/misc.ml similarity index 100% rename from src/ast_typed/misc.ml rename to src/stages/ast_typed/misc.ml diff --git a/src/ast_typed/misc_smart.ml b/src/stages/ast_typed/misc_smart.ml similarity index 100% rename from src/ast_typed/misc_smart.ml rename to src/stages/ast_typed/misc_smart.ml diff --git a/src/ast_typed/types.ml b/src/stages/ast_typed/types.ml similarity index 100% rename from src/ast_typed/types.ml rename to src/stages/ast_typed/types.ml diff --git a/src/compiler/compiler.ml b/src/stages/compiler/compiler.ml similarity index 100% rename from src/compiler/compiler.ml rename to src/stages/compiler/compiler.ml diff --git a/src/compiler/compiler_environment.ml b/src/stages/compiler/compiler_environment.ml similarity index 100% rename from src/compiler/compiler_environment.ml rename to src/stages/compiler/compiler_environment.ml diff --git a/src/compiler/compiler_program.ml b/src/stages/compiler/compiler_program.ml similarity index 100% rename from src/compiler/compiler_program.ml rename to src/stages/compiler/compiler_program.ml diff --git a/src/compiler/compiler_type.ml b/src/stages/compiler/compiler_type.ml similarity index 100% rename from src/compiler/compiler_type.ml rename to src/stages/compiler/compiler_type.ml diff --git a/src/compiler/dune b/src/stages/compiler/dune similarity index 100% rename from src/compiler/dune rename to src/stages/compiler/dune diff --git a/src/compiler/uncompiler.ml b/src/stages/compiler/uncompiler.ml similarity index 100% rename from src/compiler/uncompiler.ml rename to src/stages/compiler/uncompiler.ml diff --git a/src/mini_c/PP.ml b/src/stages/mini_c/PP.ml similarity index 100% rename from src/mini_c/PP.ml rename to src/stages/mini_c/PP.ml diff --git a/src/mini_c/combinators.ml b/src/stages/mini_c/combinators.ml similarity index 100% rename from src/mini_c/combinators.ml rename to src/stages/mini_c/combinators.ml diff --git a/src/mini_c/combinators_smart.ml b/src/stages/mini_c/combinators_smart.ml similarity index 100% rename from src/mini_c/combinators_smart.ml rename to src/stages/mini_c/combinators_smart.ml diff --git a/src/mini_c/dune b/src/stages/mini_c/dune similarity index 100% rename from src/mini_c/dune rename to src/stages/mini_c/dune diff --git a/src/mini_c/environment.ml b/src/stages/mini_c/environment.ml similarity index 100% rename from src/mini_c/environment.ml rename to src/stages/mini_c/environment.ml diff --git a/src/mini_c/mini_c.ml b/src/stages/mini_c/mini_c.ml similarity index 100% rename from src/mini_c/mini_c.ml rename to src/stages/mini_c/mini_c.ml diff --git a/src/mini_c/types.ml b/src/stages/mini_c/types.ml similarity index 100% rename from src/mini_c/types.ml rename to src/stages/mini_c/types.ml diff --git a/src/transpiler/dune b/src/stages/transpiler/dune similarity index 100% rename from src/transpiler/dune rename to src/stages/transpiler/dune diff --git a/src/transpiler/transpiler.ml b/src/stages/transpiler/transpiler.ml similarity index 100% rename from src/transpiler/transpiler.ml rename to src/stages/transpiler/transpiler.ml diff --git a/src/test/.gitignore b/test/.gitignore similarity index 100% rename from src/test/.gitignore rename to test/.gitignore diff --git a/test/.merlin b/test/.merlin new file mode 100644 index 000000000..f2a72b2ea --- /dev/null +++ b/test/.merlin @@ -0,0 +1,187 @@ +EXCLUDE_QUERY_DIR +B /home/cc/Programming/ligo/_opam/lib/alcotest +B /home/cc/Programming/ligo/_opam/lib/astring +B /home/cc/Programming/ligo/_opam/lib/base/caml +B /home/cc/Programming/ligo/_opam/lib/bigarray-compat +B /home/cc/Programming/ligo/_opam/lib/bigstring +B /home/cc/Programming/ligo/_opam/lib/biniou +B /home/cc/Programming/ligo/_opam/lib/blake2 +B /home/cc/Programming/ligo/_opam/lib/bytes +B /home/cc/Programming/ligo/_opam/lib/cmdliner +B /home/cc/Programming/ligo/_opam/lib/cstruct +B /home/cc/Programming/ligo/_opam/lib/easy-format +B /home/cc/Programming/ligo/_opam/lib/ezjsonm +B /home/cc/Programming/ligo/_opam/lib/fmt +B /home/cc/Programming/ligo/_opam/lib/getopt +B /home/cc/Programming/ligo/_opam/lib/hacl +B /home/cc/Programming/ligo/_opam/lib/hex +B /home/cc/Programming/ligo/_opam/lib/ipaddr +B /home/cc/Programming/ligo/_opam/lib/ipaddr/unix +B /home/cc/Programming/ligo/_opam/lib/jsonm +B /home/cc/Programming/ligo/_opam/lib/lwt +B /home/cc/Programming/ligo/_opam/lib/lwt/unix +B /home/cc/Programming/ligo/_opam/lib/lwt_log +B /home/cc/Programming/ligo/_opam/lib/lwt_log/core +B /home/cc/Programming/ligo/_opam/lib/macaddr +B /home/cc/Programming/ligo/_opam/lib/mmap +B /home/cc/Programming/ligo/_opam/lib/mtime +B /home/cc/Programming/ligo/_opam/lib/mtime/os +B /home/cc/Programming/ligo/_opam/lib/ocaml +B /home/cc/Programming/ligo/_opam/lib/ocaml/threads +B /home/cc/Programming/ligo/_opam/lib/ocplib-endian +B /home/cc/Programming/ligo/_opam/lib/ocplib-json-typed +B /home/cc/Programming/ligo/_opam/lib/ocplib-json-typed-bson +B /home/cc/Programming/ligo/_opam/lib/ocplib-resto +B /home/cc/Programming/ligo/_opam/lib/ocplib-resto-directory +B /home/cc/Programming/ligo/_opam/lib/parsexp +B /home/cc/Programming/ligo/_opam/lib/ppx_deriving/runtime +B /home/cc/Programming/ligo/_opam/lib/ptime +B /home/cc/Programming/ligo/_opam/lib/ptime/os +B /home/cc/Programming/ligo/_opam/lib/re +B /home/cc/Programming/ligo/_opam/lib/re/posix +B /home/cc/Programming/ligo/_opam/lib/re/str +B /home/cc/Programming/ligo/_opam/lib/result +B /home/cc/Programming/ligo/_opam/lib/secp256k1 +B /home/cc/Programming/ligo/_opam/lib/seq +B /home/cc/Programming/ligo/_opam/lib/sexplib +B /home/cc/Programming/ligo/_opam/lib/sexplib0 +B /home/cc/Programming/ligo/_opam/lib/stdlib-shims +B /home/cc/Programming/ligo/_opam/lib/stringext +B /home/cc/Programming/ligo/_opam/lib/tezos-base +B /home/cc/Programming/ligo/_opam/lib/tezos-clic +B /home/cc/Programming/ligo/_opam/lib/tezos-crypto +B /home/cc/Programming/ligo/_opam/lib/tezos-data-encoding +B /home/cc/Programming/ligo/_opam/lib/tezos-error-monad +B /home/cc/Programming/ligo/_opam/lib/tezos-event-logging +B /home/cc/Programming/ligo/_opam/lib/tezos-micheline +B /home/cc/Programming/ligo/_opam/lib/tezos-protocol-environment +B /home/cc/Programming/ligo/_opam/lib/tezos-protocol-environment-sigs +B /home/cc/Programming/ligo/_opam/lib/tezos-rpc +B /home/cc/Programming/ligo/_opam/lib/tezos-stdlib +B /home/cc/Programming/ligo/_opam/lib/tezos-stdlib-unix +B /home/cc/Programming/ligo/_opam/lib/uchar +B /home/cc/Programming/ligo/_opam/lib/uecc +B /home/cc/Programming/ligo/_opam/lib/uri +B /home/cc/Programming/ligo/_opam/lib/uuidm +B /home/cc/Programming/ligo/_opam/lib/uutf +B /home/cc/Programming/ligo/_opam/lib/yojson +B /home/cc/Programming/ligo/_opam/lib/zarith +B ../../_build/default/src/.ligo.objs/byte +B ../../_build/default/src/ast_simplified/.ast_simplified.objs/byte +B ../../_build/default/src/ast_typed/.ast_typed.objs/byte +B ../../_build/default/src/compiler/.compiler.objs/byte +B ../../_build/default/src/mini_c/.mini_c.objs/byte +B ../../_build/default/src/operators/.operators.objs/byte +B ../../_build/default/src/parser/.parser.objs/byte +B ../../_build/default/src/parser/camligo/.parser_camligo.objs/byte +B ../../_build/default/src/parser/camligo/lex/.lex.objs/byte +B ../../_build/default/src/parser/ligodity/.parser_ligodity.objs/byte +B ../../_build/default/src/parser/pascaligo/.parser_pascaligo.objs/byte +B ../../_build/default/src/parser/shared/.parser_shared.objs/byte +B ../../_build/default/src/run/.run.objs/byte +B ../../_build/default/src/simplify/.simplify.objs/byte +B ../../_build/default/src/test/.test.eobjs/byte +B ../../_build/default/src/transpiler/.transpiler.objs/byte +B ../../_build/default/src/typer/.typer.objs/byte +B ../../_build/default/vendors/ligo-utils/memory-proto-alpha/.memory_proto_alpha.objs/byte +B ../../_build/default/vendors/ligo-utils/proto-alpha-utils/.proto_alpha_utils.objs/byte +B ../../_build/default/vendors/ligo-utils/simple-utils/.simple_utils.objs/byte +B ../../_build/default/vendors/ligo-utils/tezos-protocol-alpha-parameters/.tezos_protocol_alpha_parameters.objs/byte +B ../../_build/default/vendors/ligo-utils/tezos-protocol-alpha/.tezos_protocol_alpha.objs/byte +B ../../_build/default/vendors/ligo-utils/tezos-protocol-alpha/.tezos_protocol_environment_alpha.objs/byte +B ../../_build/default/vendors/ligo-utils/tezos-protocol-alpha/.tezos_raw_protocol_alpha.objs/byte +B ../../_build/default/vendors/ligo-utils/tezos-utils/.tezos_utils.objs/byte +B ../../_build/default/vendors/ligo-utils/tezos-utils/michelson-parser/.michelson_parser.objs/byte +S /home/cc/Programming/ligo/_opam/lib/alcotest +S /home/cc/Programming/ligo/_opam/lib/astring +S /home/cc/Programming/ligo/_opam/lib/base/caml +S /home/cc/Programming/ligo/_opam/lib/bigarray-compat +S /home/cc/Programming/ligo/_opam/lib/bigstring +S /home/cc/Programming/ligo/_opam/lib/biniou +S /home/cc/Programming/ligo/_opam/lib/blake2 +S /home/cc/Programming/ligo/_opam/lib/bytes +S /home/cc/Programming/ligo/_opam/lib/cmdliner +S /home/cc/Programming/ligo/_opam/lib/cstruct +S /home/cc/Programming/ligo/_opam/lib/easy-format +S /home/cc/Programming/ligo/_opam/lib/ezjsonm +S /home/cc/Programming/ligo/_opam/lib/fmt +S /home/cc/Programming/ligo/_opam/lib/getopt +S /home/cc/Programming/ligo/_opam/lib/hacl +S /home/cc/Programming/ligo/_opam/lib/hex +S /home/cc/Programming/ligo/_opam/lib/ipaddr +S /home/cc/Programming/ligo/_opam/lib/ipaddr/unix +S /home/cc/Programming/ligo/_opam/lib/jsonm +S /home/cc/Programming/ligo/_opam/lib/lwt +S /home/cc/Programming/ligo/_opam/lib/lwt/unix +S /home/cc/Programming/ligo/_opam/lib/lwt_log +S /home/cc/Programming/ligo/_opam/lib/lwt_log/core +S /home/cc/Programming/ligo/_opam/lib/macaddr +S /home/cc/Programming/ligo/_opam/lib/mmap +S /home/cc/Programming/ligo/_opam/lib/mtime +S /home/cc/Programming/ligo/_opam/lib/mtime/os +S /home/cc/Programming/ligo/_opam/lib/ocaml +S /home/cc/Programming/ligo/_opam/lib/ocaml/threads +S /home/cc/Programming/ligo/_opam/lib/ocplib-endian +S /home/cc/Programming/ligo/_opam/lib/ocplib-json-typed +S /home/cc/Programming/ligo/_opam/lib/ocplib-json-typed-bson +S /home/cc/Programming/ligo/_opam/lib/ocplib-resto +S /home/cc/Programming/ligo/_opam/lib/ocplib-resto-directory +S /home/cc/Programming/ligo/_opam/lib/parsexp +S /home/cc/Programming/ligo/_opam/lib/ppx_deriving/runtime +S /home/cc/Programming/ligo/_opam/lib/ptime +S /home/cc/Programming/ligo/_opam/lib/ptime/os +S /home/cc/Programming/ligo/_opam/lib/re +S /home/cc/Programming/ligo/_opam/lib/re/posix +S /home/cc/Programming/ligo/_opam/lib/re/str +S /home/cc/Programming/ligo/_opam/lib/result +S /home/cc/Programming/ligo/_opam/lib/secp256k1 +S /home/cc/Programming/ligo/_opam/lib/seq +S /home/cc/Programming/ligo/_opam/lib/sexplib +S /home/cc/Programming/ligo/_opam/lib/sexplib0 +S /home/cc/Programming/ligo/_opam/lib/stdlib-shims +S /home/cc/Programming/ligo/_opam/lib/stringext +S /home/cc/Programming/ligo/_opam/lib/tezos-base +S /home/cc/Programming/ligo/_opam/lib/tezos-clic +S /home/cc/Programming/ligo/_opam/lib/tezos-crypto +S /home/cc/Programming/ligo/_opam/lib/tezos-data-encoding +S /home/cc/Programming/ligo/_opam/lib/tezos-error-monad +S /home/cc/Programming/ligo/_opam/lib/tezos-event-logging +S /home/cc/Programming/ligo/_opam/lib/tezos-micheline +S /home/cc/Programming/ligo/_opam/lib/tezos-protocol-environment +S /home/cc/Programming/ligo/_opam/lib/tezos-protocol-environment-sigs +S /home/cc/Programming/ligo/_opam/lib/tezos-rpc +S /home/cc/Programming/ligo/_opam/lib/tezos-stdlib +S /home/cc/Programming/ligo/_opam/lib/tezos-stdlib-unix +S /home/cc/Programming/ligo/_opam/lib/uchar +S /home/cc/Programming/ligo/_opam/lib/uecc +S /home/cc/Programming/ligo/_opam/lib/uri +S /home/cc/Programming/ligo/_opam/lib/uuidm +S /home/cc/Programming/ligo/_opam/lib/uutf +S /home/cc/Programming/ligo/_opam/lib/yojson +S /home/cc/Programming/ligo/_opam/lib/zarith +S .. +S ../ast_simplified +S ../ast_typed +S ../compiler +S ../mini_c +S ../operators +S ../parser +S ../parser/camligo +S ../parser/camligo/lex +S ../parser/ligodity +S ../parser/pascaligo +S ../parser/shared +S ../run +S ../simplify +S . +S ../transpiler +S ../typer +S ../../vendors/ligo-utils/memory-proto-alpha +S ../../vendors/ligo-utils/proto-alpha-utils +S ../../vendors/ligo-utils/simple-utils +S ../../vendors/ligo-utils/tezos-protocol-alpha +S ../../vendors/ligo-utils/tezos-protocol-alpha-parameters +S ../../vendors/ligo-utils/tezos-utils +S ../../vendors/ligo-utils/tezos-utils/michelson-parser +FLG -ppx '/home/cc/Programming/ligo/_build/default/.ppx/0af9cc0ed9166d3107af7264d5703b53/ppx.exe --as-ppx' +FLG -w @1..3@5..28@30..39@43@46..47@49..57@61..62-40 -strict-sequence -strict-formats -short-paths -keep-locs -w +1..62-4-9-44-40-42-48@39@33 -open Simple_utils diff --git a/src/test/bin_tests.ml b/test/bin_tests.ml similarity index 100% rename from src/test/bin_tests.ml rename to test/bin_tests.ml diff --git a/src/test/coase_tests.ml b/test/coase_tests.ml similarity index 100% rename from src/test/coase_tests.ml rename to test/coase_tests.ml diff --git a/src/test/compiler_tests.ml b/test/compiler_tests.ml similarity index 100% rename from src/test/compiler_tests.ml rename to test/compiler_tests.ml diff --git a/src/test/dune b/test/dune similarity index 100% rename from src/test/dune rename to test/dune diff --git a/src/test/heap_tests.ml b/test/heap_tests.ml similarity index 100% rename from src/test/heap_tests.ml rename to test/heap_tests.ml diff --git a/src/test/integration_tests.ml b/test/integration_tests.ml similarity index 100% rename from src/test/integration_tests.ml rename to test/integration_tests.ml diff --git a/src/test/manual_test.ml b/test/manual_test.ml similarity index 100% rename from src/test/manual_test.ml rename to test/manual_test.ml diff --git a/src/test/multifix_tests.ml b/test/multifix_tests.ml similarity index 100% rename from src/test/multifix_tests.ml rename to test/multifix_tests.ml diff --git a/src/test/test.ml b/test/test.ml similarity index 100% rename from src/test/test.ml rename to test/test.ml diff --git a/src/test/test_helpers.ml b/test/test_helpers.ml similarity index 100% rename from src/test/test_helpers.ml rename to test/test_helpers.ml diff --git a/src/test/transpiler_tests.ml b/test/transpiler_tests.ml similarity index 100% rename from src/test/transpiler_tests.ml rename to test/transpiler_tests.ml diff --git a/src/test/typer_tests.ml b/test/typer_tests.ml similarity index 100% rename from src/test/typer_tests.ml rename to test/typer_tests.ml diff --git a/src/test/vote_tests.ml b/test/vote_tests.ml similarity index 100% rename from src/test/vote_tests.ml rename to test/vote_tests.ml diff --git a/src/rope/rope.ml b/vendors/rope/rope.ml similarity index 100% rename from src/rope/rope.ml rename to vendors/rope/rope.ml diff --git a/src/rope/rope.mli b/vendors/rope/rope.mli similarity index 100% rename from src/rope/rope.mli rename to vendors/rope/rope.mli diff --git a/src/rope/rope_implementation.ml b/vendors/rope/rope_implementation.ml similarity index 100% rename from src/rope/rope_implementation.ml rename to vendors/rope/rope_implementation.ml diff --git a/src/rope/rope_implementation.mli b/vendors/rope/rope_implementation.mli similarity index 100% rename from src/rope/rope_implementation.mli rename to vendors/rope/rope_implementation.mli diff --git a/src/rope/rope_test.ml b/vendors/rope/rope_test.ml similarity index 100% rename from src/rope/rope_test.ml rename to vendors/rope/rope_test.ml diff --git a/src/rope/rope_top_level_open.ml b/vendors/rope/rope_top_level_open.ml similarity index 100% rename from src/rope/rope_top_level_open.ml rename to vendors/rope/rope_top_level_open.ml diff --git a/src/rope/rope_top_level_open.mli b/vendors/rope/rope_top_level_open.mli similarity index 100% rename from src/rope/rope_top_level_open.mli rename to vendors/rope/rope_top_level_open.mli From d187317c325df8399e8fca0ac31a9e2952e64e6b Mon Sep 17 00:00:00 2001 From: galfour Date: Mon, 9 Sep 2019 11:47:42 +0200 Subject: [PATCH 02/18] move contracts --- {src => test}/contracts/amount.mligo | 0 {src => test}/contracts/annotation.ligo | 0 {src => test}/contracts/arithmetic.ligo | 0 {src => test}/contracts/assign.ligo | 0 {src => test}/contracts/basic.mligo | 0 {src => test}/contracts/bitwise_arithmetic.ligo | 0 {src => test}/contracts/boolean_operators.ligo | 0 {src => test}/contracts/bytes_arithmetic.ligo | 0 {src => test}/contracts/closure-1.ligo | 0 {src => test}/contracts/closure-2.ligo | 0 {src => test}/contracts/closure-3.ligo | 0 {src => test}/contracts/closure.ligo | 0 {src => test}/contracts/coase.ligo | 0 {src => test}/contracts/condition-simple.ligo | 0 {src => test}/contracts/condition.ligo | 0 {src => test}/contracts/counter.ligo | 0 {src => test}/contracts/counter.mligo | 0 {src => test}/contracts/declaration-local.ligo | 0 {src => test}/contracts/declarations.ligo | 0 {src => test}/contracts/dispatch-counter.ligo | 0 {src => test}/contracts/error_syntax.ligo | 0 {src => test}/contracts/error_type.ligo | 0 {src => test}/contracts/failwith.mligo | 0 {src => test}/contracts/function-complex.ligo | 0 {src => test}/contracts/function-shared.ligo | 0 {src => test}/contracts/function.ligo | 0 {src => test}/contracts/guess_string.mligo | 0 {src => test}/contracts/heap-instance.ligo | 0 {src => test}/contracts/heap.ligo | 0 {src => test}/contracts/high-order.ligo | 0 {src => test}/contracts/included.ligo | 0 {src => test}/contracts/includer.ligo | 0 {src => test}/contracts/lambda.ligo | 0 {src => test}/contracts/lambda.mligo | 0 {src => test}/contracts/lambda2.mligo | 0 {src => test}/contracts/letin.mligo | 0 {src => test}/contracts/list.ligo | 0 {src => test}/contracts/list.mligo | 0 {src => test}/contracts/loop.ligo | 0 {src => test}/contracts/map.ligo | 0 {src => test}/contracts/match.ligo | 0 {src => test}/contracts/match.mligo | 0 {src => test}/contracts/match_bis.mligo | 0 {src => test}/contracts/multiple-parameters.ligo | 0 {src => test}/contracts/new-syntax.mligo | 0 {src => test}/contracts/option.ligo | 0 {src => test}/contracts/parser-bad-reported-term.ligo | 0 {src => test}/contracts/quote-declaration.ligo | 0 {src => test}/contracts/quote-declarations.ligo | 0 {src => test}/contracts/record.ligo | 0 {src => test}/contracts/record.mligo | 0 {src => test}/contracts/set_arithmetic-1.ligo | 0 {src => test}/contracts/set_arithmetic.ligo | 0 {src => test}/contracts/shadow.ligo | 0 {src => test}/contracts/string.ligo | 0 {src => test}/contracts/string_arithmetic.ligo | 0 {src => test}/contracts/super-counter.ligo | 0 {src => test}/contracts/super-counter.mligo | 0 {src => test}/contracts/toto.ligo | 0 {src => test}/contracts/tuple.ligo | 0 {src => test}/contracts/type-alias.ligo | 0 {src => test}/contracts/unit.ligo | 0 {src => test}/contracts/variant-matching.ligo | 0 {src => test}/contracts/variant.ligo | 0 {src => test}/contracts/vote.mligo | 0 {src => test}/contracts/website1.ligo | 0 {src => test}/contracts/website2.ligo | 0 67 files changed, 0 insertions(+), 0 deletions(-) rename {src => test}/contracts/amount.mligo (100%) rename {src => test}/contracts/annotation.ligo (100%) rename {src => test}/contracts/arithmetic.ligo (100%) rename {src => test}/contracts/assign.ligo (100%) rename {src => test}/contracts/basic.mligo (100%) rename {src => test}/contracts/bitwise_arithmetic.ligo (100%) rename {src => test}/contracts/boolean_operators.ligo (100%) rename {src => test}/contracts/bytes_arithmetic.ligo (100%) rename {src => test}/contracts/closure-1.ligo (100%) rename {src => test}/contracts/closure-2.ligo (100%) rename {src => test}/contracts/closure-3.ligo (100%) rename {src => test}/contracts/closure.ligo (100%) rename {src => test}/contracts/coase.ligo (100%) rename {src => test}/contracts/condition-simple.ligo (100%) rename {src => test}/contracts/condition.ligo (100%) rename {src => test}/contracts/counter.ligo (100%) rename {src => test}/contracts/counter.mligo (100%) rename {src => test}/contracts/declaration-local.ligo (100%) rename {src => test}/contracts/declarations.ligo (100%) rename {src => test}/contracts/dispatch-counter.ligo (100%) rename {src => test}/contracts/error_syntax.ligo (100%) rename {src => test}/contracts/error_type.ligo (100%) rename {src => test}/contracts/failwith.mligo (100%) rename {src => test}/contracts/function-complex.ligo (100%) rename {src => test}/contracts/function-shared.ligo (100%) rename {src => test}/contracts/function.ligo (100%) rename {src => test}/contracts/guess_string.mligo (100%) rename {src => test}/contracts/heap-instance.ligo (100%) rename {src => test}/contracts/heap.ligo (100%) rename {src => test}/contracts/high-order.ligo (100%) rename {src => test}/contracts/included.ligo (100%) rename {src => test}/contracts/includer.ligo (100%) rename {src => test}/contracts/lambda.ligo (100%) rename {src => test}/contracts/lambda.mligo (100%) rename {src => test}/contracts/lambda2.mligo (100%) rename {src => test}/contracts/letin.mligo (100%) rename {src => test}/contracts/list.ligo (100%) rename {src => test}/contracts/list.mligo (100%) rename {src => test}/contracts/loop.ligo (100%) rename {src => test}/contracts/map.ligo (100%) rename {src => test}/contracts/match.ligo (100%) rename {src => test}/contracts/match.mligo (100%) rename {src => test}/contracts/match_bis.mligo (100%) rename {src => test}/contracts/multiple-parameters.ligo (100%) rename {src => test}/contracts/new-syntax.mligo (100%) rename {src => test}/contracts/option.ligo (100%) rename {src => test}/contracts/parser-bad-reported-term.ligo (100%) rename {src => test}/contracts/quote-declaration.ligo (100%) rename {src => test}/contracts/quote-declarations.ligo (100%) rename {src => test}/contracts/record.ligo (100%) rename {src => test}/contracts/record.mligo (100%) rename {src => test}/contracts/set_arithmetic-1.ligo (100%) rename {src => test}/contracts/set_arithmetic.ligo (100%) rename {src => test}/contracts/shadow.ligo (100%) rename {src => test}/contracts/string.ligo (100%) rename {src => test}/contracts/string_arithmetic.ligo (100%) rename {src => test}/contracts/super-counter.ligo (100%) rename {src => test}/contracts/super-counter.mligo (100%) rename {src => test}/contracts/toto.ligo (100%) rename {src => test}/contracts/tuple.ligo (100%) rename {src => test}/contracts/type-alias.ligo (100%) rename {src => test}/contracts/unit.ligo (100%) rename {src => test}/contracts/variant-matching.ligo (100%) rename {src => test}/contracts/variant.ligo (100%) rename {src => test}/contracts/vote.mligo (100%) rename {src => test}/contracts/website1.ligo (100%) rename {src => test}/contracts/website2.ligo (100%) diff --git a/src/contracts/amount.mligo b/test/contracts/amount.mligo similarity index 100% rename from src/contracts/amount.mligo rename to test/contracts/amount.mligo diff --git a/src/contracts/annotation.ligo b/test/contracts/annotation.ligo similarity index 100% rename from src/contracts/annotation.ligo rename to test/contracts/annotation.ligo diff --git a/src/contracts/arithmetic.ligo b/test/contracts/arithmetic.ligo similarity index 100% rename from src/contracts/arithmetic.ligo rename to test/contracts/arithmetic.ligo diff --git a/src/contracts/assign.ligo b/test/contracts/assign.ligo similarity index 100% rename from src/contracts/assign.ligo rename to test/contracts/assign.ligo diff --git a/src/contracts/basic.mligo b/test/contracts/basic.mligo similarity index 100% rename from src/contracts/basic.mligo rename to test/contracts/basic.mligo diff --git a/src/contracts/bitwise_arithmetic.ligo b/test/contracts/bitwise_arithmetic.ligo similarity index 100% rename from src/contracts/bitwise_arithmetic.ligo rename to test/contracts/bitwise_arithmetic.ligo diff --git a/src/contracts/boolean_operators.ligo b/test/contracts/boolean_operators.ligo similarity index 100% rename from src/contracts/boolean_operators.ligo rename to test/contracts/boolean_operators.ligo diff --git a/src/contracts/bytes_arithmetic.ligo b/test/contracts/bytes_arithmetic.ligo similarity index 100% rename from src/contracts/bytes_arithmetic.ligo rename to test/contracts/bytes_arithmetic.ligo diff --git a/src/contracts/closure-1.ligo b/test/contracts/closure-1.ligo similarity index 100% rename from src/contracts/closure-1.ligo rename to test/contracts/closure-1.ligo diff --git a/src/contracts/closure-2.ligo b/test/contracts/closure-2.ligo similarity index 100% rename from src/contracts/closure-2.ligo rename to test/contracts/closure-2.ligo diff --git a/src/contracts/closure-3.ligo b/test/contracts/closure-3.ligo similarity index 100% rename from src/contracts/closure-3.ligo rename to test/contracts/closure-3.ligo diff --git a/src/contracts/closure.ligo b/test/contracts/closure.ligo similarity index 100% rename from src/contracts/closure.ligo rename to test/contracts/closure.ligo diff --git a/src/contracts/coase.ligo b/test/contracts/coase.ligo similarity index 100% rename from src/contracts/coase.ligo rename to test/contracts/coase.ligo diff --git a/src/contracts/condition-simple.ligo b/test/contracts/condition-simple.ligo similarity index 100% rename from src/contracts/condition-simple.ligo rename to test/contracts/condition-simple.ligo diff --git a/src/contracts/condition.ligo b/test/contracts/condition.ligo similarity index 100% rename from src/contracts/condition.ligo rename to test/contracts/condition.ligo diff --git a/src/contracts/counter.ligo b/test/contracts/counter.ligo similarity index 100% rename from src/contracts/counter.ligo rename to test/contracts/counter.ligo diff --git a/src/contracts/counter.mligo b/test/contracts/counter.mligo similarity index 100% rename from src/contracts/counter.mligo rename to test/contracts/counter.mligo diff --git a/src/contracts/declaration-local.ligo b/test/contracts/declaration-local.ligo similarity index 100% rename from src/contracts/declaration-local.ligo rename to test/contracts/declaration-local.ligo diff --git a/src/contracts/declarations.ligo b/test/contracts/declarations.ligo similarity index 100% rename from src/contracts/declarations.ligo rename to test/contracts/declarations.ligo diff --git a/src/contracts/dispatch-counter.ligo b/test/contracts/dispatch-counter.ligo similarity index 100% rename from src/contracts/dispatch-counter.ligo rename to test/contracts/dispatch-counter.ligo diff --git a/src/contracts/error_syntax.ligo b/test/contracts/error_syntax.ligo similarity index 100% rename from src/contracts/error_syntax.ligo rename to test/contracts/error_syntax.ligo diff --git a/src/contracts/error_type.ligo b/test/contracts/error_type.ligo similarity index 100% rename from src/contracts/error_type.ligo rename to test/contracts/error_type.ligo diff --git a/src/contracts/failwith.mligo b/test/contracts/failwith.mligo similarity index 100% rename from src/contracts/failwith.mligo rename to test/contracts/failwith.mligo diff --git a/src/contracts/function-complex.ligo b/test/contracts/function-complex.ligo similarity index 100% rename from src/contracts/function-complex.ligo rename to test/contracts/function-complex.ligo diff --git a/src/contracts/function-shared.ligo b/test/contracts/function-shared.ligo similarity index 100% rename from src/contracts/function-shared.ligo rename to test/contracts/function-shared.ligo diff --git a/src/contracts/function.ligo b/test/contracts/function.ligo similarity index 100% rename from src/contracts/function.ligo rename to test/contracts/function.ligo diff --git a/src/contracts/guess_string.mligo b/test/contracts/guess_string.mligo similarity index 100% rename from src/contracts/guess_string.mligo rename to test/contracts/guess_string.mligo diff --git a/src/contracts/heap-instance.ligo b/test/contracts/heap-instance.ligo similarity index 100% rename from src/contracts/heap-instance.ligo rename to test/contracts/heap-instance.ligo diff --git a/src/contracts/heap.ligo b/test/contracts/heap.ligo similarity index 100% rename from src/contracts/heap.ligo rename to test/contracts/heap.ligo diff --git a/src/contracts/high-order.ligo b/test/contracts/high-order.ligo similarity index 100% rename from src/contracts/high-order.ligo rename to test/contracts/high-order.ligo diff --git a/src/contracts/included.ligo b/test/contracts/included.ligo similarity index 100% rename from src/contracts/included.ligo rename to test/contracts/included.ligo diff --git a/src/contracts/includer.ligo b/test/contracts/includer.ligo similarity index 100% rename from src/contracts/includer.ligo rename to test/contracts/includer.ligo diff --git a/src/contracts/lambda.ligo b/test/contracts/lambda.ligo similarity index 100% rename from src/contracts/lambda.ligo rename to test/contracts/lambda.ligo diff --git a/src/contracts/lambda.mligo b/test/contracts/lambda.mligo similarity index 100% rename from src/contracts/lambda.mligo rename to test/contracts/lambda.mligo diff --git a/src/contracts/lambda2.mligo b/test/contracts/lambda2.mligo similarity index 100% rename from src/contracts/lambda2.mligo rename to test/contracts/lambda2.mligo diff --git a/src/contracts/letin.mligo b/test/contracts/letin.mligo similarity index 100% rename from src/contracts/letin.mligo rename to test/contracts/letin.mligo diff --git a/src/contracts/list.ligo b/test/contracts/list.ligo similarity index 100% rename from src/contracts/list.ligo rename to test/contracts/list.ligo diff --git a/src/contracts/list.mligo b/test/contracts/list.mligo similarity index 100% rename from src/contracts/list.mligo rename to test/contracts/list.mligo diff --git a/src/contracts/loop.ligo b/test/contracts/loop.ligo similarity index 100% rename from src/contracts/loop.ligo rename to test/contracts/loop.ligo diff --git a/src/contracts/map.ligo b/test/contracts/map.ligo similarity index 100% rename from src/contracts/map.ligo rename to test/contracts/map.ligo diff --git a/src/contracts/match.ligo b/test/contracts/match.ligo similarity index 100% rename from src/contracts/match.ligo rename to test/contracts/match.ligo diff --git a/src/contracts/match.mligo b/test/contracts/match.mligo similarity index 100% rename from src/contracts/match.mligo rename to test/contracts/match.mligo diff --git a/src/contracts/match_bis.mligo b/test/contracts/match_bis.mligo similarity index 100% rename from src/contracts/match_bis.mligo rename to test/contracts/match_bis.mligo diff --git a/src/contracts/multiple-parameters.ligo b/test/contracts/multiple-parameters.ligo similarity index 100% rename from src/contracts/multiple-parameters.ligo rename to test/contracts/multiple-parameters.ligo diff --git a/src/contracts/new-syntax.mligo b/test/contracts/new-syntax.mligo similarity index 100% rename from src/contracts/new-syntax.mligo rename to test/contracts/new-syntax.mligo diff --git a/src/contracts/option.ligo b/test/contracts/option.ligo similarity index 100% rename from src/contracts/option.ligo rename to test/contracts/option.ligo diff --git a/src/contracts/parser-bad-reported-term.ligo b/test/contracts/parser-bad-reported-term.ligo similarity index 100% rename from src/contracts/parser-bad-reported-term.ligo rename to test/contracts/parser-bad-reported-term.ligo diff --git a/src/contracts/quote-declaration.ligo b/test/contracts/quote-declaration.ligo similarity index 100% rename from src/contracts/quote-declaration.ligo rename to test/contracts/quote-declaration.ligo diff --git a/src/contracts/quote-declarations.ligo b/test/contracts/quote-declarations.ligo similarity index 100% rename from src/contracts/quote-declarations.ligo rename to test/contracts/quote-declarations.ligo diff --git a/src/contracts/record.ligo b/test/contracts/record.ligo similarity index 100% rename from src/contracts/record.ligo rename to test/contracts/record.ligo diff --git a/src/contracts/record.mligo b/test/contracts/record.mligo similarity index 100% rename from src/contracts/record.mligo rename to test/contracts/record.mligo diff --git a/src/contracts/set_arithmetic-1.ligo b/test/contracts/set_arithmetic-1.ligo similarity index 100% rename from src/contracts/set_arithmetic-1.ligo rename to test/contracts/set_arithmetic-1.ligo diff --git a/src/contracts/set_arithmetic.ligo b/test/contracts/set_arithmetic.ligo similarity index 100% rename from src/contracts/set_arithmetic.ligo rename to test/contracts/set_arithmetic.ligo diff --git a/src/contracts/shadow.ligo b/test/contracts/shadow.ligo similarity index 100% rename from src/contracts/shadow.ligo rename to test/contracts/shadow.ligo diff --git a/src/contracts/string.ligo b/test/contracts/string.ligo similarity index 100% rename from src/contracts/string.ligo rename to test/contracts/string.ligo diff --git a/src/contracts/string_arithmetic.ligo b/test/contracts/string_arithmetic.ligo similarity index 100% rename from src/contracts/string_arithmetic.ligo rename to test/contracts/string_arithmetic.ligo diff --git a/src/contracts/super-counter.ligo b/test/contracts/super-counter.ligo similarity index 100% rename from src/contracts/super-counter.ligo rename to test/contracts/super-counter.ligo diff --git a/src/contracts/super-counter.mligo b/test/contracts/super-counter.mligo similarity index 100% rename from src/contracts/super-counter.mligo rename to test/contracts/super-counter.mligo diff --git a/src/contracts/toto.ligo b/test/contracts/toto.ligo similarity index 100% rename from src/contracts/toto.ligo rename to test/contracts/toto.ligo diff --git a/src/contracts/tuple.ligo b/test/contracts/tuple.ligo similarity index 100% rename from src/contracts/tuple.ligo rename to test/contracts/tuple.ligo diff --git a/src/contracts/type-alias.ligo b/test/contracts/type-alias.ligo similarity index 100% rename from src/contracts/type-alias.ligo rename to test/contracts/type-alias.ligo diff --git a/src/contracts/unit.ligo b/test/contracts/unit.ligo similarity index 100% rename from src/contracts/unit.ligo rename to test/contracts/unit.ligo diff --git a/src/contracts/variant-matching.ligo b/test/contracts/variant-matching.ligo similarity index 100% rename from src/contracts/variant-matching.ligo rename to test/contracts/variant-matching.ligo diff --git a/src/contracts/variant.ligo b/test/contracts/variant.ligo similarity index 100% rename from src/contracts/variant.ligo rename to test/contracts/variant.ligo diff --git a/src/contracts/vote.mligo b/test/contracts/vote.mligo similarity index 100% rename from src/contracts/vote.mligo rename to test/contracts/vote.mligo diff --git a/src/contracts/website1.ligo b/test/contracts/website1.ligo similarity index 100% rename from src/contracts/website1.ligo rename to test/contracts/website1.ligo diff --git a/src/contracts/website2.ligo b/test/contracts/website2.ligo similarity index 100% rename from src/contracts/website2.ligo rename to test/contracts/website2.ligo From cdfffcf8ecaec28a7171d2f04bedb12548634f5f Mon Sep 17 00:00:00 2001 From: galfour Date: Tue, 10 Sep 2019 12:42:49 +0200 Subject: [PATCH 03/18] more refactoring --- .gitignore | 1 + src/dune | 17 --- .../{parser => 1-parser}/camligo/.gitignore | 0 .../{parser => 1-parser}/camligo/ast.ml | 0 src/passes/{parser => 1-parser}/camligo/dune | 0 .../{parser => 1-parser}/camligo/generator.ml | 0 .../{parser => 1-parser}/camligo/lex/dune | 0 .../camligo/lex/generator.ml | 0 .../{parser => 1-parser}/camligo/location.ml | 0 .../camligo/parser_camligo.ml | 0 .../camligo/pre_parser.mly | 0 .../{parser => 1-parser}/camligo/user.ml | 0 src/passes/{parser => 1-parser}/dune | 0 .../generator/doc/essai.ml | 0 .../generator/doc/mini_ml.bnf | 0 .../generator/doc/mini_ml2.bnf | 0 .../generator/doc/mini_ml3.bnf | 0 .../generator/doc/mini_ml4.bnf | 0 src/passes/{parser => 1-parser}/ligodity.ml | 0 .../{parser => 1-parser}/ligodity/.AST.ml.tag | 0 .../ligodity/.Eval.ml.tag | 0 .../ligodity/.EvalMain.ml.tag | 0 .../ligodity/.Lexer.ml.tag | 0 .../ligodity/.LexerMain.tag | 0 .../ligodity/.Parser.ml.tag | 0 .../ligodity/.Parser.mly.tag | 0 .../ligodity/.ParserMain.tag | 0 .../{parser => 1-parser}/ligodity/.links | 0 .../{parser => 1-parser}/ligodity/AST.ml | 0 .../{parser => 1-parser}/ligodity/AST.mli | 0 .../{parser => 1-parser}/ligodity/EvalOpt.ml | 0 .../{parser => 1-parser}/ligodity/EvalOpt.mli | 0 .../{parser => 1-parser}/ligodity/Lexer.mli | 0 .../{parser => 1-parser}/ligodity/Lexer.mll | 0 .../ligodity/LexerMain.ml | 0 .../ligodity/ParToken.mly | 0 .../{parser => 1-parser}/ligodity/Parser.mly | 0 .../ligodity/ParserMain.ml | 0 .../ligodity/Stubs/Simple_utils.ml | 0 .../ligodity/Tests/match.mml | 0 .../{parser => 1-parser}/ligodity/Token.ml | 0 .../{parser => 1-parser}/ligodity/Token.mli | 0 .../{parser => 1-parser}/ligodity/Utils.ml | 0 .../{parser => 1-parser}/ligodity/Utils.mli | 0 .../ligodity/check_dot_git_is_dir.sh | 0 src/passes/{parser => 1-parser}/ligodity/dune | 0 .../{parser => 1-parser}/ligodity/ligodity.ml | 0 src/passes/{parser => 1-parser}/parser.ml | 0 src/passes/{parser => 1-parser}/pascaligo.ml | 0 .../pascaligo/.Lexer.ml.tag | 0 .../pascaligo/.LexerMain.tag | 0 .../pascaligo/.Parser.mly.tag | 0 .../pascaligo/.ParserMain.tag | 0 .../{parser => 1-parser}/pascaligo/.gitignore | 0 .../{parser => 1-parser}/pascaligo/.links | 0 .../{parser => 1-parser}/pascaligo/AST.ml | 0 .../{parser => 1-parser}/pascaligo/AST.mli | 0 .../pascaligo/Doc/pascaligo.txt | 0 .../pascaligo/Doc/pascaligo_01.bnf | 0 .../pascaligo/Doc/pascaligo_02.bnf | 0 .../pascaligo/Doc/pascaligo_03.bnf | 0 .../pascaligo/Doc/pascaligo_04.bnf | 0 .../pascaligo/Doc/pascaligo_05.bnf | 0 .../pascaligo/Doc/pascaligo_06.bnf | 0 .../pascaligo/Doc/pascaligo_07.bnf | 0 .../pascaligo/Doc/pascaligo_08.bnf | 0 .../pascaligo/Doc/pascaligo_09.bnf | 0 .../pascaligo/Doc/pascaligo_10.bnf | 0 .../pascaligo/Doc/pascaligo_11.bnf | 0 .../pascaligo/Doc/pascaligo_12.bnf | 0 .../pascaligo/LexToken.mli | 0 .../pascaligo/LexToken.mll | 0 .../pascaligo/LexerMain.ml | 0 .../pascaligo/ParToken.mly | 0 .../{parser => 1-parser}/pascaligo/Parser.mly | 0 .../pascaligo/ParserLog.ml | 0 .../pascaligo/ParserLog.mli | 0 .../pascaligo/ParserMain.ml | 0 .../pascaligo/Stubs/Simple_utils.ml | 0 .../pascaligo/Tests/a.ligo | 0 .../pascaligo/Tests/crowdfunding.ligo | 0 .../pascaligo/check_dot_git_is_dir.sh | 0 .../{parser => 1-parser}/pascaligo/dune | 0 .../pascaligo/pascaligo.ml | 0 src/passes/{parser => 1-parser}/shared/.links | 0 .../shared/Doc/shared.txt | 0 .../{parser => 1-parser}/shared/Error.mli | 0 .../{parser => 1-parser}/shared/EvalOpt.ml | 0 .../{parser => 1-parser}/shared/EvalOpt.mli | 0 .../{parser => 1-parser}/shared/FQueue.ml | 0 .../{parser => 1-parser}/shared/FQueue.mli | 0 .../{parser => 1-parser}/shared/Lexer.mli | 0 .../{parser => 1-parser}/shared/Lexer.mll | 0 .../{parser => 1-parser}/shared/LexerLog.ml | 0 .../{parser => 1-parser}/shared/LexerLog.mli | 0 .../{parser => 1-parser}/shared/Markup.ml | 0 .../{parser => 1-parser}/shared/Markup.mli | 0 .../{parser => 1-parser}/shared/Utils.ml | 0 .../{parser => 1-parser}/shared/Utils.mli | 0 src/passes/{parser => 1-parser}/shared/dune | 0 .../{simplify => 2-simplify}/camligo.ml.old | 0 src/passes/{simplify => 2-simplify}/dune | 0 .../{simplify => 2-simplify}/ligodity.ml | 1 - .../{simplify => 2-simplify}/pascaligo.ml | 98 +++++++------- .../{simplify => 2-simplify}/simplify.ml | 0 src/passes/3-self_ast_simplified/dune | 12 ++ src/passes/3-self_ast_simplified/helpers.ml | 127 ++++++++++++++++++ src/passes/3-self_ast_simplified/main.ml | 0 .../self_ast_simplified.ml | 1 + .../tezos_type_annotation.ml | 16 +++ src/passes/{typer => 4-typer}/dune | 0 src/passes/{typer => 4-typer}/typer.ml | 19 +-- .../transpiler => passes/6-transpiler}/dune | 0 .../6-transpiler}/transpiler.ml | 0 .../8-compiler}/compiler.ml | 0 .../8-compiler}/compiler_environment.ml | 0 .../8-compiler}/compiler_program.ml | 0 .../8-compiler}/compiler_type.ml | 0 .../compiler => passes/8-compiler}/dune | 0 .../8-compiler}/uncompiler.ml | 0 src/run/{main => }/display.ml | 0 src/run/{main => }/dune | 0 src/run/{main => }/main.ml | 0 src/run/{main => }/run_mini_c.ml | 0 src/run/{main => }/run_simplified.ml | 0 src/run/{main => }/run_source.ml | 0 src/run/{main => }/run_typed.ml | 0 src/stages/ast_simplified/PP.ml | 2 +- src/stages/ast_simplified/combinators.ml | 93 +++++++------ src/stages/ast_simplified/misc.ml | 2 +- src/stages/ast_simplified/types.ml | 5 +- test/.merlin | 98 +++++++------- test/coase_tests.ml | 4 +- test/dune | 17 +++ 134 files changed, 340 insertions(+), 173 deletions(-) rename src/passes/{parser => 1-parser}/camligo/.gitignore (100%) rename src/passes/{parser => 1-parser}/camligo/ast.ml (100%) rename src/passes/{parser => 1-parser}/camligo/dune (100%) rename src/passes/{parser => 1-parser}/camligo/generator.ml (100%) rename src/passes/{parser => 1-parser}/camligo/lex/dune (100%) rename src/passes/{parser => 1-parser}/camligo/lex/generator.ml (100%) rename src/passes/{parser => 1-parser}/camligo/location.ml (100%) rename src/passes/{parser => 1-parser}/camligo/parser_camligo.ml (100%) rename src/passes/{parser => 1-parser}/camligo/pre_parser.mly (100%) rename src/passes/{parser => 1-parser}/camligo/user.ml (100%) rename src/passes/{parser => 1-parser}/dune (100%) rename src/passes/{parser => 1-parser}/generator/doc/essai.ml (100%) rename src/passes/{parser => 1-parser}/generator/doc/mini_ml.bnf (100%) rename src/passes/{parser => 1-parser}/generator/doc/mini_ml2.bnf (100%) rename src/passes/{parser => 1-parser}/generator/doc/mini_ml3.bnf (100%) rename src/passes/{parser => 1-parser}/generator/doc/mini_ml4.bnf (100%) rename src/passes/{parser => 1-parser}/ligodity.ml (100%) rename src/passes/{parser => 1-parser}/ligodity/.AST.ml.tag (100%) rename src/passes/{parser => 1-parser}/ligodity/.Eval.ml.tag (100%) rename src/passes/{parser => 1-parser}/ligodity/.EvalMain.ml.tag (100%) rename src/passes/{parser => 1-parser}/ligodity/.Lexer.ml.tag (100%) rename src/passes/{parser => 1-parser}/ligodity/.LexerMain.tag (100%) rename src/passes/{parser => 1-parser}/ligodity/.Parser.ml.tag (100%) rename src/passes/{parser => 1-parser}/ligodity/.Parser.mly.tag (100%) rename src/passes/{parser => 1-parser}/ligodity/.ParserMain.tag (100%) rename src/passes/{parser => 1-parser}/ligodity/.links (100%) rename src/passes/{parser => 1-parser}/ligodity/AST.ml (100%) rename src/passes/{parser => 1-parser}/ligodity/AST.mli (100%) rename src/passes/{parser => 1-parser}/ligodity/EvalOpt.ml (100%) rename src/passes/{parser => 1-parser}/ligodity/EvalOpt.mli (100%) rename src/passes/{parser => 1-parser}/ligodity/Lexer.mli (100%) rename src/passes/{parser => 1-parser}/ligodity/Lexer.mll (100%) rename src/passes/{parser => 1-parser}/ligodity/LexerMain.ml (100%) rename src/passes/{parser => 1-parser}/ligodity/ParToken.mly (100%) rename src/passes/{parser => 1-parser}/ligodity/Parser.mly (100%) rename src/passes/{parser => 1-parser}/ligodity/ParserMain.ml (100%) rename src/passes/{parser => 1-parser}/ligodity/Stubs/Simple_utils.ml (100%) rename src/passes/{parser => 1-parser}/ligodity/Tests/match.mml (100%) rename src/passes/{parser => 1-parser}/ligodity/Token.ml (100%) rename src/passes/{parser => 1-parser}/ligodity/Token.mli (100%) rename src/passes/{parser => 1-parser}/ligodity/Utils.ml (100%) rename src/passes/{parser => 1-parser}/ligodity/Utils.mli (100%) rename src/passes/{parser => 1-parser}/ligodity/check_dot_git_is_dir.sh (100%) rename src/passes/{parser => 1-parser}/ligodity/dune (100%) rename src/passes/{parser => 1-parser}/ligodity/ligodity.ml (100%) rename src/passes/{parser => 1-parser}/parser.ml (100%) rename src/passes/{parser => 1-parser}/pascaligo.ml (100%) rename src/passes/{parser => 1-parser}/pascaligo/.Lexer.ml.tag (100%) rename src/passes/{parser => 1-parser}/pascaligo/.LexerMain.tag (100%) rename src/passes/{parser => 1-parser}/pascaligo/.Parser.mly.tag (100%) rename src/passes/{parser => 1-parser}/pascaligo/.ParserMain.tag (100%) rename src/passes/{parser => 1-parser}/pascaligo/.gitignore (100%) rename src/passes/{parser => 1-parser}/pascaligo/.links (100%) rename src/passes/{parser => 1-parser}/pascaligo/AST.ml (100%) rename src/passes/{parser => 1-parser}/pascaligo/AST.mli (100%) rename src/passes/{parser => 1-parser}/pascaligo/Doc/pascaligo.txt (100%) rename src/passes/{parser => 1-parser}/pascaligo/Doc/pascaligo_01.bnf (100%) rename src/passes/{parser => 1-parser}/pascaligo/Doc/pascaligo_02.bnf (100%) rename src/passes/{parser => 1-parser}/pascaligo/Doc/pascaligo_03.bnf (100%) rename src/passes/{parser => 1-parser}/pascaligo/Doc/pascaligo_04.bnf (100%) rename src/passes/{parser => 1-parser}/pascaligo/Doc/pascaligo_05.bnf (100%) rename src/passes/{parser => 1-parser}/pascaligo/Doc/pascaligo_06.bnf (100%) rename src/passes/{parser => 1-parser}/pascaligo/Doc/pascaligo_07.bnf (100%) rename src/passes/{parser => 1-parser}/pascaligo/Doc/pascaligo_08.bnf (100%) rename src/passes/{parser => 1-parser}/pascaligo/Doc/pascaligo_09.bnf (100%) rename src/passes/{parser => 1-parser}/pascaligo/Doc/pascaligo_10.bnf (100%) rename src/passes/{parser => 1-parser}/pascaligo/Doc/pascaligo_11.bnf (100%) rename src/passes/{parser => 1-parser}/pascaligo/Doc/pascaligo_12.bnf (100%) rename src/passes/{parser => 1-parser}/pascaligo/LexToken.mli (100%) rename src/passes/{parser => 1-parser}/pascaligo/LexToken.mll (100%) rename src/passes/{parser => 1-parser}/pascaligo/LexerMain.ml (100%) rename src/passes/{parser => 1-parser}/pascaligo/ParToken.mly (100%) rename src/passes/{parser => 1-parser}/pascaligo/Parser.mly (100%) rename src/passes/{parser => 1-parser}/pascaligo/ParserLog.ml (100%) rename src/passes/{parser => 1-parser}/pascaligo/ParserLog.mli (100%) rename src/passes/{parser => 1-parser}/pascaligo/ParserMain.ml (100%) rename src/passes/{parser => 1-parser}/pascaligo/Stubs/Simple_utils.ml (100%) rename src/passes/{parser => 1-parser}/pascaligo/Tests/a.ligo (100%) rename src/passes/{parser => 1-parser}/pascaligo/Tests/crowdfunding.ligo (100%) rename src/passes/{parser => 1-parser}/pascaligo/check_dot_git_is_dir.sh (100%) rename src/passes/{parser => 1-parser}/pascaligo/dune (100%) rename src/passes/{parser => 1-parser}/pascaligo/pascaligo.ml (100%) rename src/passes/{parser => 1-parser}/shared/.links (100%) rename src/passes/{parser => 1-parser}/shared/Doc/shared.txt (100%) rename src/passes/{parser => 1-parser}/shared/Error.mli (100%) rename src/passes/{parser => 1-parser}/shared/EvalOpt.ml (100%) rename src/passes/{parser => 1-parser}/shared/EvalOpt.mli (100%) rename src/passes/{parser => 1-parser}/shared/FQueue.ml (100%) rename src/passes/{parser => 1-parser}/shared/FQueue.mli (100%) rename src/passes/{parser => 1-parser}/shared/Lexer.mli (100%) rename src/passes/{parser => 1-parser}/shared/Lexer.mll (100%) rename src/passes/{parser => 1-parser}/shared/LexerLog.ml (100%) rename src/passes/{parser => 1-parser}/shared/LexerLog.mli (100%) rename src/passes/{parser => 1-parser}/shared/Markup.ml (100%) rename src/passes/{parser => 1-parser}/shared/Markup.mli (100%) rename src/passes/{parser => 1-parser}/shared/Utils.ml (100%) rename src/passes/{parser => 1-parser}/shared/Utils.mli (100%) rename src/passes/{parser => 1-parser}/shared/dune (100%) rename src/passes/{simplify => 2-simplify}/camligo.ml.old (100%) rename src/passes/{simplify => 2-simplify}/dune (100%) rename src/passes/{simplify => 2-simplify}/ligodity.ml (99%) rename src/passes/{simplify => 2-simplify}/pascaligo.ml (94%) rename src/passes/{simplify => 2-simplify}/simplify.ml (100%) create mode 100644 src/passes/3-self_ast_simplified/dune create mode 100644 src/passes/3-self_ast_simplified/helpers.ml create mode 100644 src/passes/3-self_ast_simplified/main.ml create mode 100644 src/passes/3-self_ast_simplified/self_ast_simplified.ml create mode 100644 src/passes/3-self_ast_simplified/tezos_type_annotation.ml rename src/passes/{typer => 4-typer}/dune (100%) rename src/passes/{typer => 4-typer}/typer.ml (98%) rename src/{stages/transpiler => passes/6-transpiler}/dune (100%) rename src/{stages/transpiler => passes/6-transpiler}/transpiler.ml (100%) rename src/{stages/compiler => passes/8-compiler}/compiler.ml (100%) rename src/{stages/compiler => passes/8-compiler}/compiler_environment.ml (100%) rename src/{stages/compiler => passes/8-compiler}/compiler_program.ml (100%) rename src/{stages/compiler => passes/8-compiler}/compiler_type.ml (100%) rename src/{stages/compiler => passes/8-compiler}/dune (100%) rename src/{stages/compiler => passes/8-compiler}/uncompiler.ml (100%) rename src/run/{main => }/display.ml (100%) rename src/run/{main => }/dune (100%) rename src/run/{main => }/main.ml (100%) rename src/run/{main => }/run_mini_c.ml (100%) rename src/run/{main => }/run_simplified.ml (100%) rename src/run/{main => }/run_source.ml (100%) rename src/run/{main => }/run_typed.ml (100%) diff --git a/.gitignore b/.gitignore index 52f26081e..25b63a08d 100644 --- a/.gitignore +++ b/.gitignore @@ -1,6 +1,7 @@ /_build/ /dune-project *~ +*.merlin cache/* Version.ml /_opam/ diff --git a/src/dune b/src/dune index c2f58b54f..de5be01e6 100644 --- a/src/dune +++ b/src/dune @@ -12,20 +12,3 @@ (pps ppx_let) ) ) - -(alias - (name ligo-test) - (action (run test/test.exe)) - (deps (glob_files contracts/*)) -) - -(alias - (name runtest) - (deps (alias ligo-test)) -) - -(alias - (name manual-test) - (action (run test/manual_test.exe)) - (deps (glob_files contracts/*)) -) diff --git a/src/passes/parser/camligo/.gitignore b/src/passes/1-parser/camligo/.gitignore similarity index 100% rename from src/passes/parser/camligo/.gitignore rename to src/passes/1-parser/camligo/.gitignore diff --git a/src/passes/parser/camligo/ast.ml b/src/passes/1-parser/camligo/ast.ml similarity index 100% rename from src/passes/parser/camligo/ast.ml rename to src/passes/1-parser/camligo/ast.ml diff --git a/src/passes/parser/camligo/dune b/src/passes/1-parser/camligo/dune similarity index 100% rename from src/passes/parser/camligo/dune rename to src/passes/1-parser/camligo/dune diff --git a/src/passes/parser/camligo/generator.ml b/src/passes/1-parser/camligo/generator.ml similarity index 100% rename from src/passes/parser/camligo/generator.ml rename to src/passes/1-parser/camligo/generator.ml diff --git a/src/passes/parser/camligo/lex/dune b/src/passes/1-parser/camligo/lex/dune similarity index 100% rename from src/passes/parser/camligo/lex/dune rename to src/passes/1-parser/camligo/lex/dune diff --git a/src/passes/parser/camligo/lex/generator.ml b/src/passes/1-parser/camligo/lex/generator.ml similarity index 100% rename from src/passes/parser/camligo/lex/generator.ml rename to src/passes/1-parser/camligo/lex/generator.ml diff --git a/src/passes/parser/camligo/location.ml b/src/passes/1-parser/camligo/location.ml similarity index 100% rename from src/passes/parser/camligo/location.ml rename to src/passes/1-parser/camligo/location.ml diff --git a/src/passes/parser/camligo/parser_camligo.ml b/src/passes/1-parser/camligo/parser_camligo.ml similarity index 100% rename from src/passes/parser/camligo/parser_camligo.ml rename to src/passes/1-parser/camligo/parser_camligo.ml diff --git a/src/passes/parser/camligo/pre_parser.mly b/src/passes/1-parser/camligo/pre_parser.mly similarity index 100% rename from src/passes/parser/camligo/pre_parser.mly rename to src/passes/1-parser/camligo/pre_parser.mly diff --git a/src/passes/parser/camligo/user.ml b/src/passes/1-parser/camligo/user.ml similarity index 100% rename from src/passes/parser/camligo/user.ml rename to src/passes/1-parser/camligo/user.ml diff --git a/src/passes/parser/dune b/src/passes/1-parser/dune similarity index 100% rename from src/passes/parser/dune rename to src/passes/1-parser/dune diff --git a/src/passes/parser/generator/doc/essai.ml b/src/passes/1-parser/generator/doc/essai.ml similarity index 100% rename from src/passes/parser/generator/doc/essai.ml rename to src/passes/1-parser/generator/doc/essai.ml diff --git a/src/passes/parser/generator/doc/mini_ml.bnf b/src/passes/1-parser/generator/doc/mini_ml.bnf similarity index 100% rename from src/passes/parser/generator/doc/mini_ml.bnf rename to src/passes/1-parser/generator/doc/mini_ml.bnf diff --git a/src/passes/parser/generator/doc/mini_ml2.bnf b/src/passes/1-parser/generator/doc/mini_ml2.bnf similarity index 100% rename from src/passes/parser/generator/doc/mini_ml2.bnf rename to src/passes/1-parser/generator/doc/mini_ml2.bnf diff --git a/src/passes/parser/generator/doc/mini_ml3.bnf b/src/passes/1-parser/generator/doc/mini_ml3.bnf similarity index 100% rename from src/passes/parser/generator/doc/mini_ml3.bnf rename to src/passes/1-parser/generator/doc/mini_ml3.bnf diff --git a/src/passes/parser/generator/doc/mini_ml4.bnf b/src/passes/1-parser/generator/doc/mini_ml4.bnf similarity index 100% rename from src/passes/parser/generator/doc/mini_ml4.bnf rename to src/passes/1-parser/generator/doc/mini_ml4.bnf diff --git a/src/passes/parser/ligodity.ml b/src/passes/1-parser/ligodity.ml similarity index 100% rename from src/passes/parser/ligodity.ml rename to src/passes/1-parser/ligodity.ml diff --git a/src/passes/parser/ligodity/.AST.ml.tag b/src/passes/1-parser/ligodity/.AST.ml.tag similarity index 100% rename from src/passes/parser/ligodity/.AST.ml.tag rename to src/passes/1-parser/ligodity/.AST.ml.tag diff --git a/src/passes/parser/ligodity/.Eval.ml.tag b/src/passes/1-parser/ligodity/.Eval.ml.tag similarity index 100% rename from src/passes/parser/ligodity/.Eval.ml.tag rename to src/passes/1-parser/ligodity/.Eval.ml.tag diff --git a/src/passes/parser/ligodity/.EvalMain.ml.tag b/src/passes/1-parser/ligodity/.EvalMain.ml.tag similarity index 100% rename from src/passes/parser/ligodity/.EvalMain.ml.tag rename to src/passes/1-parser/ligodity/.EvalMain.ml.tag diff --git a/src/passes/parser/ligodity/.Lexer.ml.tag b/src/passes/1-parser/ligodity/.Lexer.ml.tag similarity index 100% rename from src/passes/parser/ligodity/.Lexer.ml.tag rename to src/passes/1-parser/ligodity/.Lexer.ml.tag diff --git a/src/passes/parser/ligodity/.LexerMain.tag b/src/passes/1-parser/ligodity/.LexerMain.tag similarity index 100% rename from src/passes/parser/ligodity/.LexerMain.tag rename to src/passes/1-parser/ligodity/.LexerMain.tag diff --git a/src/passes/parser/ligodity/.Parser.ml.tag b/src/passes/1-parser/ligodity/.Parser.ml.tag similarity index 100% rename from src/passes/parser/ligodity/.Parser.ml.tag rename to src/passes/1-parser/ligodity/.Parser.ml.tag diff --git a/src/passes/parser/ligodity/.Parser.mly.tag b/src/passes/1-parser/ligodity/.Parser.mly.tag similarity index 100% rename from src/passes/parser/ligodity/.Parser.mly.tag rename to src/passes/1-parser/ligodity/.Parser.mly.tag diff --git a/src/passes/parser/ligodity/.ParserMain.tag b/src/passes/1-parser/ligodity/.ParserMain.tag similarity index 100% rename from src/passes/parser/ligodity/.ParserMain.tag rename to src/passes/1-parser/ligodity/.ParserMain.tag diff --git a/src/passes/parser/ligodity/.links b/src/passes/1-parser/ligodity/.links similarity index 100% rename from src/passes/parser/ligodity/.links rename to src/passes/1-parser/ligodity/.links diff --git a/src/passes/parser/ligodity/AST.ml b/src/passes/1-parser/ligodity/AST.ml similarity index 100% rename from src/passes/parser/ligodity/AST.ml rename to src/passes/1-parser/ligodity/AST.ml diff --git a/src/passes/parser/ligodity/AST.mli b/src/passes/1-parser/ligodity/AST.mli similarity index 100% rename from src/passes/parser/ligodity/AST.mli rename to src/passes/1-parser/ligodity/AST.mli diff --git a/src/passes/parser/ligodity/EvalOpt.ml b/src/passes/1-parser/ligodity/EvalOpt.ml similarity index 100% rename from src/passes/parser/ligodity/EvalOpt.ml rename to src/passes/1-parser/ligodity/EvalOpt.ml diff --git a/src/passes/parser/ligodity/EvalOpt.mli b/src/passes/1-parser/ligodity/EvalOpt.mli similarity index 100% rename from src/passes/parser/ligodity/EvalOpt.mli rename to src/passes/1-parser/ligodity/EvalOpt.mli diff --git a/src/passes/parser/ligodity/Lexer.mli b/src/passes/1-parser/ligodity/Lexer.mli similarity index 100% rename from src/passes/parser/ligodity/Lexer.mli rename to src/passes/1-parser/ligodity/Lexer.mli diff --git a/src/passes/parser/ligodity/Lexer.mll b/src/passes/1-parser/ligodity/Lexer.mll similarity index 100% rename from src/passes/parser/ligodity/Lexer.mll rename to src/passes/1-parser/ligodity/Lexer.mll diff --git a/src/passes/parser/ligodity/LexerMain.ml b/src/passes/1-parser/ligodity/LexerMain.ml similarity index 100% rename from src/passes/parser/ligodity/LexerMain.ml rename to src/passes/1-parser/ligodity/LexerMain.ml diff --git a/src/passes/parser/ligodity/ParToken.mly b/src/passes/1-parser/ligodity/ParToken.mly similarity index 100% rename from src/passes/parser/ligodity/ParToken.mly rename to src/passes/1-parser/ligodity/ParToken.mly diff --git a/src/passes/parser/ligodity/Parser.mly b/src/passes/1-parser/ligodity/Parser.mly similarity index 100% rename from src/passes/parser/ligodity/Parser.mly rename to src/passes/1-parser/ligodity/Parser.mly diff --git a/src/passes/parser/ligodity/ParserMain.ml b/src/passes/1-parser/ligodity/ParserMain.ml similarity index 100% rename from src/passes/parser/ligodity/ParserMain.ml rename to src/passes/1-parser/ligodity/ParserMain.ml diff --git a/src/passes/parser/ligodity/Stubs/Simple_utils.ml b/src/passes/1-parser/ligodity/Stubs/Simple_utils.ml similarity index 100% rename from src/passes/parser/ligodity/Stubs/Simple_utils.ml rename to src/passes/1-parser/ligodity/Stubs/Simple_utils.ml diff --git a/src/passes/parser/ligodity/Tests/match.mml b/src/passes/1-parser/ligodity/Tests/match.mml similarity index 100% rename from src/passes/parser/ligodity/Tests/match.mml rename to src/passes/1-parser/ligodity/Tests/match.mml diff --git a/src/passes/parser/ligodity/Token.ml b/src/passes/1-parser/ligodity/Token.ml similarity index 100% rename from src/passes/parser/ligodity/Token.ml rename to src/passes/1-parser/ligodity/Token.ml diff --git a/src/passes/parser/ligodity/Token.mli b/src/passes/1-parser/ligodity/Token.mli similarity index 100% rename from src/passes/parser/ligodity/Token.mli rename to src/passes/1-parser/ligodity/Token.mli diff --git a/src/passes/parser/ligodity/Utils.ml b/src/passes/1-parser/ligodity/Utils.ml similarity index 100% rename from src/passes/parser/ligodity/Utils.ml rename to src/passes/1-parser/ligodity/Utils.ml diff --git a/src/passes/parser/ligodity/Utils.mli b/src/passes/1-parser/ligodity/Utils.mli similarity index 100% rename from src/passes/parser/ligodity/Utils.mli rename to src/passes/1-parser/ligodity/Utils.mli diff --git a/src/passes/parser/ligodity/check_dot_git_is_dir.sh b/src/passes/1-parser/ligodity/check_dot_git_is_dir.sh similarity index 100% rename from src/passes/parser/ligodity/check_dot_git_is_dir.sh rename to src/passes/1-parser/ligodity/check_dot_git_is_dir.sh diff --git a/src/passes/parser/ligodity/dune b/src/passes/1-parser/ligodity/dune similarity index 100% rename from src/passes/parser/ligodity/dune rename to src/passes/1-parser/ligodity/dune diff --git a/src/passes/parser/ligodity/ligodity.ml b/src/passes/1-parser/ligodity/ligodity.ml similarity index 100% rename from src/passes/parser/ligodity/ligodity.ml rename to src/passes/1-parser/ligodity/ligodity.ml diff --git a/src/passes/parser/parser.ml b/src/passes/1-parser/parser.ml similarity index 100% rename from src/passes/parser/parser.ml rename to src/passes/1-parser/parser.ml diff --git a/src/passes/parser/pascaligo.ml b/src/passes/1-parser/pascaligo.ml similarity index 100% rename from src/passes/parser/pascaligo.ml rename to src/passes/1-parser/pascaligo.ml diff --git a/src/passes/parser/pascaligo/.Lexer.ml.tag b/src/passes/1-parser/pascaligo/.Lexer.ml.tag similarity index 100% rename from src/passes/parser/pascaligo/.Lexer.ml.tag rename to src/passes/1-parser/pascaligo/.Lexer.ml.tag diff --git a/src/passes/parser/pascaligo/.LexerMain.tag b/src/passes/1-parser/pascaligo/.LexerMain.tag similarity index 100% rename from src/passes/parser/pascaligo/.LexerMain.tag rename to src/passes/1-parser/pascaligo/.LexerMain.tag diff --git a/src/passes/parser/pascaligo/.Parser.mly.tag b/src/passes/1-parser/pascaligo/.Parser.mly.tag similarity index 100% rename from src/passes/parser/pascaligo/.Parser.mly.tag rename to src/passes/1-parser/pascaligo/.Parser.mly.tag diff --git a/src/passes/parser/pascaligo/.ParserMain.tag b/src/passes/1-parser/pascaligo/.ParserMain.tag similarity index 100% rename from src/passes/parser/pascaligo/.ParserMain.tag rename to src/passes/1-parser/pascaligo/.ParserMain.tag diff --git a/src/passes/parser/pascaligo/.gitignore b/src/passes/1-parser/pascaligo/.gitignore similarity index 100% rename from src/passes/parser/pascaligo/.gitignore rename to src/passes/1-parser/pascaligo/.gitignore diff --git a/src/passes/parser/pascaligo/.links b/src/passes/1-parser/pascaligo/.links similarity index 100% rename from src/passes/parser/pascaligo/.links rename to src/passes/1-parser/pascaligo/.links diff --git a/src/passes/parser/pascaligo/AST.ml b/src/passes/1-parser/pascaligo/AST.ml similarity index 100% rename from src/passes/parser/pascaligo/AST.ml rename to src/passes/1-parser/pascaligo/AST.ml diff --git a/src/passes/parser/pascaligo/AST.mli b/src/passes/1-parser/pascaligo/AST.mli similarity index 100% rename from src/passes/parser/pascaligo/AST.mli rename to src/passes/1-parser/pascaligo/AST.mli diff --git a/src/passes/parser/pascaligo/Doc/pascaligo.txt b/src/passes/1-parser/pascaligo/Doc/pascaligo.txt similarity index 100% rename from src/passes/parser/pascaligo/Doc/pascaligo.txt rename to src/passes/1-parser/pascaligo/Doc/pascaligo.txt diff --git a/src/passes/parser/pascaligo/Doc/pascaligo_01.bnf b/src/passes/1-parser/pascaligo/Doc/pascaligo_01.bnf similarity index 100% rename from src/passes/parser/pascaligo/Doc/pascaligo_01.bnf rename to src/passes/1-parser/pascaligo/Doc/pascaligo_01.bnf diff --git a/src/passes/parser/pascaligo/Doc/pascaligo_02.bnf b/src/passes/1-parser/pascaligo/Doc/pascaligo_02.bnf similarity index 100% rename from src/passes/parser/pascaligo/Doc/pascaligo_02.bnf rename to src/passes/1-parser/pascaligo/Doc/pascaligo_02.bnf diff --git a/src/passes/parser/pascaligo/Doc/pascaligo_03.bnf b/src/passes/1-parser/pascaligo/Doc/pascaligo_03.bnf similarity index 100% rename from src/passes/parser/pascaligo/Doc/pascaligo_03.bnf rename to src/passes/1-parser/pascaligo/Doc/pascaligo_03.bnf diff --git a/src/passes/parser/pascaligo/Doc/pascaligo_04.bnf b/src/passes/1-parser/pascaligo/Doc/pascaligo_04.bnf similarity index 100% rename from src/passes/parser/pascaligo/Doc/pascaligo_04.bnf rename to src/passes/1-parser/pascaligo/Doc/pascaligo_04.bnf diff --git a/src/passes/parser/pascaligo/Doc/pascaligo_05.bnf b/src/passes/1-parser/pascaligo/Doc/pascaligo_05.bnf similarity index 100% rename from src/passes/parser/pascaligo/Doc/pascaligo_05.bnf rename to src/passes/1-parser/pascaligo/Doc/pascaligo_05.bnf diff --git a/src/passes/parser/pascaligo/Doc/pascaligo_06.bnf b/src/passes/1-parser/pascaligo/Doc/pascaligo_06.bnf similarity index 100% rename from src/passes/parser/pascaligo/Doc/pascaligo_06.bnf rename to src/passes/1-parser/pascaligo/Doc/pascaligo_06.bnf diff --git a/src/passes/parser/pascaligo/Doc/pascaligo_07.bnf b/src/passes/1-parser/pascaligo/Doc/pascaligo_07.bnf similarity index 100% rename from src/passes/parser/pascaligo/Doc/pascaligo_07.bnf rename to src/passes/1-parser/pascaligo/Doc/pascaligo_07.bnf diff --git a/src/passes/parser/pascaligo/Doc/pascaligo_08.bnf b/src/passes/1-parser/pascaligo/Doc/pascaligo_08.bnf similarity index 100% rename from src/passes/parser/pascaligo/Doc/pascaligo_08.bnf rename to src/passes/1-parser/pascaligo/Doc/pascaligo_08.bnf diff --git a/src/passes/parser/pascaligo/Doc/pascaligo_09.bnf b/src/passes/1-parser/pascaligo/Doc/pascaligo_09.bnf similarity index 100% rename from src/passes/parser/pascaligo/Doc/pascaligo_09.bnf rename to src/passes/1-parser/pascaligo/Doc/pascaligo_09.bnf diff --git a/src/passes/parser/pascaligo/Doc/pascaligo_10.bnf b/src/passes/1-parser/pascaligo/Doc/pascaligo_10.bnf similarity index 100% rename from src/passes/parser/pascaligo/Doc/pascaligo_10.bnf rename to src/passes/1-parser/pascaligo/Doc/pascaligo_10.bnf diff --git a/src/passes/parser/pascaligo/Doc/pascaligo_11.bnf b/src/passes/1-parser/pascaligo/Doc/pascaligo_11.bnf similarity index 100% rename from src/passes/parser/pascaligo/Doc/pascaligo_11.bnf rename to src/passes/1-parser/pascaligo/Doc/pascaligo_11.bnf diff --git a/src/passes/parser/pascaligo/Doc/pascaligo_12.bnf b/src/passes/1-parser/pascaligo/Doc/pascaligo_12.bnf similarity index 100% rename from src/passes/parser/pascaligo/Doc/pascaligo_12.bnf rename to src/passes/1-parser/pascaligo/Doc/pascaligo_12.bnf diff --git a/src/passes/parser/pascaligo/LexToken.mli b/src/passes/1-parser/pascaligo/LexToken.mli similarity index 100% rename from src/passes/parser/pascaligo/LexToken.mli rename to src/passes/1-parser/pascaligo/LexToken.mli diff --git a/src/passes/parser/pascaligo/LexToken.mll b/src/passes/1-parser/pascaligo/LexToken.mll similarity index 100% rename from src/passes/parser/pascaligo/LexToken.mll rename to src/passes/1-parser/pascaligo/LexToken.mll diff --git a/src/passes/parser/pascaligo/LexerMain.ml b/src/passes/1-parser/pascaligo/LexerMain.ml similarity index 100% rename from src/passes/parser/pascaligo/LexerMain.ml rename to src/passes/1-parser/pascaligo/LexerMain.ml diff --git a/src/passes/parser/pascaligo/ParToken.mly b/src/passes/1-parser/pascaligo/ParToken.mly similarity index 100% rename from src/passes/parser/pascaligo/ParToken.mly rename to src/passes/1-parser/pascaligo/ParToken.mly diff --git a/src/passes/parser/pascaligo/Parser.mly b/src/passes/1-parser/pascaligo/Parser.mly similarity index 100% rename from src/passes/parser/pascaligo/Parser.mly rename to src/passes/1-parser/pascaligo/Parser.mly diff --git a/src/passes/parser/pascaligo/ParserLog.ml b/src/passes/1-parser/pascaligo/ParserLog.ml similarity index 100% rename from src/passes/parser/pascaligo/ParserLog.ml rename to src/passes/1-parser/pascaligo/ParserLog.ml diff --git a/src/passes/parser/pascaligo/ParserLog.mli b/src/passes/1-parser/pascaligo/ParserLog.mli similarity index 100% rename from src/passes/parser/pascaligo/ParserLog.mli rename to src/passes/1-parser/pascaligo/ParserLog.mli diff --git a/src/passes/parser/pascaligo/ParserMain.ml b/src/passes/1-parser/pascaligo/ParserMain.ml similarity index 100% rename from src/passes/parser/pascaligo/ParserMain.ml rename to src/passes/1-parser/pascaligo/ParserMain.ml diff --git a/src/passes/parser/pascaligo/Stubs/Simple_utils.ml b/src/passes/1-parser/pascaligo/Stubs/Simple_utils.ml similarity index 100% rename from src/passes/parser/pascaligo/Stubs/Simple_utils.ml rename to src/passes/1-parser/pascaligo/Stubs/Simple_utils.ml diff --git a/src/passes/parser/pascaligo/Tests/a.ligo b/src/passes/1-parser/pascaligo/Tests/a.ligo similarity index 100% rename from src/passes/parser/pascaligo/Tests/a.ligo rename to src/passes/1-parser/pascaligo/Tests/a.ligo diff --git a/src/passes/parser/pascaligo/Tests/crowdfunding.ligo b/src/passes/1-parser/pascaligo/Tests/crowdfunding.ligo similarity index 100% rename from src/passes/parser/pascaligo/Tests/crowdfunding.ligo rename to src/passes/1-parser/pascaligo/Tests/crowdfunding.ligo diff --git a/src/passes/parser/pascaligo/check_dot_git_is_dir.sh b/src/passes/1-parser/pascaligo/check_dot_git_is_dir.sh similarity index 100% rename from src/passes/parser/pascaligo/check_dot_git_is_dir.sh rename to src/passes/1-parser/pascaligo/check_dot_git_is_dir.sh diff --git a/src/passes/parser/pascaligo/dune b/src/passes/1-parser/pascaligo/dune similarity index 100% rename from src/passes/parser/pascaligo/dune rename to src/passes/1-parser/pascaligo/dune diff --git a/src/passes/parser/pascaligo/pascaligo.ml b/src/passes/1-parser/pascaligo/pascaligo.ml similarity index 100% rename from src/passes/parser/pascaligo/pascaligo.ml rename to src/passes/1-parser/pascaligo/pascaligo.ml diff --git a/src/passes/parser/shared/.links b/src/passes/1-parser/shared/.links similarity index 100% rename from src/passes/parser/shared/.links rename to src/passes/1-parser/shared/.links diff --git a/src/passes/parser/shared/Doc/shared.txt b/src/passes/1-parser/shared/Doc/shared.txt similarity index 100% rename from src/passes/parser/shared/Doc/shared.txt rename to src/passes/1-parser/shared/Doc/shared.txt diff --git a/src/passes/parser/shared/Error.mli b/src/passes/1-parser/shared/Error.mli similarity index 100% rename from src/passes/parser/shared/Error.mli rename to src/passes/1-parser/shared/Error.mli diff --git a/src/passes/parser/shared/EvalOpt.ml b/src/passes/1-parser/shared/EvalOpt.ml similarity index 100% rename from src/passes/parser/shared/EvalOpt.ml rename to src/passes/1-parser/shared/EvalOpt.ml diff --git a/src/passes/parser/shared/EvalOpt.mli b/src/passes/1-parser/shared/EvalOpt.mli similarity index 100% rename from src/passes/parser/shared/EvalOpt.mli rename to src/passes/1-parser/shared/EvalOpt.mli diff --git a/src/passes/parser/shared/FQueue.ml b/src/passes/1-parser/shared/FQueue.ml similarity index 100% rename from src/passes/parser/shared/FQueue.ml rename to src/passes/1-parser/shared/FQueue.ml diff --git a/src/passes/parser/shared/FQueue.mli b/src/passes/1-parser/shared/FQueue.mli similarity index 100% rename from src/passes/parser/shared/FQueue.mli rename to src/passes/1-parser/shared/FQueue.mli diff --git a/src/passes/parser/shared/Lexer.mli b/src/passes/1-parser/shared/Lexer.mli similarity index 100% rename from src/passes/parser/shared/Lexer.mli rename to src/passes/1-parser/shared/Lexer.mli diff --git a/src/passes/parser/shared/Lexer.mll b/src/passes/1-parser/shared/Lexer.mll similarity index 100% rename from src/passes/parser/shared/Lexer.mll rename to src/passes/1-parser/shared/Lexer.mll diff --git a/src/passes/parser/shared/LexerLog.ml b/src/passes/1-parser/shared/LexerLog.ml similarity index 100% rename from src/passes/parser/shared/LexerLog.ml rename to src/passes/1-parser/shared/LexerLog.ml diff --git a/src/passes/parser/shared/LexerLog.mli b/src/passes/1-parser/shared/LexerLog.mli similarity index 100% rename from src/passes/parser/shared/LexerLog.mli rename to src/passes/1-parser/shared/LexerLog.mli diff --git a/src/passes/parser/shared/Markup.ml b/src/passes/1-parser/shared/Markup.ml similarity index 100% rename from src/passes/parser/shared/Markup.ml rename to src/passes/1-parser/shared/Markup.ml diff --git a/src/passes/parser/shared/Markup.mli b/src/passes/1-parser/shared/Markup.mli similarity index 100% rename from src/passes/parser/shared/Markup.mli rename to src/passes/1-parser/shared/Markup.mli diff --git a/src/passes/parser/shared/Utils.ml b/src/passes/1-parser/shared/Utils.ml similarity index 100% rename from src/passes/parser/shared/Utils.ml rename to src/passes/1-parser/shared/Utils.ml diff --git a/src/passes/parser/shared/Utils.mli b/src/passes/1-parser/shared/Utils.mli similarity index 100% rename from src/passes/parser/shared/Utils.mli rename to src/passes/1-parser/shared/Utils.mli diff --git a/src/passes/parser/shared/dune b/src/passes/1-parser/shared/dune similarity index 100% rename from src/passes/parser/shared/dune rename to src/passes/1-parser/shared/dune diff --git a/src/passes/simplify/camligo.ml.old b/src/passes/2-simplify/camligo.ml.old similarity index 100% rename from src/passes/simplify/camligo.ml.old rename to src/passes/2-simplify/camligo.ml.old diff --git a/src/passes/simplify/dune b/src/passes/2-simplify/dune similarity index 100% rename from src/passes/simplify/dune rename to src/passes/2-simplify/dune diff --git a/src/passes/simplify/ligodity.ml b/src/passes/2-simplify/ligodity.ml similarity index 99% rename from src/passes/simplify/ligodity.ml rename to src/passes/2-simplify/ligodity.ml index 34866fd91..10a9b346a 100644 --- a/src/passes/simplify/ligodity.ml +++ b/src/passes/2-simplify/ligodity.ml @@ -162,7 +162,6 @@ module Errors = struct let message () = "a map definition is a list of pairs" in info title message - let corner_case ~loc message = let title () = "corner case" in let content () = "We don't have a good error message for this case. \ diff --git a/src/passes/simplify/pascaligo.ml b/src/passes/2-simplify/pascaligo.ml similarity index 94% rename from src/passes/simplify/pascaligo.ml rename to src/passes/2-simplify/pascaligo.ml index 4aeab4d2a..92250a149 100644 --- a/src/passes/simplify/pascaligo.ml +++ b/src/passes/2-simplify/pascaligo.ml @@ -301,17 +301,31 @@ open Operators.Simplify.Pascaligo let r_split = Location.r_split -let return expr = ok @@ fun expr'_opt -> - let expr = expr in - match expr'_opt with - | None -> ok @@ expr - | Some expr' -> ok @@ e_sequence expr expr' +(* + Statements can't be simplified in isolation. `a ; b ; c` can get simplified either + as `let x = expr in (b ; c)` if `a` is a ` const x = expr` declaration or as + `sequence(a , sequence(b , c))` for everything else. + Because of this, simplifying sequences depend on their contents. To avoid peeking in + their contents, we instead simplify sequences elements as functions from their next + elements to the actual result. + For `return_let_in`, if there is no follow-up element, an error is triggered, as + you can't have `let x = expr in ...` with no `...`. A cleaner option might be to add + a `unit` instead of erroring. + + `return_statement` is used for non-let_in statements. +*) let return_let_in ?loc binder rhs = ok @@ fun expr'_opt -> match expr'_opt with | None -> fail @@ corner_case ~loc:__LOC__ "missing return" | Some expr' -> ok @@ e_let_in ?loc binder rhs expr' +let return_statement expr = ok @@ fun expr'_opt -> + let expr = expr in + match expr'_opt with + | None -> ok @@ expr + | Some expr' -> ok @@ e_sequence expr expr' + let rec simpl_type_expression (t:Raw.type_expr) : type_expression result = match t with | TPar x -> simpl_type_expression x.value.inside @@ -336,10 +350,13 @@ let rec simpl_type_expression (t:Raw.type_expr) : type_expression result = ok @@ T_constant (cst , lst') | TProd p -> let%bind tpl = simpl_list_type_expression - @@ npseq_to_list p.value in + @@ npseq_to_list p.value in ok tpl | TRecord r -> - let aux = fun (x, y) -> let%bind y = simpl_type_expression y in ok (x, y) in + let aux = fun (x, y) -> + let%bind y = simpl_type_expression y in + ok (x, y) + in let apply = fun (x:Raw.field_decl Raw.reg) -> (x.value.field_name.value, x.value.field_type) in let%bind lst = bind_list @@ -373,34 +390,30 @@ and simpl_list_type_expression (lst:Raw.type_expr list) : type_expression result let%bind lst = bind_list @@ List.map simpl_type_expression lst in ok @@ T_tuple lst +let simpl_projection : Raw.projection Region.reg -> _ = fun p -> + let (p' , loc) = r_split p in + let var = + let name = p'.struct_name.value in + e_variable name in + let path = p'.field_path in + let path' = + let aux (s:Raw.selection) = + match s with + | FieldName property -> Access_record property.value + | Component index -> Access_tuple (Z.to_int (snd index.value)) + in + List.map aux @@ npseq_to_list path in + ok @@ e_accessor ~loc var path' + + let rec simpl_expression (t:Raw.expr) : expr result = let return x = ok x in - let simpl_projection = fun (p : Raw.projection Region.reg) -> - let (p' , loc) = r_split p in - let var = - let name = p'.struct_name.value in - e_variable name in - let path = p'.field_path in - let path' = - let aux (s:Raw.selection) = - match s with - | FieldName property -> Access_record property.value - | Component index -> Access_tuple (Z.to_int (snd index.value)) - in - List.map aux @@ npseq_to_list path in - return @@ e_accessor ~loc var path' - in match t with | EAnnot a -> ( let ((expr , type_expr) , loc) = r_split a in let%bind expr' = simpl_expression expr in let%bind type_expr' = simpl_type_expression type_expr in - match (Location.unwrap expr', type_expr') with - | (E_literal (Literal_string str) , T_constant ("bytes" , [])) -> - trace_strong (bad_bytes loc str) @@ - e_bytes ~loc str - | _ -> - return @@ e_annotation ~loc expr' type_expr' + return @@ e_annotation ~loc expr' type_expr' ) | EVar c -> ( let (c' , loc) = r_split c in @@ -767,31 +780,25 @@ and simpl_single_instruction : Raw.single_instr -> (_ -> expression result) resu match List.assoc_opt f constants with | None -> let%bind arg = simpl_tuple_expression ~loc:args_loc args' in - return @@ e_application ~loc (e_variable ~loc:f_loc f) arg + return_statement @@ e_application ~loc (e_variable ~loc:f_loc f) arg | Some s -> let%bind lst = bind_map_list simpl_expression args' in - return @@ e_constant ~loc s lst + return_statement @@ e_constant ~loc s lst ) | Fail e -> ( let%bind expr = simpl_expression e.value.fail_expr in - return @@ e_failwith expr + return_statement @@ e_failwith expr ) | Skip reg -> ( let loc = Location.lift reg in - return @@ e_skip ~loc () + return_statement @@ e_skip ~loc () ) | Loop (While l) -> let l = l.value in let%bind cond = simpl_expression l.cond in let%bind body = simpl_block l.block.value in let%bind body = body None in - return @@ e_loop cond body - (* | Loop (For (ForCollect x)) -> ( - * let (x' , loc) = r_split x in - * let%bind expr = simpl_expression x'.expr in - * let%bind body = simpl_block x'.block.value in - * ok _ - * ) *) + return_statement @@ e_loop cond body | Loop (For (ForInt {region; _} | ForCollect {region ; _})) -> fail @@ unsupported_for_loops region | Cond c -> ( @@ -805,7 +812,7 @@ and simpl_single_instruction : Raw.single_instr -> (_ -> expression result) resu | ClauseBlock b -> simpl_statements @@ fst b.value.inside in let%bind match_true = match_true None in let%bind match_false = match_false None in - return @@ e_matching expr ~loc (Match_bool {match_true; match_false}) + return_statement @@ e_matching expr ~loc (Match_bool {match_true; match_false}) ) | Assign a -> ( let (a , loc) = r_split a in @@ -816,7 +823,7 @@ and simpl_single_instruction : Raw.single_instr -> (_ -> expression result) resu match a.lhs with | Path path -> ( let (name , path') = simpl_path path in - return @@ e_assign ~loc name path' value_expr + return_statement @@ e_assign ~loc name path' value_expr ) | MapPath v -> ( let v' = v.value in @@ -826,7 +833,7 @@ and simpl_single_instruction : Raw.single_instr -> (_ -> expression result) resu let%bind key_expr = simpl_expression v'.index.value.inside in let old_expr = e_variable name.value in let expr' = e_map_add key_expr value_expr old_expr in - return @@ e_assign ~loc name.value [] expr' + return_statement @@ e_assign ~loc name.value [] expr' ) ) | CaseInstr c -> ( @@ -841,7 +848,7 @@ and simpl_single_instruction : Raw.single_instr -> (_ -> expression result) resu @@ List.map aux @@ npseq_to_list c.cases.value in let%bind m = simpl_cases cases in - return @@ e_matching ~loc expr m + return_statement @@ e_matching ~loc expr m ) | RecordPatch r -> ( let r = r.value in @@ -858,14 +865,13 @@ and simpl_single_instruction : Raw.single_instr -> (_ -> expression result) resu e_assign ~loc name (access_path @ [ Access_record access ]) v in let assigns = List.map aux inj in match assigns with - (* E_sequence (E_skip, E_skip) ? *) | [] -> fail @@ unsupported_empty_record_patch r.record_inj | hd :: tl -> ( let aux acc cur = e_sequence acc cur in ok @@ List.fold_left aux hd tl ) in - return @@ expr + return_statement @@ expr ) | MapPatch patch -> fail @@ unsupported_map_patches patch @@ -879,7 +885,7 @@ and simpl_single_instruction : Raw.single_instr -> (_ -> expression result) resu | Path path -> fail @@ unsupported_deep_map_rm path in let%bind key' = simpl_expression key in let expr = e_constant ~loc "MAP_REMOVE" [key' ; e_variable map] in - return @@ e_assign ~loc map [] expr + return_statement @@ e_assign ~loc map [] expr ) | SetRemove r -> fail @@ unsupported_set_removal r diff --git a/src/passes/simplify/simplify.ml b/src/passes/2-simplify/simplify.ml similarity index 100% rename from src/passes/simplify/simplify.ml rename to src/passes/2-simplify/simplify.ml diff --git a/src/passes/3-self_ast_simplified/dune b/src/passes/3-self_ast_simplified/dune new file mode 100644 index 000000000..39eacaf3e --- /dev/null +++ b/src/passes/3-self_ast_simplified/dune @@ -0,0 +1,12 @@ +(library + (name self_ast_simplified) + (public_name ligo.self_ast_simplified) + (libraries + simple-utils + ast_simplified + ) + (preprocess + (pps ppx_let) + ) + (flags (:standard -w +1..62-4-9-44-40-42-48-30@39@33 -open Simple_utils )) +) diff --git a/src/passes/3-self_ast_simplified/helpers.ml b/src/passes/3-self_ast_simplified/helpers.ml new file mode 100644 index 000000000..8b41248eb --- /dev/null +++ b/src/passes/3-self_ast_simplified/helpers.ml @@ -0,0 +1,127 @@ +open Ast_simplified +open Trace + +type mapper = expression -> expression result + +let rec map_expression : mapper -> expression -> expression result = fun f e -> + let self = map_expression f in + let%bind e' = f e in + let return expression = ok { e' with expression } in + match e'.expression with + | E_list lst -> ( + let%bind lst' = bind_map_list self lst in + return @@ E_list lst' + ) + | E_set lst -> ( + let%bind lst' = bind_map_list self lst in + return @@ E_set lst' + ) + | E_map lst -> ( + let%bind lst' = bind_map_list (bind_map_pair self) lst in + return @@ E_map lst' + ) + | E_sequence ab -> ( + let%bind ab' = bind_map_pair self ab in + return @@ E_sequence ab' + ) + | E_look_up ab -> ( + let%bind ab' = bind_map_pair self ab in + return @@ E_look_up ab' + ) + | E_loop ab -> ( + let%bind ab' = bind_map_pair self ab in + return @@ E_loop ab' + ) + | E_annotation (e , t) -> ( + let%bind e' = self e in + return @@ E_annotation (e' , t) + ) + | E_assign (name , path , e) -> ( + let%bind e' = self e in + let%bind path' = map_path f path in + return @@ E_assign (name , path' , e') + ) + | E_failwith e -> ( + let%bind e' = self e in + return @@ E_failwith e' + ) + | E_matching (e , cases) -> ( + let%bind e' = self e in + let%bind cases' = map_cases f cases in + return @@ E_matching (e' , cases') + ) + | E_accessor (e , path) -> ( + let%bind e' = self e in + let%bind path' = map_path f path in + return @@ E_accessor (e' , path') + ) + | E_record m -> ( + let%bind m' = bind_map_smap self m in + return @@ E_record m' + ) + | E_constructor (name , e) -> ( + let%bind e' = self e in + return @@ E_constructor (name , e') + ) + | E_tuple lst -> ( + let%bind lst' = bind_map_list self lst in + return @@ E_tuple lst' + ) + | E_application ab -> ( + let%bind ab' = bind_map_pair self ab in + return @@ E_application ab' + ) + | E_let_in { binder ; rhs ; result } -> ( + let%bind rhs = self rhs in + let%bind result = self result in + return @@ E_let_in { binder ; rhs ; result } + ) + | E_lambda { binder ; input_type ; output_type ; result } -> ( + let%bind result = self result in + return @@ E_lambda { binder ; input_type ; output_type ; result } + ) + | E_constant (name , lst) -> ( + let%bind lst' = bind_map_list self lst in + return @@ E_constant (name , lst') + ) + | E_literal _ | E_variable _ | E_skip as e' -> return e' + +and map_path : mapper -> access_path -> access_path result = fun f p -> bind_map_list (map_access f) p + +and map_access : mapper -> access -> access result = fun f a -> + match a with + | Access_map e -> ( + let%bind e' = map_expression f e in + ok @@ Access_map e' + ) + | a -> ok a + +and map_cases : mapper -> matching_expr -> matching_expr result = fun f m -> + match m with + | Match_bool { match_true ; match_false } -> ( + let%bind match_true = map_expression f match_true in + let%bind match_false = map_expression f match_false in + ok @@ Match_bool { match_true ; match_false } + ) + | Match_list { match_nil ; match_cons = (hd , tl , cons) } -> ( + let%bind match_nil = map_expression f match_nil in + let%bind cons = map_expression f cons in + ok @@ Match_list { match_nil ; match_cons = (hd , tl , cons) } + ) + | Match_option { match_none ; match_some = (name , some) } -> ( + let%bind match_none = map_expression f match_none in + let%bind some = map_expression f some in + ok @@ Match_option { match_none ; match_some = (name , some) } + ) + | Match_tuple (names , e) -> ( + let%bind e' = map_expression f e in + ok @@ Match_tuple (names , e') + ) + | Match_variant lst -> ( + let aux ((a , b) , e) = + let%bind e' = map_expression f e in + ok ((a , b) , e') + in + let%bind lst' = bind_map_list aux lst in + ok @@ Match_variant lst' + ) diff --git a/src/passes/3-self_ast_simplified/main.ml b/src/passes/3-self_ast_simplified/main.ml new file mode 100644 index 000000000..e69de29bb diff --git a/src/passes/3-self_ast_simplified/self_ast_simplified.ml b/src/passes/3-self_ast_simplified/self_ast_simplified.ml new file mode 100644 index 000000000..48ec6fc50 --- /dev/null +++ b/src/passes/3-self_ast_simplified/self_ast_simplified.ml @@ -0,0 +1 @@ +let convert_annotation = Helpers.map_expression Tezos_type_annotation.peephole_expression diff --git a/src/passes/3-self_ast_simplified/tezos_type_annotation.ml b/src/passes/3-self_ast_simplified/tezos_type_annotation.ml new file mode 100644 index 000000000..cf664cfab --- /dev/null +++ b/src/passes/3-self_ast_simplified/tezos_type_annotation.ml @@ -0,0 +1,16 @@ +open Ast_simplified +open Trace + +let peephole_expression : expression -> expression result = fun e -> + let return expression = ok { e with expression } in + match e.expression with + | E_annotation (e' , t) as e -> ( + match (e'.expression , t) with + | (E_literal (Literal_string str) , T_constant ("address" , [])) -> return @@ E_literal (Literal_address str) + | (E_literal (Literal_string str) , T_constant ("bytes" , [])) -> ( + let%bind e' = e'_bytes str in + return e' + ) + | _ -> return e + ) + | e -> return e diff --git a/src/passes/typer/dune b/src/passes/4-typer/dune similarity index 100% rename from src/passes/typer/dune rename to src/passes/4-typer/dune diff --git a/src/passes/typer/typer.ml b/src/passes/4-typer/typer.ml similarity index 98% rename from src/passes/typer/typer.ml rename to src/passes/4-typer/typer.ml index 5c962cc10..9e2679a1b 100644 --- a/src/passes/typer/typer.ml +++ b/src/passes/4-typer/typer.ml @@ -382,19 +382,19 @@ and type_expression : environment -> ?tv_opt:O.type_value -> I.expression -> O.a match tv_opt with | None -> ok () | Some tv' -> O.assert_type_value_eq (tv' , tv) in - let location = Location.get_location ae in + let location = ae.location in ok @@ make_a_e ~location expr tv e in let main_error = let title () = "typing expression" in let content () = "" in let data = [ ("expression" , fun () -> Format.asprintf "%a" I.PP.expression ae) ; - ("location" , fun () -> Format.asprintf "%a" Location.pp @@ Location.get_location ae) ; + ("location" , fun () -> Format.asprintf "%a" Location.pp ae.location) ; ("misc" , fun () -> L.get ()) ; ] in error ~data title content in trace main_error @@ - match Location.unwrap ae with + match ae.expression with (* Basic *) | E_failwith _ -> fail @@ needs_annotation ae "the failwith keyword" | E_variable name -> @@ -406,12 +406,8 @@ and type_expression : environment -> ?tv_opt:O.type_value -> I.expression -> O.a return (E_literal (Literal_bool b)) (t_bool ()) | E_literal Literal_unit | E_skip -> return (E_literal (Literal_unit)) (t_unit ()) - | E_literal (Literal_string s) -> ( - L.log (Format.asprintf "literal_string option type: %a" PP_helpers.(option O.PP.type_value) tv_opt) ; - match Option.map Ast_typed.get_type' tv_opt with - | Some (T_constant ("address" , [])) -> return (E_literal (Literal_address s)) (t_address ()) - | _ -> return (E_literal (Literal_string s)) (t_string ()) - ) + | E_literal (Literal_string s) -> + return (E_literal (Literal_string s)) (t_string ()) | E_literal (Literal_bytes s) -> return (E_literal (Literal_bytes s)) (t_bytes ()) | E_literal (Literal_int n) -> @@ -459,7 +455,6 @@ and type_expression : environment -> ?tv_opt:O.type_value -> I.expression -> O.a in trace (simple_info "accessing") @@ bind_fold_list aux e' path - (* Sum *) | E_constructor (c, expr) -> let%bind (c_tv, sum_tv) = @@ -569,9 +564,9 @@ and type_expression : environment -> ?tv_opt:O.type_value -> I.expression -> O.a match input_type with | Some ty -> ok ty | None -> ( - match Location.unwrap result with + match result.expression with | I.E_let_in li -> ( - match Location.unwrap li.rhs with + match li.rhs.expression with | I.E_variable name when name = (fst binder) -> ( match snd li.binder with | Some ty -> ok ty diff --git a/src/stages/transpiler/dune b/src/passes/6-transpiler/dune similarity index 100% rename from src/stages/transpiler/dune rename to src/passes/6-transpiler/dune diff --git a/src/stages/transpiler/transpiler.ml b/src/passes/6-transpiler/transpiler.ml similarity index 100% rename from src/stages/transpiler/transpiler.ml rename to src/passes/6-transpiler/transpiler.ml diff --git a/src/stages/compiler/compiler.ml b/src/passes/8-compiler/compiler.ml similarity index 100% rename from src/stages/compiler/compiler.ml rename to src/passes/8-compiler/compiler.ml diff --git a/src/stages/compiler/compiler_environment.ml b/src/passes/8-compiler/compiler_environment.ml similarity index 100% rename from src/stages/compiler/compiler_environment.ml rename to src/passes/8-compiler/compiler_environment.ml diff --git a/src/stages/compiler/compiler_program.ml b/src/passes/8-compiler/compiler_program.ml similarity index 100% rename from src/stages/compiler/compiler_program.ml rename to src/passes/8-compiler/compiler_program.ml diff --git a/src/stages/compiler/compiler_type.ml b/src/passes/8-compiler/compiler_type.ml similarity index 100% rename from src/stages/compiler/compiler_type.ml rename to src/passes/8-compiler/compiler_type.ml diff --git a/src/stages/compiler/dune b/src/passes/8-compiler/dune similarity index 100% rename from src/stages/compiler/dune rename to src/passes/8-compiler/dune diff --git a/src/stages/compiler/uncompiler.ml b/src/passes/8-compiler/uncompiler.ml similarity index 100% rename from src/stages/compiler/uncompiler.ml rename to src/passes/8-compiler/uncompiler.ml diff --git a/src/run/main/display.ml b/src/run/display.ml similarity index 100% rename from src/run/main/display.ml rename to src/run/display.ml diff --git a/src/run/main/dune b/src/run/dune similarity index 100% rename from src/run/main/dune rename to src/run/dune diff --git a/src/run/main/main.ml b/src/run/main.ml similarity index 100% rename from src/run/main/main.ml rename to src/run/main.ml diff --git a/src/run/main/run_mini_c.ml b/src/run/run_mini_c.ml similarity index 100% rename from src/run/main/run_mini_c.ml rename to src/run/run_mini_c.ml diff --git a/src/run/main/run_simplified.ml b/src/run/run_simplified.ml similarity index 100% rename from src/run/main/run_simplified.ml rename to src/run/run_simplified.ml diff --git a/src/run/main/run_source.ml b/src/run/run_source.ml similarity index 100% rename from src/run/main/run_source.ml rename to src/run/run_source.ml diff --git a/src/run/main/run_typed.ml b/src/run/run_typed.ml similarity index 100% rename from src/run/main/run_typed.ml rename to src/run/run_typed.ml diff --git a/src/stages/ast_simplified/PP.ml b/src/stages/ast_simplified/PP.ml index 07277c664..01fee164d 100644 --- a/src/stages/ast_simplified/PP.ml +++ b/src/stages/ast_simplified/PP.ml @@ -31,7 +31,7 @@ let literal ppf (l:literal) = match l with | Literal_address s -> fprintf ppf "@%S" s | Literal_operation _ -> fprintf ppf "Operation(...bytes)" -let rec expression ppf (e:expression) = match Location.unwrap e with +let rec expression ppf (e:expression) = match e.expression with | E_literal l -> literal ppf l | E_variable name -> fprintf ppf "%s" name | E_application (f, arg) -> fprintf ppf "(%a)@(%a)" expression f expression arg diff --git a/src/stages/ast_simplified/combinators.ml b/src/stages/ast_simplified/combinators.ml index 622e1039c..a25a08543 100644 --- a/src/stages/ast_simplified/combinators.ml +++ b/src/stages/ast_simplified/combinators.ml @@ -47,45 +47,52 @@ let t_set key = (T_constant ("set", [key])) let make_name (s : string) : name = s -let e_var ?loc (s : string) : expression = Location.wrap ?loc @@ E_variable s -let e_literal ?loc l : expression = Location.wrap ?loc @@ E_literal l -let e_unit ?loc () : expression = Location.wrap ?loc @@ E_literal (Literal_unit) -let e_int ?loc n : expression = Location.wrap ?loc @@ E_literal (Literal_int n) -let e_nat ?loc n : expression = Location.wrap ?loc @@ E_literal (Literal_nat n) -let e_timestamp ?loc n : expression = Location.wrap ?loc @@ E_literal (Literal_timestamp n) -let e_bool ?loc b : expression = Location.wrap ?loc @@ E_literal (Literal_bool b) -let e_string ?loc s : expression = Location.wrap ?loc @@ E_literal (Literal_string s) -let e_address ?loc s : expression = Location.wrap ?loc @@ E_literal (Literal_address s) -let e_tez ?loc s : expression = Location.wrap ?loc @@ E_literal (Literal_tez s) -let e_bytes ?loc b : expression result = +let location_wrap ?(loc = Location.generated) expression = + let location = loc in + { location ; expression } + +let e_var ?loc (s : string) : expression = location_wrap ?loc @@ E_variable s +let e_literal ?loc l : expression = location_wrap ?loc @@ E_literal l +let e_unit ?loc () : expression = location_wrap ?loc @@ E_literal (Literal_unit) +let e_int ?loc n : expression = location_wrap ?loc @@ E_literal (Literal_int n) +let e_nat ?loc n : expression = location_wrap ?loc @@ E_literal (Literal_nat n) +let e_timestamp ?loc n : expression = location_wrap ?loc @@ E_literal (Literal_timestamp n) +let e_bool ?loc b : expression = location_wrap ?loc @@ E_literal (Literal_bool b) +let e_string ?loc s : expression = location_wrap ?loc @@ E_literal (Literal_string s) +let e_address ?loc s : expression = location_wrap ?loc @@ E_literal (Literal_address s) +let e_tez ?loc s : expression = location_wrap ?loc @@ E_literal (Literal_tez s) +let e'_bytes b : expression' result = let%bind bytes = generic_try (simple_error "bad hex to bytes") (fun () -> Hex.to_bytes (`Hex b)) in - ok @@ Location.wrap ?loc @@ E_literal (Literal_bytes bytes) -let e_record ?loc map : expression = Location.wrap ?loc @@ E_record map -let e_tuple ?loc lst : expression = Location.wrap ?loc @@ E_tuple lst -let e_some ?loc s : expression = Location.wrap ?loc @@ E_constant ("SOME", [s]) -let e_none ?loc () : expression = Location.wrap ?loc @@ E_constant ("NONE", []) -let e_map_add ?loc k v old : expression = Location.wrap ?loc @@ E_constant ("MAP_ADD" , [k ; v ; old]) -let e_map ?loc lst : expression = Location.wrap ?loc @@ E_map lst -let e_set ?loc lst : expression = Location.wrap ?loc @@ E_set lst -let e_list ?loc lst : expression = Location.wrap ?loc @@ E_list lst -let e_pair ?loc a b : expression = Location.wrap ?loc @@ E_tuple [a; b] -let e_constructor ?loc s a : expression = Location.wrap ?loc @@ E_constructor (s , a) -let e_matching ?loc a b : expression = Location.wrap ?loc @@ E_matching (a , b) + ok @@ E_literal (Literal_bytes bytes) +let e_bytes ?loc b : expression result = + let%bind e' = e'_bytes b in + ok @@ location_wrap ?loc e' +let e_record ?loc map : expression = location_wrap ?loc @@ E_record map +let e_tuple ?loc lst : expression = location_wrap ?loc @@ E_tuple lst +let e_some ?loc s : expression = location_wrap ?loc @@ E_constant ("SOME", [s]) +let e_none ?loc () : expression = location_wrap ?loc @@ E_constant ("NONE", []) +let e_map_add ?loc k v old : expression = location_wrap ?loc @@ E_constant ("MAP_ADD" , [k ; v ; old]) +let e_map ?loc lst : expression = location_wrap ?loc @@ E_map lst +let e_set ?loc lst : expression = location_wrap ?loc @@ E_set lst +let e_list ?loc lst : expression = location_wrap ?loc @@ E_list lst +let e_pair ?loc a b : expression = location_wrap ?loc @@ E_tuple [a; b] +let e_constructor ?loc s a : expression = location_wrap ?loc @@ E_constructor (s , a) +let e_matching ?loc a b : expression = location_wrap ?loc @@ E_matching (a , b) let e_matching_bool ?loc a b c : expression = e_matching ?loc a (Match_bool {match_true = b ; match_false = c}) -let e_accessor ?loc a b = Location.wrap ?loc @@ E_accessor (a , b) +let e_accessor ?loc a b = location_wrap ?loc @@ E_accessor (a , b) let e_accessor_props ?loc a b = e_accessor ?loc a (List.map (fun x -> Access_record x) b) -let e_variable ?loc v = Location.wrap ?loc @@ E_variable v -let e_failwith ?loc v = Location.wrap ?loc @@ E_failwith v -let e_skip ?loc () = Location.wrap ?loc @@ E_skip -let e_loop ?loc cond body = Location.wrap ?loc @@ E_loop (cond , body) -let e_sequence ?loc a b = Location.wrap ?loc @@ E_sequence (a , b) -let e_let_in ?loc binder rhs result = Location.wrap ?loc @@ E_let_in { binder ; rhs ; result } -let e_annotation ?loc expr ty = Location.wrap ?loc @@ E_annotation (expr , ty) -let e_application ?loc a b = Location.wrap ?loc @@ E_application (a , b) -let e_binop ?loc name a b = Location.wrap ?loc @@ E_constant (name , [a ; b]) -let e_constant ?loc name lst = Location.wrap ?loc @@ E_constant (name , lst) -let e_look_up ?loc x y = Location.wrap ?loc @@ E_look_up (x , y) -let e_assign ?loc a b c = Location.wrap ?loc @@ E_assign (a , b , c) +let e_variable ?loc v = location_wrap ?loc @@ E_variable v +let e_failwith ?loc v = location_wrap ?loc @@ E_failwith v +let e_skip ?loc () = location_wrap ?loc @@ E_skip +let e_loop ?loc cond body = location_wrap ?loc @@ E_loop (cond , body) +let e_sequence ?loc a b = location_wrap ?loc @@ E_sequence (a , b) +let e_let_in ?loc binder rhs result = location_wrap ?loc @@ E_let_in { binder ; rhs ; result } +let e_annotation ?loc expr ty = location_wrap ?loc @@ E_annotation (expr , ty) +let e_application ?loc a b = location_wrap ?loc @@ E_application (a , b) +let e_binop ?loc name a b = location_wrap ?loc @@ E_constant (name , [a ; b]) +let e_constant ?loc name lst = location_wrap ?loc @@ E_constant (name , lst) +let e_look_up ?loc x y = location_wrap ?loc @@ E_look_up (x , y) +let e_assign ?loc a b c = location_wrap ?loc @@ E_assign (a , b , c) let make_option_typed ?loc e t_opt = match t_opt with @@ -114,14 +121,14 @@ let e_lambda ?loc (binder : string) (output_type : type_expression option) (result : expression) : expression = - Location.wrap ?loc @@ E_lambda { + location_wrap ?loc @@ E_lambda { binder = (make_name binder , input_type) ; input_type = input_type ; output_type = output_type ; result ; } -let e_record ?loc map = Location.wrap ?loc @@ E_record map +let e_record ?loc map = location_wrap ?loc @@ E_record map let e_ez_record ?loc (lst : (string * expr) list) : expression = let map = SMap.of_list lst in @@ -153,28 +160,28 @@ let get_e_list = fun t -> | _ -> simple_fail "not a list" let get_e_failwith = fun e -> - match Location.unwrap e with + match e.expression with | E_failwith fw -> ok fw | _ -> simple_fail "not a failwith" let is_e_failwith e = to_bool @@ get_e_failwith e let extract_pair : expression -> (expression * expression) result = fun e -> - match Location.unwrap e with + match e.expression with | E_tuple [ a ; b ] -> ok (a , b) | _ -> fail @@ bad_kind "pair" e.location let extract_list : expression -> (expression list) result = fun e -> - match Location.unwrap e with + match e.expression with | E_list lst -> ok lst | _ -> fail @@ bad_kind "list" e.location let extract_record : expression -> (string * expression) list result = fun e -> - match Location.unwrap e with + match e.expression with | E_record lst -> ok @@ SMap.to_kv_list lst | _ -> fail @@ bad_kind "record" e.location let extract_map : expression -> (expression * expression) list result = fun e -> - match Location.unwrap e with + match e.expression with | E_map lst -> ok lst | _ -> fail @@ bad_kind "map" e.location diff --git a/src/stages/ast_simplified/misc.ml b/src/stages/ast_simplified/misc.ml index e1582b073..7e0dc76ab 100644 --- a/src/stages/ast_simplified/misc.ml +++ b/src/stages/ast_simplified/misc.ml @@ -67,7 +67,7 @@ let rec assert_value_eq (a, b: (expression * expression )) : unit result = Format.asprintf "\n@[- %a@;- %a]" PP.expression a PP.expression b in trace (fun () -> error (thunk "not equal") error_content ()) @@ - match (Location.unwrap a , Location.unwrap b) with + match (a.expression , b.expression) with | E_literal a , E_literal b -> assert_literal_eq (a, b) | E_literal _ , _ -> diff --git a/src/stages/ast_simplified/types.ml b/src/stages/ast_simplified/types.ml index 88b93beda..1e92cfc67 100644 --- a/src/stages/ast_simplified/types.ml +++ b/src/stages/ast_simplified/types.ml @@ -73,7 +73,10 @@ and expression' = (* Annotate *) | E_annotation of expr * type_expression -and expression = expression' Location.wrap +and expression = { + expression : expression' ; + location : Location.t ; +} and access = | Access_tuple of int diff --git a/test/.merlin b/test/.merlin index f2a72b2ea..ae626d691 100644 --- a/test/.merlin +++ b/test/.merlin @@ -66,32 +66,32 @@ B /home/cc/Programming/ligo/_opam/lib/uuidm B /home/cc/Programming/ligo/_opam/lib/uutf B /home/cc/Programming/ligo/_opam/lib/yojson B /home/cc/Programming/ligo/_opam/lib/zarith -B ../../_build/default/src/.ligo.objs/byte -B ../../_build/default/src/ast_simplified/.ast_simplified.objs/byte -B ../../_build/default/src/ast_typed/.ast_typed.objs/byte -B ../../_build/default/src/compiler/.compiler.objs/byte -B ../../_build/default/src/mini_c/.mini_c.objs/byte -B ../../_build/default/src/operators/.operators.objs/byte -B ../../_build/default/src/parser/.parser.objs/byte -B ../../_build/default/src/parser/camligo/.parser_camligo.objs/byte -B ../../_build/default/src/parser/camligo/lex/.lex.objs/byte -B ../../_build/default/src/parser/ligodity/.parser_ligodity.objs/byte -B ../../_build/default/src/parser/pascaligo/.parser_pascaligo.objs/byte -B ../../_build/default/src/parser/shared/.parser_shared.objs/byte -B ../../_build/default/src/run/.run.objs/byte -B ../../_build/default/src/simplify/.simplify.objs/byte -B ../../_build/default/src/test/.test.eobjs/byte -B ../../_build/default/src/transpiler/.transpiler.objs/byte -B ../../_build/default/src/typer/.typer.objs/byte -B ../../_build/default/vendors/ligo-utils/memory-proto-alpha/.memory_proto_alpha.objs/byte -B ../../_build/default/vendors/ligo-utils/proto-alpha-utils/.proto_alpha_utils.objs/byte -B ../../_build/default/vendors/ligo-utils/simple-utils/.simple_utils.objs/byte -B ../../_build/default/vendors/ligo-utils/tezos-protocol-alpha-parameters/.tezos_protocol_alpha_parameters.objs/byte -B ../../_build/default/vendors/ligo-utils/tezos-protocol-alpha/.tezos_protocol_alpha.objs/byte -B ../../_build/default/vendors/ligo-utils/tezos-protocol-alpha/.tezos_protocol_environment_alpha.objs/byte -B ../../_build/default/vendors/ligo-utils/tezos-protocol-alpha/.tezos_raw_protocol_alpha.objs/byte -B ../../_build/default/vendors/ligo-utils/tezos-utils/.tezos_utils.objs/byte -B ../../_build/default/vendors/ligo-utils/tezos-utils/michelson-parser/.michelson_parser.objs/byte +B ../_build/default/src/.ligo.objs/byte +B ../_build/default/src/passes/1-parser/.parser.objs/byte +B ../_build/default/src/passes/1-parser/camligo/.parser_camligo.objs/byte +B ../_build/default/src/passes/1-parser/camligo/lex/.lex.objs/byte +B ../_build/default/src/passes/1-parser/ligodity/.parser_ligodity.objs/byte +B ../_build/default/src/passes/1-parser/pascaligo/.parser_pascaligo.objs/byte +B ../_build/default/src/passes/1-parser/shared/.parser_shared.objs/byte +B ../_build/default/src/passes/2-simplify/.simplify.objs/byte +B ../_build/default/src/passes/4-typer/.typer.objs/byte +B ../_build/default/src/passes/6-transpiler/.transpiler.objs/byte +B ../_build/default/src/passes/8-compiler/.compiler.objs/byte +B ../_build/default/src/passes/operators/.operators.objs/byte +B ../_build/default/src/run/main/.main.objs/byte +B ../_build/default/src/stages/ast_simplified/.ast_simplified.objs/byte +B ../_build/default/src/stages/ast_typed/.ast_typed.objs/byte +B ../_build/default/src/stages/mini_c/.mini_c.objs/byte +B ../_build/default/test/.test.eobjs/byte +B ../_build/default/vendors/ligo-utils/memory-proto-alpha/.memory_proto_alpha.objs/byte +B ../_build/default/vendors/ligo-utils/proto-alpha-utils/.proto_alpha_utils.objs/byte +B ../_build/default/vendors/ligo-utils/simple-utils/.simple_utils.objs/byte +B ../_build/default/vendors/ligo-utils/tezos-protocol-alpha-parameters/.tezos_protocol_alpha_parameters.objs/byte +B ../_build/default/vendors/ligo-utils/tezos-protocol-alpha/.tezos_protocol_alpha.objs/byte +B ../_build/default/vendors/ligo-utils/tezos-protocol-alpha/.tezos_protocol_environment_alpha.objs/byte +B ../_build/default/vendors/ligo-utils/tezos-protocol-alpha/.tezos_raw_protocol_alpha.objs/byte +B ../_build/default/vendors/ligo-utils/tezos-utils/.tezos_utils.objs/byte +B ../_build/default/vendors/ligo-utils/tezos-utils/michelson-parser/.michelson_parser.objs/byte S /home/cc/Programming/ligo/_opam/lib/alcotest S /home/cc/Programming/ligo/_opam/lib/astring S /home/cc/Programming/ligo/_opam/lib/base/caml @@ -159,29 +159,29 @@ S /home/cc/Programming/ligo/_opam/lib/uuidm S /home/cc/Programming/ligo/_opam/lib/uutf S /home/cc/Programming/ligo/_opam/lib/yojson S /home/cc/Programming/ligo/_opam/lib/zarith -S .. -S ../ast_simplified -S ../ast_typed -S ../compiler -S ../mini_c -S ../operators -S ../parser -S ../parser/camligo -S ../parser/camligo/lex -S ../parser/ligodity -S ../parser/pascaligo -S ../parser/shared -S ../run -S ../simplify +S ../src +S ../src/passes/1-parser +S ../src/passes/1-parser/camligo +S ../src/passes/1-parser/camligo/lex +S ../src/passes/1-parser/ligodity +S ../src/passes/1-parser/pascaligo +S ../src/passes/1-parser/shared +S ../src/passes/2-simplify +S ../src/passes/4-typer +S ../src/passes/6-transpiler +S ../src/passes/8-compiler +S ../src/passes/operators +S ../src/run/main +S ../src/stages/ast_simplified +S ../src/stages/ast_typed +S ../src/stages/mini_c S . -S ../transpiler -S ../typer -S ../../vendors/ligo-utils/memory-proto-alpha -S ../../vendors/ligo-utils/proto-alpha-utils -S ../../vendors/ligo-utils/simple-utils -S ../../vendors/ligo-utils/tezos-protocol-alpha -S ../../vendors/ligo-utils/tezos-protocol-alpha-parameters -S ../../vendors/ligo-utils/tezos-utils -S ../../vendors/ligo-utils/tezos-utils/michelson-parser +S ../vendors/ligo-utils/memory-proto-alpha +S ../vendors/ligo-utils/proto-alpha-utils +S ../vendors/ligo-utils/simple-utils +S ../vendors/ligo-utils/tezos-protocol-alpha +S ../vendors/ligo-utils/tezos-protocol-alpha-parameters +S ../vendors/ligo-utils/tezos-utils +S ../vendors/ligo-utils/tezos-utils/michelson-parser FLG -ppx '/home/cc/Programming/ligo/_build/default/.ppx/0af9cc0ed9166d3107af7264d5703b53/ppx.exe --as-ppx' FLG -w @1..3@5..28@30..39@43@46..47@49..57@61..62-40 -strict-sequence -strict-formats -short-paths -keep-locs -w +1..62-4-9-44-40-42-48@39@33 -open Simple_utils diff --git a/test/coase_tests.ml b/test/coase_tests.ml index 1931b9857..bbfd75b51 100644 --- a/test/coase_tests.ml +++ b/test/coase_tests.ml @@ -210,9 +210,9 @@ let sell () = e_pair sell_action storage in let make_expecter : int -> expression -> unit result = fun n result -> - let%bind (ops , storage) = get_e_pair @@ Location.unwrap result in + let%bind (ops , storage) = get_e_pair result.expression in let%bind () = - let%bind lst = get_e_list @@ Location.unwrap ops in + let%bind lst = get_e_list ops.expression in Assert.assert_list_size lst 1 in let expected_storage = let cards = List.hds @@ cards_ez first_owner n in diff --git a/test/dune b/test/dune index 021ae172f..dda46f5e8 100644 --- a/test/dune +++ b/test/dune @@ -10,3 +10,20 @@ ) (flags (:standard -w +1..62-4-9-44-40-42-48@39@33 -open Simple_utils )) ) + +(alias + (name ligo-test) + (action (run ./test.exe)) + (deps (glob_files contracts/*)) +) + +(alias + (name runtest) + (deps (alias ligo-test)) +) + +(alias + (name manual-test) + (action (run ./manual_test.exe)) + (deps (glob_files contracts/*)) +) From 715812b2c395d6fbd57161ff24978af64b0756e6 Mon Sep 17 00:00:00 2001 From: galfour Date: Tue, 10 Sep 2019 15:19:15 +0200 Subject: [PATCH 04/18] more modifications --- src/main/compile/dune | 21 ++ src/main/compile/helpers.ml | 72 +++++++ src/main/compile/michelson.ml | 0 src/main/compile/of_mini_c.ml | 12 ++ src/main/compile/of_simplified.ml | 6 + src/main/compile/of_source.ml | 1 + src/main/compile/of_typed.ml | 11 ++ src/{ => main}/run/display.ml | 0 src/{ => main}/run/dune | 4 +- src/main/run/from_michelson.ml | 25 +++ src/{ => main}/run/main.ml | 0 src/main/run/run_mini_c.ml | 38 ++++ src/{ => main}/run/run_simplified.ml | 0 src/{ => main}/run/run_source.ml | 83 +------- src/{ => main}/run/run_typed.ml | 0 src/passes/8-compiler/compiler_environment.ml | 2 + src/run/run_mini_c.ml | 55 ------ test/.merlin | 187 ------------------ test/coase_tests.ml | 2 +- test/heap_tests.ml | 2 +- test/integration_tests.ml | 4 +- test/vote_tests.ml | 2 +- 22 files changed, 197 insertions(+), 330 deletions(-) create mode 100644 src/main/compile/dune create mode 100644 src/main/compile/helpers.ml create mode 100644 src/main/compile/michelson.ml create mode 100644 src/main/compile/of_mini_c.ml create mode 100644 src/main/compile/of_simplified.ml create mode 100644 src/main/compile/of_source.ml create mode 100644 src/main/compile/of_typed.ml rename src/{ => main}/run/display.ml (100%) rename src/{ => main}/run/dune (88%) create mode 100644 src/main/run/from_michelson.ml rename src/{ => main}/run/main.ml (100%) create mode 100644 src/main/run/run_mini_c.ml rename src/{ => main}/run/run_simplified.ml (100%) rename src/{ => main}/run/run_source.ml (74%) rename src/{ => main}/run/run_typed.ml (100%) delete mode 100644 src/run/run_mini_c.ml delete mode 100644 test/.merlin diff --git a/src/main/compile/dune b/src/main/compile/dune new file mode 100644 index 000000000..bd1ac2d33 --- /dev/null +++ b/src/main/compile/dune @@ -0,0 +1,21 @@ +(library + (name compile) + (public_name ligo.compile) + (libraries + simple-utils + tezos-utils + parser + simplify + ast_simplified + typer + ast_typed + transpiler + mini_c + operators + compiler + ) + (preprocess + (pps ppx_let) + ) + (flags (:standard -w +1..62-4-9-44-40-42-48-30@39@33 -open Simple_utils -open Tezos_utils )) +) diff --git a/src/main/compile/helpers.ml b/src/main/compile/helpers.ml new file mode 100644 index 000000000..5e47665a4 --- /dev/null +++ b/src/main/compile/helpers.ml @@ -0,0 +1,72 @@ +open Trace + +type s_syntax = Syntax_name of string +type v_syntax = Pascaligo | Cameligo + +let syntax_to_variant : s_syntax -> string option -> v_syntax result = + fun syntax source_filename -> + let subr s n = + String.sub s (String.length s - n) n in + let endswith s suffix = + let suffixlen = String.length suffix in + ( String.length s >= suffixlen + && String.equal (subr s suffixlen) suffix) + in + let (Syntax_name syntax) = syntax in + match (syntax , source_filename) with + | "auto" , Some sf when endswith sf ".ligo" -> ok Pascaligo + | "auto" , Some sf when endswith sf ".mligo" -> ok Cameligo + | "auto" , _ -> simple_fail "cannot auto-detect syntax, pleas use -s name_of_syntax" + | "pascaligo" , _ -> ok Pascaligo + | "cameligo" , _ -> ok Cameligo + | _ -> simple_fail "unrecognized parser" + +let parsify_pascaligo = fun source -> + let%bind raw = + trace (simple_error "parsing") @@ + Parser.Pascaligo.parse_file source in + let%bind simplified = + trace (simple_error "simplifying") @@ + Simplify.Pascaligo.simpl_program raw in + ok simplified + +let parsify_expression_pascaligo = fun source -> + let%bind raw = + trace (simple_error "parsing expression") @@ + Parser.Pascaligo.parse_expression source in + let%bind simplified = + trace (simple_error "simplifying expression") @@ + Simplify.Pascaligo.simpl_expression raw in + ok simplified + +let parsify_ligodity = fun source -> + let%bind raw = + trace (simple_error "parsing") @@ + Parser.Ligodity.parse_file source in + let%bind simplified = + trace (simple_error "simplifying") @@ + Simplify.Ligodity.simpl_program raw in + ok simplified + +let parsify_expression_ligodity = fun source -> + let%bind raw = + trace (simple_error "parsing expression") @@ + Parser.Ligodity.parse_expression source in + let%bind simplified = + trace (simple_error "simplifying expression") @@ + Simplify.Ligodity.simpl_expression raw in + ok simplified + +let parsify = fun (syntax : v_syntax) source_filename -> + let%bind parsify = match syntax with + | Pascaligo -> ok parsify_pascaligo + | Cameligo -> ok parsify_ligodity + in + parsify source_filename + +let parsify_expression = fun syntax source -> + let%bind parsify = match syntax with + | Pascaligo -> ok parsify_expression_pascaligo + | Cameligo -> ok parsify_expression_ligodity + in + parsify source diff --git a/src/main/compile/michelson.ml b/src/main/compile/michelson.ml new file mode 100644 index 000000000..e69de29bb diff --git a/src/main/compile/of_mini_c.ml b/src/main/compile/of_mini_c.ml new file mode 100644 index 000000000..ea964be97 --- /dev/null +++ b/src/main/compile/of_mini_c.ml @@ -0,0 +1,12 @@ +open Trace +open Mini_c +open Tezos_utils + +let compile_value : value -> type_value -> Michelson.t result = + Compiler.Program.translate_value + +let compile_expression : expression -> Michelson.t result = fun e -> + Compiler.Program.translate_expression e Compiler.Environment.empty + +let compile_function : anon_function -> type_value -> type_value -> Compiler.Program.compiled_program result = fun f in_ty out_ty -> + Compiler.Program.translate_entry f (in_ty , out_ty) diff --git a/src/main/compile/of_simplified.ml b/src/main/compile/of_simplified.ml new file mode 100644 index 000000000..b8b0ff78e --- /dev/null +++ b/src/main/compile/of_simplified.ml @@ -0,0 +1,6 @@ +open Ast_simplified +open Trace + +let compile_entry (program : program) entry_point = + let%bind typed_program = Typer.type_program program in + Of_typed.compile_entry typed_program entry_point diff --git a/src/main/compile/of_source.ml b/src/main/compile/of_source.ml new file mode 100644 index 000000000..f286ab848 --- /dev/null +++ b/src/main/compile/of_source.ml @@ -0,0 +1 @@ +open Trace diff --git a/src/main/compile/of_typed.ml b/src/main/compile/of_typed.ml new file mode 100644 index 000000000..b7a60fa3c --- /dev/null +++ b/src/main/compile/of_typed.ml @@ -0,0 +1,11 @@ +open Trace +open Ast_typed +open Tezos_utils + +let compile_expression : annotated_expression -> Michelson.t result = fun e -> + let%bind mini_c_expression = Transpiler.translate_annotated_expression e in + Of_mini_c.compile_expression mini_c_expression + +let compile_entry : program -> string -> _ = fun p entry -> + let%bind (f , (in_ty , out_ty)) = Transpiler.translate_entry p entry in + Of_mini_c.compile_function f in_ty out_ty diff --git a/src/run/display.ml b/src/main/run/display.ml similarity index 100% rename from src/run/display.ml rename to src/main/run/display.ml diff --git a/src/run/dune b/src/main/run/dune similarity index 88% rename from src/run/dune rename to src/main/run/dune index 747afb217..330bf32d5 100644 --- a/src/run/dune +++ b/src/main/run/dune @@ -1,6 +1,6 @@ (library - (name main) - (public_name ligo.main) + (name run) + (public_name ligo.run) (libraries simple-utils tezos-utils diff --git a/src/main/run/from_michelson.ml b/src/main/run/from_michelson.ml new file mode 100644 index 000000000..f34cb2333 --- /dev/null +++ b/src/main/run/from_michelson.ml @@ -0,0 +1,25 @@ +open Proto_alpha_utils +open Trace +open Compiler.Program +open Memory_proto_alpha.Protocol.Script_ir_translator +open Memory_proto_alpha.X + +type options = Memory_proto_alpha.options + +let run ?options (program:compiled_program) (input_michelson:Michelson.t) : ex_typed_value result = + let Compiler.Program.{input;output;body} : compiled_program = program in + let (Ex_ty input_ty) = input in + let (Ex_ty output_ty) = output in + let%bind input = + Trace.trace_tzresult_lwt (simple_error "error parsing input") @@ + Memory_proto_alpha.parse_michelson_data input_michelson input_ty in + let body = Michelson.strip_annots body in + let%bind descr = + Trace.trace_tzresult_lwt (simple_error "error parsing program code") @@ + Memory_proto_alpha.parse_michelson body + (Item_t (input_ty, Empty_t, None)) (Item_t (output_ty, Empty_t, None)) in + let open! Memory_proto_alpha.Protocol.Script_interpreter in + let%bind (Item(output, Empty)) = + Trace.trace_tzresult_lwt (simple_error "error of execution") @@ + Memory_proto_alpha.interpret ?options descr (Item(input, Empty)) in + ok (Ex_typed_value (output_ty, output)) diff --git a/src/run/main.ml b/src/main/run/main.ml similarity index 100% rename from src/run/main.ml rename to src/main/run/main.ml diff --git a/src/main/run/run_mini_c.ml b/src/main/run/run_mini_c.ml new file mode 100644 index 000000000..dd3dba8f1 --- /dev/null +++ b/src/main/run/run_mini_c.ml @@ -0,0 +1,38 @@ +open Proto_alpha_utils +open Memory_proto_alpha.X +open Trace +open Mini_c +open Compiler.Program + +type options = { + entry_point : anon_function ; + input_type : type_value ; + output_type : type_value ; + input : value ; + michelson_options : From_michelson.options ; +} + +let run_entry ?(debug_michelson = false) ?options (entry : anon_function) ty (input:value) : value result = + let%bind compiled = + trace error @@ + translate_entry entry ty in + let%bind input_michelson = translate_value input (fst ty) in + if debug_michelson then ( + Format.printf "Program: %a\n" Michelson.pp compiled.body ; + Format.printf "Expression: %a\n" PP.expression entry.result ; + Format.printf "Input: %a\n" PP.value input ; + Format.printf "Input Type: %a\n" PP.type_ (fst ty) ; + Format.printf "Compiled Input: %a\n" Michelson.pp input_michelson ; + ) ; + let%bind ex_ty_value = From_michelson.run ?options compiled input_michelson in + if debug_michelson then ( + let (Ex_typed_value (ty , v)) = ex_ty_value in + ignore @@ + let%bind michelson_value = + trace_tzresult_lwt (simple_error "debugging run_mini_c") @@ + Proto_alpha_utils.Memory_proto_alpha.unparse_michelson_data ty v in + Format.printf "Compiled Output: %a\n" Michelson.pp michelson_value ; + ok () + ) ; + let%bind (result : value) = Compiler.Uncompiler.translate_value ex_ty_value in + ok result diff --git a/src/run/run_simplified.ml b/src/main/run/run_simplified.ml similarity index 100% rename from src/run/run_simplified.ml rename to src/main/run/run_simplified.ml diff --git a/src/run/run_source.ml b/src/main/run/run_source.ml similarity index 74% rename from src/run/run_source.ml rename to src/main/run/run_source.ml index 10904914a..214d1e091 100644 --- a/src/run/run_source.ml +++ b/src/main/run/run_source.ml @@ -32,7 +32,7 @@ include struct trace_strong (simple_error "entry-point doesn't have a list of operation as first result") @@ assert_t_list_operation ops in let%bind () = - trace_strong (simple_error "entry-point doesn't identitcal type (storage) for second parameter and second result") @@ + trace_strong (simple_error "entry-point doesn't identical type (storage) for second parameter and second result") @@ assert_type_value_eq (storage_param , storage_result) in ok (arg' , storage_param) @@ -59,86 +59,7 @@ let transpile_value let%bind r = Run_mini_c.run_entry f ty input in ok (r , snd ty) -let parsify_pascaligo = fun source -> - let%bind raw = - trace (simple_error "parsing") @@ - Parser.Pascaligo.parse_file source in - let%bind simplified = - trace (simple_error "simplifying") @@ - Simplify.Pascaligo.simpl_program raw in - ok simplified - -let parsify_expression_pascaligo = fun source -> - let%bind raw = - trace (simple_error "parsing expression") @@ - Parser.Pascaligo.parse_expression source in - let%bind simplified = - trace (simple_error "simplifying expression") @@ - Simplify.Pascaligo.simpl_expression raw in - ok simplified - -let parsify_ligodity = fun source -> - let%bind raw = - trace (simple_error "parsing") @@ - Parser.Ligodity.parse_file source in - let%bind simplified = - trace (simple_error "simplifying") @@ - Simplify.Ligodity.simpl_program raw in - ok simplified - -let parsify_expression_ligodity = fun source -> - let%bind raw = - trace (simple_error "parsing expression") @@ - Parser.Ligodity.parse_expression source in - let%bind simplified = - trace (simple_error "simplifying expression") @@ - Simplify.Ligodity.simpl_expression raw in - ok simplified - -type s_syntax = Syntax_name of string -type v_syntax = [`pascaligo | `cameligo ] - -let syntax_to_variant : s_syntax -> string option -> v_syntax result = - fun syntax source_filename -> - let subr s n = - String.sub s (String.length s - n) n in - let endswith s suffix = - let suffixlen = String.length suffix in - ( String.length s >= suffixlen - && String.equal (subr s suffixlen) suffix) - in - match syntax with - Syntax_name syntax -> - begin - if String.equal syntax "auto" then - begin - match source_filename with - | Some source_filename - when endswith source_filename ".ligo" - -> ok `pascaligo - | Some source_filename - when endswith source_filename ".mligo" - -> ok `cameligo - | _ -> simple_fail "cannot auto-detect syntax, pleas use -s name_of_syntax" - end - else if String.equal syntax "pascaligo" then ok `pascaligo - else if String.equal syntax "cameligo" then ok `cameligo - else simple_fail "unrecognized parser" - end - -let parsify = fun (syntax : v_syntax) source_filename -> - let%bind parsify = match syntax with - | `pascaligo -> ok parsify_pascaligo - | `cameligo -> ok parsify_ligodity - in - parsify source_filename - -let parsify_expression = fun syntax source -> - let%bind parsify = match syntax with - | `pascaligo -> ok parsify_expression_pascaligo - | `cameligo -> ok parsify_expression_ligodity - in - parsify source +open Helpers let compile_contract_file : string -> string -> s_syntax -> string result = fun source_filename entry_point syntax -> let%bind syntax = syntax_to_variant syntax (Some source_filename) in diff --git a/src/run/run_typed.ml b/src/main/run/run_typed.ml similarity index 100% rename from src/run/run_typed.ml rename to src/main/run/run_typed.ml diff --git a/src/passes/8-compiler/compiler_environment.ml b/src/passes/8-compiler/compiler_environment.ml index c5fcd040b..a196d9c49 100644 --- a/src/passes/8-compiler/compiler_environment.ml +++ b/src/passes/8-compiler/compiler_environment.ml @@ -3,6 +3,8 @@ open Mini_c open Environment open Michelson +let empty : environment = [] + let get : environment -> string -> michelson result = fun e s -> let%bind (_ , position) = let error = diff --git a/src/run/run_mini_c.ml b/src/run/run_mini_c.ml deleted file mode 100644 index d13b4cc54..000000000 --- a/src/run/run_mini_c.ml +++ /dev/null @@ -1,55 +0,0 @@ -open Proto_alpha_utils -open Trace -open Mini_c -open! Compiler.Program -open Memory_proto_alpha.Protocol.Script_ir_translator -open Memory_proto_alpha.X - -let run_aux ?options (program:compiled_program) (input_michelson:Michelson.t) : ex_typed_value result = - let Compiler.Program.{input;output;body} : compiled_program = program in - let (Ex_ty input_ty) = input in - let (Ex_ty output_ty) = output in - let%bind input = - Trace.trace_tzresult_lwt (simple_error "error parsing input") @@ - Memory_proto_alpha.parse_michelson_data input_michelson input_ty in - let body = Michelson.strip_annots body in - let%bind descr = - Trace.trace_tzresult_lwt (simple_error "error parsing program code") @@ - Memory_proto_alpha.parse_michelson body - (Item_t (input_ty, Empty_t, None)) (Item_t (output_ty, Empty_t, None)) in - let open! Memory_proto_alpha.Protocol.Script_interpreter in - let%bind (Item(output, Empty)) = - Trace.trace_tzresult_lwt (simple_error "error of execution") @@ - Memory_proto_alpha.interpret ?options descr (Item(input, Empty)) in - ok (Ex_typed_value (output_ty, output)) - -let run_entry ?(debug_michelson = false) ?options (entry:anon_function) ty (input:value) : value result = - let%bind compiled = - let error = - let title () = "compile entry" in - let content () = - Format.asprintf "%a" PP.function_ entry - in - error title content in - trace error @@ - translate_entry entry ty in - let%bind input_michelson = translate_value input (fst ty) in - if debug_michelson then ( - Format.printf "Program: %a\n" Michelson.pp compiled.body ; - Format.printf "Expression: %a\n" PP.expression entry.result ; - Format.printf "Input: %a\n" PP.value input ; - Format.printf "Input Type: %a\n" PP.type_ (fst ty) ; - Format.printf "Compiled Input: %a\n" Michelson.pp input_michelson ; - ) ; - let%bind ex_ty_value = run_aux ?options compiled input_michelson in - if debug_michelson then ( - let (Ex_typed_value (ty , v)) = ex_ty_value in - ignore @@ - let%bind michelson_value = - trace_tzresult_lwt (simple_error "debugging run_mini_c") @@ - Proto_alpha_utils.Memory_proto_alpha.unparse_michelson_data ty v in - Format.printf "Compiled Output: %a\n" Michelson.pp michelson_value ; - ok () - ) ; - let%bind (result : value) = Compiler.Uncompiler.translate_value ex_ty_value in - ok result diff --git a/test/.merlin b/test/.merlin deleted file mode 100644 index ae626d691..000000000 --- a/test/.merlin +++ /dev/null @@ -1,187 +0,0 @@ -EXCLUDE_QUERY_DIR -B /home/cc/Programming/ligo/_opam/lib/alcotest -B /home/cc/Programming/ligo/_opam/lib/astring -B /home/cc/Programming/ligo/_opam/lib/base/caml -B /home/cc/Programming/ligo/_opam/lib/bigarray-compat -B /home/cc/Programming/ligo/_opam/lib/bigstring -B /home/cc/Programming/ligo/_opam/lib/biniou -B /home/cc/Programming/ligo/_opam/lib/blake2 -B /home/cc/Programming/ligo/_opam/lib/bytes -B /home/cc/Programming/ligo/_opam/lib/cmdliner -B /home/cc/Programming/ligo/_opam/lib/cstruct -B /home/cc/Programming/ligo/_opam/lib/easy-format -B /home/cc/Programming/ligo/_opam/lib/ezjsonm -B /home/cc/Programming/ligo/_opam/lib/fmt -B /home/cc/Programming/ligo/_opam/lib/getopt -B /home/cc/Programming/ligo/_opam/lib/hacl -B /home/cc/Programming/ligo/_opam/lib/hex -B /home/cc/Programming/ligo/_opam/lib/ipaddr -B /home/cc/Programming/ligo/_opam/lib/ipaddr/unix -B /home/cc/Programming/ligo/_opam/lib/jsonm -B /home/cc/Programming/ligo/_opam/lib/lwt -B /home/cc/Programming/ligo/_opam/lib/lwt/unix -B /home/cc/Programming/ligo/_opam/lib/lwt_log -B /home/cc/Programming/ligo/_opam/lib/lwt_log/core -B /home/cc/Programming/ligo/_opam/lib/macaddr -B /home/cc/Programming/ligo/_opam/lib/mmap -B /home/cc/Programming/ligo/_opam/lib/mtime -B /home/cc/Programming/ligo/_opam/lib/mtime/os -B /home/cc/Programming/ligo/_opam/lib/ocaml -B /home/cc/Programming/ligo/_opam/lib/ocaml/threads -B /home/cc/Programming/ligo/_opam/lib/ocplib-endian -B /home/cc/Programming/ligo/_opam/lib/ocplib-json-typed -B /home/cc/Programming/ligo/_opam/lib/ocplib-json-typed-bson -B /home/cc/Programming/ligo/_opam/lib/ocplib-resto -B /home/cc/Programming/ligo/_opam/lib/ocplib-resto-directory -B /home/cc/Programming/ligo/_opam/lib/parsexp -B /home/cc/Programming/ligo/_opam/lib/ppx_deriving/runtime -B /home/cc/Programming/ligo/_opam/lib/ptime -B /home/cc/Programming/ligo/_opam/lib/ptime/os -B /home/cc/Programming/ligo/_opam/lib/re -B /home/cc/Programming/ligo/_opam/lib/re/posix -B /home/cc/Programming/ligo/_opam/lib/re/str -B /home/cc/Programming/ligo/_opam/lib/result -B /home/cc/Programming/ligo/_opam/lib/secp256k1 -B /home/cc/Programming/ligo/_opam/lib/seq -B /home/cc/Programming/ligo/_opam/lib/sexplib -B /home/cc/Programming/ligo/_opam/lib/sexplib0 -B /home/cc/Programming/ligo/_opam/lib/stdlib-shims -B /home/cc/Programming/ligo/_opam/lib/stringext -B /home/cc/Programming/ligo/_opam/lib/tezos-base -B /home/cc/Programming/ligo/_opam/lib/tezos-clic -B /home/cc/Programming/ligo/_opam/lib/tezos-crypto -B /home/cc/Programming/ligo/_opam/lib/tezos-data-encoding -B /home/cc/Programming/ligo/_opam/lib/tezos-error-monad -B /home/cc/Programming/ligo/_opam/lib/tezos-event-logging -B /home/cc/Programming/ligo/_opam/lib/tezos-micheline -B /home/cc/Programming/ligo/_opam/lib/tezos-protocol-environment -B /home/cc/Programming/ligo/_opam/lib/tezos-protocol-environment-sigs -B /home/cc/Programming/ligo/_opam/lib/tezos-rpc -B /home/cc/Programming/ligo/_opam/lib/tezos-stdlib -B /home/cc/Programming/ligo/_opam/lib/tezos-stdlib-unix -B /home/cc/Programming/ligo/_opam/lib/uchar -B /home/cc/Programming/ligo/_opam/lib/uecc -B /home/cc/Programming/ligo/_opam/lib/uri -B /home/cc/Programming/ligo/_opam/lib/uuidm -B /home/cc/Programming/ligo/_opam/lib/uutf -B /home/cc/Programming/ligo/_opam/lib/yojson -B /home/cc/Programming/ligo/_opam/lib/zarith -B ../_build/default/src/.ligo.objs/byte -B ../_build/default/src/passes/1-parser/.parser.objs/byte -B ../_build/default/src/passes/1-parser/camligo/.parser_camligo.objs/byte -B ../_build/default/src/passes/1-parser/camligo/lex/.lex.objs/byte -B ../_build/default/src/passes/1-parser/ligodity/.parser_ligodity.objs/byte -B ../_build/default/src/passes/1-parser/pascaligo/.parser_pascaligo.objs/byte -B ../_build/default/src/passes/1-parser/shared/.parser_shared.objs/byte -B ../_build/default/src/passes/2-simplify/.simplify.objs/byte -B ../_build/default/src/passes/4-typer/.typer.objs/byte -B ../_build/default/src/passes/6-transpiler/.transpiler.objs/byte -B ../_build/default/src/passes/8-compiler/.compiler.objs/byte -B ../_build/default/src/passes/operators/.operators.objs/byte -B ../_build/default/src/run/main/.main.objs/byte -B ../_build/default/src/stages/ast_simplified/.ast_simplified.objs/byte -B ../_build/default/src/stages/ast_typed/.ast_typed.objs/byte -B ../_build/default/src/stages/mini_c/.mini_c.objs/byte -B ../_build/default/test/.test.eobjs/byte -B ../_build/default/vendors/ligo-utils/memory-proto-alpha/.memory_proto_alpha.objs/byte -B ../_build/default/vendors/ligo-utils/proto-alpha-utils/.proto_alpha_utils.objs/byte -B ../_build/default/vendors/ligo-utils/simple-utils/.simple_utils.objs/byte -B ../_build/default/vendors/ligo-utils/tezos-protocol-alpha-parameters/.tezos_protocol_alpha_parameters.objs/byte -B ../_build/default/vendors/ligo-utils/tezos-protocol-alpha/.tezos_protocol_alpha.objs/byte -B ../_build/default/vendors/ligo-utils/tezos-protocol-alpha/.tezos_protocol_environment_alpha.objs/byte -B ../_build/default/vendors/ligo-utils/tezos-protocol-alpha/.tezos_raw_protocol_alpha.objs/byte -B ../_build/default/vendors/ligo-utils/tezos-utils/.tezos_utils.objs/byte -B ../_build/default/vendors/ligo-utils/tezos-utils/michelson-parser/.michelson_parser.objs/byte -S /home/cc/Programming/ligo/_opam/lib/alcotest -S /home/cc/Programming/ligo/_opam/lib/astring -S /home/cc/Programming/ligo/_opam/lib/base/caml -S /home/cc/Programming/ligo/_opam/lib/bigarray-compat -S /home/cc/Programming/ligo/_opam/lib/bigstring -S /home/cc/Programming/ligo/_opam/lib/biniou -S /home/cc/Programming/ligo/_opam/lib/blake2 -S /home/cc/Programming/ligo/_opam/lib/bytes -S /home/cc/Programming/ligo/_opam/lib/cmdliner -S /home/cc/Programming/ligo/_opam/lib/cstruct -S /home/cc/Programming/ligo/_opam/lib/easy-format -S /home/cc/Programming/ligo/_opam/lib/ezjsonm -S /home/cc/Programming/ligo/_opam/lib/fmt -S /home/cc/Programming/ligo/_opam/lib/getopt -S /home/cc/Programming/ligo/_opam/lib/hacl -S /home/cc/Programming/ligo/_opam/lib/hex -S /home/cc/Programming/ligo/_opam/lib/ipaddr -S /home/cc/Programming/ligo/_opam/lib/ipaddr/unix -S /home/cc/Programming/ligo/_opam/lib/jsonm -S /home/cc/Programming/ligo/_opam/lib/lwt -S /home/cc/Programming/ligo/_opam/lib/lwt/unix -S /home/cc/Programming/ligo/_opam/lib/lwt_log -S /home/cc/Programming/ligo/_opam/lib/lwt_log/core -S /home/cc/Programming/ligo/_opam/lib/macaddr -S /home/cc/Programming/ligo/_opam/lib/mmap -S /home/cc/Programming/ligo/_opam/lib/mtime -S /home/cc/Programming/ligo/_opam/lib/mtime/os -S /home/cc/Programming/ligo/_opam/lib/ocaml -S /home/cc/Programming/ligo/_opam/lib/ocaml/threads -S /home/cc/Programming/ligo/_opam/lib/ocplib-endian -S /home/cc/Programming/ligo/_opam/lib/ocplib-json-typed -S /home/cc/Programming/ligo/_opam/lib/ocplib-json-typed-bson -S /home/cc/Programming/ligo/_opam/lib/ocplib-resto -S /home/cc/Programming/ligo/_opam/lib/ocplib-resto-directory -S /home/cc/Programming/ligo/_opam/lib/parsexp -S /home/cc/Programming/ligo/_opam/lib/ppx_deriving/runtime -S /home/cc/Programming/ligo/_opam/lib/ptime -S /home/cc/Programming/ligo/_opam/lib/ptime/os -S /home/cc/Programming/ligo/_opam/lib/re -S /home/cc/Programming/ligo/_opam/lib/re/posix -S /home/cc/Programming/ligo/_opam/lib/re/str -S /home/cc/Programming/ligo/_opam/lib/result -S /home/cc/Programming/ligo/_opam/lib/secp256k1 -S /home/cc/Programming/ligo/_opam/lib/seq -S /home/cc/Programming/ligo/_opam/lib/sexplib -S /home/cc/Programming/ligo/_opam/lib/sexplib0 -S /home/cc/Programming/ligo/_opam/lib/stdlib-shims -S /home/cc/Programming/ligo/_opam/lib/stringext -S /home/cc/Programming/ligo/_opam/lib/tezos-base -S /home/cc/Programming/ligo/_opam/lib/tezos-clic -S /home/cc/Programming/ligo/_opam/lib/tezos-crypto -S /home/cc/Programming/ligo/_opam/lib/tezos-data-encoding -S /home/cc/Programming/ligo/_opam/lib/tezos-error-monad -S /home/cc/Programming/ligo/_opam/lib/tezos-event-logging -S /home/cc/Programming/ligo/_opam/lib/tezos-micheline -S /home/cc/Programming/ligo/_opam/lib/tezos-protocol-environment -S /home/cc/Programming/ligo/_opam/lib/tezos-protocol-environment-sigs -S /home/cc/Programming/ligo/_opam/lib/tezos-rpc -S /home/cc/Programming/ligo/_opam/lib/tezos-stdlib -S /home/cc/Programming/ligo/_opam/lib/tezos-stdlib-unix -S /home/cc/Programming/ligo/_opam/lib/uchar -S /home/cc/Programming/ligo/_opam/lib/uecc -S /home/cc/Programming/ligo/_opam/lib/uri -S /home/cc/Programming/ligo/_opam/lib/uuidm -S /home/cc/Programming/ligo/_opam/lib/uutf -S /home/cc/Programming/ligo/_opam/lib/yojson -S /home/cc/Programming/ligo/_opam/lib/zarith -S ../src -S ../src/passes/1-parser -S ../src/passes/1-parser/camligo -S ../src/passes/1-parser/camligo/lex -S ../src/passes/1-parser/ligodity -S ../src/passes/1-parser/pascaligo -S ../src/passes/1-parser/shared -S ../src/passes/2-simplify -S ../src/passes/4-typer -S ../src/passes/6-transpiler -S ../src/passes/8-compiler -S ../src/passes/operators -S ../src/run/main -S ../src/stages/ast_simplified -S ../src/stages/ast_typed -S ../src/stages/mini_c -S . -S ../vendors/ligo-utils/memory-proto-alpha -S ../vendors/ligo-utils/proto-alpha-utils -S ../vendors/ligo-utils/simple-utils -S ../vendors/ligo-utils/tezos-protocol-alpha -S ../vendors/ligo-utils/tezos-protocol-alpha-parameters -S ../vendors/ligo-utils/tezos-utils -S ../vendors/ligo-utils/tezos-utils/michelson-parser -FLG -ppx '/home/cc/Programming/ligo/_build/default/.ppx/0af9cc0ed9166d3107af7264d5703b53/ppx.exe --as-ppx' -FLG -w @1..3@5..28@30..39@43@46..47@49..57@61..62-40 -strict-sequence -strict-formats -short-paths -keep-locs -w +1..62-4-9-44-40-42-48@39@33 -open Simple_utils diff --git a/test/coase_tests.ml b/test/coase_tests.ml index bbfd75b51..135f9b429 100644 --- a/test/coase_tests.ml +++ b/test/coase_tests.ml @@ -4,7 +4,7 @@ open Trace open Ligo.Run open Test_helpers -let type_file = type_file `pascaligo +let type_file = type_file Pascaligo let get_program = let s = ref None in diff --git a/test/heap_tests.ml b/test/heap_tests.ml index 5a6f440df..fb3821f27 100644 --- a/test/heap_tests.ml +++ b/test/heap_tests.ml @@ -2,7 +2,7 @@ open Trace open Ligo.Run open Test_helpers -let type_file = type_file `pascaligo +let type_file = type_file Pascaligo let get_program = let s = ref None in diff --git a/test/integration_tests.ml b/test/integration_tests.ml index 4432f07b9..781cb3a53 100644 --- a/test/integration_tests.ml +++ b/test/integration_tests.ml @@ -4,8 +4,8 @@ open Test_helpers open Ast_simplified.Combinators -let mtype_file ?debug_simplify ?debug_typed = type_file ?debug_simplify ?debug_typed `cameligo -let type_file = type_file `pascaligo +let mtype_file ?debug_simplify ?debug_typed = type_file ?debug_simplify ?debug_typed Cameligo +let type_file = type_file Pascaligo let type_alias () : unit result = let%bind program = type_file "./contracts/type-alias.ligo" in diff --git a/test/vote_tests.ml b/test/vote_tests.ml index d4d1f9336..fbcf2b7ee 100644 --- a/test/vote_tests.ml +++ b/test/vote_tests.ml @@ -7,7 +7,7 @@ let get_program = fun () -> match !s with | Some s -> ok s | None -> ( - let%bind program = type_file `cameligo "./contracts/vote.mligo" in + let%bind program = type_file Cameligo "./contracts/vote.mligo" in s := Some program ; ok program ) From 5566095e495cd8ff07a1ec406c7e64da6cd2bdc5 Mon Sep 17 00:00:00 2001 From: galfour Date: Wed, 11 Sep 2019 13:56:39 +0200 Subject: [PATCH 05/18] more stuff --- src/main/compile/of_simplified.ml | 13 +- src/main/compile/of_source.ml | 18 + src/main/compile/of_typed.ml | 112 ++++- src/main/dune | 12 + src/main/main.ml | 2 + src/main/run/run_mini_c.ml | 9 +- src/main/run/run_typed.ml | 7 +- src/passes/4-typer/typer.ml | 15 +- src/passes/6-transpiler/helpers.ml | 49 ++ src/passes/6-transpiler/transpiler.ml | 439 ++++-------------- src/passes/6-transpiler/untranspiler.ml | 193 ++++++++ src/passes/8-compiler/compiler_program.ml | 9 +- src/passes/operators/operators.ml | 7 +- src/stages/ast_typed/PP.ml | 7 +- src/stages/ast_typed/combinators.ml | 6 +- .../ast_typed/combinators_environment.ml | 2 +- src/stages/ast_typed/misc.ml | 2 +- src/stages/ast_typed/misc_smart.ml | 8 +- src/stages/ast_typed/types.ml | 8 +- src/stages/mini_c/combinators.ml | 4 +- 20 files changed, 523 insertions(+), 399 deletions(-) create mode 100644 src/main/dune create mode 100644 src/main/main.ml create mode 100644 src/passes/6-transpiler/helpers.ml create mode 100644 src/passes/6-transpiler/untranspiler.ml diff --git a/src/main/compile/of_simplified.ml b/src/main/compile/of_simplified.ml index b8b0ff78e..27bf6ebef 100644 --- a/src/main/compile/of_simplified.ml +++ b/src/main/compile/of_simplified.ml @@ -1,6 +1,15 @@ open Ast_simplified open Trace +open Tezos_utils -let compile_entry (program : program) entry_point = +let compile_function_entry (program : program) entry_point : Compiler.Program.compiled_program result = let%bind typed_program = Typer.type_program program in - Of_typed.compile_entry typed_program entry_point + Of_typed.compile_function_entry typed_program entry_point + +let compile_expression_entry (program : program) entry_point : Compiler.Program.compiled_program result = + let%bind typed_program = Typer.type_program program in + Of_typed.compile_expression_entry typed_program entry_point + +let compile_expression ae : Michelson.t result = + let%bind typed = Typer.type_expression Ast_typed.Environment.full_empty ae in + Of_typed.compile_expression typed diff --git a/src/main/compile/of_source.ml b/src/main/compile/of_source.ml index f286ab848..a4fd4e814 100644 --- a/src/main/compile/of_source.ml +++ b/src/main/compile/of_source.ml @@ -1 +1,19 @@ open Trace +open Helpers +open Tezos_utils + +let parse_file_program source_filename syntax = + let%bind syntax = syntax_to_variant syntax (Some source_filename) in + let%bind simplified = parsify syntax source_filename in + ok simplified + +let compile_file_entry : string -> string -> s_syntax -> Compiler.Program.compiled_program result = + fun source_filename entry_point syntax -> + let%bind simplified = parse_file_program source_filename syntax in + Of_simplified.compile_function_entry simplified entry_point + +let compile_file_parameter : string -> string -> string -> s_syntax -> Michelson.t result = + fun source_filename _entry_point expression syntax -> + let%bind syntax = syntax_to_variant syntax (Some source_filename) in + let%bind simplified = parsify_expression syntax expression in + Of_simplified.compile_expression simplified diff --git a/src/main/compile/of_typed.ml b/src/main/compile/of_typed.ml index b7a60fa3c..96adc461c 100644 --- a/src/main/compile/of_typed.ml +++ b/src/main/compile/of_typed.ml @@ -2,10 +2,116 @@ open Trace open Ast_typed open Tezos_utils +module Errors = struct + + let missing_entry_point name = + let title () = "missing entry point" in + let content () = "no entry point with the given name" in + let data = [ + ("name" , fun () -> name) ; + ] in + error ~data title content + + let not_functional_main location = + let title () = "not functional main" in + let content () = "main should be a function" in + let data = [ + ("location" , fun () -> Format.asprintf "%a" Location.pp location) ; + ] in + error ~data title content + +end + +(* + This converts `expr` in `fun () -> expr`. +*) +let functionalize (body : annotated_expression) : annotated_expression = + let expression = E_lambda { binder = "_" ; body } in + let type_annotation = t_function (t_unit ()) body.type_annotation () in + { body with expression ; type_annotation } + let compile_expression : annotated_expression -> Michelson.t result = fun e -> - let%bind mini_c_expression = Transpiler.translate_annotated_expression e in + let%bind mini_c_expression = Transpiler.transpile_annotated_expression e in Of_mini_c.compile_expression mini_c_expression -let compile_entry : program -> string -> _ = fun p entry -> - let%bind (f , (in_ty , out_ty)) = Transpiler.translate_entry p entry in +(* + val compile_value : annotated_expression -> Michelson.t result + This requires writing a function + `transpile_expression_as_value : annotated_expression -> Mini_c.value result` + *) + +let compile_function expr = + let%bind l = get_lambda expr.expression in + let%bind io = get_t_function expr.type_annotation in + let%bind mini_c = Transpiler.transpile_lambda Mini_c.Environment.empty l io in + let%bind (f , (in_ty , out_ty)) = + match (mini_c.content , mini_c.type_value) with + | E_literal (D_function f) , T_function ty -> ok (f , ty) + | _ -> fail @@ Errors.not_functional_main expr.location + in Of_mini_c.compile_function f in_ty out_ty + +(* + Assume the following code: + ``` + const x = 42 + const y = 120 + const z = 423 + const f = () -> x + y + ``` + It is transformed in: + ``` + const f = () -> + let x = 42 in + let y = 120 in + let z = 423 in + x + y + ``` + + To do so, each declaration `const variable = expr` is translated in + a function `body -> let variable = expr in body`. Those functions are + then applied in order, which yields `let x = 42 in let y = 120 in ...`. + + The entry-point can be an expression, which is then functionalized if + `to_functionalize` is set to true. +*) +let aggregate_declarations_for_entry (lst : program) (name : string) (to_functionalize : bool) : annotated_expression result = + let rec aux acc (lst : program) = + let%bind acc = acc in + match lst with + | [] -> fail @@ Errors.missing_entry_point name + | hd :: tl -> ( + let (Declaration_constant (an , (pre_env , _))) = Location.unwrap hd in + if (an.name <> name) then ( + let next = fun expr -> + let cur = e_a_let_in an.name an.annotated_expression expr pre_env in + acc cur in + aux (ok next) tl + ) else ( + match (an.annotated_expression.expression , to_functionalize) with + | (E_lambda l , false) -> ( + let l' = { l with body = acc l.body } in + let e' = { an.annotated_expression with expression = E_lambda l' } in + ok e' + ) + | (_ , true) -> ( + ok @@ functionalize @@ acc an.annotated_expression + ) + | _ -> fail @@ Errors.not_functional_main an.annotated_expression.location + ) + ) + in + let%bind l = aux (ok (fun x -> x)) lst in + ok l + +let compile_function_entry : program -> string -> _ = fun p entry -> + let%bind expr = aggregate_declarations_for_entry p entry false in + compile_function expr + +let compile_expression_entry : program -> string -> _ = fun p entry -> + let%bind expr = aggregate_declarations_for_entry p entry true in + compile_function expr + +let compile_expression_as_function : annotated_expression -> Compiler.Program.compiled_program result = fun e -> + let expr = functionalize e in + compile_function expr diff --git a/src/main/dune b/src/main/dune new file mode 100644 index 000000000..f4bfd2efd --- /dev/null +++ b/src/main/dune @@ -0,0 +1,12 @@ +(library + (name main) + (public_name ligo.main) + (libraries + run + compile + ) + (preprocess + (pps ppx_let) + ) + (flags (:standard -w +1..62-4-9-44-40-42-48-30@39@33 -open Simple_utils -open Tezos_utils )) +) diff --git a/src/main/main.ml b/src/main/main.ml new file mode 100644 index 000000000..5795d1e56 --- /dev/null +++ b/src/main/main.ml @@ -0,0 +1,2 @@ +module Run = Run +module Compile = Compile diff --git a/src/main/run/run_mini_c.ml b/src/main/run/run_mini_c.ml index dd3dba8f1..06864c223 100644 --- a/src/main/run/run_mini_c.ml +++ b/src/main/run/run_mini_c.ml @@ -4,6 +4,13 @@ open Trace open Mini_c open Compiler.Program +module Errors = struct + + let entry_error = + simple_error "error translating entry point" + +end + type options = { entry_point : anon_function ; input_type : type_value ; @@ -14,7 +21,7 @@ type options = { let run_entry ?(debug_michelson = false) ?options (entry : anon_function) ty (input:value) : value result = let%bind compiled = - trace error @@ + trace Errors.entry_error @@ translate_entry entry ty in let%bind input_michelson = translate_value input (fst ty) in if debug_michelson then ( diff --git a/src/main/run/run_typed.ml b/src/main/run/run_typed.ml index fc136c63c..0f41fe6fa 100644 --- a/src/main/run/run_typed.ml +++ b/src/main/run/run_typed.ml @@ -1,7 +1,7 @@ open Trace +open Ast_typed -let transpile_value - (e:Ast_typed.annotated_expression) : Mini_c.value result = +let evaluate (e : annotated_expression) : annotated_expression result = let%bind (f , ty) = let open Transpiler in let (f , _) = functionalize e in @@ -32,7 +32,8 @@ let evaluate_typed let run_typed ?(debug_mini_c = false) ?(debug_michelson = false) ?options (entry:string) - (program:Ast_typed.program) (input:Ast_typed.annotated_expression) : Ast_typed.annotated_expression result = + (program : Ast_typed.program) (input : Ast_typed.annotated_expression) : Ast_typed.annotated_expression result = + let%bind let%bind () = let open Ast_typed in let%bind (Declaration_constant (d , _)) = get_declaration_by_name program entry in diff --git a/src/passes/4-typer/typer.ml b/src/passes/4-typer/typer.ml index 9e2679a1b..edc9d05b8 100644 --- a/src/passes/4-typer/typer.ml +++ b/src/passes/4-typer/typer.ml @@ -582,9 +582,9 @@ and type_expression : environment -> ?tv_opt:O.type_value -> I.expression -> O.a bind_map_option (evaluate_type e) output_type in let e' = Environment.add_ez_binder (fst binder) input_type e in - let%bind result = type_expression ?tv_opt:output_type e' result in - let output_type = result.type_annotation in - return (E_lambda {binder = fst binder;input_type;output_type;result}) (t_function input_type output_type ()) + let%bind body = type_expression ?tv_opt:output_type e' result in + let output_type = body.type_annotation in + return (E_lambda {binder = fst binder ; body}) (t_function input_type output_type ()) ) | E_constant (name, lst) -> let%bind lst' = bind_list @@ List.map (type_expression e) lst in @@ -796,11 +796,12 @@ let rec untype_expression (e:O.annotated_expression) : (I.expression) result = let%bind f' = untype_expression f in let%bind arg' = untype_expression arg in return (e_application f' arg') - | E_lambda {binder;input_type;output_type;result} -> - let%bind input_type = untype_type_value input_type in - let%bind output_type = untype_type_value output_type in - let%bind result = untype_expression result in + | E_lambda {binder ; body} -> ( + let%bind io = get_t_function e.type_annotation in + let%bind (input_type , output_type) = bind_map_pair untype_type_value io in + let%bind result = untype_expression body in return (e_lambda binder (Some input_type) (Some output_type) result) + ) | E_tuple lst -> let%bind lst' = bind_list @@ List.map untype_expression lst in diff --git a/src/passes/6-transpiler/helpers.ml b/src/passes/6-transpiler/helpers.ml new file mode 100644 index 000000000..2609123eb --- /dev/null +++ b/src/passes/6-transpiler/helpers.ml @@ -0,0 +1,49 @@ +module AST = Ast_typed +module Append_tree = Tree.Append + +open Trace +open Mini_c + +let list_of_map m = List.rev @@ Map.String.fold (fun _ v prev -> v :: prev) m [] +let kv_list_of_map m = List.rev @@ Map.String.fold (fun k v prev -> (k, v) :: prev) m [] +let map_of_kv_list lst = + let open AST.SMap in + List.fold_left (fun prev (k, v) -> add k v prev) empty lst + +let extract_constructor (v : value) (tree : _ Append_tree.t') : (string * value * AST.type_value) result = + let open Append_tree in + let rec aux tv : (string * value * AST.type_value) result= + match tv with + | Leaf (k, t), v -> ok (k, v, t) + | Node {a}, D_left v -> aux (a, v) + | Node {b}, D_right v -> aux (b, v) + | _ -> fail @@ internal_assertion_failure "bad constructor path" + in + let%bind (s, v, t) = aux (tree, v) in + ok (s, v, t) + +let extract_tuple (v : value) (tree : AST.type_value Append_tree.t') : ((value * AST.type_value) list) result = + let open Append_tree in + let rec aux tv : ((value * AST.type_value) list) result = + match tv with + | Leaf t, v -> ok @@ [v, t] + | Node {a;b}, D_pair (va, vb) -> + let%bind a' = aux (a, va) in + let%bind b' = aux (b, vb) in + ok (a' @ b') + | _ -> fail @@ internal_assertion_failure "bad tuple path" + in + aux (tree, v) + +let extract_record (v : value) (tree : _ Append_tree.t') : (_ list) result = + let open Append_tree in + let rec aux tv : ((string * (value * AST.type_value)) list) result = + match tv with + | Leaf (s, t), v -> ok @@ [s, (v, t)] + | Node {a;b}, D_pair (va, vb) -> + let%bind a' = aux (a, va) in + let%bind b' = aux (b, vb) in + ok (a' @ b') + | _ -> fail @@ internal_assertion_failure "bad record path" + in + aux (tree, v) diff --git a/src/passes/6-transpiler/transpiler.ml b/src/passes/6-transpiler/transpiler.ml index 7d4db9321..ef8d562c4 100644 --- a/src/passes/6-transpiler/transpiler.ml +++ b/src/passes/6-transpiler/transpiler.ml @@ -1,4 +1,5 @@ open! Trace +open Helpers module AST = Ast_typed module Append_tree = Tree.Append @@ -6,15 +7,11 @@ open AST.Combinators open Mini_c open Combinators +let untranspile = Untranspiler.untranspile + let temp_unwrap_loc = Location.unwrap let temp_unwrap_loc_list = List.map Location.unwrap -let list_of_map m = List.rev @@ Map.String.fold (fun _ v prev -> v :: prev) m [] -let kv_list_of_map m = List.rev @@ Map.String.fold (fun k v prev -> (k, v) :: prev) m [] -let map_of_kv_list lst = - let open AST.SMap in - List.fold_left (fun prev (k, v) -> add k v prev) empty lst - module Errors = struct let corner_case ~loc message = let title () = "corner case" in @@ -49,53 +46,10 @@ them. please report this to the developers." in row_loc location ; ] in error ~data title content - - let not_functional_main location = - let title () = "not functional main" in - let content () = "main should be a function" in - let data = [ - ("location" , fun () -> Format.asprintf "%a" Location.pp location) ; - ] in - error ~data title content - - let missing_entry_point name = - let title () = "missing entry point" in - let content () = "no entry point with the given name" in - let data = [ - ("name" , fun () -> name) ; - ] in - error ~data title content - - let wrong_mini_c_value expected_type actual = - let title () = "illed typed intermediary value" in - let content () = "type of intermediary value doesn't match what was expected" in - let data = [ - ("expected_type" , fun () -> expected_type) ; - ("actual" , fun () -> Format.asprintf "%a" Mini_c.PP.value actual ) ; - ] in - error ~data title content - - let bad_untranspile bad_type value = - let title () = "untranspiling bad value" in - let content () = Format.asprintf "can not untranspile %s" bad_type in - let data = [ - ("bad_type" , fun () -> bad_type) ; - ("value" , fun () -> Format.asprintf "%a" Mini_c.PP.value value) ; - ] in - error ~data title content - - let unknown_untranspile unknown_type value = - let title () = "untranspiling unknown value" in - let content () = Format.asprintf "can not untranspile %s" unknown_type in - let data = [ - ("unknown_type" , fun () -> unknown_type) ; - ("value" , fun () -> Format.asprintf "%a" Mini_c.PP.value value) ; - ] in - error ~data title content end open Errors -let rec translate_type (t:AST.type_value) : type_value result = +let rec transpile_type (t:AST.type_value) : type_value result = match t.type_value' with | T_constant ("bool", []) -> ok (T_base Base_bool) | T_constant ("int", []) -> ok (T_base Base_int) @@ -108,19 +62,19 @@ let rec translate_type (t:AST.type_value) : type_value result = | T_constant ("unit", []) -> ok (T_base Base_unit) | T_constant ("operation", []) -> ok (T_base Base_operation) | T_constant ("contract", [x]) -> - let%bind x' = translate_type x in + let%bind x' = transpile_type x in ok (T_contract x') | T_constant ("map", [key;value]) -> - let%bind kv' = bind_map_pair translate_type (key, value) in + let%bind kv' = bind_map_pair transpile_type (key, value) in ok (T_map kv') | T_constant ("list", [t]) -> - let%bind t' = translate_type t in + let%bind t' = transpile_type t in ok (T_list t') | T_constant ("set", [t]) -> - let%bind t' = translate_type t in + let%bind t' = transpile_type t in ok (T_set t') | T_constant ("option", [o]) -> - let%bind o' = translate_type o in + let%bind o' = transpile_type o in ok (T_option o') | T_constant (name , _lst) -> fail @@ unrecognized_type_constant name | T_sum m -> @@ -130,7 +84,7 @@ let rec translate_type (t:AST.type_value) : type_value result = let%bind b = b in ok (T_or (a, b)) in - Append_tree.fold_ne translate_type aux node + Append_tree.fold_ne transpile_type aux node | T_record m -> let node = Append_tree.of_list @@ list_of_map m in let aux a b : type_value result = @@ -138,7 +92,7 @@ let rec translate_type (t:AST.type_value) : type_value result = let%bind b = b in ok (T_pair (a, b)) in - Append_tree.fold_ne translate_type aux node + Append_tree.fold_ne transpile_type aux node | T_tuple lst -> let node = Append_tree.of_list lst in let aux a b : type_value result = @@ -146,10 +100,10 @@ let rec translate_type (t:AST.type_value) : type_value result = let%bind b = b in ok (T_pair (a, b)) in - Append_tree.fold_ne translate_type aux node + Append_tree.fold_ne transpile_type aux node | T_function (param, result) -> ( - let%bind param' = translate_type param in - let%bind result' = translate_type result in + let%bind param' = transpile_type param in + let%bind result' = transpile_type result in ok (T_function (param', result')) ) @@ -191,7 +145,7 @@ let record_access_to_lr : type_value -> type_value AST.type_name_map -> string - bind_fold_list aux (ty , []) lr_path in ok lst -let rec translate_literal : AST.literal -> value = fun l -> match l with +let rec transpile_literal : AST.literal -> value = fun l -> match l with | Literal_bool b -> D_bool b | Literal_int n -> D_int n | Literal_nat n -> D_nat n @@ -206,12 +160,12 @@ let rec translate_literal : AST.literal -> value = fun l -> match l with and transpile_environment_element_type : AST.environment_element -> type_value result = fun ele -> match (AST.get_type' ele.type_value , ele.definition) with | (AST.T_function (f , arg) , ED_declaration (ae , ((_ :: _) as captured_variables)) ) -> - let%bind f' = translate_type f in - let%bind arg' = translate_type arg in + let%bind f' = transpile_type f in + let%bind arg' = transpile_type arg in let%bind env' = transpile_environment ae.environment in let sub_env = Mini_c.Environment.select captured_variables env' in ok @@ Combinators.t_deep_closure sub_env f' arg' - | _ -> translate_type ele.type_value + | _ -> transpile_type ele.type_value and transpile_small_environment : AST.small_environment -> Environment.t result = fun x -> let x' = AST.Environment.Small.get_environment x in @@ -231,10 +185,10 @@ and tree_of_sum : AST.type_value -> (type_name * AST.type_value) Append_tree.t r let%bind map_tv = get_t_sum t in ok @@ Append_tree.of_list @@ kv_list_of_map map_tv -and translate_annotated_expression (ae:AST.annotated_expression) : expression result = - let%bind tv = translate_type ae.type_annotation in +and transpile_annotated_expression (ae:AST.annotated_expression) : expression result = + let%bind tv = transpile_type ae.type_annotation in let return ?(tv = tv) expr = ok @@ Combinators.Expression.make_tpl (expr, tv) in - let f = translate_annotated_expression in + let f = transpile_annotated_expression in let info = let title () = "translating expression" in let content () = Format.asprintf "%a" Location.pp ae.location in @@ -242,14 +196,14 @@ and translate_annotated_expression (ae:AST.annotated_expression) : expression re trace info @@ match ae.expression with | E_let_in {binder; rhs; result} -> - let%bind rhs' = translate_annotated_expression rhs in - let%bind result' = translate_annotated_expression result in + let%bind rhs' = transpile_annotated_expression rhs in + let%bind result' = transpile_annotated_expression result in return (E_let_in ((binder, rhs'.type_value), rhs', result')) | E_failwith ae -> ( - let%bind ae' = translate_annotated_expression ae in + let%bind ae' = transpile_annotated_expression ae in return @@ E_constant ("FAILWITH" , [ae']) ) - | E_literal l -> return @@ E_literal (translate_literal l) + | E_literal l -> return @@ E_literal (transpile_literal l) | E_variable name -> ( let%bind ele = trace_option (corner_case ~loc:__LOC__ "name not in environment") @@ @@ -258,11 +212,11 @@ and translate_annotated_expression (ae:AST.annotated_expression) : expression re return ~tv @@ E_variable name ) | E_application (a, b) -> - let%bind a = translate_annotated_expression a in - let%bind b = translate_annotated_expression b in + let%bind a = transpile_annotated_expression a in + let%bind b = transpile_annotated_expression b in return @@ E_application (a, b) | E_constructor (m, param) -> ( - let%bind param' = translate_annotated_expression param in + let%bind param' = transpile_annotated_expression param in let (param'_expr , param'_tv) = Combinators.Expression.(get_content param' , get_type param') in let%bind node_tv = trace_strong (corner_case ~loc:__LOC__ "getting lr tree") @@ @@ -274,7 +228,7 @@ and translate_annotated_expression (ae:AST.annotated_expression) : expression re @@ AST.assert_type_value_eq (tv, param.type_annotation) in ok (Some (param'_expr), param'_tv) ) else ( - let%bind tv = translate_type tv in + let%bind tv = transpile_type tv in ok (None, tv) ) in let node a b : (expression' option * type_value) result = @@ -302,14 +256,14 @@ and translate_annotated_expression (ae:AST.annotated_expression) : expression re let tv = T_pair (a_ty , b_ty) in return ~tv @@ E_constant ("PAIR", [a; b]) in - Append_tree.fold_ne (translate_annotated_expression) aux node + Append_tree.fold_ne (transpile_annotated_expression) aux node ) | E_tuple_accessor (tpl, ind) -> ( - let%bind ty' = translate_type tpl.type_annotation in + let%bind ty' = transpile_type tpl.type_annotation in let%bind ty_lst = trace_strong (corner_case ~loc:__LOC__ "not a tuple") @@ get_t_tuple tpl.type_annotation in - let%bind ty'_lst = bind_map_list translate_type ty_lst in + let%bind ty'_lst = bind_map_list transpile_type ty_lst in let%bind path = trace_strong (corner_case ~loc:__LOC__ "tuple access") @@ tuple_access_to_lr ty' ty'_lst ind in @@ -318,7 +272,7 @@ and translate_annotated_expression (ae:AST.annotated_expression) : expression re | `Left -> "CAR" | `Right -> "CDR" in Combinators.Expression.make_tpl (E_constant (c, [pred]) , ty) in - let%bind tpl' = translate_annotated_expression tpl in + let%bind tpl' = transpile_annotated_expression tpl in let expr = List.fold_left aux tpl' path in ok expr ) @@ -333,14 +287,14 @@ and translate_annotated_expression (ae:AST.annotated_expression) : expression re return ~tv @@ E_constant ("PAIR", [a; b]) in trace_strong (corner_case ~loc:__LOC__ "record build") @@ - Append_tree.fold_ne (translate_annotated_expression) aux node + Append_tree.fold_ne (transpile_annotated_expression) aux node ) | E_record_accessor (record, property) -> - let%bind ty' = translate_type (get_type_annotation record) in + let%bind ty' = transpile_type (get_type_annotation record) in let%bind ty_smap = trace_strong (corner_case ~loc:__LOC__ "not a record") @@ get_t_record (get_type_annotation record) in - let%bind ty'_smap = bind_map_smap translate_type ty_smap in + let%bind ty'_smap = bind_map_smap transpile_type ty_smap in let%bind path = trace_strong (corner_case ~loc:__LOC__ "record access") @@ record_access_to_lr ty' ty'_smap property in @@ -349,7 +303,7 @@ and translate_annotated_expression (ae:AST.annotated_expression) : expression re | `Left -> "CAR" | `Right -> "CDR" in Combinators.Expression.make_tpl (E_constant (c, [pred]) , ty) in - let%bind record' = translate_annotated_expression record in + let%bind record' = transpile_annotated_expression record in let expr = List.fold_left aux record' path in ok expr | E_constant (name , lst) -> ( @@ -358,8 +312,9 @@ and translate_annotated_expression (ae:AST.annotated_expression) : expression re | [i ; f] -> ( let%bind f' = match f.expression with | E_lambda l -> ( - let%bind body' = translate_annotated_expression l.result in - let%bind input' = translate_type l.input_type in + let%bind body' = transpile_annotated_expression l.body in + let%bind (input , _) = get_t_function f.type_annotation in + let%bind input' = transpile_type input in ok ((l.binder , input') , body') ) | E_variable v -> ( @@ -370,8 +325,9 @@ and translate_annotated_expression (ae:AST.annotated_expression) : expression re | ED_declaration (f , _) -> ( match f.expression with | E_lambda l -> ( - let%bind body' = translate_annotated_expression l.result in - let%bind input' = translate_type l.input_type in + let%bind body' = transpile_annotated_expression l.body in + let%bind (input , _) = get_t_function f.type_annotation in + let%bind input' = transpile_type input in ok ((l.binder , input') , body') ) | _ -> fail @@ unsupported_iterator f.location @@ -380,7 +336,7 @@ and translate_annotated_expression (ae:AST.annotated_expression) : expression re ) | _ -> fail @@ unsupported_iterator f.location in - let%bind i' = translate_annotated_expression i in + let%bind i' = transpile_annotated_expression i in return @@ E_iterator (name , f' , i') ) | _ -> fail @@ corner_case ~loc:__LOC__ "bad iterator arity" @@ -393,7 +349,7 @@ and translate_annotated_expression (ae:AST.annotated_expression) : expression re | ("LIST_MAP" , lst) -> map lst | ("MAP_MAP" , lst) -> map lst | _ -> ( - let%bind lst' = bind_map_list (translate_annotated_expression) lst in + let%bind lst' = bind_map_list (transpile_annotated_expression) lst in return @@ E_constant (name , lst') ) ) @@ -401,12 +357,13 @@ and translate_annotated_expression (ae:AST.annotated_expression) : expression re let%bind env = trace_strong (corner_case ~loc:__LOC__ "environment") @@ transpile_environment ae.environment in - translate_lambda env l + let%bind io = get_t_function ae.type_annotation in + transpile_lambda env l io | E_list lst -> ( let%bind t = trace_strong (corner_case ~loc:__LOC__ "not a list") @@ Mini_c.Combinators.get_t_list tv in - let%bind lst' = bind_map_list (translate_annotated_expression) lst in + let%bind lst' = bind_map_list (transpile_annotated_expression) lst in let aux : expression -> expression -> expression result = fun prev cur -> return @@ E_constant ("CONS", [cur ; prev]) in let%bind (init : expression) = return @@ E_make_empty_list t in @@ -416,7 +373,7 @@ and translate_annotated_expression (ae:AST.annotated_expression) : expression re let%bind t = trace_strong (corner_case ~loc:__LOC__ "not a set") @@ Mini_c.Combinators.get_t_set tv in - let%bind lst' = bind_map_list (translate_annotated_expression) lst in + let%bind lst' = bind_map_list (transpile_annotated_expression) lst in let aux : expression -> expression -> expression result = fun prev cur -> return @@ E_constant ("SET_ADD", [cur ; prev]) in let%bind (init : expression) = return @@ E_make_empty_set t in @@ -430,7 +387,7 @@ and translate_annotated_expression (ae:AST.annotated_expression) : expression re let%bind prev' = prev in let%bind (k', v') = let v' = e_a_some v ae.environment in - bind_map_pair (translate_annotated_expression) (k , v') in + bind_map_pair (transpile_annotated_expression) (k , v') in return @@ E_constant ("UPDATE", [k' ; v' ; prev']) in let init = return @@ E_make_empty_map (src, dst) in @@ -441,26 +398,26 @@ and translate_annotated_expression (ae:AST.annotated_expression) : expression re return @@ E_constant ("MAP_GET", [i' ; ds']) ) | E_sequence (a , b) -> ( - let%bind a' = translate_annotated_expression a in - let%bind b' = translate_annotated_expression b in + let%bind a' = transpile_annotated_expression a in + let%bind b' = transpile_annotated_expression b in return @@ E_sequence (a' , b') ) | E_loop (expr , body) -> ( - let%bind expr' = translate_annotated_expression expr in - let%bind body' = translate_annotated_expression body in + let%bind expr' = transpile_annotated_expression expr in + let%bind body' = transpile_annotated_expression body in return @@ E_while (expr' , body') ) | E_assign (typed_name , path , expr) -> ( let ty = typed_name.type_value in let aux : ((AST.type_value * [`Left | `Right] list) as 'a) -> AST.access -> 'a result = fun (prev, acc) cur -> - let%bind ty' = translate_type prev in + let%bind ty' = transpile_type prev in match cur with | Access_tuple ind -> ( let%bind ty_lst = trace_strong (corner_case ~loc:__LOC__ "not a tuple") @@ AST.Combinators.get_t_tuple prev in - let%bind ty'_lst = bind_map_list translate_type ty_lst in + let%bind ty'_lst = bind_map_list transpile_type ty_lst in let%bind path = tuple_access_to_lr ty' ty'_lst ind in let path' = List.map snd path in ok (List.nth ty_lst ind, acc @ path') @@ -469,7 +426,7 @@ and translate_annotated_expression (ae:AST.annotated_expression) : expression re let%bind ty_map = trace_strong (corner_case ~loc:__LOC__ "not a record") @@ AST.Combinators.get_t_record prev in - let%bind ty'_map = bind_map_smap translate_type ty_map in + let%bind ty'_map = bind_map_smap transpile_type ty_map in let%bind path = record_access_to_lr ty' ty'_map prop in let path' = List.map snd path in ok (Map.String.find prop ty_map, acc @ path') @@ -477,20 +434,20 @@ and translate_annotated_expression (ae:AST.annotated_expression) : expression re | Access_map _k -> fail (corner_case ~loc:__LOC__ "no patch for map yet") in let%bind (_, path) = bind_fold_right_list aux (ty, []) path in - let%bind expr' = translate_annotated_expression expr in + let%bind expr' = transpile_annotated_expression expr in return (E_assignment (typed_name.type_name, path, expr')) ) | E_matching (expr, m) -> ( - let%bind expr' = translate_annotated_expression expr in + let%bind expr' = transpile_annotated_expression expr in match m with | Match_bool {match_true ; match_false} -> - let%bind (t , f) = bind_map_pair (translate_annotated_expression) (match_true, match_false) in + let%bind (t , f) = bind_map_pair (transpile_annotated_expression) (match_true, match_false) in return @@ E_if_bool (expr', t, f) | Match_option { match_none; match_some = ((name, tv), s) } -> - let%bind n = translate_annotated_expression match_none in + let%bind n = transpile_annotated_expression match_none in let%bind (tv' , s') = - let%bind tv' = translate_type tv in - let%bind s' = translate_annotated_expression s in + let%bind tv' = transpile_type tv in + let%bind s' = transpile_annotated_expression s in ok (tv' , s') in return @@ E_if_none (expr' , n , ((name , tv') , s')) | Match_variant (lst , variant) -> ( @@ -504,7 +461,7 @@ and translate_annotated_expression (ae:AST.annotated_expression) : expression re let rec aux t = match (t : _ Append_tree.t') with | Leaf (name , tv) -> - let%bind tv' = translate_type tv in + let%bind tv' = transpile_type tv in ok (`Leaf name , tv') | Node {a ; b} -> let%bind a' = aux a in @@ -520,7 +477,7 @@ and translate_annotated_expression (ae:AST.annotated_expression) : expression re let%bind ((_ , name) , body) = trace_option (corner_case ~loc:__LOC__ "missing match clause") @@ List.find_opt (fun ((constructor_name' , _) , _) -> constructor_name' = constructor_name) lst in - let%bind body' = translate_annotated_expression body in + let%bind body' = transpile_annotated_expression body in return @@ E_let_in ((name , tv) , top , body') ) | ((`Node (a , b)) , tv) -> @@ -545,284 +502,54 @@ and translate_annotated_expression (ae:AST.annotated_expression) : expression re | AST.Match_tuple _ -> fail @@ unsupported_pattern_matching "tuple" ae.location ) -and translate_lambda_deep : Mini_c.Environment.t -> AST.lambda -> Mini_c.expression result = fun env l -> - let { binder ; input_type ; output_type ; result } : AST.lambda = l in +and transpile_lambda_deep : Mini_c.Environment.t -> AST.lambda -> _ -> Mini_c.expression result = + fun env l (input_type , output_type)-> + let { binder ; body } : AST.lambda = l in (* Deep capture. Capture the relevant part of the environment. *) let%bind c_env = let free_variables = Ast_typed.Free_variables.lambda [] l in let sub_env = Mini_c.Environment.select free_variables env in ok sub_env in let%bind (f_expr' , input_tv , output_tv) = - let%bind raw_input = translate_type input_type in - let%bind output = translate_type output_type in - let%bind result = translate_annotated_expression result in + let%bind raw_input = transpile_type input_type in + let%bind output = transpile_type output_type in + let%bind result = transpile_annotated_expression body in let expr' = E_closure { binder ; result } in ok (expr' , raw_input , output) in let tv = Mini_c.t_deep_closure c_env input_tv output_tv in ok @@ Expression.make_tpl (f_expr' , tv) -and translate_lambda env l = - let { binder ; input_type ; output_type ; result } : AST.lambda = l in - (* Try to translate it in an empty env, if it succeeds, transpiles it as a quote value, else, as a closure expression. *) - let fvs = AST.Free_variables.(annotated_expression (singleton binder) result) in +and transpile_lambda env l (input_type , output_type) = + let { binder ; body } : AST.lambda = l in + let fvs = AST.Free_variables.(annotated_expression (singleton binder) body) in let%bind result = match fvs with | [] -> ( - let%bind result' = translate_annotated_expression result in - let result' = ez_e_return result' in - let%bind input = translate_type input_type in - let%bind output = translate_type output_type in + let%bind result' = transpile_annotated_expression body in + let%bind input = transpile_type input_type in + let%bind output = transpile_type output_type in let tv = Combinators.t_function input output in - let content = D_function {binder;result=result'} in + let content = D_function { binder ; result = result'} in ok @@ Combinators.Expression.make_tpl (E_literal content , tv) ) | _ -> ( - translate_lambda_deep env l + transpile_lambda_deep env l (input_type , output_type) ) in ok result -let translate_declaration env (d:AST.declaration) : toplevel_statement result = +let transpile_declaration env (d:AST.declaration) : toplevel_statement result = match d with | Declaration_constant ({name;annotated_expression} , _) -> - let%bind expression = translate_annotated_expression annotated_expression in + let%bind expression = transpile_annotated_expression annotated_expression in let tv = Combinators.Expression.get_type expression in let env' = Environment.add (name, tv) env in ok @@ ((name, expression), environment_wrap env env') -let translate_program (lst:AST.program) : program result = +let transpile_program (lst:AST.program) : program result = let aux (prev:(toplevel_statement list * Environment.t) result) cur = let%bind (tl, env) = prev in - let%bind ((_, env') as cur') = translate_declaration env cur in + let%bind ((_, env') as cur') = transpile_declaration env cur in ok (cur' :: tl, env'.post_environment) in let%bind (statements, _) = List.fold_left aux (ok ([], Environment.empty)) (temp_unwrap_loc_list lst) in ok statements - -let translate_main (l:AST.lambda) loc : (anon_function * _) result = - let%bind expr = translate_lambda Environment.empty l in - match expr.content , expr.type_value with - | E_literal (D_function f) , T_function ty -> ok (f , ty) - | _ -> fail @@ not_functional_main loc - -(* From an expression [expr], build the expression [fun () -> expr] *) -let functionalize (e:AST.annotated_expression) : AST.lambda * AST.type_value = - let t = e.type_annotation in - let open! AST in - { - binder = "_" ; - input_type = Combinators.t_unit () ; - output_type = t ; - result = e ; - }, Combinators.(t_function (t_unit ()) t ()) - -let translate_entry (lst:AST.program) (name:string) : (anon_function * _) result = - let rec aux acc (lst:AST.program) = - let%bind acc = acc in - match lst with - | [] -> fail @@ missing_entry_point name - | hd :: tl -> ( - let (AST.Declaration_constant (an , (pre_env , _))) = temp_unwrap_loc hd in - match an.name = name with - | false -> ( - let next = fun expr -> - let cur = e_a_let_in an.name an.annotated_expression expr pre_env in - acc cur in - aux (ok next) tl - ) - | true -> ( - match an.annotated_expression.expression with - | E_lambda l -> - let l' = { l with result = acc l.result } in - translate_main l' an.annotated_expression.location - | _ -> - let (l , _) = functionalize an.annotated_expression in - let l' = { l with result = acc l.result } in - translate_main l' an.annotated_expression.location - ) - ) - in - let%bind l = aux (ok (fun x -> x)) lst in - ok l - -open Combinators - -let extract_constructor (v : value) (tree : _ Append_tree.t') : (string * value * AST.type_value) result = - let open Append_tree in - let rec aux tv : (string * value * AST.type_value) result= - match tv with - | Leaf (k, t), v -> ok (k, v, t) - | Node {a}, D_left v -> aux (a, v) - | Node {b}, D_right v -> aux (b, v) - | _ -> fail @@ internal_assertion_failure "bad constructor path" - in - let%bind (s, v, t) = aux (tree, v) in - ok (s, v, t) - -let extract_tuple (v : value) (tree : AST.type_value Append_tree.t') : ((value * AST.type_value) list) result = - let open Append_tree in - let rec aux tv : ((value * AST.type_value) list) result = - match tv with - | Leaf t, v -> ok @@ [v, t] - | Node {a;b}, D_pair (va, vb) -> - let%bind a' = aux (a, va) in - let%bind b' = aux (b, vb) in - ok (a' @ b') - | _ -> fail @@ internal_assertion_failure "bad tuple path" - in - aux (tree, v) - -let extract_record (v : value) (tree : _ Append_tree.t') : (_ list) result = - let open Append_tree in - let rec aux tv : ((string * (value * AST.type_value)) list) result = - match tv with - | Leaf (s, t), v -> ok @@ [s, (v, t)] - | Node {a;b}, D_pair (va, vb) -> - let%bind a' = aux (a, va) in - let%bind b' = aux (b, vb) in - ok (a' @ b') - | _ -> fail @@ internal_assertion_failure "bad record path" - in - aux (tree, v) - -let rec untranspile (v : value) (t : AST.type_value) : AST.annotated_expression result = - let open! AST in - let return e = ok (make_a_e_empty e t) in - match t.type_value' with - | T_constant ("unit", []) -> ( - let%bind () = - trace_strong (wrong_mini_c_value "unit" v) @@ - get_unit v in - return (E_literal Literal_unit) - ) - | T_constant ("bool", []) -> ( - let%bind b = - trace_strong (wrong_mini_c_value "bool" v) @@ - get_bool v in - return (E_literal (Literal_bool b)) - ) - | T_constant ("int", []) -> ( - let%bind n = - trace_strong (wrong_mini_c_value "int" v) @@ - get_int v in - return (E_literal (Literal_int n)) - ) - | T_constant ("nat", []) -> ( - let%bind n = - trace_strong (wrong_mini_c_value "nat" v) @@ - get_nat v in - return (E_literal (Literal_nat n)) - ) - | T_constant ("timestamp", []) -> ( - let%bind n = - trace_strong (wrong_mini_c_value "timestamp" v) @@ - get_timestamp v in - return (E_literal (Literal_timestamp n)) - ) - | T_constant ("tez", []) -> ( - let%bind n = - trace_strong (wrong_mini_c_value "tez" v) @@ - get_nat v in - return (E_literal (Literal_tez n)) - ) - | T_constant ("string", []) -> ( - let%bind n = - trace_strong (wrong_mini_c_value "string" v) @@ - get_string v in - return (E_literal (Literal_string n)) - ) - | T_constant ("bytes", []) -> ( - let%bind n = - trace_strong (wrong_mini_c_value "bytes" v) @@ - get_bytes v in - return (E_literal (Literal_bytes n)) - ) - | T_constant ("address", []) -> ( - let%bind n = - trace_strong (wrong_mini_c_value "address" v) @@ - get_string v in - return (E_literal (Literal_address n)) - ) - | T_constant ("option", [o]) -> ( - let%bind opt = - trace_strong (wrong_mini_c_value "option" v) @@ - get_option v in - match opt with - | None -> ok (e_a_empty_none o) - | Some s -> - let%bind s' = untranspile s o in - ok (e_a_empty_some s') - ) - | T_constant ("map", [k_ty;v_ty]) -> ( - let%bind lst = - trace_strong (wrong_mini_c_value "map" v) @@ - get_map v in - let%bind lst' = - let aux = fun (k, v) -> - let%bind k' = untranspile k k_ty in - let%bind v' = untranspile v v_ty in - ok (k', v') in - bind_map_list aux lst in - return (E_map lst') - ) - | T_constant ("list", [ty]) -> ( - let%bind lst = - trace_strong (wrong_mini_c_value "list" v) @@ - get_list v in - let%bind lst' = - let aux = fun e -> untranspile e ty in - bind_map_list aux lst in - return (E_list lst') - ) - | T_constant ("set", [ty]) -> ( - let%bind lst = - trace_strong (wrong_mini_c_value "set" v) @@ - get_set v in - let%bind lst' = - let aux = fun e -> untranspile e ty in - bind_map_list aux lst in - return (E_set lst') - ) - | T_constant ("contract" , [_ty]) -> - fail @@ bad_untranspile "contract" v - | T_constant ("operation" , []) -> ( - let%bind op = - trace_strong (wrong_mini_c_value "operation" v) @@ - get_operation v in - return (E_literal (Literal_operation op)) - ) - | T_constant (name , _lst) -> - fail @@ unknown_untranspile name v - | T_sum m -> - let lst = kv_list_of_map m in - let%bind node = match Append_tree.of_list lst with - | Empty -> fail @@ corner_case ~loc:__LOC__ "empty sum type" - | Full t -> ok t - in - let%bind (name, v, tv) = - trace_strong (corner_case ~loc:__LOC__ "sum extract constructor") @@ - extract_constructor v node in - let%bind sub = untranspile v tv in - return (E_constructor (name, sub)) - | T_tuple lst -> - let%bind node = match Append_tree.of_list lst with - | Empty -> fail @@ corner_case ~loc:__LOC__ "empty tuple" - | Full t -> ok t in - let%bind tpl = - trace_strong (corner_case ~loc:__LOC__ "tuple extract") @@ - extract_tuple v node in - let%bind tpl' = bind_list - @@ List.map (fun (x, y) -> untranspile x y) tpl in - return (E_tuple tpl') - | T_record m -> - let lst = kv_list_of_map m in - let%bind node = match Append_tree.of_list lst with - | Empty -> fail @@ corner_case ~loc:__LOC__ "empty record" - | Full t -> ok t in - let%bind lst = - trace_strong (corner_case ~loc:__LOC__ "record extract") @@ - extract_record v node in - let%bind lst = bind_list - @@ List.map (fun (x, (y, z)) -> let%bind yz = untranspile y z in ok (x, yz)) lst in - let m' = map_of_kv_list lst in - return (E_record m') - | T_function _ -> fail @@ bad_untranspile "function" v diff --git a/src/passes/6-transpiler/untranspiler.ml b/src/passes/6-transpiler/untranspiler.ml new file mode 100644 index 000000000..d79e842b4 --- /dev/null +++ b/src/passes/6-transpiler/untranspiler.ml @@ -0,0 +1,193 @@ +open Helpers + +module AST = Ast_typed +module Append_tree = Tree.Append +open Mini_c +open Trace + +module Errors = struct + + let corner_case ~loc message = + let title () = "corner case" in + let content () = "we don't have a good error message for this case. we are +striving find ways to better report them and find the use-cases that generate +them. please report this to the developers." in + let data = [ + ("location" , fun () -> loc) ; + ("message" , fun () -> message) ; + ] in + error ~data title content + + let wrong_mini_c_value expected_type actual = + let title () = "illed typed intermediary value" in + let content () = "type of intermediary value doesn't match what was expected" in + let data = [ + ("expected_type" , fun () -> expected_type) ; + ("actual" , fun () -> Format.asprintf "%a" Mini_c.PP.value actual ) ; + ] in + error ~data title content + + let bad_untranspile bad_type value = + let title () = "untranspiling bad value" in + let content () = Format.asprintf "can not untranspile %s" bad_type in + let data = [ + ("bad_type" , fun () -> bad_type) ; + ("value" , fun () -> Format.asprintf "%a" Mini_c.PP.value value) ; + ] in + error ~data title content + + let unknown_untranspile unknown_type value = + let title () = "untranspiling unknown value" in + let content () = Format.asprintf "can not untranspile %s" unknown_type in + let data = [ + ("unknown_type" , fun () -> unknown_type) ; + ("value" , fun () -> Format.asprintf "%a" Mini_c.PP.value value) ; + ] in + error ~data title content + +end + +open Errors + +let rec untranspile (v : value) (t : AST.type_value) : AST.annotated_expression result = + let open! AST in + let return e = ok (make_a_e_empty e t) in + match t.type_value' with + | T_constant ("unit", []) -> ( + let%bind () = + trace_strong (wrong_mini_c_value "unit" v) @@ + get_unit v in + return (E_literal Literal_unit) + ) + | T_constant ("bool", []) -> ( + let%bind b = + trace_strong (wrong_mini_c_value "bool" v) @@ + get_bool v in + return (E_literal (Literal_bool b)) + ) + | T_constant ("int", []) -> ( + let%bind n = + trace_strong (wrong_mini_c_value "int" v) @@ + get_int v in + return (E_literal (Literal_int n)) + ) + | T_constant ("nat", []) -> ( + let%bind n = + trace_strong (wrong_mini_c_value "nat" v) @@ + get_nat v in + return (E_literal (Literal_nat n)) + ) + | T_constant ("timestamp", []) -> ( + let%bind n = + trace_strong (wrong_mini_c_value "timestamp" v) @@ + get_timestamp v in + return (E_literal (Literal_timestamp n)) + ) + | T_constant ("tez", []) -> ( + let%bind n = + trace_strong (wrong_mini_c_value "tez" v) @@ + get_nat v in + return (E_literal (Literal_tez n)) + ) + | T_constant ("string", []) -> ( + let%bind n = + trace_strong (wrong_mini_c_value "string" v) @@ + get_string v in + return (E_literal (Literal_string n)) + ) + | T_constant ("bytes", []) -> ( + let%bind n = + trace_strong (wrong_mini_c_value "bytes" v) @@ + get_bytes v in + return (E_literal (Literal_bytes n)) + ) + | T_constant ("address", []) -> ( + let%bind n = + trace_strong (wrong_mini_c_value "address" v) @@ + get_string v in + return (E_literal (Literal_address n)) + ) + | T_constant ("option", [o]) -> ( + let%bind opt = + trace_strong (wrong_mini_c_value "option" v) @@ + get_option v in + match opt with + | None -> ok (e_a_empty_none o) + | Some s -> + let%bind s' = untranspile s o in + ok (e_a_empty_some s') + ) + | T_constant ("map", [k_ty;v_ty]) -> ( + let%bind lst = + trace_strong (wrong_mini_c_value "map" v) @@ + get_map v in + let%bind lst' = + let aux = fun (k, v) -> + let%bind k' = untranspile k k_ty in + let%bind v' = untranspile v v_ty in + ok (k', v') in + bind_map_list aux lst in + return (E_map lst') + ) + | T_constant ("list", [ty]) -> ( + let%bind lst = + trace_strong (wrong_mini_c_value "list" v) @@ + get_list v in + let%bind lst' = + let aux = fun e -> untranspile e ty in + bind_map_list aux lst in + return (E_list lst') + ) + | T_constant ("set", [ty]) -> ( + let%bind lst = + trace_strong (wrong_mini_c_value "set" v) @@ + get_set v in + let%bind lst' = + let aux = fun e -> untranspile e ty in + bind_map_list aux lst in + return (E_set lst') + ) + | T_constant ("contract" , [_ty]) -> + fail @@ bad_untranspile "contract" v + | T_constant ("operation" , []) -> ( + let%bind op = + trace_strong (wrong_mini_c_value "operation" v) @@ + get_operation v in + return (E_literal (Literal_operation op)) + ) + | T_constant (name , _lst) -> + fail @@ unknown_untranspile name v + | T_sum m -> + let lst = kv_list_of_map m in + let%bind node = match Append_tree.of_list lst with + | Empty -> fail @@ corner_case ~loc:__LOC__ "empty sum type" + | Full t -> ok t + in + let%bind (name, v, tv) = + trace_strong (corner_case ~loc:__LOC__ "sum extract constructor") @@ + extract_constructor v node in + let%bind sub = untranspile v tv in + return (E_constructor (name, sub)) + | T_tuple lst -> + let%bind node = match Append_tree.of_list lst with + | Empty -> fail @@ corner_case ~loc:__LOC__ "empty tuple" + | Full t -> ok t in + let%bind tpl = + trace_strong (corner_case ~loc:__LOC__ "tuple extract") @@ + extract_tuple v node in + let%bind tpl' = bind_list + @@ List.map (fun (x, y) -> untranspile x y) tpl in + return (E_tuple tpl') + | T_record m -> + let lst = kv_list_of_map m in + let%bind node = match Append_tree.of_list lst with + | Empty -> fail @@ corner_case ~loc:__LOC__ "empty record" + | Full t -> ok t in + let%bind lst = + trace_strong (corner_case ~loc:__LOC__ "record extract") @@ + extract_record v node in + let%bind lst = bind_list + @@ List.map (fun (x, (y, z)) -> let%bind yz = untranspile y z in ok (x, yz)) lst in + let m' = map_of_kv_list lst in + return (E_record m') + | T_function _ -> fail @@ bad_untranspile "function" v diff --git a/src/passes/8-compiler/compiler_program.ml b/src/passes/8-compiler/compiler_program.ml index 789000391..a06fc2a6e 100644 --- a/src/passes/8-compiler/compiler_program.ml +++ b/src/passes/8-compiler/compiler_program.ml @@ -1,14 +1,11 @@ open Trace open Mini_c - open Michelson - open Memory_proto_alpha.Protocol.Script_ir_translator - open Operators.Compiler -let get_predicate : string -> type_value -> expression list -> predicate result = fun s ty lst -> - match Map.String.find_opt s Operators.Compiler.predicates with +let get_operator : string -> type_value -> expression list -> predicate result = fun s ty lst -> + match Map.String.find_opt s Operators.Compiler.operators with | Some x -> ok x | None -> ( match s with @@ -196,7 +193,7 @@ and translate_expression (expr:expression) (env:environment) : michelson result PP.environment env ; ok (seq [ expr_code ; dip code ]) in bind_fold_right_list aux (seq []) lst in - let%bind predicate = get_predicate str ty lst in + let%bind predicate = get_operator str ty lst in let%bind code = match (predicate, List.length lst) with | Constant c, 0 -> ok @@ seq [ pre_code ; diff --git a/src/passes/operators/operators.ml b/src/passes/operators/operators.ml index cdf983b6a..23c6aaf44 100644 --- a/src/passes/operators/operators.ml +++ b/src/passes/operators/operators.ml @@ -639,7 +639,7 @@ module Compiler = struct include Helpers.Compiler open Tezos_utils.Michelson - let predicates = Map.String.of_list [ + let operators = Map.String.of_list [ ("ADD" , simple_binary @@ prim I_ADD) ; ("SUB" , simple_binary @@ prim I_SUB) ; ("TIMES" , simple_binary @@ prim I_MUL) ; @@ -693,6 +693,9 @@ module Compiler = struct ("CONCAT" , simple_binary @@ prim I_CONCAT) ; ] - (* Some complex predicates will need to be added in compiler/compiler_program *) + (* + Some complex operators will need to be added in compiler/compiler_program. + All operators whose compilations involve a type are found there. + *) end diff --git a/src/stages/ast_typed/PP.ml b/src/stages/ast_typed/PP.ml index 3e8edf30c..514a091df 100644 --- a/src/stages/ast_typed/PP.ml +++ b/src/stages/ast_typed/PP.ml @@ -24,10 +24,9 @@ let rec annotated_expression ppf (ae:annotated_expression) : unit = | _ -> fprintf ppf "@[%a@]" expression ae.expression and lambda ppf l = - let {binder;input_type;output_type;result} = l in - fprintf ppf "lambda (%s:%a) : %a return %a" - binder type_value input_type type_value output_type - annotated_expression result + let ({ binder ; body } : lambda) = l in + fprintf ppf "lambda (%s) -> %a" + binder annotated_expression body and expression ppf (e:expression) : unit = match e with diff --git a/src/stages/ast_typed/combinators.ml b/src/stages/ast_typed/combinators.ml index ec745fabc..6b2358c28 100644 --- a/src/stages/ast_typed/combinators.ml +++ b/src/stages/ast_typed/combinators.ml @@ -56,6 +56,10 @@ let get_type' (x:type_value) = x.type_value' let get_environment (x:annotated_expression) = x.environment let get_expression (x:annotated_expression) = x.expression +let get_lambda e : _ result = match e with + | E_lambda l -> ok l + | _ -> simple_fail "not a lambda" + let get_t_bool (t:type_value) : unit result = match t.type_value' with | T_constant ("bool", []) -> ok () | _ -> simple_fail "not a bool" @@ -235,7 +239,7 @@ let e_a_string s = make_a_e (e_string s) (t_string ()) let e_a_address s = make_a_e (e_address s) (t_address ()) let e_a_pair a b = make_a_e (e_pair a b) (t_pair a.type_annotation b.type_annotation ()) let e_a_some s = make_a_e (e_some s) (t_option s.type_annotation ()) -let e_a_lambda l = make_a_e (e_lambda l) (t_function l.input_type l.output_type ()) +let e_a_lambda l in_ty out_ty = make_a_e (e_lambda l) (t_function in_ty out_ty ()) let e_a_none t = make_a_e e_none (t_option t ()) let e_a_tuple lst = make_a_e (E_tuple lst) (t_tuple (List.map get_type_annotation lst) ()) let e_a_record r = make_a_e (e_record r) (t_record (SMap.map get_type_annotation r) ()) diff --git a/src/stages/ast_typed/combinators_environment.ml b/src/stages/ast_typed/combinators_environment.ml index e8ca37530..4c41f7296 100644 --- a/src/stages/ast_typed/combinators_environment.ml +++ b/src/stages/ast_typed/combinators_environment.ml @@ -18,7 +18,7 @@ let e_a_empty_record r = e_a_record r Environment.full_empty let e_a_empty_map lst k v = e_a_map lst k v Environment.full_empty let e_a_empty_list lst t = e_a_list lst t Environment.full_empty let ez_e_a_empty_record r = ez_e_a_record r Environment.full_empty -let e_a_empty_lambda l = e_a_lambda l Environment.full_empty +let e_a_empty_lambda l i o = e_a_lambda l i o Environment.full_empty open Environment diff --git a/src/stages/ast_typed/misc.ml b/src/stages/ast_typed/misc.ml index 091531789..a71ff3fae 100644 --- a/src/stages/ast_typed/misc.ml +++ b/src/stages/ast_typed/misc.ml @@ -171,7 +171,7 @@ module Free_variables = struct and lambda : bindings -> lambda -> bindings = fun b l -> let b' = union (singleton l.binder) b in - annotated_expression b' l.result + annotated_expression b' l.body and annotated_expression : bindings -> annotated_expression -> bindings = fun b ae -> expression b ae.expression diff --git a/src/stages/ast_typed/misc_smart.ml b/src/stages/ast_typed/misc_smart.ml index 0d0e8cd02..9e9520e3d 100644 --- a/src/stages/ast_typed/misc_smart.ml +++ b/src/stages/ast_typed/misc_smart.ml @@ -4,7 +4,7 @@ open Combinators open Misc let program_to_main : program -> string -> lambda result = fun p s -> - let%bind (main , input_type , output_type) = + let%bind (main , input_type , _) = let pred = fun d -> match d with | Declaration_constant (d , _) when d.name = s -> Some d.annotated_expression @@ -25,15 +25,13 @@ let program_to_main : program -> string -> lambda result = fun p s -> | Declaration_constant (_ , (_ , post_env)) -> post_env in List.fold_left aux Environment.full_empty (List.map Location.unwrap p) in let binder = "@contract_input" in - let result = + let body = let input_expr = e_a_variable binder input_type env in let main_expr = e_a_variable s (get_type_annotation main) env in e_a_application main_expr input_expr env in ok { binder ; - input_type ; - output_type ; - result ; + body ; } module Captured_variables = struct diff --git a/src/stages/ast_typed/types.ml b/src/stages/ast_typed/types.ml index cf8c40fec..6fe7f921e 100644 --- a/src/stages/ast_typed/types.ml +++ b/src/stages/ast_typed/types.ml @@ -69,10 +69,10 @@ and named_type_value = { } and lambda = { - binder: name ; - input_type: tv ; - output_type: tv ; - result: ae ; + binder : name ; + (* input_type: tv ; + * output_type: tv ; *) + body : ae ; } and let_in = { diff --git a/src/stages/mini_c/combinators.ml b/src/stages/mini_c/combinators.ml index f7342987e..9e8467207 100644 --- a/src/stages/mini_c/combinators.ml +++ b/src/stages/mini_c/combinators.ml @@ -164,12 +164,10 @@ let e_let_int v tv expr body : expression = Expression.(make_tpl ( let ez_e_sequence a b : expression = Expression.(make_tpl (E_sequence (make_tpl (a , t_unit) , b) , get_type b)) -let ez_e_return e : expression = e - let d_unit : value = D_unit let basic_quote expr : anon_function result = - ok @@ quote "input" (ez_e_return expr) + ok @@ quote "input" expr let basic_int_quote expr : anon_function result = basic_quote expr From d8b7a12c690d7cea4bd0ae7a808b3e6bb555c06f Mon Sep 17 00:00:00 2001 From: galfour Date: Sun, 15 Sep 2019 13:12:19 +0200 Subject: [PATCH 06/18] more refactoring --- src/bin/cli_helpers.ml | 2 +- src/main/compile/of_mini_c.ml | 3 + src/main/compile/of_simplified.ml | 21 +- src/main/compile/of_source.ml | 35 +++ src/main/compile/of_typed.ml | 98 ++++++--- src/main/{run => }/display.ml | 0 src/main/run/dune | 1 + src/main/run/main.ml | 137 ------------ .../{from_michelson.ml => of_michelson.ml} | 0 src/main/run/{run_mini_c.ml => of_mini_c.ml} | 6 +- src/main/run/of_simplified.ml | 31 +++ src/main/run/of_source.ml | 92 ++++++++ src/main/run/of_typed.ml | 34 +++ src/main/run/run.ml | 4 + src/main/run/run_simplified.ml | 27 --- src/main/run/run_source.ml | 207 ------------------ src/main/run/run_typed.ml | 71 ------ {test => src/test}/.gitignore | 0 {test => src/test}/bin_tests.ml | 0 {test => src/test}/coase_tests.ml | 0 {test => src/test}/compiler_tests.ml | 0 {test => src/test}/contracts/amount.mligo | 0 {test => src/test}/contracts/annotation.ligo | 0 {test => src/test}/contracts/arithmetic.ligo | 0 {test => src/test}/contracts/assign.ligo | 0 {test => src/test}/contracts/basic.mligo | 0 .../test}/contracts/bitwise_arithmetic.ligo | 0 .../test}/contracts/boolean_operators.ligo | 0 .../test}/contracts/bytes_arithmetic.ligo | 0 {test => src/test}/contracts/closure-1.ligo | 0 {test => src/test}/contracts/closure-2.ligo | 0 {test => src/test}/contracts/closure-3.ligo | 0 {test => src/test}/contracts/closure.ligo | 0 {test => src/test}/contracts/coase.ligo | 0 .../test}/contracts/condition-simple.ligo | 0 {test => src/test}/contracts/condition.ligo | 0 {test => src/test}/contracts/counter.ligo | 0 {test => src/test}/contracts/counter.mligo | 0 .../test}/contracts/declaration-local.ligo | 0 .../test}/contracts/declarations.ligo | 0 .../test}/contracts/dispatch-counter.ligo | 0 .../test}/contracts/error_syntax.ligo | 0 {test => src/test}/contracts/error_type.ligo | 0 {test => src/test}/contracts/failwith.mligo | 0 .../test}/contracts/function-complex.ligo | 0 .../test}/contracts/function-shared.ligo | 0 {test => src/test}/contracts/function.ligo | 0 .../test}/contracts/guess_string.mligo | 0 .../test}/contracts/heap-instance.ligo | 0 {test => src/test}/contracts/heap.ligo | 0 {test => src/test}/contracts/high-order.ligo | 0 {test => src/test}/contracts/included.ligo | 0 {test => src/test}/contracts/includer.ligo | 0 {test => src/test}/contracts/lambda.ligo | 0 {test => src/test}/contracts/lambda.mligo | 0 {test => src/test}/contracts/lambda2.mligo | 0 {test => src/test}/contracts/letin.mligo | 0 {test => src/test}/contracts/list.ligo | 0 {test => src/test}/contracts/list.mligo | 0 {test => src/test}/contracts/loop.ligo | 0 {test => src/test}/contracts/map.ligo | 0 {test => src/test}/contracts/match.ligo | 0 {test => src/test}/contracts/match.mligo | 0 {test => src/test}/contracts/match_bis.mligo | 0 .../test}/contracts/multiple-parameters.ligo | 0 {test => src/test}/contracts/new-syntax.mligo | 0 {test => src/test}/contracts/option.ligo | 0 .../contracts/parser-bad-reported-term.ligo | 0 .../test}/contracts/quote-declaration.ligo | 0 .../test}/contracts/quote-declarations.ligo | 0 {test => src/test}/contracts/record.ligo | 0 {test => src/test}/contracts/record.mligo | 0 .../test}/contracts/set_arithmetic-1.ligo | 0 .../test}/contracts/set_arithmetic.ligo | 0 {test => src/test}/contracts/shadow.ligo | 0 {test => src/test}/contracts/string.ligo | 0 .../test}/contracts/string_arithmetic.ligo | 0 .../test}/contracts/super-counter.ligo | 0 .../test}/contracts/super-counter.mligo | 0 {test => src/test}/contracts/toto.ligo | 0 {test => src/test}/contracts/tuple.ligo | 0 {test => src/test}/contracts/type-alias.ligo | 0 {test => src/test}/contracts/unit.ligo | 0 .../test}/contracts/variant-matching.ligo | 0 {test => src/test}/contracts/variant.ligo | 0 {test => src/test}/contracts/vote.mligo | 0 {test => src/test}/contracts/website1.ligo | 0 {test => src/test}/contracts/website2.ligo | 0 {test => src/test}/dune | 0 {test => src/test}/heap_tests.ml | 0 {test => src/test}/integration_tests.ml | 0 {test => src/test}/manual_test.ml | 0 {test => src/test}/multifix_tests.ml | 0 {test => src/test}/test.ml | 0 {test => src/test}/test_helpers.ml | 0 {test => src/test}/transpiler_tests.ml | 0 {test => src/test}/typer_tests.ml | 0 {test => src/test}/vote_tests.ml | 0 98 files changed, 288 insertions(+), 481 deletions(-) rename src/main/{run => }/display.ml (100%) delete mode 100644 src/main/run/main.ml rename src/main/run/{from_michelson.ml => of_michelson.ml} (100%) rename src/main/run/{run_mini_c.ml => of_mini_c.ml} (86%) create mode 100644 src/main/run/of_simplified.ml create mode 100644 src/main/run/of_source.ml create mode 100644 src/main/run/of_typed.ml create mode 100644 src/main/run/run.ml delete mode 100644 src/main/run/run_simplified.ml delete mode 100644 src/main/run/run_source.ml delete mode 100644 src/main/run/run_typed.ml rename {test => src/test}/.gitignore (100%) rename {test => src/test}/bin_tests.ml (100%) rename {test => src/test}/coase_tests.ml (100%) rename {test => src/test}/compiler_tests.ml (100%) rename {test => src/test}/contracts/amount.mligo (100%) rename {test => src/test}/contracts/annotation.ligo (100%) rename {test => src/test}/contracts/arithmetic.ligo (100%) rename {test => src/test}/contracts/assign.ligo (100%) rename {test => src/test}/contracts/basic.mligo (100%) rename {test => src/test}/contracts/bitwise_arithmetic.ligo (100%) rename {test => src/test}/contracts/boolean_operators.ligo (100%) rename {test => src/test}/contracts/bytes_arithmetic.ligo (100%) rename {test => src/test}/contracts/closure-1.ligo (100%) rename {test => src/test}/contracts/closure-2.ligo (100%) rename {test => src/test}/contracts/closure-3.ligo (100%) rename {test => src/test}/contracts/closure.ligo (100%) rename {test => src/test}/contracts/coase.ligo (100%) rename {test => src/test}/contracts/condition-simple.ligo (100%) rename {test => src/test}/contracts/condition.ligo (100%) rename {test => src/test}/contracts/counter.ligo (100%) rename {test => src/test}/contracts/counter.mligo (100%) rename {test => src/test}/contracts/declaration-local.ligo (100%) rename {test => src/test}/contracts/declarations.ligo (100%) rename {test => src/test}/contracts/dispatch-counter.ligo (100%) rename {test => src/test}/contracts/error_syntax.ligo (100%) rename {test => src/test}/contracts/error_type.ligo (100%) rename {test => src/test}/contracts/failwith.mligo (100%) rename {test => src/test}/contracts/function-complex.ligo (100%) rename {test => src/test}/contracts/function-shared.ligo (100%) rename {test => src/test}/contracts/function.ligo (100%) rename {test => src/test}/contracts/guess_string.mligo (100%) rename {test => src/test}/contracts/heap-instance.ligo (100%) rename {test => src/test}/contracts/heap.ligo (100%) rename {test => src/test}/contracts/high-order.ligo (100%) rename {test => src/test}/contracts/included.ligo (100%) rename {test => src/test}/contracts/includer.ligo (100%) rename {test => src/test}/contracts/lambda.ligo (100%) rename {test => src/test}/contracts/lambda.mligo (100%) rename {test => src/test}/contracts/lambda2.mligo (100%) rename {test => src/test}/contracts/letin.mligo (100%) rename {test => src/test}/contracts/list.ligo (100%) rename {test => src/test}/contracts/list.mligo (100%) rename {test => src/test}/contracts/loop.ligo (100%) rename {test => src/test}/contracts/map.ligo (100%) rename {test => src/test}/contracts/match.ligo (100%) rename {test => src/test}/contracts/match.mligo (100%) rename {test => src/test}/contracts/match_bis.mligo (100%) rename {test => src/test}/contracts/multiple-parameters.ligo (100%) rename {test => src/test}/contracts/new-syntax.mligo (100%) rename {test => src/test}/contracts/option.ligo (100%) rename {test => src/test}/contracts/parser-bad-reported-term.ligo (100%) rename {test => src/test}/contracts/quote-declaration.ligo (100%) rename {test => src/test}/contracts/quote-declarations.ligo (100%) rename {test => src/test}/contracts/record.ligo (100%) rename {test => src/test}/contracts/record.mligo (100%) rename {test => src/test}/contracts/set_arithmetic-1.ligo (100%) rename {test => src/test}/contracts/set_arithmetic.ligo (100%) rename {test => src/test}/contracts/shadow.ligo (100%) rename {test => src/test}/contracts/string.ligo (100%) rename {test => src/test}/contracts/string_arithmetic.ligo (100%) rename {test => src/test}/contracts/super-counter.ligo (100%) rename {test => src/test}/contracts/super-counter.mligo (100%) rename {test => src/test}/contracts/toto.ligo (100%) rename {test => src/test}/contracts/tuple.ligo (100%) rename {test => src/test}/contracts/type-alias.ligo (100%) rename {test => src/test}/contracts/unit.ligo (100%) rename {test => src/test}/contracts/variant-matching.ligo (100%) rename {test => src/test}/contracts/variant.ligo (100%) rename {test => src/test}/contracts/vote.mligo (100%) rename {test => src/test}/contracts/website1.ligo (100%) rename {test => src/test}/contracts/website2.ligo (100%) rename {test => src/test}/dune (100%) rename {test => src/test}/heap_tests.ml (100%) rename {test => src/test}/integration_tests.ml (100%) rename {test => src/test}/manual_test.ml (100%) rename {test => src/test}/multifix_tests.ml (100%) rename {test => src/test}/test.ml (100%) rename {test => src/test}/test_helpers.ml (100%) rename {test => src/test}/transpiler_tests.ml (100%) rename {test => src/test}/typer_tests.ml (100%) rename {test => src/test}/vote_tests.ml (100%) diff --git a/src/bin/cli_helpers.ml b/src/bin/cli_helpers.ml index 068f2bf1d..28a565e40 100644 --- a/src/bin/cli_helpers.ml +++ b/src/bin/cli_helpers.ml @@ -4,6 +4,6 @@ let toplevel x = match x with | Trace.Ok ((), annotations) -> ignore annotations; () | Error ss -> ( - Format.printf "%a%!" Ligo.Display.error_pp (ss ()) + Format.printf "%a%!" Display.error_pp (ss ()) ) diff --git a/src/main/compile/of_mini_c.ml b/src/main/compile/of_mini_c.ml index ea964be97..ffd31b259 100644 --- a/src/main/compile/of_mini_c.ml +++ b/src/main/compile/of_mini_c.ml @@ -10,3 +10,6 @@ let compile_expression : expression -> Michelson.t result = fun e -> let compile_function : anon_function -> type_value -> type_value -> Compiler.Program.compiled_program result = fun f in_ty out_ty -> Compiler.Program.translate_entry f (in_ty , out_ty) + +let uncompile_value : Proto_alpha_utils.Memory_proto_alpha.X.ex_typed_value -> value result = fun x -> + Compiler.Uncompiler.translate_value x diff --git a/src/main/compile/of_simplified.ml b/src/main/compile/of_simplified.ml index 27bf6ebef..f6c4500ac 100644 --- a/src/main/compile/of_simplified.ml +++ b/src/main/compile/of_simplified.ml @@ -10,6 +10,23 @@ let compile_expression_entry (program : program) entry_point : Compiler.Program. let%bind typed_program = Typer.type_program program in Of_typed.compile_expression_entry typed_program entry_point -let compile_expression ae : Michelson.t result = - let%bind typed = Typer.type_expression Ast_typed.Environment.full_empty ae in +let compile_expression ?(env = Ast_typed.Environment.full_empty) ae : Michelson.t result = + let%bind typed = Typer.type_expression env ae in Of_typed.compile_expression typed + +let uncompile_typed_program_entry_expression_result program entry ex_ty_value = + let%bind output_type = + let%bind (entry_expression , _ ) = Of_typed.get_entry program entry in + ok entry_expression.type_annotation + in + let%bind typed = Of_typed.uncompile_value ex_ty_value output_type in + Typer.untype_expression typed + +let uncompile_typed_program_entry_function_result program entry ex_ty_value = + let%bind output_type = + let%bind (entry_expression , _ ) = Of_typed.get_entry program entry in + let%bind (_ , output_type) = Ast_typed.get_t_function entry_expression.type_annotation in + ok output_type + in + let%bind typed = Of_typed.uncompile_value ex_ty_value output_type in + Typer.untype_expression typed diff --git a/src/main/compile/of_source.ml b/src/main/compile/of_source.ml index a4fd4e814..9d6005e4d 100644 --- a/src/main/compile/of_source.ml +++ b/src/main/compile/of_source.ml @@ -17,3 +17,38 @@ let compile_file_parameter : string -> string -> string -> s_syntax -> Michelson let%bind syntax = syntax_to_variant syntax (Some source_filename) in let%bind simplified = parsify_expression syntax expression in Of_simplified.compile_expression simplified + +let compile_file_expression : string -> string -> string -> s_syntax -> Michelson.t result = + fun source_filename _entry_point expression syntax -> + let%bind syntax = syntax_to_variant syntax (Some source_filename) in + let%bind simplified = parsify_expression syntax expression in + Of_simplified.compile_expression simplified + +let compile_file_storage : string -> string -> string -> s_syntax -> Michelson.t result = + fun source_filename _entry_point expression syntax -> + let%bind syntax = syntax_to_variant syntax (Some source_filename) in + let%bind simplified = parsify_expression syntax expression in + Of_simplified.compile_expression simplified + +let compile_file_contract_args = + fun source_filename _entry_point storage parameter syntax -> + let%bind syntax = syntax_to_variant syntax (Some source_filename) in + let%bind storage_simplified = parsify_expression syntax storage in + let%bind parameter_simplified = parsify_expression syntax parameter in + let args = Ast_simplified.e_pair storage_simplified parameter_simplified in + Of_simplified.compile_expression args + +let type_file ?(debug_simplify = false) ?(debug_typed = false) + syntax (source_filename:string) : Ast_typed.program result = + let%bind syntax = syntax_to_variant syntax (Some source_filename) in + let%bind simpl = parsify syntax source_filename in + (if debug_simplify then + Format.(printf "Simplified : %a\n%!" Ast_simplified.PP.program simpl) + ) ; + let%bind typed = + trace (simple_error "typing") @@ + Typer.type_program simpl in + (if debug_typed then ( + Format.(printf "Typed : %a\n%!" Ast_typed.PP.program typed) + )) ; + ok typed diff --git a/src/main/compile/of_typed.ml b/src/main/compile/of_typed.ml index 96adc461c..962543444 100644 --- a/src/main/compile/of_typed.ml +++ b/src/main/compile/of_typed.ml @@ -51,6 +51,27 @@ let compile_function expr = in Of_mini_c.compile_function f in_ty out_ty + +let get_entry (lst : program) (name : string) : (annotated_expression * int) result = + let%bind entry_expression = + trace_option (Errors.missing_entry_point name) @@ + let aux x = + let (Declaration_constant (an , _)) = Location.unwrap x in + if (an.name = name) + then Some an.annotated_expression + else None + in + List.find_map aux lst + in + let entry_index = + let aux x = + let (Declaration_constant (an , _)) = Location.unwrap x in + an.name = name + in + List.find_index aux lst + in + ok (entry_expression , entry_index) + (* Assume the following code: ``` @@ -68,50 +89,61 @@ let compile_function expr = x + y ``` - To do so, each declaration `const variable = expr` is translated in - a function `body -> let variable = expr in body`. Those functions are - then applied in order, which yields `let x = 42 in let y = 120 in ...`. - The entry-point can be an expression, which is then functionalized if `to_functionalize` is set to true. *) -let aggregate_declarations_for_entry (lst : program) (name : string) (to_functionalize : bool) : annotated_expression result = - let rec aux acc (lst : program) = - let%bind acc = acc in - match lst with - | [] -> fail @@ Errors.missing_entry_point name - | hd :: tl -> ( - let (Declaration_constant (an , (pre_env , _))) = Location.unwrap hd in - if (an.name <> name) then ( - let next = fun expr -> - let cur = e_a_let_in an.name an.annotated_expression expr pre_env in - acc cur in - aux (ok next) tl - ) else ( - match (an.annotated_expression.expression , to_functionalize) with - | (E_lambda l , false) -> ( - let l' = { l with body = acc l.body } in - let e' = { an.annotated_expression with expression = E_lambda l' } in - ok e' - ) - | (_ , true) -> ( - ok @@ functionalize @@ acc an.annotated_expression - ) - | _ -> fail @@ Errors.not_functional_main an.annotated_expression.location - ) - ) +let get_aggregated_entry (lst : program) (name : string) (to_functionalize : bool) : annotated_expression result = + let%bind (entry_expression , entry_index) = get_entry lst name in + let pre_declarations = + let sub_program = List.until entry_index lst in + let aux x = Location.unwrap x in + List.map aux sub_program in - let%bind l = aux (ok (fun x -> x)) lst in - ok l + let wrapper = + let aux prec cur = + let (Declaration_constant (an , (pre_env , _))) = cur in + e_a_let_in an.name an.annotated_expression prec pre_env + in + fun expr -> List.fold_right' aux expr pre_declarations + in + match (entry_expression.expression , to_functionalize) with + | (E_lambda l , false) -> ( + let l' = { l with body = wrapper l.body } in + let e' = { entry_expression with expression = E_lambda l' } in + ok e' + ) + | (_ , true) -> ( + ok @@ functionalize @@ wrapper entry_expression + ) + | _ -> fail @@ Errors.not_functional_main entry_expression.location let compile_function_entry : program -> string -> _ = fun p entry -> - let%bind expr = aggregate_declarations_for_entry p entry false in + let%bind expr = get_aggregated_entry p entry false in compile_function expr let compile_expression_entry : program -> string -> _ = fun p entry -> - let%bind expr = aggregate_declarations_for_entry p entry true in + let%bind expr = get_aggregated_entry p entry true in compile_function expr let compile_expression_as_function : annotated_expression -> Compiler.Program.compiled_program result = fun e -> let expr = functionalize e in compile_function expr + +let uncompile_value : _ -> _ -> annotated_expression result = fun x ty -> + let%bind mini_c = Of_mini_c.uncompile_value x in + Transpiler.untranspile mini_c ty + +let uncompile_entry_function_result = fun program entry ex_ty_value -> + let%bind output_type = + let%bind (entry_expression , _ ) = get_entry program entry in + let%bind (_ , output_type) = get_t_function entry_expression.type_annotation in + ok output_type + in + uncompile_value ex_ty_value output_type + +let uncompile_entry_expression_result = fun program entry ex_ty_value -> + let%bind output_type = + let%bind (entry_expression , _ ) = get_entry program entry in + ok entry_expression.type_annotation + in + uncompile_value ex_ty_value output_type diff --git a/src/main/run/display.ml b/src/main/display.ml similarity index 100% rename from src/main/run/display.ml rename to src/main/display.ml diff --git a/src/main/run/dune b/src/main/run/dune index 330bf32d5..34f7986af 100644 --- a/src/main/run/dune +++ b/src/main/run/dune @@ -13,6 +13,7 @@ mini_c operators compiler + compile ) (preprocess (pps ppx_let) diff --git a/src/main/run/main.ml b/src/main/run/main.ml deleted file mode 100644 index 1c4afcd58..000000000 --- a/src/main/run/main.ml +++ /dev/null @@ -1,137 +0,0 @@ -module Run_mini_c = Run_mini_c - -(* open Trace *) -module Parser = Parser -module AST_Raw = Parser.Pascaligo.AST -module AST_Simplified = Ast_simplified -module AST_Typed = Ast_typed -module Mini_c = Mini_c -module Typer = Typer -module Transpiler = Transpiler - -module Run = struct - include Run_source - include Run_simplified - include Run_typed - include Run_mini_c -end - -module Display = Display - -(* module Parser_multifix = Multifix - * module Simplify_multifix = Simplify_multifix *) - - -(* let simplify (p:AST_Raw.t) : Ast_simplified.program result = Simplify.Pascaligo.simpl_program p - * let simplify_expr (e:AST_Raw.expr) : Ast_simplified.expression result = Simplify.Pascaligo.simpl_expression e - * let unparse_simplified_expr (e:AST_Simplified.expression) : string result = - * ok @@ Format.asprintf "%a" AST_Simplified.PP.expression e - * - * let type_ (p:AST_Simplified.program) : AST_Typed.program result = Typer.type_program p - * let type_expression ?(env:Typer.Environment.t = Typer.Environment.full_empty) - * (e:AST_Simplified.expression) : AST_Typed.annotated_expression result = - * Typer.type_expression env e - * let untype_expression (e:AST_Typed.annotated_expression) : AST_Simplified.expression result = Typer.untype_expression e - * - * let transpile (p:AST_Typed.program) : Mini_c.program result = Transpiler.translate_program p - * let transpile_entry (p:AST_Typed.program) (name:string) : Mini_c.anon_function result = Transpiler.translate_entry p name - * let transpile_expression (e:AST_Typed.annotated_expression) : Mini_c.expression result = Transpiler.translate_annotated_expression e - * - * let untranspile_value (v : Mini_c.value) (e:AST_Typed.type_value) : AST_Typed.annotated_expression result = - * Transpiler.untranspile v e - * - * let compile : Mini_c.program -> string -> Compiler.Program.compiled_program result = Compiler.Program.translate_program - * - * let easy_evaluate_typed (entry:string) (program:AST_Typed.program) : AST_Typed.annotated_expression result = - * let%bind result = - * let%bind mini_c_main = - * transpile_entry program entry in - * Run_mini_c.run_entry mini_c_main (Mini_c.Combinators.d_unit) in - * let%bind typed_result = - * let%bind typed_main = Ast_typed.get_entry program entry in - * untranspile_value result typed_main.type_annotation in - * ok typed_result - * - * - * let easy_evaluate_typed = trace_f_2_ez easy_evaluate_typed (thunk "easy evaluate typed") - * - * - * let easy_run_typed - * ?(debug_mini_c = false) ?options (entry:string) - * (program:AST_Typed.program) (input:AST_Typed.annotated_expression) : AST_Typed.annotated_expression result = - * let%bind () = - * let open Ast_typed in - * let%bind (Declaration_constant (d , _)) = get_declaration_by_name program entry in - * let%bind (arg_ty , _) = - * trace_strong (simple_error "entry-point doesn't have a function type") @@ - * get_t_function @@ get_type_annotation d.annotated_expression in - * Ast_typed.assert_type_value_eq (arg_ty , (Ast_typed.get_type_annotation input)) - * in - * - * let%bind mini_c_main = - * trace (simple_error "transpile mini_c entry") @@ - * transpile_entry program entry in - * (if debug_mini_c then - * Format.(printf "Mini_c : %a\n%!" Mini_c.PP.function_ mini_c_main) - * ) ; - * - * let%bind mini_c_value = transpile_value input in - * - * let%bind mini_c_result = - * let error = - * let title () = "run Mini_c" in - * let content () = - * Format.asprintf "\n%a" Mini_c.PP.function_ mini_c_main - * in - * error title content in - * trace error @@ - * Run_mini_c.run_entry ?options mini_c_main mini_c_value in - * let%bind typed_result = - * let%bind main_result_type = - * let%bind typed_main = Ast_typed.get_functional_entry program entry in - * match (snd typed_main).type_value' with - * | T_function (_, result) -> ok result - * | _ -> simple_fail "main doesn't have fun type" in - * untranspile_value mini_c_result main_result_type in - * ok typed_result - * - * let easy_run_typed_simplified - * ?(debug_mini_c = false) ?(debug_michelson = false) ?options (entry:string) - * (program:AST_Typed.program) (input:Ast_simplified.expression) : Ast_simplified.expression result = - * let%bind mini_c_main = - * trace (simple_error "transpile mini_c entry") @@ - * transpile_entry program entry in - * (if debug_mini_c then - * Format.(printf "Mini_c : %a\n%!" Mini_c.PP.function_ mini_c_main) - * ) ; - * - * let%bind typed_value = - * let env = - * let last_declaration = Location.unwrap List.(hd @@ rev program) in - * match last_declaration with - * | Declaration_constant (_ , (_ , post_env)) -> post_env - * in - * type_expression ~env input in - * let%bind mini_c_value = transpile_value typed_value in - * - * let%bind mini_c_result = - * let error = - * let title () = "run Mini_c" in - * let content () = - * Format.asprintf "\n%a" Mini_c.PP.function_ mini_c_main - * in - * error title content in - * trace error @@ - * Run_mini_c.run_entry ~debug_michelson ?options mini_c_main mini_c_value in - * let%bind typed_result = - * let%bind main_result_type = - * let%bind typed_main = Ast_typed.get_functional_entry program entry in - * match (snd typed_main).type_value' with - * | T_function (_, result) -> ok result - * | _ -> simple_fail "main doesn't have fun type" in - * untranspile_value mini_c_result main_result_type in - * let%bind annotated_result = untype_expression typed_result in - * ok annotated_result *) - - -(* module Contract = Contract *) diff --git a/src/main/run/from_michelson.ml b/src/main/run/of_michelson.ml similarity index 100% rename from src/main/run/from_michelson.ml rename to src/main/run/of_michelson.ml diff --git a/src/main/run/run_mini_c.ml b/src/main/run/of_mini_c.ml similarity index 86% rename from src/main/run/run_mini_c.ml rename to src/main/run/of_mini_c.ml index 06864c223..8e22c8a54 100644 --- a/src/main/run/run_mini_c.ml +++ b/src/main/run/of_mini_c.ml @@ -16,7 +16,7 @@ type options = { input_type : type_value ; output_type : type_value ; input : value ; - michelson_options : From_michelson.options ; + michelson_options : Of_michelson.options ; } let run_entry ?(debug_michelson = false) ?options (entry : anon_function) ty (input:value) : value result = @@ -31,7 +31,7 @@ let run_entry ?(debug_michelson = false) ?options (entry : anon_function) ty (in Format.printf "Input Type: %a\n" PP.type_ (fst ty) ; Format.printf "Compiled Input: %a\n" Michelson.pp input_michelson ; ) ; - let%bind ex_ty_value = From_michelson.run ?options compiled input_michelson in + let%bind ex_ty_value = Of_michelson.run ?options compiled input_michelson in if debug_michelson then ( let (Ex_typed_value (ty , v)) = ex_ty_value in ignore @@ @@ -41,5 +41,5 @@ let run_entry ?(debug_michelson = false) ?options (entry : anon_function) ty (in Format.printf "Compiled Output: %a\n" Michelson.pp michelson_value ; ok () ) ; - let%bind (result : value) = Compiler.Uncompiler.translate_value ex_ty_value in + let%bind (result : value) = Compile.Of_mini_c.uncompile_value ex_ty_value in ok result diff --git a/src/main/run/of_simplified.ml b/src/main/run/of_simplified.ml new file mode 100644 index 000000000..22e3d7026 --- /dev/null +++ b/src/main/run/of_simplified.ml @@ -0,0 +1,31 @@ +open Trace +open Ast_simplified + +let get_final_environment program = + let last_declaration = Location.unwrap List.(hd @@ rev program) in + let (Ast_typed.Declaration_constant (_ , (_ , post_env))) = last_declaration in + post_env + +let run_typed_program + ?options + (program : Ast_typed.program) (entry : string) + (input : expression) : expression result = + let%bind code = Compile.Of_typed.compile_function_entry program entry in + let%bind input = + let env = get_final_environment program in + Compile.Of_simplified.compile_expression ~env input + in + let%bind ex_ty_value = Of_michelson.run ?options code input in + Compile.Of_simplified.uncompile_typed_program_entry_function_result program entry ex_ty_value + +let evaluate_typed_program_entry + ?options + (program : Ast_typed.program) (entry : string) + : Ast_simplified.expression result = + let%bind code = Compile.Of_typed.compile_expression_entry program entry in + let%bind input = + let fake_input = Ast_typed.(e_a_unit Environment.full_empty) in + Compile.Of_typed.compile_expression fake_input + in + let%bind ex_ty_value = Of_michelson.run ?options code input in + Compile.Of_simplified.uncompile_typed_program_entry_expression_result program entry ex_ty_value diff --git a/src/main/run/of_source.ml b/src/main/run/of_source.ml new file mode 100644 index 000000000..55a455f9e --- /dev/null +++ b/src/main/run/of_source.ml @@ -0,0 +1,92 @@ +open Trace + +include struct + open Ast_simplified + + let assert_entry_point_defined : program -> string -> unit result = + fun program entry_point -> + let aux : declaration -> bool = fun declaration -> + match declaration with + | Declaration_type _ -> false + | Declaration_constant (name , _ , _) -> name = entry_point + in + trace_strong (simple_error "no entry-point with given name") @@ + Assert.assert_true @@ List.exists aux @@ List.map Location.unwrap program +end + +include struct + open Ast_typed + open Combinators + + let get_entry_point_type : type_value -> (type_value * type_value) result = fun t -> + let%bind (arg , result) = + trace_strong (simple_error "entry-point doesn't have a function type") @@ + get_t_function t in + let%bind (arg' , storage_param) = + trace_strong (simple_error "entry-point doesn't have 2 parameters") @@ + get_t_pair arg in + let%bind (ops , storage_result) = + trace_strong (simple_error "entry-point doesn't have 2 results") @@ + get_t_pair result in + let%bind () = + trace_strong (simple_error "entry-point doesn't have a list of operation as first result") @@ + assert_t_list_operation ops in + let%bind () = + trace_strong (simple_error "entry-point doesn't identical type (storage) for second parameter and second result") @@ + assert_type_value_eq (storage_param , storage_result) in + ok (arg' , storage_param) + + let get_entry_point : program -> string -> (type_value * type_value) result = fun p e -> + let%bind declaration = get_declaration_by_name p e in + match declaration with + | Declaration_constant (d , _) -> get_entry_point_type d.annotated_expression.type_annotation + + let assert_valid_entry_point = fun p e -> + let%bind _ = get_entry_point p e in + ok () +end + +let run_contract ?amount source_filename entry_point storage parameter syntax = + let%bind program = Compile.Of_source.type_file syntax source_filename in + let%bind code = Compile.Of_typed.compile_function_entry program entry_point in + let%bind args = Compile.Of_source.compile_file_contract_args source_filename entry_point storage parameter syntax in + let%bind ex_value_ty = + let options = + let open Proto_alpha_utils.Memory_proto_alpha in + let amount = Option.bind (fun amount -> Protocol.Alpha_context.Tez.of_string amount) amount in + (make_options ?amount ()) + in + Of_michelson.run ~options code args + in + Compile.Of_simplified.uncompile_typed_program_entry_function_result program entry_point ex_value_ty + +let run_function ?amount source_filename entry_point input syntax = + let%bind program = Compile.Of_source.type_file syntax source_filename in + let%bind code = Compile.Of_typed.compile_function_entry program entry_point in + let%bind args = Compile.Of_source.compile_file_expression source_filename entry_point input syntax in + let%bind ex_value_ty = + let options = + let open Proto_alpha_utils.Memory_proto_alpha in + let amount = Option.bind (fun amount -> Protocol.Alpha_context.Tez.of_string amount) amount in + (make_options ?amount ()) + in + Of_michelson.run ~options code args + in + Compile.Of_simplified.uncompile_typed_program_entry_function_result program entry_point ex_value_ty + +let evaluate ?amount source_filename entry_point syntax = + let%bind program = Compile.Of_source.type_file syntax source_filename in + let%bind code = Compile.Of_typed.compile_expression_entry program entry_point in + let%bind input = + let fake_input = Ast_simplified.e_unit () in + Compile.Of_simplified.compile_expression fake_input + in + let%bind ex_value_ty = + let options = + let open Proto_alpha_utils.Memory_proto_alpha in + let amount = Option.bind (fun amount -> Protocol.Alpha_context.Tez.of_string amount) amount in + (make_options ?amount ()) + in + Of_michelson.run ~options code input + in + Compile.Of_simplified.uncompile_typed_program_entry_expression_result program entry_point ex_value_ty diff --git a/src/main/run/of_typed.ml b/src/main/run/of_typed.ml new file mode 100644 index 000000000..a7bbcb88c --- /dev/null +++ b/src/main/run/of_typed.ml @@ -0,0 +1,34 @@ +open Trace +open Ast_typed + +let run_function ?options f input = + let%bind code = Compile.Of_typed.compile_function f in + let%bind input = Compile.Of_typed.compile_expression input in + let%bind ex_ty_value = Of_michelson.run ?options code input in + let%bind ty = + let%bind (_ , output_ty) = get_t_function f.type_annotation in + ok output_ty + in + Compile.Of_typed.uncompile_value ex_ty_value ty + +let run_entry + ?options (entry : string) + (program : Ast_typed.program) (input : Ast_typed.annotated_expression) : Ast_typed.annotated_expression result = + let%bind code = Compile.Of_typed.compile_function_entry program entry in + let%bind input = Compile.Of_typed.compile_expression input in + let%bind ex_ty_value = Of_michelson.run ?options code input in + Compile.Of_typed.uncompile_entry_function_result program entry ex_ty_value + +let evaluate ?options (e : annotated_expression) : annotated_expression result = + let%bind code = Compile.Of_typed.compile_expression_as_function e in + let fake_input = e_a_unit Environment.full_empty in + let%bind input = Compile.Of_typed.compile_expression fake_input in + let%bind ex_ty_value = Of_michelson.run ?options code input in + Compile.Of_typed.uncompile_value ex_ty_value e.type_annotation + +let evaluate_entry ?options program entry = + let%bind code = Compile.Of_typed.compile_expression_entry program entry in + let fake_input = e_a_unit Environment.full_empty in + let%bind input = Compile.Of_typed.compile_expression fake_input in + let%bind ex_ty_value = Of_michelson.run ?options code input in + Compile.Of_typed.uncompile_entry_expression_result program entry ex_ty_value diff --git a/src/main/run/run.ml b/src/main/run/run.ml new file mode 100644 index 000000000..10ca5ed1d --- /dev/null +++ b/src/main/run/run.ml @@ -0,0 +1,4 @@ +module Of_typed = Of_typed +module Of_simplified = Of_simplified +module Of_mini_c = Of_mini_c +module Of_michelson = Of_michelson diff --git a/src/main/run/run_simplified.ml b/src/main/run/run_simplified.ml deleted file mode 100644 index 4faf34aaf..000000000 --- a/src/main/run/run_simplified.ml +++ /dev/null @@ -1,27 +0,0 @@ -open Trace - -let run_simplityped - ?options - ?(debug_mini_c = false) ?(debug_michelson = false) - (program : Ast_typed.program) (entry : string) - (input : Ast_simplified.expression) : Ast_simplified.expression result = - let%bind typed_input = - let env = - let last_declaration = Location.unwrap List.(hd @@ rev program) in - match last_declaration with - | Declaration_constant (_ , (_ , post_env)) -> post_env - in - Typer.type_expression env input in - let%bind typed_result = - Run_typed.run_typed ?options ~debug_mini_c ~debug_michelson entry program typed_input in - let%bind annotated_result = Typer.untype_expression typed_result in - ok annotated_result - -let evaluate_simplityped - ?options - ?(debug_mini_c = false) ?(debug_michelson = false) - (program : Ast_typed.program) (entry : string) - : Ast_simplified.expression result = - let%bind typed_result = Run_typed.evaluate_typed ?options ~debug_mini_c ~debug_michelson entry program in - let%bind annotated_result = Typer.untype_expression typed_result in - ok annotated_result diff --git a/src/main/run/run_source.ml b/src/main/run/run_source.ml deleted file mode 100644 index 214d1e091..000000000 --- a/src/main/run/run_source.ml +++ /dev/null @@ -1,207 +0,0 @@ -open Trace - -include struct - open Ast_simplified - - let assert_entry_point_defined : program -> string -> unit result = - fun program entry_point -> - let aux : declaration -> bool = fun declaration -> - match declaration with - | Declaration_type _ -> false - | Declaration_constant (name , _ , _) -> name = entry_point - in - trace_strong (simple_error "no entry-point with given name") @@ - Assert.assert_true @@ List.exists aux @@ List.map Location.unwrap program -end - -include struct - open Ast_typed - open Combinators - - let get_entry_point_type : type_value -> (type_value * type_value) result = fun t -> - let%bind (arg , result) = - trace_strong (simple_error "entry-point doesn't have a function type") @@ - get_t_function t in - let%bind (arg' , storage_param) = - trace_strong (simple_error "entry-point doesn't have 2 parameters") @@ - get_t_pair arg in - let%bind (ops , storage_result) = - trace_strong (simple_error "entry-point doesn't have 2 results") @@ - get_t_pair result in - let%bind () = - trace_strong (simple_error "entry-point doesn't have a list of operation as first result") @@ - assert_t_list_operation ops in - let%bind () = - trace_strong (simple_error "entry-point doesn't identical type (storage) for second parameter and second result") @@ - assert_type_value_eq (storage_param , storage_result) in - ok (arg' , storage_param) - - let get_entry_point : program -> string -> (type_value * type_value) result = fun p e -> - let%bind declaration = get_declaration_by_name p e in - match declaration with - | Declaration_constant (d , _) -> get_entry_point_type d.annotated_expression.type_annotation - - let assert_valid_entry_point = fun p e -> - let%bind _ = get_entry_point p e in - ok () -end - -let transpile_value - (e:Ast_typed.annotated_expression) : (Mini_c.value * _) result = - let%bind (f , ty) = - let open Transpiler in - let (f , _) = functionalize e in - let%bind main = translate_main f e.location in - ok main - in - - let input = Mini_c.Combinators.d_unit in - let%bind r = Run_mini_c.run_entry f ty input in - ok (r , snd ty) - -open Helpers - -let compile_contract_file : string -> string -> s_syntax -> string result = fun source_filename entry_point syntax -> - let%bind syntax = syntax_to_variant syntax (Some source_filename) in - let%bind simplified = parsify syntax source_filename in - let%bind () = - assert_entry_point_defined simplified entry_point in - let%bind typed = - trace (simple_error "typing") @@ - Typer.type_program simplified in - let%bind (mini_c , mini_c_ty) = - trace (simple_error "transpiling") @@ - Transpiler.translate_entry typed entry_point in - let%bind michelson = - trace (simple_error "compiling") @@ - Compiler.translate_contract mini_c mini_c_ty in - let str = - Format.asprintf "%a" Michelson.pp_stripped michelson in - ok str - -let compile_contract_parameter : string -> string -> string -> s_syntax -> string result = fun source_filename entry_point expression syntax -> - let%bind syntax = syntax_to_variant syntax (Some source_filename) in - let%bind (program , parameter_tv) = - let%bind simplified = parsify syntax source_filename in - let%bind () = - assert_entry_point_defined simplified entry_point in - let%bind typed = - trace (simple_error "typing file") @@ - Typer.type_program simplified in - let%bind (param_ty , _) = - get_entry_point typed entry_point in - ok (typed , param_ty) - in - let%bind expr = - let%bind typed = - let%bind simplified = parsify_expression syntax expression in - let env = - let last_declaration = Location.unwrap List.(hd @@ rev program) in - match last_declaration with - | Declaration_constant (_ , (_ , post_env)) -> post_env - in - trace (simple_error "typing expression") @@ - Typer.type_expression env simplified in - let%bind () = - trace (simple_error "expression type doesn't match type parameter") @@ - Ast_typed.assert_type_value_eq (parameter_tv , typed.type_annotation) in - let%bind (mini_c , mini_c_ty) = - trace (simple_error "transpiling expression") @@ - transpile_value typed in - let%bind michelson = - trace (simple_error "compiling expression") @@ - Compiler.translate_value mini_c mini_c_ty in - let str = - Format.asprintf "%a" Michelson.pp_stripped michelson in - ok str - in - ok expr - - -let compile_contract_storage : string -> string -> string -> s_syntax -> string result = fun source_filename entry_point expression syntax -> - let%bind syntax = syntax_to_variant syntax (Some source_filename) in - let%bind (program , storage_tv) = - let%bind simplified = parsify syntax source_filename in - let%bind () = - assert_entry_point_defined simplified entry_point in - let%bind typed = - trace (simple_error "typing file") @@ - Typer.type_program simplified in - let%bind (_ , storage_ty) = - get_entry_point typed entry_point in - ok (typed , storage_ty) - in - let%bind expr = - let%bind simplified = parsify_expression syntax expression in - let%bind typed = - let env = - let last_declaration = Location.unwrap List.(hd @@ rev program) in - match last_declaration with - | Declaration_constant (_ , (_ , post_env)) -> post_env - in - trace (simple_error "typing expression") @@ - Typer.type_expression env simplified in - let%bind () = - trace (simple_error "expression type doesn't match type storage") @@ - Ast_typed.assert_type_value_eq (storage_tv , typed.type_annotation) in - let%bind (mini_c , mini_c_ty) = - trace (simple_error "transpiling expression") @@ - transpile_value typed in - let%bind michelson = - trace (simple_error "compiling expression") @@ - Compiler.translate_value mini_c mini_c_ty in - let str = - Format.asprintf "%a" Michelson.pp_stripped michelson in - ok str - in - ok expr - -let type_file ?(debug_simplify = false) ?(debug_typed = false) - syntax (source_filename:string) : Ast_typed.program result = - let%bind simpl = parsify syntax source_filename in - (if debug_simplify then - Format.(printf "Simplified : %a\n%!" Ast_simplified.PP.program simpl) - ) ; - let%bind typed = - trace (simple_error "typing") @@ - Typer.type_program simpl in - (if debug_typed then ( - Format.(printf "Typed : %a\n%!" Ast_typed.PP.program typed) - )) ; - ok typed - -let run_contract ?amount source_filename entry_point storage input syntax = - let%bind syntax = syntax_to_variant syntax (Some source_filename) in - let%bind typed = - type_file syntax source_filename in - let%bind storage_simpl = - parsify_expression syntax storage in - let%bind input_simpl = - parsify_expression syntax input in - let options = - let open Proto_alpha_utils.Memory_proto_alpha in - let amount = Option.bind (fun amount -> Protocol.Alpha_context.Tez.of_string amount) amount in - (make_options ?amount ()) in - Run_simplified.run_simplityped ~options typed entry_point (Ast_simplified.e_pair storage_simpl input_simpl) - -let run_function ?amount source_filename entry_point parameter syntax = - let%bind syntax = syntax_to_variant syntax (Some source_filename) in - let%bind typed = - type_file syntax source_filename in - let%bind parameter' = - parsify_expression syntax parameter in - let options = - let open Proto_alpha_utils.Memory_proto_alpha in - let amount = Option.bind (fun amount -> Protocol.Alpha_context.Tez.of_string amount) amount in - (make_options ?amount ()) in - Run_simplified.run_simplityped ~options typed entry_point parameter' - -let evaluate_value ?amount source_filename entry_point syntax = - let%bind syntax = syntax_to_variant syntax (Some source_filename) in - let%bind typed = - type_file syntax source_filename in - let options = - let open Proto_alpha_utils.Memory_proto_alpha in - let amount = Option.bind (fun amount -> Protocol.Alpha_context.Tez.of_string amount) amount in - (make_options ?amount ()) in - Run_simplified.evaluate_simplityped ~options typed entry_point diff --git a/src/main/run/run_typed.ml b/src/main/run/run_typed.ml deleted file mode 100644 index 0f41fe6fa..000000000 --- a/src/main/run/run_typed.ml +++ /dev/null @@ -1,71 +0,0 @@ -open Trace -open Ast_typed - -let evaluate (e : annotated_expression) : annotated_expression result = - let%bind (f , ty) = - let open Transpiler in - let (f , _) = functionalize e in - let%bind main = translate_main f e.location in - ok main - in - - let input = Mini_c.Combinators.d_unit in - let%bind r = Run_mini_c.run_entry f ty input in - ok r - -let evaluate_typed - ?(debug_mini_c = false) ?(debug_michelson = false) - ?options (entry:string) (program:Ast_typed.program) : Ast_typed.annotated_expression result = - trace (simple_error "easy evaluate typed") @@ - let%bind result = - let%bind (mini_c_main , ty) = - Transpiler.translate_entry program entry in - (if debug_mini_c then - Format.(printf "Mini_c : %a\n%!" Mini_c.PP.function_ mini_c_main) - ) ; - Run_mini_c.run_entry ?options ~debug_michelson mini_c_main ty (Mini_c.Combinators.d_unit) - in - let%bind typed_result = - let%bind typed_main = Ast_typed.get_entry program entry in - Transpiler.untranspile result typed_main.type_annotation in - ok typed_result - -let run_typed - ?(debug_mini_c = false) ?(debug_michelson = false) ?options (entry:string) - (program : Ast_typed.program) (input : Ast_typed.annotated_expression) : Ast_typed.annotated_expression result = - let%bind - let%bind () = - let open Ast_typed in - let%bind (Declaration_constant (d , _)) = get_declaration_by_name program entry in - let%bind (arg_ty , _) = - trace_strong (simple_error "entry-point doesn't have a function type") @@ - get_t_function @@ get_type_annotation d.annotated_expression in - Ast_typed.assert_type_value_eq (arg_ty , (Ast_typed.get_type_annotation input)) - in - - let%bind (mini_c_main , ty) = - trace (simple_error "transpile mini_c entry") @@ - Transpiler.translate_entry program entry in - (if debug_mini_c then - Format.(printf "Mini_c : %a\n%!" Mini_c.PP.function_ mini_c_main) - ) ; - - let%bind mini_c_value = transpile_value input in - - let%bind mini_c_result = - let error = - let title () = "run Mini_c" in - let content () = - Format.asprintf "\n%a" Mini_c.PP.function_ mini_c_main - in - error title content in - trace error @@ - Run_mini_c.run_entry ~debug_michelson ?options mini_c_main ty mini_c_value in - let%bind typed_result = - let%bind main_result_type = - let%bind typed_main = Ast_typed.get_functional_entry program entry in - match (snd typed_main).type_value' with - | T_function (_, result) -> ok result - | _ -> simple_fail "main doesn't have fun type" in - Transpiler.untranspile mini_c_result main_result_type in - ok typed_result diff --git a/test/.gitignore b/src/test/.gitignore similarity index 100% rename from test/.gitignore rename to src/test/.gitignore diff --git a/test/bin_tests.ml b/src/test/bin_tests.ml similarity index 100% rename from test/bin_tests.ml rename to src/test/bin_tests.ml diff --git a/test/coase_tests.ml b/src/test/coase_tests.ml similarity index 100% rename from test/coase_tests.ml rename to src/test/coase_tests.ml diff --git a/test/compiler_tests.ml b/src/test/compiler_tests.ml similarity index 100% rename from test/compiler_tests.ml rename to src/test/compiler_tests.ml diff --git a/test/contracts/amount.mligo b/src/test/contracts/amount.mligo similarity index 100% rename from test/contracts/amount.mligo rename to src/test/contracts/amount.mligo diff --git a/test/contracts/annotation.ligo b/src/test/contracts/annotation.ligo similarity index 100% rename from test/contracts/annotation.ligo rename to src/test/contracts/annotation.ligo diff --git a/test/contracts/arithmetic.ligo b/src/test/contracts/arithmetic.ligo similarity index 100% rename from test/contracts/arithmetic.ligo rename to src/test/contracts/arithmetic.ligo diff --git a/test/contracts/assign.ligo b/src/test/contracts/assign.ligo similarity index 100% rename from test/contracts/assign.ligo rename to src/test/contracts/assign.ligo diff --git a/test/contracts/basic.mligo b/src/test/contracts/basic.mligo similarity index 100% rename from test/contracts/basic.mligo rename to src/test/contracts/basic.mligo diff --git a/test/contracts/bitwise_arithmetic.ligo b/src/test/contracts/bitwise_arithmetic.ligo similarity index 100% rename from test/contracts/bitwise_arithmetic.ligo rename to src/test/contracts/bitwise_arithmetic.ligo diff --git a/test/contracts/boolean_operators.ligo b/src/test/contracts/boolean_operators.ligo similarity index 100% rename from test/contracts/boolean_operators.ligo rename to src/test/contracts/boolean_operators.ligo diff --git a/test/contracts/bytes_arithmetic.ligo b/src/test/contracts/bytes_arithmetic.ligo similarity index 100% rename from test/contracts/bytes_arithmetic.ligo rename to src/test/contracts/bytes_arithmetic.ligo diff --git a/test/contracts/closure-1.ligo b/src/test/contracts/closure-1.ligo similarity index 100% rename from test/contracts/closure-1.ligo rename to src/test/contracts/closure-1.ligo diff --git a/test/contracts/closure-2.ligo b/src/test/contracts/closure-2.ligo similarity index 100% rename from test/contracts/closure-2.ligo rename to src/test/contracts/closure-2.ligo diff --git a/test/contracts/closure-3.ligo b/src/test/contracts/closure-3.ligo similarity index 100% rename from test/contracts/closure-3.ligo rename to src/test/contracts/closure-3.ligo diff --git a/test/contracts/closure.ligo b/src/test/contracts/closure.ligo similarity index 100% rename from test/contracts/closure.ligo rename to src/test/contracts/closure.ligo diff --git a/test/contracts/coase.ligo b/src/test/contracts/coase.ligo similarity index 100% rename from test/contracts/coase.ligo rename to src/test/contracts/coase.ligo diff --git a/test/contracts/condition-simple.ligo b/src/test/contracts/condition-simple.ligo similarity index 100% rename from test/contracts/condition-simple.ligo rename to src/test/contracts/condition-simple.ligo diff --git a/test/contracts/condition.ligo b/src/test/contracts/condition.ligo similarity index 100% rename from test/contracts/condition.ligo rename to src/test/contracts/condition.ligo diff --git a/test/contracts/counter.ligo b/src/test/contracts/counter.ligo similarity index 100% rename from test/contracts/counter.ligo rename to src/test/contracts/counter.ligo diff --git a/test/contracts/counter.mligo b/src/test/contracts/counter.mligo similarity index 100% rename from test/contracts/counter.mligo rename to src/test/contracts/counter.mligo diff --git a/test/contracts/declaration-local.ligo b/src/test/contracts/declaration-local.ligo similarity index 100% rename from test/contracts/declaration-local.ligo rename to src/test/contracts/declaration-local.ligo diff --git a/test/contracts/declarations.ligo b/src/test/contracts/declarations.ligo similarity index 100% rename from test/contracts/declarations.ligo rename to src/test/contracts/declarations.ligo diff --git a/test/contracts/dispatch-counter.ligo b/src/test/contracts/dispatch-counter.ligo similarity index 100% rename from test/contracts/dispatch-counter.ligo rename to src/test/contracts/dispatch-counter.ligo diff --git a/test/contracts/error_syntax.ligo b/src/test/contracts/error_syntax.ligo similarity index 100% rename from test/contracts/error_syntax.ligo rename to src/test/contracts/error_syntax.ligo diff --git a/test/contracts/error_type.ligo b/src/test/contracts/error_type.ligo similarity index 100% rename from test/contracts/error_type.ligo rename to src/test/contracts/error_type.ligo diff --git a/test/contracts/failwith.mligo b/src/test/contracts/failwith.mligo similarity index 100% rename from test/contracts/failwith.mligo rename to src/test/contracts/failwith.mligo diff --git a/test/contracts/function-complex.ligo b/src/test/contracts/function-complex.ligo similarity index 100% rename from test/contracts/function-complex.ligo rename to src/test/contracts/function-complex.ligo diff --git a/test/contracts/function-shared.ligo b/src/test/contracts/function-shared.ligo similarity index 100% rename from test/contracts/function-shared.ligo rename to src/test/contracts/function-shared.ligo diff --git a/test/contracts/function.ligo b/src/test/contracts/function.ligo similarity index 100% rename from test/contracts/function.ligo rename to src/test/contracts/function.ligo diff --git a/test/contracts/guess_string.mligo b/src/test/contracts/guess_string.mligo similarity index 100% rename from test/contracts/guess_string.mligo rename to src/test/contracts/guess_string.mligo diff --git a/test/contracts/heap-instance.ligo b/src/test/contracts/heap-instance.ligo similarity index 100% rename from test/contracts/heap-instance.ligo rename to src/test/contracts/heap-instance.ligo diff --git a/test/contracts/heap.ligo b/src/test/contracts/heap.ligo similarity index 100% rename from test/contracts/heap.ligo rename to src/test/contracts/heap.ligo diff --git a/test/contracts/high-order.ligo b/src/test/contracts/high-order.ligo similarity index 100% rename from test/contracts/high-order.ligo rename to src/test/contracts/high-order.ligo diff --git a/test/contracts/included.ligo b/src/test/contracts/included.ligo similarity index 100% rename from test/contracts/included.ligo rename to src/test/contracts/included.ligo diff --git a/test/contracts/includer.ligo b/src/test/contracts/includer.ligo similarity index 100% rename from test/contracts/includer.ligo rename to src/test/contracts/includer.ligo diff --git a/test/contracts/lambda.ligo b/src/test/contracts/lambda.ligo similarity index 100% rename from test/contracts/lambda.ligo rename to src/test/contracts/lambda.ligo diff --git a/test/contracts/lambda.mligo b/src/test/contracts/lambda.mligo similarity index 100% rename from test/contracts/lambda.mligo rename to src/test/contracts/lambda.mligo diff --git a/test/contracts/lambda2.mligo b/src/test/contracts/lambda2.mligo similarity index 100% rename from test/contracts/lambda2.mligo rename to src/test/contracts/lambda2.mligo diff --git a/test/contracts/letin.mligo b/src/test/contracts/letin.mligo similarity index 100% rename from test/contracts/letin.mligo rename to src/test/contracts/letin.mligo diff --git a/test/contracts/list.ligo b/src/test/contracts/list.ligo similarity index 100% rename from test/contracts/list.ligo rename to src/test/contracts/list.ligo diff --git a/test/contracts/list.mligo b/src/test/contracts/list.mligo similarity index 100% rename from test/contracts/list.mligo rename to src/test/contracts/list.mligo diff --git a/test/contracts/loop.ligo b/src/test/contracts/loop.ligo similarity index 100% rename from test/contracts/loop.ligo rename to src/test/contracts/loop.ligo diff --git a/test/contracts/map.ligo b/src/test/contracts/map.ligo similarity index 100% rename from test/contracts/map.ligo rename to src/test/contracts/map.ligo diff --git a/test/contracts/match.ligo b/src/test/contracts/match.ligo similarity index 100% rename from test/contracts/match.ligo rename to src/test/contracts/match.ligo diff --git a/test/contracts/match.mligo b/src/test/contracts/match.mligo similarity index 100% rename from test/contracts/match.mligo rename to src/test/contracts/match.mligo diff --git a/test/contracts/match_bis.mligo b/src/test/contracts/match_bis.mligo similarity index 100% rename from test/contracts/match_bis.mligo rename to src/test/contracts/match_bis.mligo diff --git a/test/contracts/multiple-parameters.ligo b/src/test/contracts/multiple-parameters.ligo similarity index 100% rename from test/contracts/multiple-parameters.ligo rename to src/test/contracts/multiple-parameters.ligo diff --git a/test/contracts/new-syntax.mligo b/src/test/contracts/new-syntax.mligo similarity index 100% rename from test/contracts/new-syntax.mligo rename to src/test/contracts/new-syntax.mligo diff --git a/test/contracts/option.ligo b/src/test/contracts/option.ligo similarity index 100% rename from test/contracts/option.ligo rename to src/test/contracts/option.ligo diff --git a/test/contracts/parser-bad-reported-term.ligo b/src/test/contracts/parser-bad-reported-term.ligo similarity index 100% rename from test/contracts/parser-bad-reported-term.ligo rename to src/test/contracts/parser-bad-reported-term.ligo diff --git a/test/contracts/quote-declaration.ligo b/src/test/contracts/quote-declaration.ligo similarity index 100% rename from test/contracts/quote-declaration.ligo rename to src/test/contracts/quote-declaration.ligo diff --git a/test/contracts/quote-declarations.ligo b/src/test/contracts/quote-declarations.ligo similarity index 100% rename from test/contracts/quote-declarations.ligo rename to src/test/contracts/quote-declarations.ligo diff --git a/test/contracts/record.ligo b/src/test/contracts/record.ligo similarity index 100% rename from test/contracts/record.ligo rename to src/test/contracts/record.ligo diff --git a/test/contracts/record.mligo b/src/test/contracts/record.mligo similarity index 100% rename from test/contracts/record.mligo rename to src/test/contracts/record.mligo diff --git a/test/contracts/set_arithmetic-1.ligo b/src/test/contracts/set_arithmetic-1.ligo similarity index 100% rename from test/contracts/set_arithmetic-1.ligo rename to src/test/contracts/set_arithmetic-1.ligo diff --git a/test/contracts/set_arithmetic.ligo b/src/test/contracts/set_arithmetic.ligo similarity index 100% rename from test/contracts/set_arithmetic.ligo rename to src/test/contracts/set_arithmetic.ligo diff --git a/test/contracts/shadow.ligo b/src/test/contracts/shadow.ligo similarity index 100% rename from test/contracts/shadow.ligo rename to src/test/contracts/shadow.ligo diff --git a/test/contracts/string.ligo b/src/test/contracts/string.ligo similarity index 100% rename from test/contracts/string.ligo rename to src/test/contracts/string.ligo diff --git a/test/contracts/string_arithmetic.ligo b/src/test/contracts/string_arithmetic.ligo similarity index 100% rename from test/contracts/string_arithmetic.ligo rename to src/test/contracts/string_arithmetic.ligo diff --git a/test/contracts/super-counter.ligo b/src/test/contracts/super-counter.ligo similarity index 100% rename from test/contracts/super-counter.ligo rename to src/test/contracts/super-counter.ligo diff --git a/test/contracts/super-counter.mligo b/src/test/contracts/super-counter.mligo similarity index 100% rename from test/contracts/super-counter.mligo rename to src/test/contracts/super-counter.mligo diff --git a/test/contracts/toto.ligo b/src/test/contracts/toto.ligo similarity index 100% rename from test/contracts/toto.ligo rename to src/test/contracts/toto.ligo diff --git a/test/contracts/tuple.ligo b/src/test/contracts/tuple.ligo similarity index 100% rename from test/contracts/tuple.ligo rename to src/test/contracts/tuple.ligo diff --git a/test/contracts/type-alias.ligo b/src/test/contracts/type-alias.ligo similarity index 100% rename from test/contracts/type-alias.ligo rename to src/test/contracts/type-alias.ligo diff --git a/test/contracts/unit.ligo b/src/test/contracts/unit.ligo similarity index 100% rename from test/contracts/unit.ligo rename to src/test/contracts/unit.ligo diff --git a/test/contracts/variant-matching.ligo b/src/test/contracts/variant-matching.ligo similarity index 100% rename from test/contracts/variant-matching.ligo rename to src/test/contracts/variant-matching.ligo diff --git a/test/contracts/variant.ligo b/src/test/contracts/variant.ligo similarity index 100% rename from test/contracts/variant.ligo rename to src/test/contracts/variant.ligo diff --git a/test/contracts/vote.mligo b/src/test/contracts/vote.mligo similarity index 100% rename from test/contracts/vote.mligo rename to src/test/contracts/vote.mligo diff --git a/test/contracts/website1.ligo b/src/test/contracts/website1.ligo similarity index 100% rename from test/contracts/website1.ligo rename to src/test/contracts/website1.ligo diff --git a/test/contracts/website2.ligo b/src/test/contracts/website2.ligo similarity index 100% rename from test/contracts/website2.ligo rename to src/test/contracts/website2.ligo diff --git a/test/dune b/src/test/dune similarity index 100% rename from test/dune rename to src/test/dune diff --git a/test/heap_tests.ml b/src/test/heap_tests.ml similarity index 100% rename from test/heap_tests.ml rename to src/test/heap_tests.ml diff --git a/test/integration_tests.ml b/src/test/integration_tests.ml similarity index 100% rename from test/integration_tests.ml rename to src/test/integration_tests.ml diff --git a/test/manual_test.ml b/src/test/manual_test.ml similarity index 100% rename from test/manual_test.ml rename to src/test/manual_test.ml diff --git a/test/multifix_tests.ml b/src/test/multifix_tests.ml similarity index 100% rename from test/multifix_tests.ml rename to src/test/multifix_tests.ml diff --git a/test/test.ml b/src/test/test.ml similarity index 100% rename from test/test.ml rename to src/test/test.ml diff --git a/test/test_helpers.ml b/src/test/test_helpers.ml similarity index 100% rename from test/test_helpers.ml rename to src/test/test_helpers.ml diff --git a/test/transpiler_tests.ml b/src/test/transpiler_tests.ml similarity index 100% rename from test/transpiler_tests.ml rename to src/test/transpiler_tests.ml diff --git a/test/typer_tests.ml b/src/test/typer_tests.ml similarity index 100% rename from test/typer_tests.ml rename to src/test/typer_tests.ml diff --git a/test/vote_tests.ml b/src/test/vote_tests.ml similarity index 100% rename from test/vote_tests.ml rename to src/test/vote_tests.ml From b619fa1f1712284dbdda65e224cdf7589f5ac4dd Mon Sep 17 00:00:00 2001 From: galfour Date: Wed, 18 Sep 2019 18:49:33 +0200 Subject: [PATCH 07/18] further down the road --- src/bin/cli.ml | 18 +++++++++--------- src/bin/cli_helpers.ml | 2 +- src/main/compile/of_source.ml | 10 ++++++++-- src/main/main.ml | 1 + src/main/run/of_simplified.ml | 3 ++- src/main/run/run.ml | 1 + src/passes/1-parser/pascaligo.ml | 2 +- src/test/bin_tests.ml | 3 +-- src/test/coase_tests.ml | 3 +-- src/test/compiler_tests.ml | 4 ++-- src/test/heap_tests.ml | 5 +++-- src/test/integration_tests.ml | 15 +++++++-------- src/test/test_helpers.ml | 6 +++--- src/test/typer_tests.ml | 8 ++++---- src/test/vote_tests.ml | 7 ++++--- vendors/ligo-utils/simple-utils/x_list.ml | 1 - 16 files changed, 48 insertions(+), 41 deletions(-) diff --git a/src/bin/cli.ml b/src/bin/cli.ml index 11777b504..29fa6247c 100644 --- a/src/bin/cli.ml +++ b/src/bin/cli.ml @@ -50,8 +50,8 @@ let compile_file = toplevel @@ let%bind contract = trace (simple_info "compiling contract to michelson") @@ - Ligo.Run.compile_contract_file source entry_point (Syntax_name syntax) in - Format.printf "%s\n" contract ; + Ligo.Compile.Of_source.compile_file_contract_entry source entry_point (Syntax_name syntax) in + Format.printf "%a\n" Tezos_utils.Michelson.pp contract ; ok () in let term = @@ -65,8 +65,8 @@ let compile_parameter = toplevel @@ let%bind value = trace (simple_error "compile-input") @@ - Ligo.Run.compile_contract_parameter source entry_point expression (Syntax_name syntax) in - Format.printf "%s\n" value; + Ligo.Compile.Of_source.compile_file_contract_parameter source entry_point expression (Syntax_name syntax) in + Format.printf "%a\n" Tezos_utils.Michelson.pp value; ok () in let term = @@ -80,8 +80,8 @@ let compile_storage = toplevel @@ let%bind value = trace (simple_error "compile-storage") @@ - Ligo.Run.compile_contract_storage source entry_point expression (Syntax_name syntax) in - Format.printf "%s\n" value; + Ligo.Compile.Of_source.compile_file_contract_storage source entry_point expression (Syntax_name syntax) in + Format.printf "%a\n" Tezos_utils.Michelson.pp value; ok () in let term = @@ -94,7 +94,7 @@ let dry_run = let f source entry_point storage input amount syntax = toplevel @@ let%bind output = - Ligo.Run.run_contract ~amount source entry_point storage input (Syntax_name syntax) in + Ligo.Run.Of_source.run_contract ~amount source entry_point storage input (Syntax_name syntax) in Format.printf "%a\n" Ast_simplified.PP.expression output ; ok () in @@ -108,7 +108,7 @@ let run_function = let f source entry_point parameter amount syntax = toplevel @@ let%bind output = - Ligo.Run.run_function ~amount source entry_point parameter (Syntax_name syntax) in + Ligo.Run.Of_source.run_function ~amount source entry_point parameter (Syntax_name syntax) in Format.printf "%a\n" Ast_simplified.PP.expression output ; ok () in @@ -122,7 +122,7 @@ let evaluate_value = let f source entry_point amount syntax = toplevel @@ let%bind output = - Ligo.Run.evaluate_value ~amount source entry_point (Syntax_name syntax) in + Ligo.Run.Of_source.evaluate ~amount source entry_point (Syntax_name syntax) in Format.printf "%a\n" Ast_simplified.PP.expression output ; ok () in diff --git a/src/bin/cli_helpers.ml b/src/bin/cli_helpers.ml index 28a565e40..ac0354368 100644 --- a/src/bin/cli_helpers.ml +++ b/src/bin/cli_helpers.ml @@ -4,6 +4,6 @@ let toplevel x = match x with | Trace.Ok ((), annotations) -> ignore annotations; () | Error ss -> ( - Format.printf "%a%!" Display.error_pp (ss ()) + Format.printf "%a%!" Main.Display.error_pp (ss ()) ) diff --git a/src/main/compile/of_source.ml b/src/main/compile/of_source.ml index 9d6005e4d..15134ee93 100644 --- a/src/main/compile/of_source.ml +++ b/src/main/compile/of_source.ml @@ -12,7 +12,13 @@ let compile_file_entry : string -> string -> s_syntax -> Compiler.Program.compil let%bind simplified = parse_file_program source_filename syntax in Of_simplified.compile_function_entry simplified entry_point -let compile_file_parameter : string -> string -> string -> s_syntax -> Michelson.t result = +let compile_file_contract_entry : string -> string -> s_syntax -> Michelson.t result = + fun source_filename entry_point syntax -> + let%bind simplified = parse_file_program source_filename syntax in + let%bind f = Of_simplified.compile_function_entry simplified entry_point in + ok f.body + +let compile_file_contract_parameter : string -> string -> string -> s_syntax -> Michelson.t result = fun source_filename _entry_point expression syntax -> let%bind syntax = syntax_to_variant syntax (Some source_filename) in let%bind simplified = parsify_expression syntax expression in @@ -24,7 +30,7 @@ let compile_file_expression : string -> string -> string -> s_syntax -> Michelso let%bind simplified = parsify_expression syntax expression in Of_simplified.compile_expression simplified -let compile_file_storage : string -> string -> string -> s_syntax -> Michelson.t result = +let compile_file_contract_storage : string -> string -> string -> s_syntax -> Michelson.t result = fun source_filename _entry_point expression syntax -> let%bind syntax = syntax_to_variant syntax (Some source_filename) in let%bind simplified = parsify_expression syntax expression in diff --git a/src/main/main.ml b/src/main/main.ml index 5795d1e56..e5214bc31 100644 --- a/src/main/main.ml +++ b/src/main/main.ml @@ -1,2 +1,3 @@ module Run = Run module Compile = Compile +module Display = Display diff --git a/src/main/run/of_simplified.ml b/src/main/run/of_simplified.ml index 22e3d7026..8937fd83f 100644 --- a/src/main/run/of_simplified.ml +++ b/src/main/run/of_simplified.ml @@ -18,6 +18,7 @@ let run_typed_program let%bind ex_ty_value = Of_michelson.run ?options code input in Compile.Of_simplified.uncompile_typed_program_entry_function_result program entry ex_ty_value + let evaluate_typed_program_entry ?options (program : Ast_typed.program) (entry : string) @@ -25,7 +26,7 @@ let evaluate_typed_program_entry let%bind code = Compile.Of_typed.compile_expression_entry program entry in let%bind input = let fake_input = Ast_typed.(e_a_unit Environment.full_empty) in - Compile.Of_typed.compile_expression fake_input + in let%bind ex_ty_value = Of_michelson.run ?options code input in Compile.Of_simplified.uncompile_typed_program_entry_expression_result program entry ex_ty_value diff --git a/src/main/run/run.ml b/src/main/run/run.ml index 10ca5ed1d..2436e3455 100644 --- a/src/main/run/run.ml +++ b/src/main/run/run.ml @@ -1,3 +1,4 @@ +module Of_source = Of_source module Of_typed = Of_typed module Of_simplified = Of_simplified module Of_mini_c = Of_mini_c diff --git a/src/passes/1-parser/pascaligo.ml b/src/passes/1-parser/pascaligo.ml index 1f95166e2..9fffdcb46 100644 --- a/src/passes/1-parser/pascaligo.ml +++ b/src/passes/1-parser/pascaligo.ml @@ -4,7 +4,7 @@ module Parser = Parser_pascaligo.Parser module AST = Parser_pascaligo.AST module ParserLog = Parser_pascaligo.ParserLog -let parse_file (source: string) : AST.t result = +let parse_file (source: string) : AST.t result = let pp_input = let prefix = Filename.(source |> basename |> remove_extension) and suffix = ".pp.ligo" diff --git a/src/test/bin_tests.ml b/src/test/bin_tests.ml index 2ee1485bc..6e109d6fd 100644 --- a/src/test/bin_tests.ml +++ b/src/test/bin_tests.ml @@ -1,10 +1,9 @@ open Trace -open Ligo.Run open Test_helpers let compile_contract_basic () : unit result = let%bind _ = - compile_contract_file "./contracts/dispatch-counter.ligo" "main" (Syntax_name "pascaligo") + Ligo.Compile.Of_source.compile_file_entry "./contracts/dispatch-counter.ligo" "main" (Syntax_name "pascaligo") in ok () diff --git a/src/test/coase_tests.ml b/src/test/coase_tests.ml index 135f9b429..7b7b38ae8 100644 --- a/src/test/coase_tests.ml +++ b/src/test/coase_tests.ml @@ -1,10 +1,9 @@ (* Copyright Coase, Inc 2019 *) open Trace -open Ligo.Run open Test_helpers -let type_file = type_file Pascaligo +let type_file = Ligo.Compile.Of_source.type_file (Syntax_name "pascaligo") let get_program = let s = ref None in diff --git a/src/test/compiler_tests.ml b/src/test/compiler_tests.ml index 0407c281f..b77c595f5 100644 --- a/src/test/compiler_tests.ml +++ b/src/test/compiler_tests.ml @@ -1,11 +1,11 @@ open Trace -open Ligo.Mini_c +open Mini_c open Combinators open Test_helpers let run_entry_int (e:anon_function) (n:int) : int result = let param : value = D_int n in - let%bind result = Main.Run_mini_c.run_entry e (t_int , t_int) param in + let%bind result = Run.Of_mini_c.run_entry e (t_int , t_int) param in match result with | D_int n -> ok n | _ -> simple_fail "result is not an int" diff --git a/src/test/heap_tests.ml b/src/test/heap_tests.ml index fb3821f27..2b66de488 100644 --- a/src/test/heap_tests.ml +++ b/src/test/heap_tests.ml @@ -1,8 +1,7 @@ open Trace -open Ligo.Run open Test_helpers -let type_file = type_file Pascaligo +let type_file = Ligo.Compile.Of_source.type_file (Syntax_name "pascaligo") let get_program = let s = ref None in @@ -45,6 +44,8 @@ let dummy n = @@ range (n + 1) ) +let run_typed = Run.Of_typed.run_entry + let is_empty () : unit result = let%bind program = get_program () in let aux n = diff --git a/src/test/integration_tests.ml b/src/test/integration_tests.ml index 781cb3a53..f2dcd21c1 100644 --- a/src/test/integration_tests.ml +++ b/src/test/integration_tests.ml @@ -1,11 +1,10 @@ open Trace -open Ligo.Run open Test_helpers open Ast_simplified.Combinators -let mtype_file ?debug_simplify ?debug_typed = type_file ?debug_simplify ?debug_typed Cameligo -let type_file = type_file Pascaligo +let mtype_file ?debug_simplify ?debug_typed = Ligo.Compile.Of_source.type_file ?debug_simplify ?debug_typed (Syntax_name "cameligo") +let type_file = Ligo.Compile.Of_source.type_file (Syntax_name "pascaligo") let type_alias () : unit result = let%bind program = type_file "./contracts/type-alias.ligo" in @@ -184,9 +183,9 @@ let bytes_arithmetic () : unit result = let%bind () = expect_eq program "slice_op" tata at in let%bind () = expect_fail program "slice_op" foo in let%bind () = expect_fail program "slice_op" ba in - let%bind b1 = run_simplityped program "hasherman" foo in + let%bind b1 = Run.Of_simplified.run_typed_program program "hasherman" foo in let%bind () = expect_eq program "hasherman" foo b1 in - let%bind b3 = run_simplityped program "hasherman" foototo in + let%bind b3 = Run.Of_simplified.run_typed_program program "hasherman" foototo in let%bind () = Assert.assert_fail @@ Ast_simplified.Misc.assert_value_eq (b3 , b1) in ok () @@ -577,9 +576,9 @@ let guess_string_mligo () : unit result = let basic_mligo () : unit result = let%bind typed = mtype_file ~debug_simplify:true "./contracts/basic.mligo" in - let%bind result = evaluate_typed "foo" typed in - Ligo.AST_Typed.assert_value_eq - (Ligo.AST_Typed.Combinators.e_a_empty_int (42 + 127), result) + let%bind result = Run.Of_typed.evaluate_entry typed "foo" in + Ast_typed.assert_value_eq + (Ast_typed.Combinators.e_a_empty_int (42 + 127), result) let counter_mligo () : unit result = let%bind program = mtype_file "./contracts/counter.mligo" in diff --git a/src/test/test_helpers.ml b/src/test/test_helpers.ml index f1a51a794..8b1bab00b 100644 --- a/src/test/test_helpers.ml +++ b/src/test/test_helpers.ml @@ -38,7 +38,7 @@ let expect ?options program entry_point input expecter = let content () = Format.asprintf "Entry_point: %s" entry_point in error title content in trace run_error @@ - Ligo.Run.run_simplityped ~debug_michelson:true ?options program entry_point input in + Ligo.Run.Of_simplified.run_typed_program ?options program entry_point input in expecter result let expect_fail ?options program entry_point input = @@ -49,7 +49,7 @@ let expect_fail ?options program entry_point input = in trace run_error @@ Assert.assert_fail - @@ Ligo.Run.run_simplityped ~debug_michelson:true ?options program entry_point input + @@ Ligo.Run.Of_simplified.run_typed_program ?options program entry_point input let expect_eq ?options program entry_point input expected = @@ -70,7 +70,7 @@ let expect_evaluate program entry_point expecter = let content () = Format.asprintf "Entry_point: %s" entry_point in error title content in trace error @@ - let%bind result = Ligo.Run.evaluate_simplityped ~debug_mini_c:true ~debug_michelson:true program entry_point in + let%bind result = Ligo.Run.Of_simplified.evaluate_typed_program_entry program entry_point in expecter result let expect_eq_evaluate program entry_point expected = diff --git a/src/test/typer_tests.ml b/src/test/typer_tests.ml index b61da4bd0..b22fb01db 100644 --- a/src/test/typer_tests.ml +++ b/src/test/typer_tests.ml @@ -1,10 +1,10 @@ open Trace -open Ligo.AST_Simplified +open Ast_simplified open Test_helpers -module Typed = Ligo.AST_Typed -module Typer = Ligo.Typer -module Simplified = Ligo.AST_Simplified +module Typed = Ast_typed +module Typer = Typer +module Simplified = Ast_simplified let int () : unit result = let open Combinators in diff --git a/src/test/vote_tests.ml b/src/test/vote_tests.ml index fbcf2b7ee..683169ee2 100644 --- a/src/test/vote_tests.ml +++ b/src/test/vote_tests.ml @@ -1,13 +1,14 @@ open Trace -open Ligo.Run open Test_helpers +let type_file = Ligo.Compile.Of_source.type_file (Syntax_name "cameligo") + let get_program = let s = ref None in fun () -> match !s with | Some s -> ok s | None -> ( - let%bind program = type_file Cameligo "./contracts/vote.mligo" in + let%bind program = type_file "./contracts/vote.mligo" in s := Some program ; ok program ) @@ -39,7 +40,7 @@ let vote str = let init_vote () = let%bind program = get_program () in - let%bind result = Ligo.Run.run_simplityped program "main" (e_pair (vote "Yes") (init_storage "basic")) in + let%bind result = Ligo.Run.Of_simplified.run_typed_program program "main" (e_pair (vote "Yes") (init_storage "basic")) in let%bind (_ , storage) = extract_pair result in let%bind storage' = extract_record storage in let votes = List.assoc "candidates" storage' in diff --git a/vendors/ligo-utils/simple-utils/x_list.ml b/vendors/ligo-utils/simple-utils/x_list.ml index 9037b0e9e..67ee96331 100644 --- a/vendors/ligo-utils/simple-utils/x_list.ml +++ b/vendors/ligo-utils/simple-utils/x_list.ml @@ -5,7 +5,6 @@ let rec remove n = function | _ :: tl when n = 0 -> tl | hd :: tl -> hd :: remove (n - 1) tl - let map ?(acc = []) f lst = let rec aux acc f = function | [] -> acc From 015e1971839c7c77e3102413bd781c91308c881c Mon Sep 17 00:00:00 2001 From: galfour Date: Thu, 19 Sep 2019 01:34:37 +0200 Subject: [PATCH 08/18] back on track --- src/bin/cli.ml | 2 +- src/main/compile/of_mini_c.ml | 30 +++- src/main/compile/of_simplified.ml | 14 +- src/main/compile/of_source.ml | 7 +- src/main/compile/of_typed.ml | 138 +++--------------- src/main/run/of_michelson.ml | 14 +- src/main/run/of_mini_c.ml | 52 +++---- src/main/run/of_simplified.ml | 9 +- src/main/run/of_source.ml | 2 +- src/main/run/of_typed.ml | 10 +- src/passes/6-transpiler/transpiler.ml | 14 +- src/passes/8-compiler/compiler_program.ml | 4 +- src/stages/ast_typed/combinators.ml | 5 + src/stages/ast_typed/misc.ml | 27 ++++ src/stages/ast_typed/types.ml | 20 --- src/stages/mini_c/PP.ml | 4 +- src/stages/mini_c/combinators.ml | 36 +++-- src/stages/mini_c/mini_c.ml | 1 + src/stages/mini_c/misc.ml | 93 ++++++++++++ src/stages/mini_c/types.ml | 3 +- src/test/compiler_tests.ml | 12 +- vendors/ligo-utils/tezos-utils/x_michelson.ml | 4 +- 22 files changed, 276 insertions(+), 225 deletions(-) create mode 100644 src/stages/mini_c/misc.ml diff --git a/src/bin/cli.ml b/src/bin/cli.ml index 29fa6247c..8d051dd83 100644 --- a/src/bin/cli.ml +++ b/src/bin/cli.ml @@ -51,7 +51,7 @@ let compile_file = let%bind contract = trace (simple_info "compiling contract to michelson") @@ Ligo.Compile.Of_source.compile_file_contract_entry source entry_point (Syntax_name syntax) in - Format.printf "%a\n" Tezos_utils.Michelson.pp contract ; + Format.printf "%a\n" Tezos_utils.Michelson.pp contract.body ; ok () in let term = diff --git a/src/main/compile/of_mini_c.ml b/src/main/compile/of_mini_c.ml index ffd31b259..b8d685975 100644 --- a/src/main/compile/of_mini_c.ml +++ b/src/main/compile/of_mini_c.ml @@ -5,11 +5,35 @@ open Tezos_utils let compile_value : value -> type_value -> Michelson.t result = Compiler.Program.translate_value -let compile_expression : expression -> Michelson.t result = fun e -> +let compile_expression : expression -> _ result = fun e -> Compiler.Program.translate_expression e Compiler.Environment.empty -let compile_function : anon_function -> type_value -> type_value -> Compiler.Program.compiled_program result = fun f in_ty out_ty -> - Compiler.Program.translate_entry f (in_ty , out_ty) +let compile_expression_as_function : expression -> _ result = fun e -> + let (input , output) = t_unit , e.type_value in + let%bind body = get_function e in + let%bind body = compile_value body (t_function input output) in + let%bind (input , output) = bind_map_pair Compiler.Type.Ty.type_ (input , output) in + let open! Compiler.Program in + ok { input ; output ; body } + +let compile_function = fun e -> + let%bind (input , output) = get_t_function e.type_value in + let%bind body = get_function e in + let%bind body = compile_value body (t_function input output) in + let%bind (input , output) = bind_map_pair Compiler.Type.Ty.type_ (input , output) in + let open! Compiler.Program in + ok { input ; output ; body } + +(* let compile_function : anon_function -> (type_value * type_value) -> Compiler.Program.compiled_program result = fun f io -> + * Compiler.Program.translate_entry f io *) + +let compile_expression_as_function_entry = fun program name -> + let%bind aggregated = aggregate_entry program name true in + compile_function aggregated + +let compile_function_entry = fun program name -> + let%bind aggregated = aggregate_entry program name false in + compile_function aggregated let uncompile_value : Proto_alpha_utils.Memory_proto_alpha.X.ex_typed_value -> value result = fun x -> Compiler.Uncompiler.translate_value x diff --git a/src/main/compile/of_simplified.ml b/src/main/compile/of_simplified.ml index f6c4500ac..1e2a11ca9 100644 --- a/src/main/compile/of_simplified.ml +++ b/src/main/compile/of_simplified.ml @@ -2,13 +2,13 @@ open Ast_simplified open Trace open Tezos_utils -let compile_function_entry (program : program) entry_point : Compiler.Program.compiled_program result = - let%bind typed_program = Typer.type_program program in - Of_typed.compile_function_entry typed_program entry_point +let compile_function_entry (program : program) entry_point : _ result = + let%bind prog_typed = Typer.type_program program in + Of_typed.compile_function_entry prog_typed entry_point -let compile_expression_entry (program : program) entry_point : Compiler.Program.compiled_program result = +let compile_expression_as_function_entry (program : program) entry_point : _ result = let%bind typed_program = Typer.type_program program in - Of_typed.compile_expression_entry typed_program entry_point + Of_typed.compile_expression_as_function_entry typed_program entry_point let compile_expression ?(env = Ast_typed.Environment.full_empty) ae : Michelson.t result = let%bind typed = Typer.type_expression env ae in @@ -16,7 +16,7 @@ let compile_expression ?(env = Ast_typed.Environment.full_empty) ae : Michelson. let uncompile_typed_program_entry_expression_result program entry ex_ty_value = let%bind output_type = - let%bind (entry_expression , _ ) = Of_typed.get_entry program entry in + let%bind entry_expression = Ast_typed.get_entry program entry in ok entry_expression.type_annotation in let%bind typed = Of_typed.uncompile_value ex_ty_value output_type in @@ -24,7 +24,7 @@ let uncompile_typed_program_entry_expression_result program entry ex_ty_value = let uncompile_typed_program_entry_function_result program entry ex_ty_value = let%bind output_type = - let%bind (entry_expression , _ ) = Of_typed.get_entry program entry in + let%bind entry_expression = Ast_typed.get_entry program entry in let%bind (_ , output_type) = Ast_typed.get_t_function entry_expression.type_annotation in ok output_type in diff --git a/src/main/compile/of_source.ml b/src/main/compile/of_source.ml index 15134ee93..fd0b93dc7 100644 --- a/src/main/compile/of_source.ml +++ b/src/main/compile/of_source.ml @@ -7,16 +7,15 @@ let parse_file_program source_filename syntax = let%bind simplified = parsify syntax source_filename in ok simplified -let compile_file_entry : string -> string -> s_syntax -> Compiler.Program.compiled_program result = +let compile_file_entry : string -> string -> s_syntax -> _ result = fun source_filename entry_point syntax -> let%bind simplified = parse_file_program source_filename syntax in Of_simplified.compile_function_entry simplified entry_point -let compile_file_contract_entry : string -> string -> s_syntax -> Michelson.t result = +let compile_file_contract_entry : string -> string -> s_syntax -> _ result = fun source_filename entry_point syntax -> let%bind simplified = parse_file_program source_filename syntax in - let%bind f = Of_simplified.compile_function_entry simplified entry_point in - ok f.body + Of_simplified.compile_function_entry simplified entry_point let compile_file_contract_parameter : string -> string -> string -> s_syntax -> Michelson.t result = fun source_filename _entry_point expression syntax -> diff --git a/src/main/compile/of_typed.ml b/src/main/compile/of_typed.ml index 962543444..a8855e904 100644 --- a/src/main/compile/of_typed.ml +++ b/src/main/compile/of_typed.ml @@ -2,37 +2,21 @@ open Trace open Ast_typed open Tezos_utils -module Errors = struct - - let missing_entry_point name = - let title () = "missing entry point" in - let content () = "no entry point with the given name" in - let data = [ - ("name" , fun () -> name) ; - ] in - error ~data title content - - let not_functional_main location = - let title () = "not functional main" in - let content () = "main should be a function" in - let data = [ - ("location" , fun () -> Format.asprintf "%a" Location.pp location) ; - ] in - error ~data title content - -end - -(* - This converts `expr` in `fun () -> expr`. -*) -let functionalize (body : annotated_expression) : annotated_expression = - let expression = E_lambda { binder = "_" ; body } in - let type_annotation = t_function (t_unit ()) body.type_annotation () in - { body with expression ; type_annotation } let compile_expression : annotated_expression -> Michelson.t result = fun e -> let%bind mini_c_expression = Transpiler.transpile_annotated_expression e in - Of_mini_c.compile_expression mini_c_expression + let%bind expr = Of_mini_c.compile_expression mini_c_expression in + ok expr + +let compile_expression_as_function : annotated_expression -> _ result = fun e -> + let%bind mini_c_expression = Transpiler.transpile_annotated_expression e in + let%bind expr = Of_mini_c.compile_expression_as_function mini_c_expression in + ok expr + +let compile_function : annotated_expression -> _ result = fun e -> + let%bind mini_c_expression = Transpiler.transpile_annotated_expression e in + let%bind expr = Of_mini_c.compile_function mini_c_expression in + ok expr (* val compile_value : annotated_expression -> Michelson.t result @@ -40,102 +24,22 @@ let compile_expression : annotated_expression -> Michelson.t result = fun e -> `transpile_expression_as_value : annotated_expression -> Mini_c.value result` *) -let compile_function expr = - let%bind l = get_lambda expr.expression in - let%bind io = get_t_function expr.type_annotation in - let%bind mini_c = Transpiler.transpile_lambda Mini_c.Environment.empty l io in - let%bind (f , (in_ty , out_ty)) = - match (mini_c.content , mini_c.type_value) with - | E_literal (D_function f) , T_function ty -> ok (f , ty) - | _ -> fail @@ Errors.not_functional_main expr.location - in - Of_mini_c.compile_function f in_ty out_ty - - -let get_entry (lst : program) (name : string) : (annotated_expression * int) result = - let%bind entry_expression = - trace_option (Errors.missing_entry_point name) @@ - let aux x = - let (Declaration_constant (an , _)) = Location.unwrap x in - if (an.name = name) - then Some an.annotated_expression - else None - in - List.find_map aux lst - in - let entry_index = - let aux x = - let (Declaration_constant (an , _)) = Location.unwrap x in - an.name = name - in - List.find_index aux lst - in - ok (entry_expression , entry_index) - -(* - Assume the following code: - ``` - const x = 42 - const y = 120 - const z = 423 - const f = () -> x + y - ``` - It is transformed in: - ``` - const f = () -> - let x = 42 in - let y = 120 in - let z = 423 in - x + y - ``` - - The entry-point can be an expression, which is then functionalized if - `to_functionalize` is set to true. -*) -let get_aggregated_entry (lst : program) (name : string) (to_functionalize : bool) : annotated_expression result = - let%bind (entry_expression , entry_index) = get_entry lst name in - let pre_declarations = - let sub_program = List.until entry_index lst in - let aux x = Location.unwrap x in - List.map aux sub_program - in - let wrapper = - let aux prec cur = - let (Declaration_constant (an , (pre_env , _))) = cur in - e_a_let_in an.name an.annotated_expression prec pre_env - in - fun expr -> List.fold_right' aux expr pre_declarations - in - match (entry_expression.expression , to_functionalize) with - | (E_lambda l , false) -> ( - let l' = { l with body = wrapper l.body } in - let e' = { entry_expression with expression = E_lambda l' } in - ok e' - ) - | (_ , true) -> ( - ok @@ functionalize @@ wrapper entry_expression - ) - | _ -> fail @@ Errors.not_functional_main entry_expression.location - let compile_function_entry : program -> string -> _ = fun p entry -> - let%bind expr = get_aggregated_entry p entry false in - compile_function expr + let%bind prog_mini_c = Transpiler.transpile_program p in + Of_mini_c.compile_function_entry prog_mini_c entry -let compile_expression_entry : program -> string -> _ = fun p entry -> - let%bind expr = get_aggregated_entry p entry true in - compile_function expr - -let compile_expression_as_function : annotated_expression -> Compiler.Program.compiled_program result = fun e -> - let expr = functionalize e in - compile_function expr +let compile_expression_as_function_entry : program -> string -> _ = fun p entry -> + let%bind prog_mini_c = Transpiler.transpile_program p in + Of_mini_c.compile_expression_as_function_entry prog_mini_c entry let uncompile_value : _ -> _ -> annotated_expression result = fun x ty -> let%bind mini_c = Of_mini_c.uncompile_value x in - Transpiler.untranspile mini_c ty + let%bind typed = Transpiler.untranspile mini_c ty in + ok typed let uncompile_entry_function_result = fun program entry ex_ty_value -> let%bind output_type = - let%bind (entry_expression , _ ) = get_entry program entry in + let%bind entry_expression = get_entry program entry in let%bind (_ , output_type) = get_t_function entry_expression.type_annotation in ok output_type in @@ -143,7 +47,7 @@ let uncompile_entry_function_result = fun program entry ex_ty_value -> let uncompile_entry_expression_result = fun program entry ex_ty_value -> let%bind output_type = - let%bind (entry_expression , _ ) = get_entry program entry in + let%bind entry_expression = get_entry program entry in ok entry_expression.type_annotation in uncompile_value ex_ty_value output_type diff --git a/src/main/run/of_michelson.ml b/src/main/run/of_michelson.ml index f34cb2333..4eb9d9c9a 100644 --- a/src/main/run/of_michelson.ml +++ b/src/main/run/of_michelson.ml @@ -13,7 +13,17 @@ let run ?options (program:compiled_program) (input_michelson:Michelson.t) : ex_t let%bind input = Trace.trace_tzresult_lwt (simple_error "error parsing input") @@ Memory_proto_alpha.parse_michelson_data input_michelson input_ty in - let body = Michelson.strip_annots body in + let body = Michelson.(strip_nops @@ strip_annots body) in + + let%bind input_ty_mich = + Trace.trace_tzresult_lwt (simple_error "error unparsing input ty") @@ + Memory_proto_alpha.unparse_michelson_ty input_ty in + let%bind output_ty_mich = + Trace.trace_tzresult_lwt (simple_error "error unparsing output ty") @@ + Memory_proto_alpha.unparse_michelson_ty output_ty in + Format.printf "code: %a\n" Michelson.pp program.body ; + Format.printf "input: %a\n" Michelson.pp input_ty_mich ; + Format.printf "output: %a\n" Michelson.pp output_ty_mich ; let%bind descr = Trace.trace_tzresult_lwt (simple_error "error parsing program code") @@ Memory_proto_alpha.parse_michelson body @@ -23,3 +33,5 @@ let run ?options (program:compiled_program) (input_michelson:Michelson.t) : ex_t Trace.trace_tzresult_lwt (simple_error "error of execution") @@ Memory_proto_alpha.interpret ?options descr (Item(input, Empty)) in ok (Ex_typed_value (output_ty, output)) + +let evaluate ?options program = run ?options program Michelson.d_unit diff --git a/src/main/run/of_mini_c.ml b/src/main/run/of_mini_c.ml index 8e22c8a54..0fecd02bb 100644 --- a/src/main/run/of_mini_c.ml +++ b/src/main/run/of_mini_c.ml @@ -2,7 +2,7 @@ open Proto_alpha_utils open Memory_proto_alpha.X open Trace open Mini_c -open Compiler.Program +open! Compiler.Program module Errors = struct @@ -19,27 +19,29 @@ type options = { michelson_options : Of_michelson.options ; } -let run_entry ?(debug_michelson = false) ?options (entry : anon_function) ty (input:value) : value result = - let%bind compiled = - trace Errors.entry_error @@ - translate_entry entry ty in - let%bind input_michelson = translate_value input (fst ty) in - if debug_michelson then ( - Format.printf "Program: %a\n" Michelson.pp compiled.body ; - Format.printf "Expression: %a\n" PP.expression entry.result ; - Format.printf "Input: %a\n" PP.value input ; - Format.printf "Input Type: %a\n" PP.type_ (fst ty) ; - Format.printf "Compiled Input: %a\n" Michelson.pp input_michelson ; - ) ; - let%bind ex_ty_value = Of_michelson.run ?options compiled input_michelson in - if debug_michelson then ( - let (Ex_typed_value (ty , v)) = ex_ty_value in - ignore @@ - let%bind michelson_value = - trace_tzresult_lwt (simple_error "debugging run_mini_c") @@ - Proto_alpha_utils.Memory_proto_alpha.unparse_michelson_data ty v in - Format.printf "Compiled Output: %a\n" Michelson.pp michelson_value ; - ok () - ) ; - let%bind (result : value) = Compile.Of_mini_c.uncompile_value ex_ty_value in - ok result +let evaluate ?options expression = + let%bind code = Compile.Of_mini_c.compile_expression_as_function expression in + let%bind ex_ty_value = Of_michelson.evaluate ?options code in + Compile.Of_mini_c.uncompile_value ex_ty_value + +let evaluate_entry ?options program entry = + let%bind code = Compile.Of_mini_c.compile_expression_as_function_entry program entry in + let%bind ex_ty_value = Of_michelson.evaluate ?options code in + Compile.Of_mini_c.uncompile_value ex_ty_value + +let run_function ?options expression input ty = + let%bind code = Compile.Of_mini_c.compile_function expression in + let%bind input = Compile.Of_mini_c.compile_value input ty in + let%bind ex_ty_value = Of_michelson.run ?options code input in + Compile.Of_mini_c.uncompile_value ex_ty_value + +let run_function_entry ?options program entry input = + let%bind code = Compile.Of_mini_c.compile_function_entry program entry in + let%bind input_michelson = + let%bind code = Compile.Of_mini_c.compile_expression_as_function input in + let%bind (Ex_typed_value (ty , value)) = Of_michelson.evaluate ?options code in + Trace.trace_tzresult_lwt (simple_error "error unparsing input") @@ + Memory_proto_alpha.unparse_michelson_data ty value + in + let%bind ex_ty_value = Of_michelson.run ?options code input_michelson in + Compile.Of_mini_c.uncompile_value ex_ty_value diff --git a/src/main/run/of_simplified.ml b/src/main/run/of_simplified.ml index 8937fd83f..4332ca9e5 100644 --- a/src/main/run/of_simplified.ml +++ b/src/main/run/of_simplified.ml @@ -18,15 +18,10 @@ let run_typed_program let%bind ex_ty_value = Of_michelson.run ?options code input in Compile.Of_simplified.uncompile_typed_program_entry_function_result program entry ex_ty_value - let evaluate_typed_program_entry ?options (program : Ast_typed.program) (entry : string) : Ast_simplified.expression result = - let%bind code = Compile.Of_typed.compile_expression_entry program entry in - let%bind input = - let fake_input = Ast_typed.(e_a_unit Environment.full_empty) in - - in - let%bind ex_ty_value = Of_michelson.run ?options code input in + let%bind code = Compile.Of_typed.compile_expression_as_function_entry program entry in + let%bind ex_ty_value = Of_michelson.evaluate ?options code in Compile.Of_simplified.uncompile_typed_program_entry_expression_result program entry ex_ty_value diff --git a/src/main/run/of_source.ml b/src/main/run/of_source.ml index 55a455f9e..5bc8b421c 100644 --- a/src/main/run/of_source.ml +++ b/src/main/run/of_source.ml @@ -76,7 +76,7 @@ let run_function ?amount source_filename entry_point input syntax = let evaluate ?amount source_filename entry_point syntax = let%bind program = Compile.Of_source.type_file syntax source_filename in - let%bind code = Compile.Of_typed.compile_expression_entry program entry_point in + let%bind code = Compile.Of_typed.compile_expression_as_function_entry program entry_point in let%bind input = let fake_input = Ast_simplified.e_unit () in Compile.Of_simplified.compile_expression fake_input diff --git a/src/main/run/of_typed.ml b/src/main/run/of_typed.ml index a7bbcb88c..a645250cc 100644 --- a/src/main/run/of_typed.ml +++ b/src/main/run/of_typed.ml @@ -21,14 +21,10 @@ let run_entry let evaluate ?options (e : annotated_expression) : annotated_expression result = let%bind code = Compile.Of_typed.compile_expression_as_function e in - let fake_input = e_a_unit Environment.full_empty in - let%bind input = Compile.Of_typed.compile_expression fake_input in - let%bind ex_ty_value = Of_michelson.run ?options code input in + let%bind ex_ty_value = Of_michelson.evaluate ?options code in Compile.Of_typed.uncompile_value ex_ty_value e.type_annotation let evaluate_entry ?options program entry = - let%bind code = Compile.Of_typed.compile_expression_entry program entry in - let fake_input = e_a_unit Environment.full_empty in - let%bind input = Compile.Of_typed.compile_expression fake_input in - let%bind ex_ty_value = Of_michelson.run ?options code input in + let%bind code = Compile.Of_typed.compile_expression_as_function_entry program entry in + let%bind ex_ty_value = Of_michelson.evaluate ?options code in Compile.Of_typed.uncompile_entry_expression_result program entry ex_ty_value diff --git a/src/passes/6-transpiler/transpiler.ml b/src/passes/6-transpiler/transpiler.ml index ef8d562c4..df99e3b4b 100644 --- a/src/passes/6-transpiler/transpiler.ml +++ b/src/passes/6-transpiler/transpiler.ml @@ -313,7 +313,7 @@ and transpile_annotated_expression (ae:AST.annotated_expression) : expression re let%bind f' = match f.expression with | E_lambda l -> ( let%bind body' = transpile_annotated_expression l.body in - let%bind (input , _) = get_t_function f.type_annotation in + let%bind (input , _) = AST.get_t_function f.type_annotation in let%bind input' = transpile_type input in ok ((l.binder , input') , body') ) @@ -326,7 +326,7 @@ and transpile_annotated_expression (ae:AST.annotated_expression) : expression re match f.expression with | E_lambda l -> ( let%bind body' = transpile_annotated_expression l.body in - let%bind (input , _) = get_t_function f.type_annotation in + let%bind (input , _) = AST.get_t_function f.type_annotation in let%bind input' = transpile_type input in ok ((l.binder , input') , body') ) @@ -357,7 +357,7 @@ and transpile_annotated_expression (ae:AST.annotated_expression) : expression re let%bind env = trace_strong (corner_case ~loc:__LOC__ "environment") @@ transpile_environment ae.environment in - let%bind io = get_t_function ae.type_annotation in + let%bind io = AST.get_t_function ae.type_annotation in transpile_lambda env l io | E_list lst -> ( let%bind t = @@ -513,8 +513,8 @@ and transpile_lambda_deep : Mini_c.Environment.t -> AST.lambda -> _ -> Mini_c.ex let%bind (f_expr' , input_tv , output_tv) = let%bind raw_input = transpile_type input_type in let%bind output = transpile_type output_type in - let%bind result = transpile_annotated_expression body in - let expr' = E_closure { binder ; result } in + let%bind body = transpile_annotated_expression body in + let expr' = E_closure { binder ; body } in ok (expr' , raw_input , output) in let tv = Mini_c.t_deep_closure c_env input_tv output_tv in ok @@ Expression.make_tpl (f_expr' , tv) @@ -529,7 +529,7 @@ and transpile_lambda env l (input_type , output_type) = let%bind input = transpile_type input_type in let%bind output = transpile_type output_type in let tv = Combinators.t_function input output in - let content = D_function { binder ; result = result'} in + let content = D_function { binder ; body = result'} in ok @@ Combinators.Expression.make_tpl (E_literal content , tv) ) | _ -> ( @@ -545,7 +545,7 @@ let transpile_declaration env (d:AST.declaration) : toplevel_statement result = let env' = Environment.add (name, tv) env in ok @@ ((name, expression), environment_wrap env env') -let transpile_program (lst:AST.program) : program result = +let transpile_program (lst : AST.program) : program result = let aux (prev:(toplevel_statement list * Environment.t) result) cur = let%bind (tl, env) = prev in let%bind ((_, env') as cur') = transpile_declaration env cur in diff --git a/src/passes/8-compiler/compiler_program.ml b/src/passes/8-compiler/compiler_program.ml index a06fc2a6e..1e7ff7d51 100644 --- a/src/passes/8-compiler/compiler_program.ml +++ b/src/passes/8-compiler/compiler_program.ml @@ -361,10 +361,10 @@ and translate_expression (expr:expression) (env:environment) : michelson result ] ) -and translate_function_body ({result ; binder} : anon_function) lst input : michelson result = +and translate_function_body ({body ; binder} : anon_function) lst input : michelson result = let pre_env = Environment.of_list lst in let env = Environment.(add (binder , input) pre_env) in - let%bind expr_code = translate_expression result env in + let%bind expr_code = translate_expression body env in let%bind unpack_closure_code = Compiler_environment.unpack_closure pre_env in let code = seq [ i_comment "unpack closure env" ; diff --git a/src/stages/ast_typed/combinators.ml b/src/stages/ast_typed/combinators.ml index 6b2358c28..f0ae6f648 100644 --- a/src/stages/ast_typed/combinators.ml +++ b/src/stages/ast_typed/combinators.ml @@ -60,6 +60,11 @@ let get_lambda e : _ result = match e with | E_lambda l -> ok l | _ -> simple_fail "not a lambda" +let get_lambda_with_type e = + match (e.expression , e.type_annotation.type_value') with + | E_lambda l , T_function io -> ok (l , io) + | _ -> simple_fail "not a lambda with functional type" + let get_t_bool (t:type_value) : unit result = match t.type_value' with | T_constant ("bool", []) -> ok () | _ -> simple_fail "not a bool" diff --git a/src/stages/ast_typed/misc.ml b/src/stages/ast_typed/misc.ml index a71ff3fae..c13200c9a 100644 --- a/src/stages/ast_typed/misc.ml +++ b/src/stages/ast_typed/misc.ml @@ -125,6 +125,23 @@ module Errors = struct ("missing_key" , fun () -> Format.asprintf "%s" k) ] in error ~data title message () + + let missing_entry_point name = + let title () = "missing entry point" in + let content () = "no entry point with the given name" in + let data = [ + ("name" , fun () -> name) ; + ] in + error ~data title content + + let not_functional_main location = + let title () = "not functional main" in + let content () = "main should be a function" in + let data = [ + ("location" , fun () -> Format.asprintf "%a" Location.pp location) ; + ] in + error ~data title content + end module Free_variables = struct @@ -473,3 +490,13 @@ let merge_annotation (a:type_value option) (b:type_value option) err : type_valu match a.simplified, b.simplified with | _, None -> ok a | _, Some _ -> ok b + +let get_entry (lst : program) (name : string) : annotated_expression result = + trace_option (Errors.missing_entry_point name) @@ + let aux x = + let (Declaration_constant (an , _)) = Location.unwrap x in + if (an.name = name) + then Some an.annotated_expression + else None + in + List.find_map aux lst diff --git a/src/stages/ast_typed/types.ml b/src/stages/ast_typed/types.ml index 6fe7f921e..f7ef1595f 100644 --- a/src/stages/ast_typed/types.ml +++ b/src/stages/ast_typed/types.ml @@ -148,23 +148,3 @@ and 'a matching = | Match_variant of (((constructor_name * name) * 'a) list * type_value) and matching_expr = ae matching - -open Trace - -let get_entry (p:program) (entry : string) : annotated_expression result = - let aux (d:declaration) = - match d with - | Declaration_constant ({name ; annotated_expression} , _) when entry = name -> Some annotated_expression - | Declaration_constant _ -> None - in - let%bind result = - trace_option (simple_error "no entry point with given name") @@ - List.find_map aux (List.map Location.unwrap p) in - ok result - -let get_functional_entry (p:program) (entry : string) : (lambda * type_value) result = - let%bind entry = get_entry p entry in - match entry.expression with - | E_lambda l -> ok (l , entry.type_annotation) - | _ -> simple_fail "given entry point is not functional" - diff --git a/src/stages/mini_c/PP.ml b/src/stages/mini_c/PP.ml index 13fb005fc..f2527d27b 100644 --- a/src/stages/mini_c/PP.ml +++ b/src/stages/mini_c/PP.ml @@ -100,10 +100,10 @@ and expression_with_type : _ -> expression -> _ = fun ppf e -> expression' e.content type_ e.type_value -and function_ ppf ({binder ; result}:anon_function) = +and function_ ppf ({binder ; body}:anon_function) = fprintf ppf "fun %s -> (%a)" binder - expression result + expression body and assignment ppf ((n, e):assignment) = fprintf ppf "%s = %a;" n expression e diff --git a/src/stages/mini_c/combinators.ml b/src/stages/mini_c/combinators.ml index 9e8467207..e9090a9d8 100644 --- a/src/stages/mini_c/combinators.ml +++ b/src/stages/mini_c/combinators.ml @@ -7,18 +7,15 @@ module Expression = struct let get_content : t -> t' = fun e -> e.content let get_type : t -> type_value = fun e -> e.type_value - let is_toplevel : t -> bool = fun e -> e.is_toplevel - let make = fun ?(itl = false) e' t -> { + let make = fun e' t -> { content = e' ; type_value = t ; - is_toplevel = itl ; } - let make_tpl = fun ?(itl = false) (e' , t) -> { + let make_tpl = fun (e' , t) -> { content = e' ; type_value = t ; - is_toplevel = itl ; } let pair : t -> t -> t' = fun a b -> E_constant ("PAIR" , [ a ; b ]) @@ -70,6 +67,20 @@ let get_set (v:value) = match v with | D_set lst -> ok lst | _ -> simple_fail "not a set" +let get_function_with_ty (e : expression) = + match (e.content , e.type_value) with + | E_literal (D_function f) , T_function ty -> ok (f , ty) + | _ -> simple_fail "not a function with functional type" + +let get_function (e : expression) = + match (e.content) with + | E_literal (D_function f) -> ok (D_function f) + | _ -> simple_fail "not a function" + +let get_t_function tv = match tv with + | T_function ty -> ok ty + | _ -> simple_fail "not a function" + let get_t_option (v:type_value) = match v with | T_option t -> ok t | _ -> simple_fail "not an option" @@ -146,10 +157,10 @@ let t_deep_closure x y z : type_value = T_deep_closure ( x , y , z ) let t_pair x y : type_value = T_pair ( x , y ) let t_union x y : type_value = T_or ( x , y ) -let quote binder result : anon_function = +let quote binder body : anon_function = { binder ; - result ; + body ; } @@ -157,7 +168,7 @@ let e_int expr : expression = Expression.make_tpl (expr, t_int) let e_unit : expression = Expression.make_tpl (E_literal D_unit, t_unit) let e_skip : expression = Expression.make_tpl (E_skip, t_unit) let e_var_int name : expression = e_int (E_variable name) -let e_let_int v tv expr body : expression = Expression.(make_tpl ( +let e_let_in v tv expr body : expression = Expression.(make_tpl ( E_let_in ((v , tv) , expr , body) , get_type body )) @@ -166,11 +177,12 @@ let ez_e_sequence a b : expression = Expression.(make_tpl (E_sequence (make_tpl let d_unit : value = D_unit -let basic_quote expr : anon_function result = - ok @@ quote "input" expr +let basic_quote expr in_ty out_ty : expression result = + let expr' = E_literal (D_function (quote "input" expr)) in + ok @@ Expression.make_tpl (expr' , t_function in_ty out_ty) -let basic_int_quote expr : anon_function result = - basic_quote expr +let basic_int_quote expr : expression result = + basic_quote expr t_int t_int let environment_wrap pre_environment post_environment = { pre_environment ; post_environment } diff --git a/src/stages/mini_c/mini_c.ml b/src/stages/mini_c/mini_c.ml index 5f4e9f5a2..891f746d7 100644 --- a/src/stages/mini_c/mini_c.ml +++ b/src/stages/mini_c/mini_c.ml @@ -8,3 +8,4 @@ module Combinators = struct end include Combinators module Environment = Environment +include Misc diff --git a/src/stages/mini_c/misc.ml b/src/stages/mini_c/misc.ml new file mode 100644 index 000000000..7fa6a9779 --- /dev/null +++ b/src/stages/mini_c/misc.ml @@ -0,0 +1,93 @@ +open Types +open Combinators +open Trace + +module Errors = struct + + let missing_entry_point name = + let title () = "missing entry point" in + let content () = "no entry point with the given name" in + let data = [ + ("name" , fun () -> name) ; + ] in + error ~data title content + + let not_functional_main name = + let title () = "not functional main" in + let content () = "main should be a function" in + let data = [ + ("name" , fun () -> Format.asprintf "%s" name) ; + ] in + error ~data title content + +end + +(* + Converts `expr` in `fun () -> expr`. +*) +let functionalize (body : expression) : expression = + let content = E_literal (D_function { binder = "_" ; body }) in + let type_value = t_function t_unit body.type_value in + { content ; type_value } + +let get_entry (lst : program) (name : string) : (expression * int) result = + let%bind entry_expression = + trace_option (Errors.missing_entry_point name) @@ + let aux x = + let (((decl_name , decl_expr) , _)) = x in + if (decl_name = name) + then Some decl_expr + else None + in + List.find_map aux lst + in + let entry_index = + let aux x = + let (((decl_name , _) , _)) = x in + decl_name = name + in + List.find_index aux lst + in + ok (entry_expression , entry_index) + + +(* + Assume the following code: + ``` + const x = 42 + const y = 120 + const z = 423 + const f = () -> x + y + ``` + It is transformed in: + ``` + const f = () -> + let x = 42 in + let y = 120 in + let z = 423 in + x + y + ``` + + The entry-point can be an expression, which is then functionalized if + `to_functionalize` is set to true. +*) +let aggregate_entry (lst : program) (name : string) (to_functionalize : bool) : expression result = + let%bind (entry_expression , entry_index) = get_entry lst name in + let pre_declarations = List.until entry_index lst in + let wrapper = + let aux prec cur = + let (((name , expr) , _)) = cur in + e_let_in name expr.type_value expr prec + in + fun expr -> List.fold_right' aux expr pre_declarations + in + match (entry_expression.content , to_functionalize) with + | (E_literal (D_function l) , false) -> ( + let l' = { l with body = wrapper l.body } in + let e' = { entry_expression with content = E_literal (D_function l') } in + ok e' + ) + | (_ , true) -> ( + ok @@ functionalize @@ wrapper entry_expression + ) + | _ -> fail @@ Errors.not_functional_main name diff --git a/src/stages/mini_c/types.ml b/src/stages/mini_c/types.ml index fd0ddd021..d3b6bcf36 100644 --- a/src/stages/mini_c/types.ml +++ b/src/stages/mini_c/types.ml @@ -78,7 +78,6 @@ and expression' = and expression = { content : expression' ; type_value : type_value ; - is_toplevel : bool ; } and assignment = var_name * expression @@ -87,7 +86,7 @@ and toplevel_statement = assignment * environment_wrap and anon_function = { binder : string ; - result : expression ; + body : expression ; } and program = toplevel_statement list diff --git a/src/test/compiler_tests.ml b/src/test/compiler_tests.ml index b77c595f5..dd18c53f2 100644 --- a/src/test/compiler_tests.ml +++ b/src/test/compiler_tests.ml @@ -3,9 +3,9 @@ open Mini_c open Combinators open Test_helpers -let run_entry_int (e:anon_function) (n:int) : int result = +let run_entry_int e (n:int) : int result = let param : value = D_int n in - let%bind result = Run.Of_mini_c.run_entry e (t_int , t_int) param in + let%bind result = Run.Of_mini_c.run_function e param t_int in match result with | D_int n -> ok n | _ -> simple_fail "result is not an int" @@ -18,10 +18,10 @@ let identity () : unit result = let multiple_vars () : unit result = let expr = - e_let_int "a" t_int (e_var_int "input") @@ - e_let_int "b" t_int (e_var_int "input") @@ - e_let_int "c" t_int (e_var_int "a") @@ - e_let_int "output" t_int (e_var_int "c") @@ + e_let_in "a" t_int (e_var_int "input") @@ + e_let_in "b" t_int (e_var_int "input") @@ + e_let_in "c" t_int (e_var_int "a") @@ + e_let_in "output" t_int (e_var_int "c") @@ e_var_int "output" in let%bind f = basic_int_quote expr in let%bind result = run_entry_int f 42 in diff --git a/vendors/ligo-utils/tezos-utils/x_michelson.ml b/vendors/ligo-utils/tezos-utils/x_michelson.ml index 6bb8e6203..88684549e 100644 --- a/vendors/ligo-utils/tezos-utils/x_michelson.ml +++ b/vendors/ligo-utils/tezos-utils/x_michelson.ml @@ -15,7 +15,6 @@ let annotate annot = function let seq s : michelson = Seq (0, s) -let i_comment s : michelson = seq [ prim ~annot:["\"" ^ s ^ "\""] I_UNIT ; prim I_DROP ] let contract parameter storage code = seq [ @@ -45,6 +44,9 @@ let i_piar = seq [ i_swap ; i_pair ] let i_push ty code = prim ~children:[ty;code] I_PUSH let i_push_unit = i_push t_unit d_unit let i_push_string str = i_push t_string (string str) + +let i_comment s : michelson = seq [ i_push_string s ; prim I_DROP ] + let i_none ty = prim ~children:[ty] I_NONE let i_nil ty = prim ~children:[ty] I_NIL let i_empty_set ty = prim ~children:[ty] I_EMPTY_SET From 6fe48ff6ad8b4f571340e22d75ef800daf832866 Mon Sep 17 00:00:00 2001 From: galfour Date: Thu, 19 Sep 2019 08:29:31 +0200 Subject: [PATCH 09/18] more working --- src/main/run/of_michelson.ml | 31 ++++++++++++++++++++++--------- 1 file changed, 22 insertions(+), 9 deletions(-) diff --git a/src/main/run/of_michelson.ml b/src/main/run/of_michelson.ml index 4eb9d9c9a..307aa2274 100644 --- a/src/main/run/of_michelson.ml +++ b/src/main/run/of_michelson.ml @@ -6,15 +6,10 @@ open Memory_proto_alpha.X type options = Memory_proto_alpha.options -let run ?options (program:compiled_program) (input_michelson:Michelson.t) : ex_typed_value result = +let run ?options ?(is_input_value = false) (program:compiled_program) (input_michelson:Michelson.t) : ex_typed_value result = let Compiler.Program.{input;output;body} : compiled_program = program in let (Ex_ty input_ty) = input in let (Ex_ty output_ty) = output in - let%bind input = - Trace.trace_tzresult_lwt (simple_error "error parsing input") @@ - Memory_proto_alpha.parse_michelson_data input_michelson input_ty in - let body = Michelson.(strip_nops @@ strip_annots body) in - let%bind input_ty_mich = Trace.trace_tzresult_lwt (simple_error "error unparsing input ty") @@ Memory_proto_alpha.unparse_michelson_ty input_ty in @@ -22,8 +17,26 @@ let run ?options (program:compiled_program) (input_michelson:Michelson.t) : ex_t Trace.trace_tzresult_lwt (simple_error "error unparsing output ty") @@ Memory_proto_alpha.unparse_michelson_ty output_ty in Format.printf "code: %a\n" Michelson.pp program.body ; - Format.printf "input: %a\n" Michelson.pp input_ty_mich ; - Format.printf "output: %a\n" Michelson.pp output_ty_mich ; + Format.printf "input_ty: %a\n" Michelson.pp input_ty_mich ; + Format.printf "output_ty: %a\n" Michelson.pp output_ty_mich ; + Format.printf "input: %a\n" Michelson.pp input_michelson ; + let%bind input = + if is_input_value then ( + Trace.trace_tzresult_lwt (simple_error "error parsing input") @@ + Memory_proto_alpha.parse_michelson_data input_michelson input_ty + ) else ( + let input_michelson = Michelson.(seq [ input_michelson ; dip i_drop ]) in + let body = Michelson.(strip_nops @@ strip_annots input_michelson) in + let%bind descr = + Trace.trace_tzresult_lwt (simple_error "error parsing input code") @@ + Memory_proto_alpha.parse_michelson body + (Item_t (Memory_proto_alpha.Protocol.Script_typed_ir.Unit_t None, Empty_t, None)) (Item_t (input_ty, Empty_t, None)) in + let%bind (Item(output, Empty)) = + Trace.trace_tzresult_lwt (simple_error "input error of execution") @@ + Memory_proto_alpha.interpret ?options descr (Item((), Empty)) in + ok output + ) in + let body = Michelson.(strip_nops @@ strip_annots body) in let%bind descr = Trace.trace_tzresult_lwt (simple_error "error parsing program code") @@ Memory_proto_alpha.parse_michelson body @@ -34,4 +47,4 @@ let run ?options (program:compiled_program) (input_michelson:Michelson.t) : ex_t Memory_proto_alpha.interpret ?options descr (Item(input, Empty)) in ok (Ex_typed_value (output_ty, output)) -let evaluate ?options program = run ?options program Michelson.d_unit +let evaluate ?options program = run ?options ~is_input_value:true program Michelson.d_unit From e3179bd7c7eeacf461a9c3fc365581a45c5a0035 Mon Sep 17 00:00:00 2001 From: galfour Date: Thu, 19 Sep 2019 12:59:07 +0200 Subject: [PATCH 10/18] tests pass again --- src/main/compile/dune | 1 + src/main/compile/helpers.ml | 8 ++++++-- src/main/run/of_mini_c.ml | 6 ++++++ src/passes/3-self_ast_simplified/helpers.ml | 11 +++++++++++ .../self_ast_simplified.ml | 3 ++- src/passes/6-transpiler/transpiler.ml | 4 ++-- src/stages/mini_c/PP.ml | 2 +- src/stages/mini_c/combinators.ml | 4 ++++ src/stages/mini_c/misc.ml | 17 ++++++++++++++++- src/stages/mini_c/types.ml | 2 +- src/test/compiler_tests.ml | 2 +- src/test/contracts/annotation.ligo | 4 +--- src/test/integration_tests.ml | 10 +++++++--- 13 files changed, 59 insertions(+), 15 deletions(-) diff --git a/src/main/compile/dune b/src/main/compile/dune index bd1ac2d33..e8520e473 100644 --- a/src/main/compile/dune +++ b/src/main/compile/dune @@ -7,6 +7,7 @@ parser simplify ast_simplified + self_ast_simplified typer ast_typed transpiler diff --git a/src/main/compile/helpers.ml b/src/main/compile/helpers.ml index 5e47665a4..054c9e00d 100644 --- a/src/main/compile/helpers.ml +++ b/src/main/compile/helpers.ml @@ -62,11 +62,15 @@ let parsify = fun (syntax : v_syntax) source_filename -> | Pascaligo -> ok parsify_pascaligo | Cameligo -> ok parsify_ligodity in - parsify source_filename + let%bind parsified = parsify source_filename in + let%bind applied = Self_ast_simplified.convert_annotation_program parsified in + ok applied let parsify_expression = fun syntax source -> let%bind parsify = match syntax with | Pascaligo -> ok parsify_expression_pascaligo | Cameligo -> ok parsify_expression_ligodity in - parsify source + let%bind parsified = parsify source in + let%bind applied = Self_ast_simplified.convert_annotation_expression parsified in + ok applied diff --git a/src/main/run/of_mini_c.ml b/src/main/run/of_mini_c.ml index 0fecd02bb..dbe02bf08 100644 --- a/src/main/run/of_mini_c.ml +++ b/src/main/run/of_mini_c.ml @@ -35,6 +35,12 @@ let run_function ?options expression input ty = let%bind ex_ty_value = Of_michelson.run ?options code input in Compile.Of_mini_c.uncompile_value ex_ty_value +let run_function_value ?options expression input ty = + let%bind code = Compile.Of_mini_c.compile_function expression in + let%bind input = Compile.Of_mini_c.compile_value input ty in + let%bind ex_ty_value = Of_michelson.run ~is_input_value:true ?options code input in + Compile.Of_mini_c.uncompile_value ex_ty_value + let run_function_entry ?options program entry input = let%bind code = Compile.Of_mini_c.compile_function_entry program entry in let%bind input_michelson = diff --git a/src/passes/3-self_ast_simplified/helpers.ml b/src/passes/3-self_ast_simplified/helpers.ml index 8b41248eb..61aa8fcb2 100644 --- a/src/passes/3-self_ast_simplified/helpers.ml +++ b/src/passes/3-self_ast_simplified/helpers.ml @@ -125,3 +125,14 @@ and map_cases : mapper -> matching_expr -> matching_expr result = fun f m -> let%bind lst' = bind_map_list aux lst in ok @@ Match_variant lst' ) + +and map_program : mapper -> program -> program result = fun m p -> + let aux = fun (x : declaration) -> + match x with + | Declaration_constant (t , o , e) -> ( + let%bind e' = map_expression m e in + ok (Declaration_constant (t , o , e')) + ) + | Declaration_type _ -> ok x + in + bind_map_list (bind_map_location aux) p diff --git a/src/passes/3-self_ast_simplified/self_ast_simplified.ml b/src/passes/3-self_ast_simplified/self_ast_simplified.ml index 48ec6fc50..6aafa38a4 100644 --- a/src/passes/3-self_ast_simplified/self_ast_simplified.ml +++ b/src/passes/3-self_ast_simplified/self_ast_simplified.ml @@ -1 +1,2 @@ -let convert_annotation = Helpers.map_expression Tezos_type_annotation.peephole_expression +let convert_annotation_expression = Helpers.map_expression Tezos_type_annotation.peephole_expression +let convert_annotation_program = Helpers.map_program Tezos_type_annotation.peephole_expression diff --git a/src/passes/6-transpiler/transpiler.ml b/src/passes/6-transpiler/transpiler.ml index df99e3b4b..8e65cfdb7 100644 --- a/src/passes/6-transpiler/transpiler.ml +++ b/src/passes/6-transpiler/transpiler.ml @@ -547,9 +547,9 @@ let transpile_declaration env (d:AST.declaration) : toplevel_statement result = let transpile_program (lst : AST.program) : program result = let aux (prev:(toplevel_statement list * Environment.t) result) cur = - let%bind (tl, env) = prev in + let%bind (hds, env) = prev in let%bind ((_, env') as cur') = transpile_declaration env cur in - ok (cur' :: tl, env'.post_environment) + ok (hds @ [ cur' ], env'.post_environment) in let%bind (statements, _) = List.fold_left aux (ok ([], Environment.empty)) (temp_unwrap_loc_list lst) in ok statements diff --git a/src/stages/mini_c/PP.ml b/src/stages/mini_c/PP.ml index f2527d27b..3bb230627 100644 --- a/src/stages/mini_c/PP.ml +++ b/src/stages/mini_c/PP.ml @@ -69,7 +69,7 @@ and value_assoc ppf : (value * value) -> unit = fun (a, b) -> and expression' ppf (e:expression') = match e with | E_skip -> fprintf ppf "skip" - | E_closure x -> function_ ppf x + | E_closure x -> fprintf ppf "C(%a)" function_ x | E_variable v -> fprintf ppf "V(%s)" v | E_application(a, b) -> fprintf ppf "(%a)@(%a)" expression a expression b | E_constant(p, lst) -> fprintf ppf "%s %a" p (pp_print_list ~pp_sep:space_sep expression) lst diff --git a/src/stages/mini_c/combinators.ml b/src/stages/mini_c/combinators.ml index e9090a9d8..f19536e8f 100644 --- a/src/stages/mini_c/combinators.ml +++ b/src/stages/mini_c/combinators.ml @@ -81,6 +81,10 @@ let get_t_function tv = match tv with | T_function ty -> ok ty | _ -> simple_fail "not a function" +let get_t_closure tv = match tv with + | T_deep_closure ty -> ok ty + | _ -> simple_fail "not a function" + let get_t_option (v:type_value) = match v with | T_option t -> ok t | _ -> simple_fail "not an option" diff --git a/src/stages/mini_c/misc.ml b/src/stages/mini_c/misc.ml index 7fa6a9779..21e049e38 100644 --- a/src/stages/mini_c/misc.ml +++ b/src/stages/mini_c/misc.ml @@ -87,7 +87,22 @@ let aggregate_entry (lst : program) (name : string) (to_functionalize : bool) : let e' = { entry_expression with content = E_literal (D_function l') } in ok e' ) + | (E_closure l , false) -> ( + let l' = { l with body = wrapper l.body } in + let%bind t' = + let%bind (_ , input_ty , output_ty) = get_t_closure entry_expression.type_value in + ok (t_function input_ty output_ty) + in + let e' = { + content = E_literal (D_function l') ; + type_value = t' ; + } in + ok e' + ) | (_ , true) -> ( ok @@ functionalize @@ wrapper entry_expression ) - | _ -> fail @@ Errors.not_functional_main name + | _ -> ( + Format.printf "Not functional: %a\n" PP.expression entry_expression ; + fail @@ Errors.not_functional_main name + ) diff --git a/src/stages/mini_c/types.ml b/src/stages/mini_c/types.ml index d3b6bcf36..26801d227 100644 --- a/src/stages/mini_c/types.ml +++ b/src/stages/mini_c/types.ml @@ -12,7 +12,7 @@ type type_value = | T_pair of (type_value * type_value) | T_or of type_value * type_value | T_function of (type_value * type_value) - | T_deep_closure of environment * type_value * type_value + | T_deep_closure of (environment * type_value * type_value) | T_base of type_base | T_map of (type_value * type_value) | T_list of type_value diff --git a/src/test/compiler_tests.ml b/src/test/compiler_tests.ml index dd18c53f2..a93fb2ee7 100644 --- a/src/test/compiler_tests.ml +++ b/src/test/compiler_tests.ml @@ -5,7 +5,7 @@ open Test_helpers let run_entry_int e (n:int) : int result = let param : value = D_int n in - let%bind result = Run.Of_mini_c.run_function e param t_int in + let%bind result = Run.Of_mini_c.run_function_value e param t_int in match result with | D_int n -> ok n | _ -> simple_fail "result is not an int" diff --git a/src/test/contracts/annotation.ligo b/src/test/contracts/annotation.ligo index 1cae3ffe9..1eaef7b0c 100644 --- a/src/test/contracts/annotation.ligo +++ b/src/test/contracts/annotation.ligo @@ -1,5 +1,3 @@ const lst : list(int) = list [] ; -const address : address = "tz1KqTpEZ7Yob7QbPE4Hy4Wo8fHG8LhKxZSx" ; - -const address_2 : address = ("tz1KqTpEZ7Yob7QbPE4Hy4Wo8fHG8LhKxZSx" : address) ; +const address : address = ("tz1KqTpEZ7Yob7QbPE4Hy4Wo8fHG8LhKxZSx" : address) ; diff --git a/src/test/integration_tests.ml b/src/test/integration_tests.ml index f2dcd21c1..e5b097981 100644 --- a/src/test/integration_tests.ml +++ b/src/test/integration_tests.ml @@ -28,9 +28,6 @@ let annotation () : unit result = let%bind () = expect_eq_evaluate program "address" (e_address "tz1KqTpEZ7Yob7QbPE4Hy4Wo8fHG8LhKxZSx") in - let%bind () = - expect_eq_evaluate program "address_2" (e_address "tz1KqTpEZ7Yob7QbPE4Hy4Wo8fHG8LhKxZSx") - in ok () let complex_function () : unit result = @@ -99,14 +96,21 @@ let higher_order () : unit result = let shared_function () : unit result = let%bind program = type_file "./contracts/function-shared.ligo" in + Format.printf "inc\n" ; let%bind () = let make_expect = fun n -> (n + 1) in expect_eq_n_int program "inc" make_expect in + Format.printf "double inc?\n" ; + let%bind () = + expect_eq program "double_inc" (e_int 0) (e_int 2) + in + Format.printf "double incd!\n" ; let%bind () = let make_expect = fun n -> (n + 2) in expect_eq_n_int program "double_inc" make_expect in + Format.printf "foo\n" ; let%bind () = let make_expect = fun n -> (2 * n + 3) in expect_eq program "foo" (e_int 0) (e_int @@ make_expect 0) From 2a90be292c245d83b166844b7c7a727d448f7ac9 Mon Sep 17 00:00:00 2001 From: galfour Date: Fri, 20 Sep 2019 11:59:44 +0200 Subject: [PATCH 11/18] more formats --- src/bin/cli.ml | 62 ++++++++++++++++++++++-------------------- src/bin/cli_helpers.ml | 17 +++++++----- src/main/display.ml | 55 +++++++++++++++++++++++++++++++++---- 3 files changed, 91 insertions(+), 43 deletions(-) diff --git a/src/bin/cli.ml b/src/bin/cli.ml index 8d051dd83..4e7897720 100644 --- a/src/bin/cli.ml +++ b/src/bin/cli.ml @@ -45,89 +45,91 @@ let amount = info ~docv ~doc ["amount"] in value @@ opt string "0" info +let display_format = + let open Arg in + let info = + let docv = "DISPLAY_FORMAT" in + let doc = "$(docv) is the format that will be used by the CLI. Available formats are 'dev', 'json', and 'human-readable' (default). When human-readable lacks details (we are still tweaking it), please contact us and use another format in the meanwhile." in + info ~docv ~doc ["format" ; "display-format"] in + value @@ opt string "human-readable" info + let compile_file = - let f source entry_point syntax = - toplevel @@ + let f source entry_point syntax display_format = + toplevel ~display_format @@ let%bind contract = trace (simple_info "compiling contract to michelson") @@ Ligo.Compile.Of_source.compile_file_contract_entry source entry_point (Syntax_name syntax) in - Format.printf "%a\n" Tezos_utils.Michelson.pp contract.body ; - ok () + ok @@ Format.asprintf "%a\n" Tezos_utils.Michelson.pp contract.body in let term = - Term.(const f $ source 0 $ entry_point 1 $ syntax) in + Term.(const f $ source 0 $ entry_point 1 $ syntax $ display_format) in let cmdname = "compile-contract" in let docs = "Subcommand: compile a contract. See `ligo " ^ cmdname ^ " --help' for a list of options specific to this subcommand." in (term , Term.info ~docs cmdname) let compile_parameter = - let f source entry_point expression syntax = - toplevel @@ + let f source entry_point expression syntax display_format = + toplevel ~display_format @@ let%bind value = trace (simple_error "compile-input") @@ Ligo.Compile.Of_source.compile_file_contract_parameter source entry_point expression (Syntax_name syntax) in - Format.printf "%a\n" Tezos_utils.Michelson.pp value; - ok () + ok @@ Format.asprintf "%a\n" Tezos_utils.Michelson.pp value in let term = - Term.(const f $ source 0 $ entry_point 1 $ expression "PARAMETER" 2 $ syntax) in + Term.(const f $ source 0 $ entry_point 1 $ expression "PARAMETER" 2 $ syntax $ display_format) in let cmdname = "compile-parameter" in let docs = "Subcommand: compile parameters to a michelson expression. The resulting michelson expression can be passed as an argument in a transaction which calls a contract. See `ligo " ^ cmdname ^ " --help' for a list of options specific to this subcommand." in (term , Term.info ~docs cmdname) let compile_storage = - let f source entry_point expression syntax = - toplevel @@ + let f source entry_point expression syntax display_format = + toplevel ~display_format @@ let%bind value = trace (simple_error "compile-storage") @@ Ligo.Compile.Of_source.compile_file_contract_storage source entry_point expression (Syntax_name syntax) in - Format.printf "%a\n" Tezos_utils.Michelson.pp value; - ok () + ok @@ Format.asprintf "%a\n" Tezos_utils.Michelson.pp value in let term = - Term.(const f $ source 0 $ entry_point 1 $ expression "STORAGE" 2 $ syntax) in + Term.(const f $ source 0 $ entry_point 1 $ expression "STORAGE" 2 $ syntax $ display_format) in let cmdname = "compile-storage" in let docs = "Subcommand: compile an initial storage in ligo syntax to a michelson expression. The resulting michelson expression can be passed as an argument in a transaction which originates a contract. See `ligo " ^ cmdname ^ " --help' for a list of options specific to this subcommand." in (term , Term.info ~docs cmdname) let dry_run = - let f source entry_point storage input amount syntax = - toplevel @@ + let f source entry_point storage input amount syntax display_format = + toplevel ~display_format @@ let%bind output = Ligo.Run.Of_source.run_contract ~amount source entry_point storage input (Syntax_name syntax) in - Format.printf "%a\n" Ast_simplified.PP.expression output ; - ok () + ok @@ Format.asprintf "%a\n" Ast_simplified.PP.expression output in let term = - Term.(const f $ source 0 $ entry_point 1 $ expression "PARAMETER" 2 $ expression "STORAGE" 3 $ amount $ syntax) in + Term.(const f $ source 0 $ entry_point 1 $ expression "PARAMETER" 2 $ expression "STORAGE" 3 $ amount $ syntax $ display_format) in let cmdname = "dry-run" in let docs = "Subcommand: run a smart-contract with the given storage and input." in (term , Term.info ~docs cmdname) let run_function = - let f source entry_point parameter amount syntax = - toplevel @@ + let f source entry_point parameter amount syntax display_format = + toplevel ~display_format @@ let%bind output = Ligo.Run.Of_source.run_function ~amount source entry_point parameter (Syntax_name syntax) in - Format.printf "%a\n" Ast_simplified.PP.expression output ; - ok () + ok @@ Format.asprintf "%a\n" Ast_simplified.PP.expression output in let term = - Term.(const f $ source 0 $ entry_point 1 $ expression "PARAMETER" 2 $ amount $ syntax) in + Term.(const f $ source 0 $ entry_point 1 $ expression "PARAMETER" 2 $ amount $ syntax $ display_format) in let cmdname = "run-function" in let docs = "Subcommand: run a function with the given parameter." in (term , Term.info ~docs cmdname) let evaluate_value = - let f source entry_point amount syntax = - toplevel @@ + let f source entry_point amount syntax display_format = + toplevel ~display_format @@ let%bind output = Ligo.Run.Of_source.evaluate ~amount source entry_point (Syntax_name syntax) in - Format.printf "%a\n" Ast_simplified.PP.expression output ; - ok () + ok @@ Format.asprintf "%a\n" Ast_simplified.PP.expression output in let term = - Term.(const f $ source 0 $ entry_point 1 $ amount $ syntax) in + Term.(const f $ source 0 $ entry_point 1 $ amount $ syntax $ display_format) in let cmdname = "evaluate-value" in let docs = "Subcommand: evaluate a given definition." in (term , Term.info ~docs cmdname) diff --git a/src/bin/cli_helpers.ml b/src/bin/cli_helpers.ml index ac0354368..dacac127e 100644 --- a/src/bin/cli_helpers.ml +++ b/src/bin/cli_helpers.ml @@ -1,9 +1,12 @@ open Trace +open Main.Display -let toplevel x = - match x with - | Trace.Ok ((), annotations) -> ignore annotations; () - | Error ss -> ( - Format.printf "%a%!" Main.Display.error_pp (ss ()) - ) - +let toplevel ~(display_format : string) (x : string result) = + let display_format = + try display_format_of_string display_format + with _ -> ( + Format.printf "bad display format %s, try looking at DISPLAY_FORMAT in the man (--help)." display_format ; + failwith "Display format" + ) + in + Format.printf "%a" (formatted_string_result_pp display_format) x diff --git a/src/main/display.ml b/src/main/display.ml index ab35528cb..753da77ec 100644 --- a/src/main/display.ml +++ b/src/main/display.ml @@ -1,8 +1,6 @@ -open Trace +open! Trace -let dev = false - -let rec error_pp out (e : error) = +let rec error_pp ?(dev = false) out (e : error) = let open JSON_string_utils in let message = let opt = e |> member "message" |> string in @@ -50,7 +48,52 @@ let rec error_pp out (e : error) = print "%s%s%s%s%s" location title error_code message data ) else ( print "%s%s%s.\n%s%s\n%a\n%a\n" title error_code message data location - (Format.pp_print_list error_pp) infos - (Format.pp_print_list error_pp) children + (Format.pp_print_list (error_pp ~dev)) infos + (Format.pp_print_list (error_pp ~dev)) children ) +let result_pp_hr f out (r : _ result) = + match r with + | Ok (s , _) -> Format.fprintf out "%a" f s + | Error e -> Format.fprintf out "%a" (error_pp ~dev:false) (e ()) + +let string_result_pp_hr = result_pp_hr (fun out s -> Format.fprintf out "%s" s) + +let result_pp_dev f out (r : _ result) = + match r with + | Ok (s , _) -> Format.fprintf out "%a" f s + | Error e -> Format.fprintf out "%a" (error_pp ~dev:false) (e ()) + +let string_result_pp_dev = result_pp_hr (fun out s -> Format.fprintf out "%s" s) + +let string_result_pp_json out (r : string result) = + let status_json status content : J.t = `Assoc ([ + ("status" , `String status) ; + ("content" , content) ; + ]) in + match r with + | Ok (x , _) -> ( + Format.fprintf out "%a" J.pp (status_json "ok" (`String x)) + ) + | Error e -> ( + Format.fprintf out "%a" J.pp (status_json "error" (e ())) + ) + +type display_format = [ + | `Human_readable + | `Json + | `Dev +] + +let display_format_of_string = fun s : display_format -> + match s with + | "dev" -> `Dev + | "json" -> `Json + | "human-readable" -> `Human_readable + | _ -> failwith "bad display_format" + +let formatted_string_result_pp (display_format : display_format) = + match display_format with + | `Human_readable -> string_result_pp_hr + | `Dev -> string_result_pp_dev + | `Json -> string_result_pp_json From 66efff631dc4c4354dc8133f9a9a877e786f621c Mon Sep 17 00:00:00 2001 From: galfour Date: Fri, 20 Sep 2019 18:56:55 +0200 Subject: [PATCH 12/18] add micheline --- src/bin/cli.ml | 15 ++++- src/main/compile/of_mini_c.ml | 13 ++++ src/main/compile/of_simplified.ml | 4 ++ src/main/compile/of_source.ml | 3 +- src/main/compile/of_typed.ml | 4 ++ src/main/display.ml | 15 +++++ src/test/test_helpers.ml | 4 +- super-counter.pp.ligo | 65 +++++++++++++++++++ vendors/ligo-utils/tezos-utils/x_michelson.ml | 12 ++++ 9 files changed, 129 insertions(+), 6 deletions(-) create mode 100644 super-counter.pp.ligo diff --git a/src/bin/cli.ml b/src/bin/cli.ml index 4e7897720..4cac0fe45 100644 --- a/src/bin/cli.ml +++ b/src/bin/cli.ml @@ -53,16 +53,25 @@ let display_format = info ~docv ~doc ["format" ; "display-format"] in value @@ opt string "human-readable" info +let michelson_code_format = + let open Arg in + let info = + let docv = "MICHELSON_FORMAT" in + let doc = "$(docv) is the format that will be used by compile-contract for the resulting Michelson. Available formats are 'micheline', and 'michelson' (default). Micheline is the format used by [XXX]." in + info ~docv ~doc ["michelson-format"] in + value @@ opt string "michelson" info + let compile_file = - let f source entry_point syntax display_format = + let f source entry_point syntax display_format michelson_format = toplevel ~display_format @@ + let%bind michelson_format = Main.Display.michelson_format_of_string michelson_format in let%bind contract = trace (simple_info "compiling contract to michelson") @@ Ligo.Compile.Of_source.compile_file_contract_entry source entry_point (Syntax_name syntax) in - ok @@ Format.asprintf "%a\n" Tezos_utils.Michelson.pp contract.body + ok @@ Format.asprintf "%a\n" (Main.Display.michelson_pp michelson_format) contract in let term = - Term.(const f $ source 0 $ entry_point 1 $ syntax $ display_format) in + Term.(const f $ source 0 $ entry_point 1 $ syntax $ display_format $ michelson_code_format) in let cmdname = "compile-contract" in let docs = "Subcommand: compile a contract. See `ligo " ^ cmdname ^ " --help' for a list of options specific to this subcommand." in (term , Term.info ~docs cmdname) diff --git a/src/main/compile/of_mini_c.ml b/src/main/compile/of_mini_c.ml index b8d685975..5a1ff886e 100644 --- a/src/main/compile/of_mini_c.ml +++ b/src/main/compile/of_mini_c.ml @@ -35,5 +35,18 @@ let compile_function_entry = fun program name -> let%bind aggregated = aggregate_entry program name false in compile_function aggregated +let compile_contract_entry = fun program name -> + let%bind aggregated = aggregate_entry program name false in + let%bind compiled = compile_function aggregated in + let%bind (param_ty , storage_ty) = + let%bind fun_ty = get_t_function aggregated.type_value in + Mini_c.get_t_pair (fst fun_ty) + in + let%bind param_michelson = Compiler.Type.type_ param_ty in + let%bind storage_michelson = Compiler.Type.type_ storage_ty in + let contract = Michelson.contract param_michelson storage_michelson compiled.body in + ok contract + + let uncompile_value : Proto_alpha_utils.Memory_proto_alpha.X.ex_typed_value -> value result = fun x -> Compiler.Uncompiler.translate_value x diff --git a/src/main/compile/of_simplified.ml b/src/main/compile/of_simplified.ml index 1e2a11ca9..fa27f3d6e 100644 --- a/src/main/compile/of_simplified.ml +++ b/src/main/compile/of_simplified.ml @@ -2,6 +2,10 @@ open Ast_simplified open Trace open Tezos_utils +let compile_contract_entry (program : program) entry_point = + let%bind prog_typed = Typer.type_program program in + Of_typed.compile_contract_entry prog_typed entry_point + let compile_function_entry (program : program) entry_point : _ result = let%bind prog_typed = Typer.type_program program in Of_typed.compile_function_entry prog_typed entry_point diff --git a/src/main/compile/of_source.ml b/src/main/compile/of_source.ml index fd0b93dc7..169dba0da 100644 --- a/src/main/compile/of_source.ml +++ b/src/main/compile/of_source.ml @@ -15,7 +15,8 @@ let compile_file_entry : string -> string -> s_syntax -> _ result = let compile_file_contract_entry : string -> string -> s_syntax -> _ result = fun source_filename entry_point syntax -> let%bind simplified = parse_file_program source_filename syntax in - Of_simplified.compile_function_entry simplified entry_point + let%bind compiled_contract = Of_simplified.compile_contract_entry simplified entry_point in + ok compiled_contract let compile_file_contract_parameter : string -> string -> string -> s_syntax -> Michelson.t result = fun source_filename _entry_point expression syntax -> diff --git a/src/main/compile/of_typed.ml b/src/main/compile/of_typed.ml index a8855e904..e6a33abd7 100644 --- a/src/main/compile/of_typed.ml +++ b/src/main/compile/of_typed.ml @@ -28,6 +28,10 @@ let compile_function_entry : program -> string -> _ = fun p entry -> let%bind prog_mini_c = Transpiler.transpile_program p in Of_mini_c.compile_function_entry prog_mini_c entry +let compile_contract_entry : program -> string -> _ = fun p entry -> + let%bind prog_mini_c = Transpiler.transpile_program p in + Of_mini_c.compile_contract_entry prog_mini_c entry + let compile_expression_as_function_entry : program -> string -> _ = fun p entry -> let%bind prog_mini_c = Transpiler.transpile_program p in Of_mini_c.compile_expression_as_function_entry prog_mini_c entry diff --git a/src/main/display.ml b/src/main/display.ml index 753da77ec..2d24e8008 100644 --- a/src/main/display.ml +++ b/src/main/display.ml @@ -97,3 +97,18 @@ let formatted_string_result_pp (display_format : display_format) = | `Human_readable -> string_result_pp_hr | `Dev -> string_result_pp_dev | `Json -> string_result_pp_json + +type michelson_format = [ + | `Michelson + | `Micheline +] + +let michelson_format_of_string = fun s : michelson_format result -> + match s with + | "michelson" -> ok `Michelson + | "micheline" -> ok `Micheline + | _ -> simple_fail "bad michelson format" + +let michelson_pp (mf : michelson_format) = match mf with + | `Michelson -> Michelson.pp + | `Micheline -> Michelson.pp_json diff --git a/src/test/test_helpers.ml b/src/test/test_helpers.ml index 8b1bab00b..96b5522cb 100644 --- a/src/test/test_helpers.ml +++ b/src/test/test_helpers.ml @@ -12,14 +12,14 @@ let wrap_test name f = match result with | Ok ((), annotations) -> ignore annotations; () | Error err -> - Format.printf "%a\n%!" Ligo.Display.error_pp (err ()) ; + Format.printf "%a\n%!" (Ligo.Display.error_pp ~dev:true) (err ()) ; raise Alcotest.Test_error let wrap_test_raw f = match f () with | Trace.Ok ((), annotations) -> ignore annotations; () | Error err -> - Format.printf "%a\n%!" Ligo.Display.error_pp (err ()) + Format.printf "%a\n%!" (Ligo.Display.error_pp ~dev:true) (err ()) let test name f = Test ( diff --git a/super-counter.pp.ligo b/super-counter.pp.ligo new file mode 100644 index 000000000..0097fbc63 --- /dev/null +++ b/super-counter.pp.ligo @@ -0,0 +1,65 @@ +# 1 "./src/test/contracts/super-counter.ligo" +# 1 "" +# 1 "" +# 31 "" +# 1 "/usr/include/stdc-predef.h" 1 3 4 + +# 17 "/usr/include/stdc-predef.h" 3 4 + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +# 32 "" 2 +# 1 "./src/test/contracts/super-counter.ligo" +type action is +| Increment of int +| Decrement of int + +function main (const p : action ; const s : int) : (list(operation) * int) is + block {skip} with ((nil : list(operation)), + case p of + | Increment (n) -> s + n + | Decrement (n) -> s - n + end) diff --git a/vendors/ligo-utils/tezos-utils/x_michelson.ml b/vendors/ligo-utils/tezos-utils/x_michelson.ml index 88684549e..f55e1a493 100644 --- a/vendors/ligo-utils/tezos-utils/x_michelson.ml +++ b/vendors/ligo-utils/tezos-utils/x_michelson.ml @@ -86,6 +86,18 @@ let pp ppf (michelson:michelson) = let node = printable string_of_prim canonical in print_expr ppf node +let pp_json ppf (michelson : michelson) = + let open Micheline_printer in + let canonical = strip_locations michelson in + let node = printable string_of_prim canonical in + let json = Tezos_data_encoding.( + Json.construct + (Micheline.erased_encoding ~variant:"???" {comment = None} Data_encoding.string) + node + ) + in + Format.fprintf ppf "%a" Tezos_data_encoding.Json.pp json + let pp_stripped ppf (michelson:michelson) = let open Micheline_printer in let michelson' = strip_nops @@ strip_annots michelson in From dc9294bbccaa68529a1e61fd5469b058a777f883 Mon Sep 17 00:00:00 2001 From: galfour Date: Fri, 20 Sep 2019 20:38:04 +0200 Subject: [PATCH 13/18] add options in cameligo --- src/passes/2-simplify/ligodity.ml | 70 +++++++++++++++---- .../3-self_ast_simplified/none_variant.ml | 9 +++ .../self_ast_simplified.ml | 1 + src/test/contracts/option.mligo | 4 ++ src/test/integration_tests.ml | 13 ++++ 5 files changed, 84 insertions(+), 13 deletions(-) create mode 100644 src/passes/3-self_ast_simplified/none_variant.ml create mode 100644 src/test/contracts/option.mligo diff --git a/src/passes/2-simplify/ligodity.ml b/src/passes/2-simplify/ligodity.ml index 10a9b346a..3a1fe5132 100644 --- a/src/passes/2-simplify/ligodity.ml +++ b/src/passes/2-simplify/ligodity.ml @@ -404,6 +404,9 @@ let rec simpl_expression : | "Some" -> ( return @@ e_some ~loc arg ) + | "None" -> ( + return @@ e_none ~loc () + ) | _ -> ( return @@ e_constructor ~loc c_name arg ) @@ -699,6 +702,24 @@ and simpl_cases : type a . (Raw.pattern * a) list -> a matching result = ) | _ -> fail @@ only_constructors t in + let rec get_constr_opt (t:Raw.pattern) = + match t with + | PPar p -> get_constr_opt p.value.inside + | PConstr v -> ( + let (const , pat_opt) = v.value in + let%bind var_opt = + match pat_opt with + | None -> ok None + | Some pat -> ( + let%bind single_pat = get_single pat in + let%bind var = get_var single_pat in + ok (Some var) + ) + in + ok (const.value , var_opt) + ) + | _ -> fail @@ only_constructors t + in let%bind patterns = let aux (x , y) = let xs = get_tuple x in @@ -727,21 +748,44 @@ and simpl_cases : type a . (Raw.pattern * a) list -> a matching result = ok @@ Match_list {match_cons = (a, b, cons) ; match_nil = nil} ) | lst -> ( - trace (simple_info "currently, only booleans, lists and constructors \ - are supported in patterns") @@ - let%bind constrs = + let error x = + let title () = "Pattern" in + let content () = + Format.asprintf "Pattern : %a" (PP_helpers.printer Raw.print_pattern) x in + error title content + in + let as_variant () = + trace (simple_info "currently, only booleans, lists, options, and constructors \ + are supported in patterns") @@ + let%bind constrs = + let aux (x , y) = + let%bind x' = + trace (error x) @@ + get_constr x + in + ok (x' , y) + in + bind_map_list aux lst + in + ok @@ Match_variant constrs + in + let as_option () = let aux (x , y) = - let error = - let title () = "Pattern" in - let content () = - Format.asprintf "Pattern : %a" (PP_helpers.printer Raw.print_pattern) x in - error title content in let%bind x' = - trace error @@ - get_constr x in - ok (x' , y) in - bind_map_list aux lst in - ok @@ Match_variant constrs + trace (error x) @@ + get_constr_opt x + in + ok (x' , y) + in + let%bind constrs = bind_map_list aux lst in + match constrs with + | [ (("Some" , Some some_var) , some_expr) ; (("None" , None) , none_expr) ] + | [ (("None" , None) , none_expr) ; (("Some" , Some some_var) , some_expr) ] -> ( + ok @@ Match_option { match_some = (some_var , some_expr) ; match_none = none_expr } + ) + | _ -> simple_fail "bad option pattern" + in + bind_or (as_option () , as_variant ()) ) let simpl_program : Raw.ast -> program result = fun t -> diff --git a/src/passes/3-self_ast_simplified/none_variant.ml b/src/passes/3-self_ast_simplified/none_variant.ml new file mode 100644 index 000000000..d64350a81 --- /dev/null +++ b/src/passes/3-self_ast_simplified/none_variant.ml @@ -0,0 +1,9 @@ +open Ast_simplified +open Trace + +let peephole_expression : expression -> expression result = fun e -> + let return expression = ok { e with expression } in + match e.expression with + | E_constructor ("Some" , e) -> return @@ E_constant ("SOME" , [ e ]) + | E_constructor ("None" , _) -> return @@ E_constant ("NONE" , [ ]) + | e -> return e diff --git a/src/passes/3-self_ast_simplified/self_ast_simplified.ml b/src/passes/3-self_ast_simplified/self_ast_simplified.ml index 6aafa38a4..b3ebb08db 100644 --- a/src/passes/3-self_ast_simplified/self_ast_simplified.ml +++ b/src/passes/3-self_ast_simplified/self_ast_simplified.ml @@ -1,2 +1,3 @@ let convert_annotation_expression = Helpers.map_expression Tezos_type_annotation.peephole_expression let convert_annotation_program = Helpers.map_program Tezos_type_annotation.peephole_expression +let convert_none_variant_to_const = Helpers.map_program None_variant.peephole_expression diff --git a/src/test/contracts/option.mligo b/src/test/contracts/option.mligo new file mode 100644 index 000000000..034871499 --- /dev/null +++ b/src/test/contracts/option.mligo @@ -0,0 +1,4 @@ +type foobar = int option + +let s : foobar = Some 42 +let n : foobar = None diff --git a/src/test/integration_tests.ml b/src/test/integration_tests.ml index 5efcc9fc1..df2b2cb86 100644 --- a/src/test/integration_tests.ml +++ b/src/test/integration_tests.ml @@ -340,6 +340,18 @@ let option () : unit result = in ok () +let moption () : unit result = + let%bind program = mtype_file "./contracts/option.mligo" in + let%bind () = + let expected = e_some (e_int 42) in + expect_eq_evaluate program "s" expected + in + let%bind () = + let expected = e_typed_none t_int in + expect_eq_evaluate program "n" expected + in + ok () + let map () : unit result = let%bind program = type_file "./contracts/map.ligo" in let ez lst = @@ -692,6 +704,7 @@ let main = test_suite "Integration (End to End)" [ test "unit" unit_expression ; test "string" string_expression ; test "option" option ; + test "option (mligo)" moption ; test "map" map ; test "list" list ; test "loop" loop ; From ad79188c4f1cdbe24d933d5116516bb7093d94c4 Mon Sep 17 00:00:00 2001 From: galfour Date: Sat, 21 Sep 2019 09:12:00 +0200 Subject: [PATCH 14/18] add list pattern matching --- src/passes/4-typer/typer.ml | 8 ++++---- src/passes/6-transpiler/transpiler.ml | 17 +++++++++++++++-- src/passes/8-compiler/compiler_program.ml | 18 ++++++++++++++++++ src/stages/ast_typed/PP.ml | 4 ++-- src/stages/ast_typed/misc.ml | 2 +- src/stages/ast_typed/misc_smart.ml | 2 +- src/stages/ast_typed/types.ml | 2 +- src/stages/mini_c/PP.ml | 1 + src/stages/mini_c/types.ml | 1 + src/test/integration_tests.ml | 2 +- vendors/ligo-utils/tezos-utils/x_michelson.ml | 1 + 11 files changed, 46 insertions(+), 12 deletions(-) diff --git a/src/passes/4-typer/typer.ml b/src/passes/4-typer/typer.ml index edc9d05b8..cd27b1cf4 100644 --- a/src/passes/4-typer/typer.ml +++ b/src/passes/4-typer/typer.ml @@ -274,7 +274,7 @@ and type_match : type i o . (environment -> i -> o result) -> environment -> O.t let e' = Environment.add_ez_binder hd t_list e in let e' = Environment.add_ez_binder tl t e' in let%bind b' = f e' b in - ok (O.Match_list {match_nil ; match_cons = (hd, tl, b')}) + ok (O.Match_list {match_nil ; match_cons = (((hd , t_list), (tl , t)), b')}) | Match_tuple (lst, b) -> let%bind t_tuple = trace_strong (match_error ~expected:i ~actual:t loc) @@ -646,7 +646,7 @@ and type_expression : environment -> ?tv_opt:O.type_value -> I.expression -> O.a let aux (cur:O.value O.matching) = match cur with | Match_bool { match_true ; match_false } -> [ match_true ; match_false ] - | Match_list { match_nil ; match_cons = (_ , _ , match_cons) } -> [ match_nil ; match_cons ] + | Match_list { match_nil ; match_cons = ((_ , _) , match_cons) } -> [ match_nil ; match_cons ] | Match_option { match_none ; match_some = (_ , match_some) } -> [ match_none ; match_some ] | Match_tuple (_ , match_tuple) -> [ match_tuple ] | Match_variant (lst , _) -> List.map snd lst in @@ -862,10 +862,10 @@ and untype_matching : type o i . (o -> i result) -> o O.matching -> (i I.matchin let%bind some = f some in let match_some = fst v, some in ok @@ Match_option {match_none ; match_some} - | Match_list {match_nil ; match_cons = (hd, tl, cons)} -> + | Match_list {match_nil ; match_cons = (((hd_name , _) , (tl_name , _)), cons)} -> let%bind match_nil = f match_nil in let%bind cons = f cons in - let match_cons = hd, tl, cons in + let match_cons = hd_name , tl_name , cons in ok @@ Match_list {match_nil ; match_cons} | Match_variant (lst , _) -> let aux ((a,b),c) = diff --git a/src/passes/6-transpiler/transpiler.ml b/src/passes/6-transpiler/transpiler.ml index 8e65cfdb7..76ca3a770 100644 --- a/src/passes/6-transpiler/transpiler.ml +++ b/src/passes/6-transpiler/transpiler.ml @@ -448,8 +448,22 @@ and transpile_annotated_expression (ae:AST.annotated_expression) : expression re let%bind (tv' , s') = let%bind tv' = transpile_type tv in let%bind s' = transpile_annotated_expression s in - ok (tv' , s') in + ok (tv' , s') + in return @@ E_if_none (expr' , n , ((name , tv') , s')) + | Match_list { + match_nil ; + match_cons = (((hd_name , hd_ty) , (tl_name , tl_ty)) , match_cons) ; + } -> ( + let%bind nil = transpile_annotated_expression match_nil in + let%bind cons = + let%bind hd_ty' = transpile_type hd_ty in + let%bind tl_ty' = transpile_type tl_ty in + let%bind match_cons' = transpile_annotated_expression match_cons in + ok (((hd_name , hd_ty') , (tl_name , tl_ty')) , match_cons') + in + return @@ E_if_cons (expr' , nil , cons) + ) | Match_variant (lst , variant) -> ( let%bind tree = trace_strong (corner_case ~loc:__LOC__ "getting lr tree") @@ @@ -498,7 +512,6 @@ and transpile_annotated_expression (ae:AST.annotated_expression) : expression re trace_strong (corner_case ~loc:__LOC__ "building constructor") @@ aux expr' tree'' ) - | AST.Match_list _ -> fail @@ unsupported_pattern_matching "list" ae.location | AST.Match_tuple _ -> fail @@ unsupported_pattern_matching "tuple" ae.location ) diff --git a/src/passes/8-compiler/compiler_program.ml b/src/passes/8-compiler/compiler_program.ml index 1e7ff7d51..bf0193fe3 100644 --- a/src/passes/8-compiler/compiler_program.ml +++ b/src/passes/8-compiler/compiler_program.ml @@ -256,6 +256,24 @@ and translate_expression (expr:expression) (env:environment) : michelson result ]) in return code ) + | E_if_cons (cond , nil , ((hd , tl) , cons)) -> ( + let%bind cond' = translate_expression cond env in + let%bind nil' = translate_expression nil env in + let s_env = + Environment.add hd + @@ Environment.add tl env + in + let%bind s' = translate_expression cons s_env in + let%bind code = ok (seq [ + cond' ; + i_if_cons (seq [ + s' ; + dip (seq [ i_drop ; i_drop ]) ; + ]) nil' + ; + ]) in + return code + ) | E_if_left (c, (l_ntv , l), (r_ntv , r)) -> ( let%bind c' = translate_expression c env in let l_env = Environment.add l_ntv env in diff --git a/src/stages/ast_typed/PP.ml b/src/stages/ast_typed/PP.ml index 514a091df..36298bbf6 100644 --- a/src/stages/ast_typed/PP.ml +++ b/src/stages/ast_typed/PP.ml @@ -89,8 +89,8 @@ and matching : type a . (formatter -> a -> unit) -> _ -> a matching -> unit = fu fprintf ppf "%a" (list_sep (matching_variant_case f) (tag "@.")) lst | Match_bool {match_true ; match_false} -> fprintf ppf "| True -> %a @.| False -> %a" f match_true f match_false - | Match_list {match_nil ; match_cons = (hd, tl, match_cons)} -> - fprintf ppf "| Nil -> %a @.| %s :: %s -> %a" f match_nil hd tl f match_cons + | Match_list {match_nil ; match_cons = (((hd_name , _), (tl_name , _)), match_cons)} -> + fprintf ppf "| Nil -> %a @.| %s :: %s -> %a" f match_nil hd_name tl_name f match_cons | Match_option {match_none ; match_some = (some, match_some)} -> fprintf ppf "| None -> %a @.| Some %s -> %a" f match_none (fst some) f match_some diff --git a/src/stages/ast_typed/misc.ml b/src/stages/ast_typed/misc.ml index c13200c9a..3f99790fd 100644 --- a/src/stages/ast_typed/misc.ml +++ b/src/stages/ast_typed/misc.ml @@ -199,7 +199,7 @@ module Free_variables = struct and matching : type a . (bindings -> a -> bindings) -> bindings -> a matching -> bindings = fun f b m -> match m with | Match_bool { match_true = t ; match_false = fa } -> union (f b t) (f b fa) - | Match_list { match_nil = n ; match_cons = (hd, tl, c) } -> union (f b n) (f (union (of_list [hd ; tl]) b) c) + | Match_list { match_nil = n ; match_cons = (((hd, _), (tl, _)), c) } -> union (f b n) (f (union (of_list [hd ; tl]) b) c) | Match_option { match_none = n ; match_some = ((opt, _), s) } -> union (f b n) (f (union (singleton opt) b) s) | Match_tuple (lst , a) -> f (union (of_list lst) b) a | Match_variant (lst , _) -> unions @@ List.map (matching_variant_case f b) lst diff --git a/src/stages/ast_typed/misc_smart.ml b/src/stages/ast_typed/misc_smart.ml index 9e9520e3d..dc74d35b2 100644 --- a/src/stages/ast_typed/misc_smart.ml +++ b/src/stages/ast_typed/misc_smart.ml @@ -107,7 +107,7 @@ module Captured_variables = struct let%bind t' = f b t in let%bind fa' = f b fa in ok @@ union t' fa' - | Match_list { match_nil = n ; match_cons = (hd, tl, c) } -> + | Match_list { match_nil = n ; match_cons = (((hd, _), (tl, _)), c) } -> let%bind n' = f b n in let%bind c' = f (union (of_list [hd ; tl]) b) c in ok @@ union n' c' diff --git a/src/stages/ast_typed/types.ml b/src/stages/ast_typed/types.ml index f7ef1595f..06a63e975 100644 --- a/src/stages/ast_typed/types.ml +++ b/src/stages/ast_typed/types.ml @@ -138,7 +138,7 @@ and 'a matching = } | Match_list of { match_nil : 'a ; - match_cons : name * name * 'a ; + match_cons : ((name * type_value) * (name * type_value)) * 'a ; } | Match_option of { match_none : 'a ; diff --git a/src/stages/mini_c/PP.ml b/src/stages/mini_c/PP.ml index 3bb230627..52d87a887 100644 --- a/src/stages/mini_c/PP.ml +++ b/src/stages/mini_c/PP.ml @@ -80,6 +80,7 @@ and expression' ppf (e:expression') = match e with | E_make_none _ -> fprintf ppf "none" | E_if_bool (c, a, b) -> fprintf ppf "%a ? %a : %a" expression c expression a expression b | E_if_none (c, n, ((name, _) , s)) -> fprintf ppf "%a ?? %a : %s -> %a" expression c expression n name expression s + | E_if_cons (c, n, (((hd_name, _) , (tl_name, _)) , cons)) -> fprintf ppf "%a ?? %a : (%s :: %s) -> %a" expression c expression n hd_name tl_name expression cons | E_if_left (c, ((name_l, _) , l), ((name_r, _) , r)) -> fprintf ppf "%a ?? %s -> %a : %s -> %a" expression c name_l expression l name_r expression r | E_sequence (a , b) -> fprintf ppf "%a ;; %a" expression a expression b diff --git a/src/stages/mini_c/types.ml b/src/stages/mini_c/types.ml index 26801d227..bbffddbc6 100644 --- a/src/stages/mini_c/types.ml +++ b/src/stages/mini_c/types.ml @@ -69,6 +69,7 @@ and expression' = | E_iterator of (string * ((var_name * type_value) * expression) * expression) | E_if_bool of expression * expression * expression | E_if_none of expression * expression * ((var_name * type_value) * expression) + | E_if_cons of (expression * expression * (((var_name * type_value) * (var_name * type_value)) * expression)) | E_if_left of expression * ((var_name * type_value) * expression) * ((var_name * type_value) * expression) | E_let_in of ((var_name * type_value) * expression * expression) | E_sequence of (expression * expression) diff --git a/src/test/integration_tests.ml b/src/test/integration_tests.ml index df2b2cb86..e7030bc1f 100644 --- a/src/test/integration_tests.ml +++ b/src/test/integration_tests.ml @@ -722,7 +722,7 @@ let main = test_suite "Integration (End to End)" [ test "let-in (mligo)" let_in_mligo ; test "match variant (mligo)" match_variant ; test "match variant 2 (mligo)" match_matej ; - (* test "list matching (mligo)" mligo_list ; *) + test "list matching (mligo)" mligo_list ; (* test "guess the hash mligo" guess_the_hash_mligo ; WIP? *) (* test "failwith mligo" failwith_mligo ; *) (* test "guess string mligo" guess_string_mligo ; WIP? *) diff --git a/vendors/ligo-utils/tezos-utils/x_michelson.ml b/vendors/ligo-utils/tezos-utils/x_michelson.ml index f55e1a493..5ac8d1282 100644 --- a/vendors/ligo-utils/tezos-utils/x_michelson.ml +++ b/vendors/ligo-utils/tezos-utils/x_michelson.ml @@ -60,6 +60,7 @@ let i_exec = prim I_EXEC let i_if a b = prim ~children:[seq [a] ; seq[b]] I_IF let i_if_none a b = prim ~children:[seq [a] ; seq[b]] I_IF_NONE +let i_if_cons a b = prim ~children:[seq [a] ; seq[b]] I_IF_CONS let i_if_left a b = prim ~children:[seq [a] ; seq[b]] I_IF_LEFT let i_failwith = prim I_FAILWITH let i_assert_some = i_if_none (seq [i_push_string "ASSERT_SOME" ; i_failwith]) (seq []) From 9fb65e71e803fc6599cb060c572303d9b10f1f65 Mon Sep 17 00:00:00 2001 From: galfour Date: Sat, 21 Sep 2019 11:30:41 +0200 Subject: [PATCH 15/18] more lists --- src/passes/2-simplify/pascaligo.ml | 20 ++++++++++++++------ src/test/contracts/list.mligo | 4 ++++ src/test/contracts/match.ligo | 7 +++++++ src/test/integration_tests.ml | 28 +++++++++++++++++++++------- 4 files changed, 46 insertions(+), 13 deletions(-) diff --git a/src/passes/2-simplify/pascaligo.ml b/src/passes/2-simplify/pascaligo.ml index 92250a149..0a6fe63d3 100644 --- a/src/passes/2-simplify/pascaligo.ml +++ b/src/passes/2-simplify/pascaligo.ml @@ -247,7 +247,9 @@ module Errors = struct let pattern_loc = Raw.pattern_to_region p in let data = [ ("pattern_loc", - fun () -> Format.asprintf "%a" Location.pp_lift @@ pattern_loc) + fun () -> Format.asprintf "%a" Location.pp_lift @@ pattern_loc) ; + ("pattern", + fun () -> Format.asprintf "%a" (Simple_utils.PP_helpers.printer Parser.Pascaligo.ParserLog.print_pattern) p) ; ] in error ~data title message @@ -914,7 +916,6 @@ and simpl_cases : type a . (Raw.pattern * a) list -> a matching result = fun t - | p -> fail @@ unsupported_non_var_pattern p in let get_tuple (t: Raw.pattern) = match t with - | PCons v -> npseq_to_list v.value | PTuple v -> npseq_to_list v.value.inside | x -> [ x ] in let get_single (t: Raw.pattern) = @@ -923,6 +924,15 @@ and simpl_cases : type a . (Raw.pattern * a) list -> a matching result = fun t - trace_strong (unsupported_tuple_pattern t) @@ Assert.assert_list_size t' 1 in ok (List.hd t') in + let get_toplevel (t : Raw.pattern) = + match t with + | PCons x -> ( + let (x' , lst) = x.value in + match lst with + | [] -> ok x' + | _ -> ok t + ) + | _ -> fail @@ corner_case ~loc:__LOC__ "unexpected pattern" in let get_constr (t: Raw.pattern) = match t with | PConstr v -> ( @@ -943,10 +953,8 @@ and simpl_cases : type a . (Raw.pattern * a) list -> a matching result = fun t - | _ -> fail @@ only_constructors t in let%bind patterns = let aux (x , y) = - let xs = get_tuple x in - trace_strong (unsupported_tuple_pattern x) @@ - Assert.assert_list_size xs 1 >>? fun () -> - ok (List.hd xs , y) + let%bind x' = get_toplevel x in + ok (x' , y) in bind_map_list aux t in match patterns with | [(PFalse _ , f) ; (PTrue _ , t)] diff --git a/src/test/contracts/list.mligo b/src/test/contracts/list.mligo index 31e2f7d50..34450fde8 100644 --- a/src/test/contracts/list.mligo +++ b/src/test/contracts/list.mligo @@ -2,6 +2,10 @@ type storage = int * int list type param = int list +let x : int list = [] +let y : int list = [ 3 ; 4 ; 5 ] +let z : int list = 2 :: y + let%entry main (p : param) storage = let storage = match p with diff --git a/src/test/contracts/match.ligo b/src/test/contracts/match.ligo index ff5e3a0a4..cddde26c0 100644 --- a/src/test/contracts/match.ligo +++ b/src/test/contracts/match.ligo @@ -29,3 +29,10 @@ function match_expr_option (const o : option(int)) : int is | None -> 42 | Some (s) -> s end + +function match_expr_list (const l : list(int)) : int is + begin skip end with + case l of + | nil -> -1 + | hd # tl -> hd + end diff --git a/src/test/integration_tests.ml b/src/test/integration_tests.ml index e7030bc1f..9215b5a5c 100644 --- a/src/test/integration_tests.ml +++ b/src/test/integration_tests.ml @@ -517,6 +517,13 @@ let matching () : unit result = bind_iter_list aux [Some 0 ; Some 2 ; Some 42 ; Some 163 ; Some (-1) ; None] in + let%bind () = + let aux lst = e_annotation (e_list @@ List.map e_int lst) (t_list t_int) in + let%bind () = expect_eq program "match_expr_list" (aux [ 14 ; 2 ; 3 ]) (e_int 14) in + let%bind () = expect_eq program "match_expr_list" (aux [ 13 ; 2 ; 3 ]) (e_int 13) in + let%bind () = expect_eq program "match_expr_list" (aux []) (e_int (-1)) in + ok () + in ok () let declarations () : unit result = @@ -635,13 +642,20 @@ let match_matej () : unit result = let mligo_list () : unit result = let%bind program = mtype_file "./contracts/list.mligo" in - let make_input n = - e_pair (e_list [e_int n; e_int (2*n)]) - (e_pair (e_int 3) (e_list [e_int 8])) in - let make_expected n = - e_pair (e_typed_list [] t_operation) - (e_pair (e_int (n+3)) (e_list [e_int (2*n)])) - in expect_eq_n program "main" make_input make_expected + let%bind () = + let make_input n = + e_pair (e_list [e_int n; e_int (2*n)]) + (e_pair (e_int 3) (e_list [e_int 8])) in + let make_expected n = + e_pair (e_typed_list [] t_operation) + (e_pair (e_int (n+3)) (e_list [e_int (2*n)])) + in + expect_eq_n program "main" make_input make_expected + in + let%bind () = expect_eq_evaluate program "x" (e_list []) in + let%bind () = expect_eq_evaluate program "y" (e_list @@ List.map e_int [3 ; 4 ; 5]) in + let%bind () = expect_eq_evaluate program "z" (e_list @@ List.map e_int [2 ; 3 ; 4 ; 5]) in + ok () let lambda_mligo () : unit result = let%bind program = mtype_file "./contracts/lambda.mligo" in From 2773a2e4cd719e1813ec715e5d1f5ef00203b562 Mon Sep 17 00:00:00 2001 From: Matej Sima Date: Sat, 21 Sep 2019 14:28:33 +0200 Subject: [PATCH 16/18] Bring back local-repo-job for testing --- .gitlab-ci.yml | 16 ++++++++-------- 1 file changed, 8 insertions(+), 8 deletions(-) diff --git a/.gitlab-ci.yml b/.gitlab-ci.yml index fd988aca4..6f6889714 100644 --- a/.gitlab-ci.yml +++ b/.gitlab-ci.yml @@ -76,14 +76,14 @@ local-dune-job: # TODO: uncomment this -# TODO -# local-repo-job: -# <<: *before_script -# stage: test -# script: -# - scripts/install_vendors_deps.sh -# # TODO: also try from time to time with --build-test -# - opam install -y ligo +local-repo-job: + <<: *before_script + stage: test + script: + - scripts/install_vendors_deps.sh + # TODO: also try from time to time with --build-test + - opam install -y ligo + - ligo remote-repo-job: <<: *before_script From 2909530b22132fa02adbdff36d53c523771c6a10 Mon Sep 17 00:00:00 2001 From: Tom Jack Date: Sat, 21 Sep 2019 13:35:08 -0700 Subject: [PATCH 17/18] Ignore pp.ligos in root --- .gitignore | 1 + super-counter.pp.ligo | 65 ------------------------------------------- 2 files changed, 1 insertion(+), 65 deletions(-) delete mode 100644 super-counter.pp.ligo diff --git a/.gitignore b/.gitignore index bf25b5759..793d181d1 100644 --- a/.gitignore +++ b/.gitignore @@ -5,3 +5,4 @@ dune-project cache/* Version.ml /_opam/ +/*.pp.ligo diff --git a/super-counter.pp.ligo b/super-counter.pp.ligo deleted file mode 100644 index 0097fbc63..000000000 --- a/super-counter.pp.ligo +++ /dev/null @@ -1,65 +0,0 @@ -# 1 "./src/test/contracts/super-counter.ligo" -# 1 "" -# 1 "" -# 31 "" -# 1 "/usr/include/stdc-predef.h" 1 3 4 - -# 17 "/usr/include/stdc-predef.h" 3 4 - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -# 32 "" 2 -# 1 "./src/test/contracts/super-counter.ligo" -type action is -| Increment of int -| Decrement of int - -function main (const p : action ; const s : int) : (list(operation) * int) is - block {skip} with ((nil : list(operation)), - case p of - | Increment (n) -> s + n - | Decrement (n) -> s - n - end) From 33dbd11482fb5ed2802071cacd4ffbe14a990bfe Mon Sep 17 00:00:00 2001 From: Tom Jack Date: Sat, 21 Sep 2019 13:50:01 -0700 Subject: [PATCH 18/18] Delete broken local-repo-job --- .gitlab-ci.yml | 11 ----------- 1 file changed, 11 deletions(-) diff --git a/.gitlab-ci.yml b/.gitlab-ci.yml index 6f6889714..223f33240 100644 --- a/.gitlab-ci.yml +++ b/.gitlab-ci.yml @@ -74,17 +74,6 @@ local-dune-job: - scripts/build_ligo_local.sh - dune build @ligo-test -# TODO: uncomment this - -local-repo-job: - <<: *before_script - stage: test - script: - - scripts/install_vendors_deps.sh - # TODO: also try from time to time with --build-test - - opam install -y ligo - - ligo - remote-repo-job: <<: *before_script stage: test