From cdfffcf8ecaec28a7171d2f04bedb12548634f5f Mon Sep 17 00:00:00 2001 From: galfour Date: Tue, 10 Sep 2019 12:42:49 +0200 Subject: [PATCH] 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/*)) +)