Repository: PlasmaLang/plasma Branch: master Commit: 81e35cececdc Files: 761 Total size: 1.9 MB Directory structure: gitextract_m9d_heqr/ ├── .clang-format ├── .github/ │ └── workflows/ │ └── ci.yaml ├── .gitignore ├── .gitmessage ├── CODE_OF_CONDUCT.md ├── CONTRIBUTING.md ├── LICENSE ├── LICENSE.code ├── LICENSE.docs ├── LICENSE.unlicense ├── Makefile ├── README.md ├── SECURITY.md ├── THANKS ├── defaults.mk ├── docs/ │ ├── .gitignore │ ├── README.md │ ├── asciidoc.conf │ ├── contributing.txt │ ├── css/ │ │ ├── asciidoc.css │ │ └── docs-offline.css │ ├── design_concept_map.txt │ ├── design_ideas.txt │ ├── design_principles.txt │ ├── design_types.txt │ ├── dev_bugtracking.txt │ ├── dev_compiler_internals.txt │ ├── dev_howto_make_pr.txt │ ├── dev_maintainers.txt │ ├── dev_mercury_grades.txt │ ├── dev_style_c.txt │ ├── dev_style_mercury.txt │ ├── dev_testing.txt │ ├── getting_started.txt │ ├── index.txt │ ├── plasma_ref.txt │ ├── pz_machine.txt │ ├── references.txt │ └── user_guide.txt ├── examples/ │ ├── .gitignore │ ├── BUILD.plz │ ├── Makefile │ ├── README.md │ ├── ackermann.exp │ ├── ackermann.p │ ├── change.exp │ ├── change.in │ ├── change.p │ ├── fib.exp │ ├── fib.p │ ├── hello.exp │ ├── hello.p │ ├── module_example.p │ ├── module_to_import.p │ ├── modules.exp │ ├── mr4.exp │ ├── mr4.p │ ├── readline.exp │ ├── readline.in │ ├── readline.p │ ├── sequences.p │ ├── set.p │ ├── string.p │ ├── temperature.exp │ ├── temperature.p │ ├── types.exp │ ├── types.p │ └── util.p ├── runtime/ │ ├── .gitignore │ ├── README.md │ ├── pz.cpp │ ├── pz.h │ ├── pz_array.h │ ├── pz_builtin.cpp │ ├── pz_builtin.h │ ├── pz_closure.h │ ├── pz_code.cpp │ ├── pz_code.h │ ├── pz_common.h │ ├── pz_config.h.in │ ├── pz_cxx_future.h │ ├── pz_data.cpp │ ├── pz_data.h │ ├── pz_foreign.cpp │ ├── pz_foreign.h │ ├── pz_format.h │ ├── pz_gc.cpp │ ├── pz_gc.h │ ├── pz_gc.impl.h │ ├── pz_gc_alloc.cpp │ ├── pz_gc_collect.cpp │ ├── pz_gc_debug.cpp │ ├── pz_gc_layout.h │ ├── pz_gc_layout.impl.h │ ├── pz_gc_layout_bop.h │ ├── pz_gc_layout_fit.h │ ├── pz_gc_util.cpp │ ├── pz_gc_util.h │ ├── pz_generic.cpp │ ├── pz_generic_builder.cpp │ ├── pz_generic_builtin.cpp │ ├── pz_generic_closure.cpp │ ├── pz_generic_closure.h │ ├── pz_generic_run.cpp │ ├── pz_generic_run.h │ ├── pz_instructions.cpp │ ├── pz_instructions.h │ ├── pz_interp.h │ ├── pz_io.cpp │ ├── pz_io.h │ ├── pz_library.cpp │ ├── pz_library.h │ ├── pz_main.cpp │ ├── pz_memory.cpp │ ├── pz_memory.h │ ├── pz_option.cpp │ ├── pz_option.h │ ├── pz_read.cpp │ ├── pz_read.h │ ├── pz_string.cpp │ ├── pz_string.h │ ├── pz_trace.cpp │ ├── pz_trace.h │ ├── pz_util.h │ └── pz_vector.h ├── scripts/ │ ├── README.md │ ├── do_mmc_make │ └── docker/ │ ├── Dockerfile │ ├── README.md │ ├── build.sh │ ├── gitconfig │ ├── install.sh │ ├── mercury.list │ ├── paul.gpg │ ├── vimrc │ └── welcome.sh ├── src/ │ ├── .gitignore │ ├── .vim_mmc_make │ ├── Mercury.options │ ├── README.md │ ├── asm.m │ ├── asm_ast.m │ ├── asm_error.m │ ├── ast.m │ ├── build.m │ ├── builtins.m │ ├── common_types.m │ ├── compile.m │ ├── compile_error.m │ ├── constant.m │ ├── context.m │ ├── core.arity_chk.m │ ├── core.branch_chk.m │ ├── core.code.m │ ├── core.function.m │ ├── core.m │ ├── core.pretty.m │ ├── core.res_chk.m │ ├── core.resource.m │ ├── core.simplify.m │ ├── core.type_chk.m │ ├── core.type_chk.solve.m │ ├── core.types.m │ ├── core.util.m │ ├── core_to_pz.closure.m │ ├── core_to_pz.code.m │ ├── core_to_pz.data.m │ ├── core_to_pz.locn.m │ ├── core_to_pz.m │ ├── dump_stage.m │ ├── file_utils.m │ ├── foreign.m │ ├── lex.automata.m │ ├── lex.buf.m │ ├── lex.convert_NFA_to_DFA.m │ ├── lex.lexeme.m │ ├── lex.m │ ├── lex.regexp.m │ ├── options.m │ ├── parse.m │ ├── parse_util.m │ ├── parsing.m │ ├── plzasm.m │ ├── plzbuild.m │ ├── plzc.m │ ├── plzdisasm.m │ ├── plzgeninit.m │ ├── plzlnk.m │ ├── pre.ast_to_core.m │ ├── pre.bang.m │ ├── pre.branches.m │ ├── pre.closures.m │ ├── pre.env.m │ ├── pre.from_ast.m │ ├── pre.import.m │ ├── pre.m │ ├── pre.pre_ds.m │ ├── pre.pretty.m │ ├── pre.to_core.m │ ├── pre.util.m │ ├── pz.bytecode.m │ ├── pz.code.m │ ├── pz.format.m │ ├── pz.link.m │ ├── pz.m │ ├── pz.pretty.m │ ├── pz.pz_ds.m │ ├── pz.read.m │ ├── pz.write.m │ ├── pzt_parse.m │ ├── q_name.m │ ├── toml.m │ ├── util.log.m │ ├── util.m │ ├── util.mercury.m │ ├── util.my_exception.m │ ├── util.my_io.m │ ├── util.my_string.m │ ├── util.my_time.m │ ├── util.path.m │ ├── util.pretty.m │ ├── util.pretty_old.m │ ├── util.result.m │ ├── varmap.m │ └── write_interface.m ├── template.mk ├── tests/ │ ├── .gitignore │ ├── BUILD.plz │ ├── README.md │ ├── build/ │ │ ├── bad_file_1.build │ │ ├── bad_file_1.exp │ │ ├── bad_file_2.exp │ │ ├── bad_file_2.test │ │ ├── bad_file_3.build │ │ ├── bad_file_3.exp │ │ ├── bad_file_4.build │ │ ├── bad_file_4.exp │ │ ├── bad_module_name.build │ │ ├── bad_module_name.exp │ │ ├── bad_module_name_2.build │ │ ├── bad_module_name_2.exp │ │ ├── bad_module_name_2.p │ │ ├── dup_module_name.build │ │ ├── dup_module_name.exp │ │ ├── dup_module_name_2.build │ │ ├── dup_module_name_2.exp │ │ ├── dup_module_name_2.p │ │ ├── extra_module.p │ │ ├── file_in_other_program.build │ │ ├── file_in_other_program.expish │ │ ├── file_in_other_program.p │ │ ├── include_file_nobuild.build │ │ ├── include_file_nobuild.exp │ │ ├── include_file_nobuild.p │ │ ├── include_nofile_build.build │ │ ├── include_nofile_build.exp │ │ ├── include_nofile_build.p │ │ ├── include_nofile_nobuild.build │ │ ├── include_nofile_nobuild.expish │ │ ├── include_nofile_nobuild.p │ │ ├── options_compiler_01.build │ │ ├── options_compiler_01.exp │ │ ├── options_compiler_01.p │ │ ├── options_compiler_02.build │ │ ├── options_compiler_02.exp │ │ ├── options_compiler_02.p │ │ ├── options_compiler_03.build │ │ ├── options_compiler_03.exp │ │ └── other_program.p │ ├── builtins/ │ │ ├── BUILD.plz │ │ ├── builtin_01.exp │ │ ├── builtin_01.p │ │ ├── builtin_02_int.exp │ │ ├── builtin_02_int.p │ │ ├── builtin_03_bool.exp │ │ ├── builtin_03_bool.p │ │ ├── builtin_04_string.exp │ │ ├── builtin_04_string.p │ │ ├── builtin_05_list.exp │ │ ├── builtin_05_list.p │ │ ├── builtin_not_found.build │ │ ├── builtin_not_found.exp │ │ └── builtin_not_found.p │ ├── ffi/ │ │ ├── .gitignore │ │ ├── BUILD.plz │ │ ├── import_from_two_modules.cpp │ │ ├── import_from_two_modules.exp │ │ ├── import_from_two_modules.h │ │ ├── import_from_two_modules_1.p │ │ ├── import_from_two_modules_2.p │ │ ├── import_function.cpp │ │ ├── import_function.exp │ │ ├── import_function.h │ │ ├── import_function.p │ │ ├── import_shared_module.cpp │ │ ├── import_shared_module.h │ │ ├── import_shared_module.p │ │ ├── import_two_sources.cpp │ │ ├── import_two_sources.exp │ │ ├── import_two_sources.h │ │ ├── import_two_sources.p │ │ ├── unrecognised_extension.build │ │ ├── unrecognised_extension.exp │ │ └── unrecognised_extension.p │ ├── hello.exp │ ├── hello.p │ ├── language/ │ │ ├── BUILD.plz │ │ ├── arity_01.exp │ │ ├── arity_01.p │ │ ├── arity_02.build │ │ ├── arity_02.exp │ │ ├── arity_02.p │ │ ├── arity_ho_1.build │ │ ├── arity_ho_1.exp │ │ ├── arity_ho_1.p │ │ ├── arity_ho_2.build │ │ ├── arity_ho_2.exp │ │ ├── arity_ho_2.p │ │ ├── arity_lambda.build │ │ ├── arity_lambda.exp │ │ ├── arity_lambda.p │ │ ├── comment.exp │ │ ├── comment.p │ │ ├── comment_end.build │ │ ├── comment_end.exp │ │ ├── comment_end.p │ │ ├── coverage_1.build │ │ ├── coverage_1.exp │ │ ├── coverage_1.p │ │ ├── entrypoint_bad_sig.build │ │ ├── entrypoint_bad_sig.exp │ │ ├── entrypoint_bad_sig.p │ │ ├── entrypoint_multi.build │ │ ├── entrypoint_multi.exp │ │ ├── entrypoint_multi.p │ │ ├── entrypoint_none.build │ │ ├── entrypoint_none.exp │ │ ├── entrypoint_none.p │ │ ├── export_bad_resource.build │ │ ├── export_bad_resource.exp │ │ ├── export_bad_resource.p │ │ ├── export_bad_type.build │ │ ├── export_bad_type.exp │ │ ├── export_bad_type.p │ │ ├── ho/ │ │ │ ├── BUILD.plz │ │ │ ├── closure_01.exp │ │ │ ├── closure_01.p │ │ │ ├── closure_02.exp │ │ │ ├── closure_02.p │ │ │ ├── closure_03.exp │ │ │ ├── closure_03.p │ │ │ ├── closure_04.exp │ │ │ ├── closure_04.p │ │ │ ├── closure_05.exp │ │ │ ├── closure_05.p │ │ │ ├── closure_06.exp │ │ │ ├── closure_06.p │ │ │ ├── closure_bad_01.build │ │ │ ├── closure_bad_01.exp │ │ │ ├── closure_bad_01.p │ │ │ ├── closure_bad_02.build │ │ │ ├── closure_bad_02.exp │ │ │ ├── closure_bad_02.p │ │ │ ├── closure_bad_03.build │ │ │ ├── closure_bad_03.exp │ │ │ ├── closure_bad_03.p │ │ │ ├── closure_bad_04.build │ │ │ ├── closure_bad_04.exp │ │ │ ├── closure_bad_04.p │ │ │ ├── closure_bad_05.build │ │ │ ├── closure_bad_05.exp │ │ │ ├── closure_bad_05.p │ │ │ ├── closure_bad_06.build │ │ │ ├── closure_bad_06.exp │ │ │ ├── closure_bad_06.p │ │ │ ├── closure_bad_07.build │ │ │ ├── closure_bad_07.exp │ │ │ ├── closure_bad_07.p │ │ │ ├── closure_bad_08.build │ │ │ ├── closure_bad_08.exp │ │ │ ├── closure_bad_08.p │ │ │ ├── closure_bad_09.build │ │ │ ├── closure_bad_09.exp │ │ │ ├── closure_bad_09.p │ │ │ ├── closure_bad_10.build │ │ │ ├── closure_bad_10.exp │ │ │ ├── closure_bad_10.p │ │ │ ├── closure_mut_rec.build │ │ │ ├── closure_mut_rec.exp │ │ │ ├── closure_mut_rec.p │ │ │ ├── ho_1.exp │ │ │ ├── ho_1.p │ │ │ ├── ho_2.exp │ │ │ ├── ho_2.p │ │ │ ├── ho_bad_7.build │ │ │ ├── ho_bad_7.exp │ │ │ ├── ho_bad_7.p │ │ │ ├── ho_call_bug_30.exp │ │ │ └── ho_call_bug_30.p │ │ ├── ite_1.exp │ │ ├── ite_1.p │ │ ├── ite_2.exp │ │ ├── ite_2.p │ │ ├── ite_3.exp │ │ ├── ite_3.p │ │ ├── list.exp │ │ ├── list.p │ │ ├── match/ │ │ │ ├── BUILD.plz │ │ │ ├── match_1.exp │ │ │ ├── match_1.p │ │ │ ├── match_2.exp │ │ │ ├── match_2.p │ │ │ ├── match_bad_1.build │ │ │ ├── match_bad_1.exp │ │ │ ├── match_bad_1.p │ │ │ ├── match_bad_2.build │ │ │ ├── match_bad_2.exp │ │ │ ├── match_bad_2.p │ │ │ ├── match_bad_3.build │ │ │ ├── match_bad_3.exp │ │ │ ├── match_bad_3.p │ │ │ ├── match_bad_error_1.build │ │ │ ├── match_bad_error_1.exp │ │ │ ├── match_bad_error_1.p │ │ │ ├── match_empty_case.exp │ │ │ ├── match_empty_case.p │ │ │ ├── match_multiple.build │ │ │ ├── match_multiple.exp │ │ │ ├── match_multiple.p │ │ │ ├── unpack_1.exp │ │ │ ├── unpack_1.p │ │ │ ├── unpack_nest.build │ │ │ ├── unpack_nest.exp │ │ │ └── unpack_nest.p │ │ ├── operators.exp │ │ ├── operators.p │ │ ├── pragma_bad_args.build │ │ ├── pragma_bad_args.exp │ │ ├── pragma_bad_args.p │ │ ├── pragma_unknown_1.build │ │ ├── pragma_unknown_1.exp │ │ ├── pragma_unknown_1.p │ │ ├── pragma_unknown_2.build │ │ ├── pragma_unknown_2.exp │ │ ├── pragma_unknown_2.p │ │ ├── res/ │ │ │ ├── BUILD.plz │ │ │ ├── multiple_bang.build │ │ │ ├── multiple_bang.exp │ │ │ ├── multiple_bang.p │ │ │ ├── resource.exp │ │ │ ├── resource.p │ │ │ ├── resource_invalid_1.build │ │ │ ├── resource_invalid_1.exp │ │ │ ├── resource_invalid_1.p │ │ │ ├── resource_invalid_2.build │ │ │ ├── resource_invalid_2.exp │ │ │ ├── resource_invalid_2.p │ │ │ ├── resource_invalid_3.build │ │ │ ├── resource_invalid_3.exp │ │ │ └── resource_invalid_3.p │ │ ├── return.build │ │ ├── return.exp │ │ ├── return.p │ │ ├── string.exp │ │ ├── string.p │ │ ├── types/ │ │ │ ├── BUILD.plz │ │ │ ├── bug_375.build │ │ │ ├── bug_375.exp │ │ │ ├── bug_375.p │ │ │ ├── closure_infer_1.build │ │ │ ├── closure_infer_1.exp │ │ │ ├── closure_infer_1.p │ │ │ ├── closure_infer_2.build │ │ │ ├── closure_infer_2.exp │ │ │ ├── closure_infer_2.p │ │ │ ├── constructor_duplicate.build │ │ │ ├── constructor_duplicate.exp │ │ │ ├── constructor_duplicate.p │ │ │ ├── constructor_overload.exp │ │ │ ├── constructor_overload.p │ │ │ ├── enum.exp │ │ │ ├── enum.p │ │ │ ├── ho_bad_1.build │ │ │ ├── ho_bad_1.exp │ │ │ ├── ho_bad_1.p │ │ │ ├── ho_bad_2.build │ │ │ ├── ho_bad_2.exp │ │ │ ├── ho_bad_2.p │ │ │ ├── ho_bad_3.build │ │ │ ├── ho_bad_3.exp │ │ │ ├── ho_bad_3.p │ │ │ ├── ho_bad_4.build │ │ │ ├── ho_bad_4.exp │ │ │ ├── ho_bad_4.p │ │ │ ├── ho_bad_5.build │ │ │ ├── ho_bad_5.exp │ │ │ ├── ho_bad_5.p │ │ │ ├── ho_bad_6.build │ │ │ ├── ho_bad_6.exp │ │ │ ├── ho_bad_6.p │ │ │ ├── occurs1.build │ │ │ ├── occurs1.exp │ │ │ ├── occurs1.p │ │ │ ├── occurs2.build │ │ │ ├── occurs2.exp │ │ │ ├── occurs2.p │ │ │ ├── occurs3.build │ │ │ ├── occurs3.exp │ │ │ ├── occurs3.p │ │ │ ├── occurs4.build │ │ │ ├── occurs4.exp │ │ │ ├── occurs4.p │ │ │ ├── occurs5.build │ │ │ ├── occurs5.exp │ │ │ ├── occurs5.p │ │ │ ├── parametric.exp │ │ │ ├── parametric.p │ │ │ ├── playing_card.exp │ │ │ ├── playing_card.p │ │ │ ├── polymorphic.exp │ │ │ ├── polymorphic.p │ │ │ ├── recursive.exp │ │ │ ├── recursive.p │ │ │ ├── tagging1.exp │ │ │ ├── tagging1.p │ │ │ ├── tagging2.exp │ │ │ ├── tagging2.p │ │ │ ├── types_invalid_02.build │ │ │ ├── types_invalid_02.exp │ │ │ ├── types_invalid_02.p │ │ │ ├── types_invalid_03.build │ │ │ ├── types_invalid_03.exp │ │ │ ├── types_invalid_03.p │ │ │ ├── types_invalid_04.build │ │ │ ├── types_invalid_04.exp │ │ │ ├── types_invalid_04.p │ │ │ ├── types_invalid_05.build │ │ │ ├── types_invalid_05.exp │ │ │ ├── types_invalid_05.p │ │ │ ├── types_invalid_06.build │ │ │ ├── types_invalid_06.exp │ │ │ ├── types_invalid_06.p │ │ │ ├── types_invalid_07.build │ │ │ ├── types_invalid_07.exp │ │ │ ├── types_invalid_07.p │ │ │ ├── types_invalid_08.build │ │ │ ├── types_invalid_08.exp │ │ │ └── types_invalid_08.p │ │ └── vars/ │ │ ├── BUILD.plz │ │ ├── vars_1.exp │ │ ├── vars_1.p │ │ ├── vars_2.exp │ │ ├── vars_2.p │ │ ├── vars_invalid_01.build │ │ ├── vars_invalid_01.exp │ │ ├── vars_invalid_01.p │ │ ├── vars_invalid_02.build │ │ ├── vars_invalid_02.exp │ │ ├── vars_invalid_02.p │ │ ├── vars_invalid_03.build │ │ ├── vars_invalid_03.exp │ │ ├── vars_invalid_03.p │ │ ├── vars_invalid_04.build │ │ ├── vars_invalid_04.exp │ │ ├── vars_invalid_04.p │ │ ├── vars_invalid_05.build │ │ ├── vars_invalid_05.exp │ │ ├── vars_invalid_05.p │ │ ├── vars_invalid_06.build │ │ ├── vars_invalid_06.exp │ │ ├── vars_invalid_06.p │ │ ├── vars_invalid_07.build │ │ ├── vars_invalid_07.exp │ │ ├── vars_invalid_07.p │ │ ├── vars_invalid_08.build │ │ ├── vars_invalid_08.exp │ │ ├── vars_invalid_08.p │ │ ├── vars_invalid_09.build │ │ ├── vars_invalid_09.exp │ │ ├── vars_invalid_09.p │ │ ├── vars_invalid_10.build │ │ ├── vars_invalid_10.exp │ │ ├── vars_invalid_10.p │ │ ├── vars_invalid_11.build │ │ ├── vars_invalid_11.exp │ │ ├── vars_invalid_11.p │ │ ├── vars_invalid_12.build │ │ ├── vars_invalid_12.exp │ │ ├── vars_invalid_12.p │ │ ├── vars_invalid_13.build │ │ ├── vars_invalid_13.exp │ │ ├── vars_invalid_13.p │ │ ├── vars_invalid_14.build │ │ ├── vars_invalid_14.exp │ │ ├── vars_invalid_14.p │ │ ├── vars_invalid_15.build │ │ ├── vars_invalid_15.exp │ │ └── vars_invalid_15.p │ ├── library/ │ │ ├── BUILD.plz │ │ ├── args.exp │ │ └── args.p │ ├── modules/ │ │ ├── BUILD.plz │ │ ├── Makefile │ │ ├── dyn_link_01.exp │ │ ├── dyn_link_01.p │ │ ├── dyn_link_01.sh │ │ ├── dyn_link_01_a.p │ │ ├── dyn_link_02.exp │ │ ├── dyn_link_02.p │ │ ├── dyn_link_02.sh │ │ ├── dyn_link_02_a.p │ │ ├── dyn_link_02_b.p │ │ ├── entrypoint_1.build │ │ ├── entrypoint_1.exp │ │ ├── entrypoint_1a.p │ │ ├── entrypoint_1b.p │ │ ├── entrypoint_2.exp │ │ ├── entrypoint_2a.p │ │ ├── entrypoint_2b.p │ │ ├── entrypoint_3.exp │ │ ├── entrypoint_3a.p │ │ ├── entrypoint_3b.p │ │ ├── heir.foo.p │ │ ├── heir.foo_bar.p │ │ ├── heir_test.build │ │ ├── heir_test.exp │ │ ├── heir_test.p │ │ ├── module_01.build │ │ ├── module_01.exp │ │ ├── module_01.p │ │ ├── module_01a.p │ │ ├── module_02.build │ │ ├── module_02.exp │ │ ├── module_02.p │ │ ├── module_02a.p │ │ ├── module_03a.exp │ │ ├── module_03a.p │ │ ├── module_03a.sh │ │ ├── module_03ar.exp │ │ ├── module_03ar.sh │ │ ├── module_03b.exp │ │ ├── module_03b.p │ │ ├── module_03b.sh │ │ ├── module_03br.exp │ │ ├── module_03br.sh │ │ ├── module_03c.exp │ │ ├── module_03c.p │ │ ├── module_03c.sh │ │ ├── module_03cr.exp │ │ ├── module_03cr.sh │ │ ├── module_04.exp │ │ ├── module_04.p │ │ ├── module_04a.p │ │ ├── module_05.exp │ │ ├── module_05.p │ │ ├── module_05a.p │ │ ├── module_06.exp │ │ ├── module_06.p │ │ ├── module_06a.p │ │ ├── module_07.exp │ │ ├── module_07.p │ │ ├── module_07a.p │ │ ├── module_08.p │ │ ├── module_08a.exp │ │ ├── module_08a.sh │ │ ├── module_08b.exp │ │ ├── module_08b.sh │ │ ├── module_name_test.build │ │ ├── module_name_test.exp │ │ ├── module_name_test.p │ │ ├── opaque_resource.p │ │ ├── opaque_resource_1.build │ │ ├── opaque_resource_1.exp │ │ ├── opaque_resource_1.p │ │ ├── opaque_resource_2.build │ │ ├── opaque_resource_2.exp │ │ ├── opaque_resource_2.p │ │ ├── res_vis_01.a.p │ │ ├── res_vis_01.b.p │ │ ├── res_vis_01.c.p │ │ ├── res_vis_01.d.p │ │ ├── res_vis_01.exp │ │ └── res_vis_01.p │ ├── pretty.lua │ ├── run-tests.lua │ ├── runtime/ │ │ ├── BUILD.plz │ │ ├── allocateLots.exp │ │ ├── allocateLots.p │ │ ├── die.exp │ │ ├── die.p │ │ ├── parameters.exp │ │ └── parameters.p │ └── update-outputs.sh └── tests-old/ ├── .gitignore ├── README.md ├── modules-invalid/ │ ├── .gitignore │ ├── BUILD.plz │ ├── Makefile │ ├── module_01.exp │ ├── module_01.p │ ├── module_02.exp │ ├── module_02.p │ ├── module_03.exp │ ├── module_03.p │ ├── module_03a.p │ ├── module_04a.exp │ ├── module_04a.p │ ├── module_04b.exp │ ├── module_04b.p │ ├── module_04c.exp │ ├── module_04c.p │ ├── module_04d.exp │ ├── module_04d.p │ ├── module_04import.p │ ├── module_05.exp │ ├── module_05.p │ ├── module_05_.p │ ├── module_06.exp │ ├── module_06.p │ ├── module_06a.p │ ├── module_07.exp │ ├── module_07.p │ ├── module_08.c.p │ ├── module_08.d.p │ ├── module_08.expish │ ├── module_08.p │ ├── module_08b.expish │ └── module_08b.p ├── pzt/ │ ├── Makefile │ ├── ccov.exp │ ├── ccov.pzt │ ├── closure.exp │ ├── closure.pzt │ ├── fib.exp │ ├── fib.pzt │ ├── hello.exp │ ├── hello.pzt │ ├── link_01.exp │ ├── link_01.p │ ├── link_01.pzt │ ├── link_02.exp │ ├── link_02.pzt │ ├── link_03.exp │ ├── link_03.pzt │ ├── link_target_01.pzt │ ├── link_target_02.pzt │ ├── memory.exp │ ├── memory.pzt │ ├── mutual.exp │ ├── mutual.pzt │ ├── stack.exp │ ├── stack.pzt │ ├── struct.exp │ ├── struct.pzt │ ├── tags.exp │ ├── tags.pzt │ ├── temperature.exp │ ├── temperature.pzt │ ├── trunc_ze_se.exp │ └── trunc_ze_se.pzt └── run_tests.sh ================================================ FILE CONTENTS ================================================ ================================================ FILE: .clang-format ================================================ --- Language: Cpp BasedOnStyle: Google IndentWidth: 4 BreakBeforeBraces: Custom BraceWrapping: AfterCaseLabel: false AfterClass: true AfterControlStatement: MultiLine AfterEnum: false AfterFunction: true AfterNamespace: false AfterStruct: false AfterUnion: false AfterExternBlock: false BeforeCatch: false BeforeElse: false SplitEmptyFunction: false BinPackArguments: false AllowAllConstructorInitializersOnNextLine: false AllowAllParametersOfDeclarationOnNextLine: false AlignConsecutiveAssignments: true # This is good except it looks bad in function declarations. AlignConsecutiveDeclarations: true AlignConsecutiveMacros: true BreakConstructorInitializers: BeforeComma AlignTrailingComments: true DerivePointerAlignment: false PointerAlignment: Middle # For now, TODO: switch to Regroup IncludeBlocks: Preserve ... ================================================ FILE: .github/workflows/ci.yaml ================================================ # # This is free and unencumbered software released into the public domain. # See ../LICENSE.unlicense # # This workflow controls Plasma's continious integration. See documentation # for github workflows: # # * https://help.github.com/en/actions/configuring-and-managing-workflows/configuring-and-managing-workflow-files-and-runs # * https://help.github.com/en/actions/reference/workflow-syntax-for-github-actions # # And the action we use is here: # * https://github.com/PlasmaLang/ci name: CI on: [push, pull_request] jobs: test: name: Test (${{ matrix.buildType }} ${{ matrix.c }}) runs-on: ubuntu-latest strategy: matrix: c: [gcc, clang] buildType: [dev, rel] fail-fast: false steps: - name: checkout uses: actions/checkout@v4 - name: setup uses: PlasmaLang/ci/stable@v2_1 with: command: setup c: ${{ matrix.c }} buildType: ${{ matrix.buildType }} - name: build uses: PlasmaLang/ci/stable@v2_1 with: command: build - name: test uses: PlasmaLang/ci/stable@v2_1 with: command: test - name: gctest uses: PlasmaLang/ci/stable@v2_1 if: matrix.buildType == 'dev' with: command: gctest - name: copy-results uses: actions/upload-artifact@v4 if: failure() with: name: test-results ${{ matrix.buildType }} ${{ matrix.c }} path: . retention-days: 7 docs: name: Build docs runs-on: ubuntu-latest strategy: fail-fast: false steps: - name: checkout uses: actions/checkout@v4 - name: docs uses: PlasmaLang/ci/docs@v1 lint: name: Lint (${{ matrix.buildType }}) runs-on: ubuntu-latest strategy: matrix: buildType: [dev, rel] fail-fast: false steps: - name: checkout uses: actions/checkout@v4 - name: setup uses: PlasmaLang/ci/stable@v2_1 with: command: setup c: clang buildType: ${{ matrix.buildType }} lint: lint - name: build uses: PlasmaLang/ci/stable@v2_1 with: command: build - name: extra uses: PlasmaLang/ci/stable@v2_1 with: command: extra ================================================ FILE: .gitignore ================================================ .dep .docs_warning .mer_progs build.mk ================================================ FILE: .gitmessage ================================================ [component(s)] Title Description Any other changes including changes that were needed to support this change or followed as a concequence of this change. # Current components are: # pz: the PZ file format, # pzrun: the runtime, # pzasm: the PZ assembler, # plasmac: the compiler generally, # plasmac/parse: the first phase: parsing. # plasmac/ast: the second phase: the AST and operations on it, # plasmac/pre: the third phase: the pre-core representation and operations, # plasmac/core: the fourth phase: the core representation and operations, # plasmac/pz: the fitht phase: the PZ code generator, # docs: documentation, # build: the build system, # # The title doesn't need to be a full English sentence. # You can use wildcards to convey groups of files if that # makes things easier to read. (for a human) ================================================ FILE: CODE_OF_CONDUCT.md ================================================ # The Plasma Code of Conduct The canonical version of this document can be found [in the master branch of the plasma repository](https://github.com/PlasmaLang/plasma/blob/master/CODE_OF_CONDUCT.md). We are committed to providing a friendly and safe environment for all, regardless of level of experience, gender identity and expression, sexual orientation, disability, personal appearance, body size, race, ethnicity, age, religion, nationality, relationship status or other similar characteristic. ## Contact If you have any questions or wish to report harassment you may contact the Plasma community moderators by e-mailing [mods@plasmalang.org](mailto:mods@plasmalang.org). This e-mail alias currently messages Paul Bone only. Reports will be handled discreetly. ## Rules for conduct All participants are expected to follow these rules at all times. * Avoid using rude, sexual, or otherwise inappropriate nicknames or avatars. * Harassment is unwelcome behaviour, we will exclude anyone engaging in harassment. Harassment may include: * Violence, threats of violence or violent language directed against another person. * Discriminatory, hateful, or exclusionary jokes, language, remarks and behaviour. * Personal insults and cursing directed at another person, cursing at things is okay, but not with oppressive language. * Posting or displaying sexually explicit or violent material. * Posting or threatening to post other people’s personally identifying information ("doxing"). * Inappropriate photography or recording. * Inappropriate physical contact. You should have someone’s consent before touching them. * Unwelcome sexual attention. This includes, sexualized comments or jokes; inappropriate touching, groping, and unwelcomed sexual advances. * Deliberate intimidation, stalking or following (online or in person). * Advocating for, or encouraging, any of the above behaviour. * Disruptive behaviour interferes with other people's ability to contribute or use Plasma. * Trolling, flaming, baiting or other attention-stealing behaviour is not welcome. * Sustained disruption of community events, including talks and presentations. * The moderators are responsible for maintaining a healthy and happy community, and this code of conduct may be subject to change or interpretation to achieve that. ## Scope * These rules apply to the Discord server, github and the mailing lists and any other 'official' place as listed on http://plasmalang.org/contact.html * Private harassment is also unacceptable. Whether you're a regular contributor or a newcomer, if you feel you have been or are being harassed or made uncomfortable by a community member, please contact us (see above). We care about making this community a safe place for you and we've got your back. * Conduct outside the project may affect a person's eligibility to hold a position of responsibility (eg: code review, moderation), and may contribute to their standing within the Plasma community. ## Good ideas for productive conduct When differences of opinion arise we want to have productive discussions, here are some ideas for ensuring discussions remain productive and respectful. * Respect that people have differences of opinion and that every design or implementation choice carries a trade-off and numerous costs. Disagreements about such decisions are okay so long as they are productive and everyone avoids personal attacks. * Please keep unstructured critique to a minimum. If you have solid ideas you want to experiment with, make a fork and see how it works. * When providing feedback, ask yourself "Is this code/docs/etc better than before?" not "Is this contribution perfect?", particularly for new contributors. * Spamming mailing lists, Discord server etc can make it difficult for other on-topic discussions to occur. Interruptions like these will be moderated if necessary. We do not forbid small off-topic discussions like "How was your weekend?" as they are usually positive for the community. ## Moderation These are the policies for upholding our community's standards of conduct. If you feel that a discussion needs moderation, please contact the Moderation Team (see above). 1. Moderators will first respond with a warning for most violations. If the violation is particularly severe mods may exclude someone immediately and permanently. 2. If the warning is unheeded, the user will be "kicked," i.e., kicked out of the communication channel to cool off. 3. If the user comes back and continues to make trouble, they will be banned, i.e., indefinitely excluded. 4. Moderators may choose at their discretion to un-ban the user if it was a first offense and they offer the offended party a genuine apology. 5. If a moderator bans someone and you think it was unjustified, please take it up with that moderator, or with a different moderator, **in private**. Complaints about bans in-channel are not allowed. * Moderators are held to a higher standard than other community members. If a moderator creates an inappropriate situation, they should expect less leeway than others. In the Plasma community we strive to go the extra step to look out for each other. Don't just aim to be technically unimpeachable, try to be your best self. In particular, avoid flirting with offensive or sensitive issues, particularly if they're off-topic; this all too often leads to unnecessary fights, hurt feelings, and damaged trust; worse, it can drive people away from the community entirely. And if someone takes issue with something you said or did, resist the urge to be defensive. Just stop doing what it was they complained about and apologize. Even if you feel you were misinterpreted or unfairly accused, chances are good there was something you could've communicated better — remember that it's your responsibility to make your fellow contributors comfortable. Everyone wants to get along and we are all here first and foremost because we want to talk about cool technology. You will find that people will be eager to assume good intent and forgive as long as you earn their trust. ## Other projects For other projects adopting the Plasma Code of Conduct, please contact the maintainers of those projects for enforcement. If you wish to use this code of conduct for your own project, consider explicitly mentioning your moderation policy or making a copy with your own moderation policy so as to avoid confusion. *Adapted from the [Rust Code of Conduct](https://www.rust-lang.org/en-US/conduct.html) and the [Citizen Code of Conduct](http://citizencodeofconduct.org/). [CC-BY-SA 3.0](https://creativecommons.org/licenses/by-sa/3.0/)* ================================================ FILE: CONTRIBUTING.md ================================================ # Plasma Contributors' Information This file contains information for potential and current Plasma contributors. ## Summary and legal stuff * We prefer github pull requests or patches mailed to the [developers' mailing list](https://plasmalang.org/lists/listinfo/dev). If you need to discuss a security issue confidently you can e-mail plasma at plasmalang dot org * The license of your contribution must match the project's licenses: * Code: MIT * Docs: CC BY-SA 4.0 * Build scripts, tests, and sample code: Unlicense * No contributor agreement is required, you retain the copyright for your contribution. * Please follow the style guides as much as possible (see below) * Please format your log messages following the log message style (see below) * By submitting a PR you acknowledge these terms and agree to the [Code of Conduct](CODE_OF_CONDUCT.md) * By opening an issue/commenting/messaging you agree to the [Code of Conduct](CODE_OF_CONDUCT.md) ## What and how to contribute Full contributing information is provided [in the contributors' guide](https://plasmalang.org/docs/contributing.html). ## Submitting your changes All code contributions must be made under the appropriate license: * Code: MIT * Docs: CC BY-SA 4.0 * Build scripts, tests, and sample code: Unlicense No transfer of copyright or other rights or permissions is required. Instead we ask contributors to list themselves (pseudonyms are okay) in the AUTHORS file, not only so we can credit and honor them but so that we know who the copyright owners are. This could be important if, in the future, licensing decisions need to be made (it's unlikely but it's best for Plasma). You may choose not to be listed (e.g: if contributing a small fix) but doing so means that you agree that Paul Bone shall make any licensing decisions on your behalf. You may add your name later when making a more significant change. Log messages should follow the style: ``` [component(s)] Title Description Any other changes including changes that were needed to support this change or followed as a concequence of this change. ``` We provide a .gitmessage in the root of the repository. Run this command to start using the new commit message template: ``` git config --local commit.template /path/to/repo/.gitmessage ``` ```components``` is one or more parts of the system. This helps people identify (in mailing lists, change logs etc) what kind of change has been made at a glace. It also helps people and software search for changes. Current components are: * pz: the PZ file format, * rt: the runtime generally, * rt/interp: the bytecode interpreter, * rt/gc: the garbage collector, * asm: the PZ assembler, * compiler: the compiler generally, * compiler/parse: the first phase: parsing. * compiler/ast: the second phase: the AST and operations on it, * compiler/pre: the third phase: the pre-core representation and operations, * compiler/core: the fourth phase: the core representation and operations, * compiler/pz: the fitht phase: the PZ code generator, * compiler/util: other utility code in the compiler, * link: the bytecode linker * build: the plzbuild tool, * docs: documentation, * scripts: the build system and other scripts, * tests: the test suite, Sometimes it makes sense to pick the component with the most sagnificant changes rather than listing all of them. This is typical for changes to the compiler. Each patch should contain a single change and changes required by that change (should compile and pass tests). Changes may e rolled together when they're trivial related changes (eg, multiple spelling fixes). Also, not a real component: * merge: for merge commits (see the maintainer's guide). ================================================ FILE: LICENSE ================================================ Code ---- The code except for lex.* are: Copyright (C) 2015-2025 Plasma Team Distributed under the terms of the MIT License see LICENSE.code The `git log` indicates the members of Plasma Team src/lex.* --------- The tools currently depend on the lex library for Mercury. https://github.com/Mercury-Language/mercury/tree/master/extras/lex Copyright (C) 2001-2002 Ralph Becket Copyright (C) 2001-2002 The Rationalizer Intelligent Software AG Copyright (C) 2002, 2006, 2010-2011 The University of Melbourne Copyright (C) 2015 Paul Bone Distributed under the terms of the LGPL (no version is specified in the original. Examples -------- Examples and build scripts are released into the public domain. See LICENSE.unlicense Documentation ------------- The Plasma documentation (the contents of the doc/ directory, except for the style guides and asciidoc.css, plus the *.md files excluding CODE_OF_CONDUCT.md) is Copyright (C) 2015-2017 Plasma Team and made available under the Creative Commons Attribution-ShareAlike 4.0 International Public License See LICENSE.docs CODE_OF_CONDUCT.md is Copyright Plasma Team, Rust Project and various other authors. It is distributed under the Creative Commons Attribution-ShareAlike 3.0 license. docs/*_Style.txt ---------------- The style guides are derrived from the Mercury Project's where their copyright and licenseing terms are unclear. We use them with permission. docs/html/asciidoc.css ---------------------- Copyright (C) 2000-2007 Stuart Rackham License: GPL2 or later ================================================ FILE: LICENSE.code ================================================ The MIT License (MIT) Permission is hereby granted, free of charge, to any person obtaining a copy of this software and associated documentation files (the "Software"), to deal in the Software without restriction, including without limitation the rights to use, copy, modify, merge, publish, distribute, sublicense, and/or sell copies of the Software, and to permit persons to whom the Software is furnished to do so, subject to the following conditions: The above copyright notice and this permission notice shall be included in all copies or substantial portions of the Software. THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. ================================================ FILE: LICENSE.docs ================================================ The Plasma documentation (the contents of the doc/ directory, except for the style guides) is Copyright (C) 2015-2018 Plasma Team and made available under the Creative Commons Attribution-ShareAlike 4.0 International Public License The style guides are derived from the Mercury Project's where their copyright and licensing terms are unclear. We use them with permission. The license text is: By exercising the Licensed Rights (defined below), You accept and agree to be bound by the terms and conditions of this Creative Commons Attribution-ShareAlike 4.0 International Public License ("Public License"). To the extent this Public License may be interpreted as a contract, You are granted the Licensed Rights in consideration of Your acceptance of these terms and conditions, and the Licensor grants You such rights in consideration of benefits the Licensor receives from making the Licensed Material available under these terms and conditions. Section 1 -- Definitions. a. Adapted Material means material subject to Copyright and Similar Rights that is derived from or based upon the Licensed Material and in which the Licensed Material is translated, altered, arranged, transformed, or otherwise modified in a manner requiring permission under the Copyright and Similar Rights held by the Licensor. For purposes of this Public License, where the Licensed Material is a musical work, performance, or sound recording, Adapted Material is always produced where the Licensed Material is synched in timed relation with a moving image. b. Adapter's License means the license You apply to Your Copyright and Similar Rights in Your contributions to Adapted Material in accordance with the terms and conditions of this Public License. c. BY-SA Compatible License means a license listed at creativecommons.org/compatiblelicenses, approved by Creative Commons as essentially the equivalent of this Public License. d. Copyright and Similar Rights means copyright and/or similar rights closely related to copyright including, without limitation, performance, broadcast, sound recording, and Sui Generis Database Rights, without regard to how the rights are labeled or categorized. For purposes of this Public License, the rights specified in Section 2(b)(1)-(2) are not Copyright and Similar Rights. e. Effective Technological Measures means those measures that, in the absence of proper authority, may not be circumvented under laws fulfilling obligations under Article 11 of the WIPO Copyright Treaty adopted on December 20, 1996, and/or similar international agreements. f. Exceptions and Limitations means fair use, fair dealing, and/or any other exception or limitation to Copyright and Similar Rights that applies to Your use of the Licensed Material. g. License Elements means the license attributes listed in the name of a Creative Commons Public License. The License Elements of this Public License are Attribution and ShareAlike. h. Licensed Material means the artistic or literary work, database, or other material to which the Licensor applied this Public License. i. Licensed Rights means the rights granted to You subject to the terms and conditions of this Public License, which are limited to all Copyright and Similar Rights that apply to Your use of the Licensed Material and that the Licensor has authority to license. j. Licensor means the individual(s) or entity(ies) granting rights under this Public License. k. Share means to provide material to the public by any means or process that requires permission under the Licensed Rights, such as reproduction, public display, public performance, distribution, dissemination, communication, or importation, and to make material available to the public including in ways that members of the public may access the material from a place and at a time individually chosen by them. l. Sui Generis Database Rights means rights other than copyright resulting from Directive 96/9/EC of the European Parliament and of the Council of 11 March 1996 on the legal protection of databases, as amended and/or succeeded, as well as other essentially equivalent rights anywhere in the world. m. You means the individual or entity exercising the Licensed Rights under this Public License. Your has a corresponding meaning. Section 2 -- Scope. a. License grant. 1. Subject to the terms and conditions of this Public License, the Licensor hereby grants You a worldwide, royalty-free, non-sublicensable, non-exclusive, irrevocable license to exercise the Licensed Rights in the Licensed Material to: a. reproduce and Share the Licensed Material, in whole or in part; and b. produce, reproduce, and Share Adapted Material. 2. Exceptions and Limitations. For the avoidance of doubt, where Exceptions and Limitations apply to Your use, this Public License does not apply, and You do not need to comply with its terms and conditions. 3. Term. The term of this Public License is specified in Section 6(a). 4. Media and formats; technical modifications allowed. The Licensor authorizes You to exercise the Licensed Rights in all media and formats whether now known or hereafter created, and to make technical modifications necessary to do so. The Licensor waives and/or agrees not to assert any right or authority to forbid You from making technical modifications necessary to exercise the Licensed Rights, including technical modifications necessary to circumvent Effective Technological Measures. For purposes of this Public License, simply making modifications authorized by this Section 2(a) (4) never produces Adapted Material. 5. Downstream recipients. a. Offer from the Licensor -- Licensed Material. Every recipient of the Licensed Material automatically receives an offer from the Licensor to exercise the Licensed Rights under the terms and conditions of this Public License. b. Additional offer from the Licensor -- Adapted Material. Every recipient of Adapted Material from You automatically receives an offer from the Licensor to exercise the Licensed Rights in the Adapted Material under the conditions of the Adapter's License You apply. c. No downstream restrictions. You may not offer or impose any additional or different terms or conditions on, or apply any Effective Technological Measures to, the Licensed Material if doing so restricts exercise of the Licensed Rights by any recipient of the Licensed Material. 6. No endorsement. Nothing in this Public License constitutes or may be construed as permission to assert or imply that You are, or that Your use of the Licensed Material is, connected with, or sponsored, endorsed, or granted official status by, the Licensor or others designated to receive attribution as provided in Section 3(a)(1)(A)(i). b. Other rights. 1. Moral rights, such as the right of integrity, are not licensed under this Public License, nor are publicity, privacy, and/or other similar personality rights; however, to the extent possible, the Licensor waives and/or agrees not to assert any such rights held by the Licensor to the limited extent necessary to allow You to exercise the Licensed Rights, but not otherwise. 2. Patent and trademark rights are not licensed under this Public License. 3. To the extent possible, the Licensor waives any right to collect royalties from You for the exercise of the Licensed Rights, whether directly or through a collecting society under any voluntary or waivable statutory or compulsory licensing scheme. In all other cases the Licensor expressly reserves any right to collect such royalties. Section 3 -- License Conditions. Your exercise of the Licensed Rights is expressly made subject to the following conditions. a. Attribution. 1. If You Share the Licensed Material (including in modified form), You must: a. retain the following if it is supplied by the Licensor with the Licensed Material: i. identification of the creator(s) of the Licensed Material and any others designated to receive attribution, in any reasonable manner requested by the Licensor (including by pseudonym if designated); ii. a copyright notice; iii. a notice that refers to this Public License; iv. a notice that refers to the disclaimer of warranties; v. a URI or hyperlink to the Licensed Material to the extent reasonably practicable; b. indicate if You modified the Licensed Material and retain an indication of any previous modifications; and c. indicate the Licensed Material is licensed under this Public License, and include the text of, or the URI or hyperlink to, this Public License. 2. You may satisfy the conditions in Section 3(a)(1) in any reasonable manner based on the medium, means, and context in which You Share the Licensed Material. For example, it may be reasonable to satisfy the conditions by providing a URI or hyperlink to a resource that includes the required information. 3. If requested by the Licensor, You must remove any of the information required by Section 3(a)(1)(A) to the extent reasonably practicable. b. ShareAlike. In addition to the conditions in Section 3(a), if You Share Adapted Material You produce, the following conditions also apply. 1. The Adapter's License You apply must be a Creative Commons license with the same License Elements, this version or later, or a BY-SA Compatible License. 2. You must include the text of, or the URI or hyperlink to, the Adapter's License You apply. You may satisfy this condition in any reasonable manner based on the medium, means, and context in which You Share Adapted Material. 3. You may not offer or impose any additional or different terms or conditions on, or apply any Effective Technological Measures to, Adapted Material that restrict exercise of the rights granted under the Adapter's License You apply. Section 4 -- Sui Generis Database Rights. Where the Licensed Rights include Sui Generis Database Rights that apply to Your use of the Licensed Material: a. for the avoidance of doubt, Section 2(a)(1) grants You the right to extract, reuse, reproduce, and Share all or a substantial portion of the contents of the database; b. if You include all or a substantial portion of the database contents in a database in which You have Sui Generis Database Rights, then the database in which You have Sui Generis Database Rights (but not its individual contents) is Adapted Material, including for purposes of Section 3(b); and c. You must comply with the conditions in Section 3(a) if You Share all or a substantial portion of the contents of the database. For the avoidance of doubt, this Section 4 supplements and does not replace Your obligations under this Public License where the Licensed Rights include other Copyright and Similar Rights. Section 5 -- Disclaimer of Warranties and Limitation of Liability. a. UNLESS OTHERWISE SEPARATELY UNDERTAKEN BY THE LICENSOR, TO THE EXTENT POSSIBLE, THE LICENSOR OFFERS THE LICENSED MATERIAL AS-IS AND AS-AVAILABLE, AND MAKES NO REPRESENTATIONS OR WARRANTIES OF ANY KIND CONCERNING THE LICENSED MATERIAL, WHETHER EXPRESS, IMPLIED, STATUTORY, OR OTHER. THIS INCLUDES, WITHOUT LIMITATION, WARRANTIES OF TITLE, MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE, NON-INFRINGEMENT, ABSENCE OF LATENT OR OTHER DEFECTS, ACCURACY, OR THE PRESENCE OR ABSENCE OF ERRORS, WHETHER OR NOT KNOWN OR DISCOVERABLE. WHERE DISCLAIMERS OF WARRANTIES ARE NOT ALLOWED IN FULL OR IN PART, THIS DISCLAIMER MAY NOT APPLY TO YOU. b. TO THE EXTENT POSSIBLE, IN NO EVENT WILL THE LICENSOR BE LIABLE TO YOU ON ANY LEGAL THEORY (INCLUDING, WITHOUT LIMITATION, NEGLIGENCE) OR OTHERWISE FOR ANY DIRECT, SPECIAL, INDIRECT, INCIDENTAL, CONSEQUENTIAL, PUNITIVE, EXEMPLARY, OR OTHER LOSSES, COSTS, EXPENSES, OR DAMAGES ARISING OUT OF THIS PUBLIC LICENSE OR USE OF THE LICENSED MATERIAL, EVEN IF THE LICENSOR HAS BEEN ADVISED OF THE POSSIBILITY OF SUCH LOSSES, COSTS, EXPENSES, OR DAMAGES. WHERE A LIMITATION OF LIABILITY IS NOT ALLOWED IN FULL OR IN PART, THIS LIMITATION MAY NOT APPLY TO YOU. c. The disclaimer of warranties and limitation of liability provided above shall be interpreted in a manner that, to the extent possible, most closely approximates an absolute disclaimer and waiver of all liability. Section 6 -- Term and Termination. a. This Public License applies for the term of the Copyright and Similar Rights licensed here. However, if You fail to comply with this Public License, then Your rights under this Public License terminate automatically. b. Where Your right to use the Licensed Material has terminated under Section 6(a), it reinstates: 1. automatically as of the date the violation is cured, provided it is cured within 30 days of Your discovery of the violation; or 2. upon express reinstatement by the Licensor. For the avoidance of doubt, this Section 6(b) does not affect any right the Licensor may have to seek remedies for Your violations of this Public License. c. For the avoidance of doubt, the Licensor may also offer the Licensed Material under separate terms or conditions or stop distributing the Licensed Material at any time; however, doing so will not terminate this Public License. d. Sections 1, 5, 6, 7, and 8 survive termination of this Public License. Section 7 -- Other Terms and Conditions. a. The Licensor shall not be bound by any additional or different terms or conditions communicated by You unless expressly agreed. b. Any arrangements, understandings, or agreements regarding the Licensed Material not stated herein are separate from and independent of the terms and conditions of this Public License. Section 8 -- Interpretation. a. For the avoidance of doubt, this Public License does not, and shall not be interpreted to, reduce, limit, restrict, or impose conditions on any use of the Licensed Material that could lawfully be made without permission under this Public License. b. To the extent possible, if any provision of this Public License is deemed unenforceable, it shall be automatically reformed to the minimum extent necessary to make it enforceable. If the provision cannot be reformed, it shall be severed from this Public License without affecting the enforceability of the remaining terms and conditions. c. No term or condition of this Public License will be waived and no failure to comply consented to unless expressly agreed to by the Licensor. d. Nothing in this Public License constitutes or may be interpreted as a limitation upon, or waiver of, any privileges and immunities that apply to the Licensor or You, including from the legal processes of any jurisdiction or authority. ======================================================================= Creative Commons is not a party to its public licenses. Notwithstanding, Creative Commons may elect to apply one of its public licenses to material it publishes and in those instances will be considered the “Licensor.” The text of the Creative Commons public licenses is dedicated to the public domain under the CC0 Public Domain Dedication. Except for the limited purpose of indicating that material is shared under a Creative Commons public license or as otherwise permitted by the Creative Commons policies published at creativecommons.org/policies, Creative Commons does not authorize the use of the trademark "Creative Commons" or any other trademark or logo of Creative Commons without its prior written consent including, without limitation, in connection with any unauthorized modifications to any of its public licenses or any other arrangements, understandings, or agreements concerning use of licensed material. For the avoidance of doubt, this paragraph does not form part of the public licenses. Creative Commons may be contacted at creativecommons.org. ================================================ FILE: LICENSE.unlicense ================================================ Some files in this project are free and unencumbered software released into the public domain. Anyone is free to copy, modify, publish, use, compile, sell, or distribute this software, either in source code form or as a compiled binary, for any purpose, commercial or non-commercial, and by any means. In jurisdictions that recognize copyright laws, the author or authors of this software dedicate any and all copyright interest in the software to the public domain. We make this dedication for the benefit of the public at large and to the detriment of our heirs and successors. We intend this dedication to be an overt act of relinquishment in perpetuity of all present and future rights to this software under copyright law. THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. For more information, please refer to ================================================ FILE: Makefile ================================================ # # This is free and unencumbered software released into the public domain. # See ../LICENSE.unlicense # # vim: noet sw=4 ts=4 # # ====================== # # No configuration here # See build.mk include defaults.mk -include build.mk # # ====================== # As the build system gets more complex I want to avoid autoconf. Perhaps # instead create a config.h and makefile for each major OS+platform # combination. An optional configure script could put the right file in # place. Also consider autosetup. vpath %.m src vpath %.c runtime vpath %.cpp runtime vpath %.h runtime vpath %.o runtime vpath %.txt docs vpath %.html docs/html MERCURY_SOURCES=$(wildcard src/*.m) # There are no C sources but we keep this in case we add some C code (eg # a library interface.) The tags target will need to be fixed if C sources # are added. C_SOURCES= # NOTE that when we add alternative interpreters we'll need to seperate out # the generic files, that includes updating pz_closure.h so it includes # different files. CXX_SOURCES=runtime/pz_main.cpp \ runtime/pz.cpp \ runtime/pz_builtin.cpp \ runtime/pz_code.cpp \ runtime/pz_data.cpp \ runtime/pz_foreign.cpp \ runtime/pz_generic_closure.cpp \ runtime/pz_generic_builtin.cpp \ runtime/pz_generic_run.cpp \ runtime/pz_gc.cpp \ runtime/pz_gc_alloc.cpp \ runtime/pz_gc_collect.cpp \ runtime/pz_gc_util.cpp \ runtime/pz_instructions.cpp \ runtime/pz_io.cpp \ runtime/pz_library.cpp \ runtime/pz_memory.cpp \ runtime/pz_option.cpp \ runtime/pz_read.cpp \ runtime/pz_string.cpp \ runtime/pz_generic.cpp \ runtime/pz_generic_builder.cpp C_CXX_SOURCES=$(C_SOURCES) $(CXX_SOURCES) C_HEADERS=$(wildcard runtime/*.h) OBJECTS=$(patsubst %.c,%.o,$(C_SOURCES)) $(patsubst %.cpp,%.o,$(CXX_SOURCES)) DOCS_HTML=docs/index.html \ docs/getting_started.html \ docs/user_guide.html \ docs/plasma_ref.html \ docs/contributing.html \ docs/dev_howto_make_pr.html \ docs/dev_compiler_internals.html \ docs/dev_testing.html \ docs/dev_style_mercury.html \ docs/dev_style_c.html \ docs/dev_mercury_grades.html \ docs/dev_maintainers.html \ docs/dev_bugtracking.html \ docs/design_principles.html \ docs/design_concept_map.html \ docs/design_types.html \ docs/design_ideas.html \ docs/references.html \ docs/pz_machine.html # Extra development modules ifeq ($(BUILD_TYPE),dev) CXX_SOURCES+= \ runtime/pz_gc_debug.cpp \ runtime/pz_trace.cpp else endif ifneq ($(shell which $(ASCIIDOC)),) DOCS_TARGETS=$(DOCS_HTML) else DOCS_TARGETS=.docs_warning endif CFLAGS=$(DEPFLAGS) $(C_CXX_FLAGS) $(C_ONLY_FLAGS) CXXFLAGS=$(DEPFLAGS) $(C_CXX_FLAGS) $(CXX_ONLY_FLAGS) $(shell mkdir -p $(DEPDIR)/runtime >/dev/null) .SUFFIXES: .PHONY: all all : progs docs .PHONY: progs progs : \ runtime/plzrun \ src/plzasm \ src/plzbuild \ src/plzc \ src/plzdisasm \ src/plzgeninit \ src/plzlnk .PHONY: install install: install_progs install_docs install_examples .PHONY: install_dirs install_dirs: $(INSTALL_DIR) $(DEST_DIR)$(BINDIR) $(INSTALL_DIR) $(DEST_DIR)$(DOCDIR) .PHONY: install_progs install_progs : install_dirs progs $(INSTALL_STRIP) runtime/plzrun $(DEST_DIR)$(BINDIR) $(INSTALL_STRIP) src/plzasm $(DEST_DIR)$(BINDIR) $(INSTALL_STRIP) src/plzbuild $(DEST_DIR)$(BINDIR) $(INSTALL_STRIP) src/plzc $(DEST_DIR)$(BINDIR) $(INSTALL_STRIP) src/plzdisasm $(DEST_DIR)$(BINDIR) $(INSTALL_STRIP) src/plzgeninit $(DEST_DIR)$(BINDIR) $(INSTALL_STRIP) src/plzlnk $(DEST_DIR)$(BINDIR) .PHONY: install_docs install_docs : install_dirs docs cd docs/ ; for FILE in $$(find -name '*.txt' -o -name '*.html' ); do \ $(INSTALL) $$FILE $(DEST_DIR)$(DOCDIR); \ done if [ -f docs/index.html ]; then \ $(INSTALL_DIR) $(DEST_DIR)$(DOCDIR)/css; \ $(INSTALL_DIR) $(DEST_DIR)$(DOCDIR)/images; \ $(INSTALL) docs/css/asciidoc.css $(DEST_DIR)$(DOCDIR)/css; \ $(INSTALL) docs/css/docs-offline.css $(DEST_DIR)$(DOCDIR)/css; \ $(INSTALL) docs/images/favicon.ico $(DEST_DIR)$(DOCDIR)/images; \ $(INSTALL) docs/images/sunt-200.png $(DEST_DIR)$(DOCDIR)/images; \ fi .PHONY: install_examples install_examples : install_dirs $(INSTALL_DIR) $(DEST_DIR)$(DOCDIR)/examples $(INSTALL) examples/BUILD.plz $(DEST_DIR)$(DOCDIR)/examples $(INSTALL) examples/README.md $(DEST_DIR)$(DOCDIR)/examples $(INSTALL) examples/hello.p $(DEST_DIR)$(DOCDIR)/examples $(INSTALL) examples/fib.p $(DEST_DIR)$(DOCDIR)/examples $(INSTALL) examples/module_example.p $(DEST_DIR)$(DOCDIR)/examples $(INSTALL) examples/module_to_import.p $(DEST_DIR)$(DOCDIR)/examples $(INSTALL) examples/mr4.p $(DEST_DIR)$(DOCDIR)/examples $(INSTALL) examples/temperature.p $(DEST_DIR)$(DOCDIR)/examples # .mer_progs must be real and not a phony target to make this work with # make -j src/plzasm : .mer_progs touch src/plzasm src/plzbuild : .mer_progs touch src/plzbuild src/plzc : .mer_progs touch src/plzc src/plzdisasm : .mer_progs touch src/plzdisasm src/plzgeninit : .mer_progs touch src/plzgeninit src/plzlnk : .mer_progs touch src/plzlnk .mer_progs : $(MERCURY_SOURCES) runtime/pz_config.h $(C_HEADERS) rm -f src/*.err (cd src; $(MMC_MAKE) --cflags="$(C_CXX_FLAGS_BASE)" $(MCFLAGS) plzasm) (cd src; $(MMC_MAKE) --cflags="$(C_CXX_FLAGS_BASE)" $(MCFLAGS) plzbuild) (cd src; $(MMC_MAKE) --cflags="$(C_CXX_FLAGS_BASE)" $(MCFLAGS) plzc) (cd src; $(MMC_MAKE) --cflags="$(C_CXX_FLAGS_BASE)" $(MCFLAGS) plzdisasm) (cd src; $(MMC_MAKE) --cflags="$(C_CXX_FLAGS_BASE)" $(MCFLAGS) plzgeninit) (cd src; $(MMC_MAKE) --cflags="$(C_CXX_FLAGS_BASE)" $(MCFLAGS) plzlnk) touch .mer_progs # We need -rdynamic here so that the foreign code libraries can resolve # symbols in the runtime's executable. runtime/plzrun : $(OBJECTS) $(CXX) $(CFLAGS) -o $@ $^ -ldl -rdynamic %.o : %.c runtime/pz_config.h $(CC) $(CFLAGS) -o $@ -c $< mv -f $(DEPDIR)/$(basename $*).Td $(DEPDIR)/$(basename $*).d %.o : %.cpp runtime/pz_config.h $(CXX) $(CXXFLAGS) -o $@ -c $< mv -f $(DEPDIR)/$(basename $*).Td $(DEPDIR)/$(basename $*).d runtime/pz_config.h : runtime/pz_config.h.in defaults.mk build.mk sed -e 's/@VERSION@/${VERSION}/' < $< > $@ $(DEPDIR)/%.d : ; .PRECIOUS: $(DEPDIR)/%.d .PHONY: test test : test-old test-new .PHONY: test-old test-old : src/plzasm src/plzlnk src/plzc src/plzbuild runtime/plzrun (cd tests-old; ./run_tests.sh $(BUILD_TYPE)) .PHONY: test-new test-new : src/plzasm src/plzlnk src/plzc src/plzbuild runtime/plzrun BUILD_TYPE=$(BUILD_TYPE) ./tests/run-tests.lua examples tests | ./tests/pretty.lua .PHONY: tags tags : src/tags runtime/tags src/tags : $(MERCURY_SOURCES) (cd src; mtags *.m) runtime/tags: $(CXX_SOURCES) $(C_HEADERS) (cd runtime; ctags *.cpp *.h) .PHONY: docs docs : $(DOCS_TARGETS) .docs_warning : @echo @echo Warning: $(ASCIIDOC) not found, not building documentation. @echo -------------------------------------------------------- @echo touch .docs_warning %.html : %.txt docs/asciidoc.conf $(ASCIIDOC) --conf-file docs/asciidoc.conf -o $@ $< # # Clean removes all intermediate files # .PHONY: clean clean : localclean $(MAKE) -C examples clean $(MAKE) -C tests-old/pzt clean $(MAKE) -C tests-old/modules clean $(MAKE) -C tests-old/modules-invalid clean find tests -name *.pz -o \ -name *.pzo -o \ -name *.pi -o \ -name *.out -o \ -name *.outs -o \ -name *.so \ | xargs -r rm find tests -name _build -o \ -name \*.dir \ | xargs -r rm -r # # Realclean removes all generated files plus plasma-dump files. # .PHONY: realclean realclean : localclean $(MAKE) -C examples realclean $(MAKE) -C tests-old/pzt realclean $(MAKE) -C tests-old/modules realclean $(MAKE) -C tests-old/modules-invalid realclean rm -f src/tags rm -f src/plzasm src/plzbuild src/plzc src/plzdisasm src/plzgeninit \ src/plzlnk rm -rf src/Mercury rm -f .mer_progs rm -rf runtime/tags runtime/plzrun rm -rf $(DOCS_HTML) .PHONY: localclean localclean: for dir in \ date0s \ date3s \ dates \ err_dates \ int0s \ int2s \ int3s \ ints \ module_deps ; \ do \ rm -rf src/Mercury/$$dir; \ done for dir in cs os c_dates ; do \ rm -rf src/Mercury/*/*/Mercury/$$dir; \ done rm -rf src/*.err src/*.mh rm -rf runtime/*.o runtime/pz_config.h rm -rf examples/*.pz examples/*.diff examples/*.out rm -rf .docs_warning rm -rf $(DEPDIR) # Nither formatting tool does a perfect job, but clang-format seems to be # the best. .PHONY: format format: formatclangformat .PHONY: formatclangformat formatclangformat: $(CLANGFORMAT) -style=file -i $(C_SOURCES) $(CXX_SOURCES) $(C_HEADERS) include $(wildcard $(patsubst %,$(DEPDIR)/%.d,$(basename $(C_CXX_SOURCES)))) ================================================ FILE: README.md ================================================ # Plasma Language ## *a new programming language* Plasma is a new programming language for safe and efficient general purpose use. It is a statically typed, side-effect free single assignment language and will have functional programming and concurrent programming features. It will support deterministic parallel execution. For a general overview, please visit [https://plasmalang.org/](https://plasmalang.org/) It is in early development. It is free software, Copyright (C) 2015-2025 The Plasma Team, distributed mostly under the MIT license, see [LICENSE](LICENSE) for details. ![CI](https://github.com/PlasmaLang/plasma/workflows/CI/badge.svg) ## Getting started This README.md contains some quick info for getting started. For more complete info please see our [getting started guide](https://plasmalang.org/docs/getting_started.html). ### Dependencies Plasma has been tested on Linux, Windows subsystem for Linux 1 and 2 on x86\_64. You will need: * A C compiler (C99 on a POSIX.1-2008 environment), I've been testing with GCC. Clang should also work. * GNU Make * [Mercury](https://www.mercurylang.org/). A recent stable version is required (22.01.x). Plasma's CI currently tests with 22.01. * The [ninja build system](https://ninja-build.org), at least version 1.10. Optionally to build the documentation you will also need: * asciidoc * source-highlight Optionally to run the test suite you will also need: * lua * lua-file-system * lua-posix * lua-curses * diffutils * ncurses On Debian (also Ubuntu, Mint etc) Linux $ apt install build-essential ninja-build lua5.3 lua-filesystem lua-posix diffutils asciidoc source-highlight ncurses-bin Will get you started, then proceed to installing Mercury below. ### Mercury installation The easiest way to install Mercury is to install the [.deb packages](https://dl.mercurylang.org/deb/) (on Debian, Ubuntu, etc). Otherwise download Mercury's [source package](https://dl.mercurylang.org) and follow the installation instructions in the [INSTALL](https://github.com/Mercury-Language/mercury/blob/master/.INSTALL.in) file. We've made some [notes about grades](https://plasmalang.org/docs/grades.html) that may help with choosing which grades you may need. There is also a [README.bootstrap](https://github.com/Mercury-Language/mercury/blob/master/README.bootstrap) file with Mercury bootstrapping information if you wish to do that, it may also provide some additional explaination. ### Usage Copy `template.mk` to `build.mk` and edit it to make any build configuration changes you need. Use ```make``` in the root directory to build the project. Then ```make install`` to install the tools into ```$PREFIX/bin```. This compiles and installs the following programs. Make sure they're in your ```PATH```. * src/plzc - The plasma compiler, compiles plasma (```.p```) files to plasma modules (```.pzo```) * src/plzlnk - The plasma linker, links one more more modules (```.pzo```) into a plasma program (```.pz```) * src/plzbuild - The plasma build system * runtime/plzrun - The runtime system, executes plasma programs (```.pz```). * src/plzasm - The plasma bytecode assembler. This compiles textual bytecode (```.pzt```) to bytecode (```.pzo```). It is useful for testing the runtime. There are example plasma programs in ```examples/```. Running ```plzbuild``` in ```examples/``` will build them. Each program's bytecode is copied to a file in ```examples/``` eg ```hello.pz```, run them with ```plzrun ```. ### Layout * [docs](docs) - Documentation * [examples](examples) - Example Plasma programs * [runtime](runtime) - Runtime system (C code) * [scripts](scripts) - Some scripts to aid developers * [src](src) - The compiler and other tools * [tests](tests) - The test suite (in addition to some of the files in [examples](examples)) ## Contributing Please see [CONTRIBUTING.md](CONTRIBUTING.md) and [CODE_OF_CONDUCT.md](CODE_OF_CONDUCT.md). For detailed information including what to work on please see [Contributing to Plasma](https://plasmalang.org/docs/contributing.html) in our documentation. ## Getting help If you're stuck and the [Documentation](https://plasmalang.org/docs/) doesn't contain the answer or clue you need or you're struggling to find it. Please ask for help. The [Contact](https://plasmalang.org/contact.html) page of the website lists all the ways you can get in touch. In particular the [Plasma Help mailing list](https://plasmalang.org/lists/listinfo/help) and [Discord server](https://discord.gg/x4g83w7tKh) are the best resources for help. For bugs or missing information please [file a bug](https://github.com/PlasmaLang/plasma/issues/new). ================================================ FILE: SECURITY.md ================================================ # Security Policy ## Supported Versions The master branch is currently the only "supported" version. In the future there will be stable / development versions with various support lengths. The bytecode/runtime is not designed as a secure execution environment. Bad bytecode can run arbitrary code / cause crashes. For a secure bytecode/interpreter consider using [WebAssembly](https://webassembly.org). ## Reporting a Vulnerability Write an e-mail to `bugs@plasmalang.org`. Do not submit a PR or issue, Github does not support "private" PRs and they shouldn't be used to share information that could lead to users being harmed if shared publicly. ================================================ FILE: THANKS ================================================ Thanks ====== Plasma is primarly developed by Paul Bone. We would also like to thank the following people for their contributions and support: Code contributions by: CcxWrk Gert Meulyzer Jace Benson James Barnes Jeremy Wright Manu Abraham rightfold (https://github.com/rightfold) Website contributions by: Anne Ogborn Slavfox (https://github.com/slavfox) Tobin Harding Brainstorming/checking, discussions and general support: Brendan Zabarauskas Emily McDonough (AlaskanEmily) Gert Meulyzer Michael Richter ================================================ FILE: defaults.mk ================================================ # # This is free and unencumbered software released into the public domain. # See ../LICENSE.unlicense # # vim: noet sw=4 ts=4 ft=make # # Where programs are installed PREFIX=/usr/local BINDIR=$(PREFIX)/bin DOCDIR=$(PREFIX)/share/doc/plasma VERSION=dev # The number of parallel jobs the Mercury compiler should spawn. JOBS=$(shell if X=$$(nproc 2>&1); then echo $$X; else echo 1; fi) # How the Mercury compiler should be called. You may need to adjust this if # it is not in your path. MMC_MAKE=mmc --make -j$(JOBS) --use-grade-subdirs # How the C compiler should be called. gcc and clang should both work. # Note that Mercury has its own configuration for its C backend, which is # not, and must not be changed here. # Note also that we'd normally define _DEFAULT_SOURCE once in # C_CXX_FLAGS_BASE, but Mercury also defines this so we avoid a warning by # listing it twice for C_ONLY then CXX_ONLY. CC=gcc CXX=g++ C_CXX_FLAGS_BASE=-D_POSIX_C_SOURCE=200809L C_ONLY_FLAGS=-std=c99 -D_DEFAULT_SOURCE CXX_ONLY_FLAGS=-std=c++11 -fno-rtti -fno-exceptions -D_DEFAULT_SOURCE MCFLAGS= # gcc and probably clang support dependency tracking. If your compiler # doesn't uncomment the 2nd line. DEPDIR=.dep DEPFLAGS=-MT $@ -MMD -MP -MF $(DEPDIR)/$(basename $*).Td # How to install programs, specify here the owner, group and mode of # installed files. INSTALL=install INSTALL_STRIP=install -s INSTALL_DIR=install -d # How to call asciidoc (optional). A full path or any flags here won't work # without other changes to the makefile. ASCIIDOC=asciidoc # How to call clang-format (optional) CLANGFORMAT=clang-format-10 # This base configuration works on Linux but you may need to change them for # other systems / compilers. C_CXX_FLAGS=$(C_CXX_FLAGS_BASE) -O1 -Wall BUILD_TYPE=rel # This is a suitable build for development. It has assertions enabled in # the C code some of which are slow, so they shouldn't be used for # performance measurement. Comment it out to use one of the optimised # builds below. # # Note to maintainers: When Plasma is actually "used" we should change this # default and provide a better way for developers to setup a "dev" build # with assertions and other checks. # Development build options MCFLAGS+=--warn-dead-procs C_CXX_FLAGS+=-Werror -DDEBUG -DPZ_DEV BUILD_TYPE=dev ================================================ FILE: docs/.gitignore ================================================ *.html ================================================ FILE: docs/README.md ================================================ Documentation ============= We're assuming you are running Linux. For Mac it will probably be similar. Since Plasma is currently not supported on Windows, building the docs on that platform is also not documented. You will need a working copy of AsciiDoc on your PC to build the documentation. For Ubuntu, it is simply a matter of typing ```shell sudo apt-get install asciidoc source-highlight ``` For Fedora: ```shell sudo dnf install asciidoc ``` For other distros, check your package manager. You also need to install [source-highlight](https://www.gnu.org/software/src-highlite/source-highlight.html) to get the C code properly highlighted. Your package manager should also have this. With these installed, you should be set. To build the documentation type ``make docs`` in the project's top-level directory. This will generate the HTML output. ================================================ FILE: docs/asciidoc.conf ================================================ [attributes] linkcss=yes backend=html5 [header] Plasma Programming Language: {doctitle} {docinfo1,docinfo2#}{include:{docdir}/docinfo.html} {docinfo,docinfo2#}{include:{docdir}/{docname}-docinfo.html}
[footer] {disable-javascript%
} ================================================ FILE: docs/contributing.txt ================================================ Contributing to Plasma ====================== :Author: Paul Bone :Email: paul@plasmalang.org :Date: September, 2022 :Copyright: Copyright (C) Plasma Team :License: CC BY-SA 4.0 :toc: This file contains information for potential and current Plasma contributors. == Summary and legal stuff * We prefer github pull requests or patches mailed to the https://plasmalang.org/lists/listinfo/dev[developers' mailing list]. If you need to discuss a security issue confidently you can e-mail plasma at plasmalang dot org * The license of your contribution must match the project's licenses: ** Code: MIT ** Docs: CC BY-SA 4.0 ** Build scripts, tests, and sample code: Unlicense * No contributor agreement is required, you retain the copyright for your contribution. * Please follow the style guides as much as possible (see below) * Please format your log messages following the log message style (see below) * By opening a PR you acknowledge these terms and agree to the https://github.com/PlasmaLang/plasma/blob/master/CODE_OF_CONDUCT.md[Code of Conduct]. * By opening an issue or adding a comment or message you also agree to the https://github.com/PlasmaLang/plasma/blob/master/CODE_OF_CONDUCT.md[Code of Conduct]. == Getting started For information on how to setup the dependencies and compile Plasma the best place to start is the link:getting_started.html[Getting Started] Guide. === vim If you'll be working on the compiler you probably want some editor support for Mercury. Support is included in the https://github.com/Mercury-Language/mercury/tree/master/vim[Mercury repository]/source distribution if you've used the Debian package it's at `/usr/share/doc/mercury-rotd-tools/examples/vim/` You may also wish to use the https://github.com/PlasmaLang/plasma/tree/master/scripts[extra script] and configuration change to make it easier to build the Mercury sources from within vim. == What to contribute You want to contribute but aren't sure what you'd like to work on? The most valuable contributions will fit with Plasma's https://plasmalang.org/about.html[goals] and current development status (https://plasmalang.org/roadmap.html[project roadmap]). The project is at an early stage and therefore we are prioritising work that makes the language useful above things like compiler optimisations. === Suggestions and good first bugs If you're looking for a suggestion of what to contribute please consider the https://github.com/PlasmaLang/plasma/issues?q=is%3Aopen+is%3Aissue+no%3Aassignee[open unassigned github issues] We label our issues within github to help searchability but also to provide some ideas about what is involved with each issue. Some issues have the https://github.com/PlasmaLang/plasma/issues?q=is%3Aopen+is%3Aissue+no%3Aassignee+label%3A%22meta%3A+good-first-bug%22[good-first-bug] label. These tend to be really small changes that require relatively little experience to complete. They should take someone with a year of programming experience no more than 2 hours, usually much less. They might not be suitable for someone in their first month or two of programming. The https://github.com/PlasmaLang/plasma/issues?utf8=%E2%9C%93&q=is%3Aopen+is%3Aissue+no%3Aassignee+label%3A%22meta%3A+no-domain-knowledge%22+[no-domain-knowledge] label contains more difficult changes. These may require a fair amount of programming experience but they do not require any programming language implementation experience, or otherwise have very clear help. Other labels can indicate what component they are relevant to, for example: 'component: docs' or 'component: compiler'. Or what skills may be required 'skill: C++'. There is also a https://github.com/PlasmaLang/plasma/issues?q=is%3Aopen+is%3Aissue+label%3A%22meta%3A+help+wanted%22[help wanted] label for anything where people already involved with the project might not have the skills we think are required. If you file a new bug, do not worry about adding labels, a project maintainer will follow link:bugtracking.html[this guide] to triage it. There are also many `TODO` and `XXX` notes in the source code, which things that are not handled. Search for the strings `TODO` and `XXX`. Keep in mind that there may be good reasons why these are not yet handled, eg: it may depend on other incomplete work. If you find something undocumented whose behaviour is unlikely to change, consider filling in that part of the documentation. When reading code if something isn't clear, please ask us about it. We'll also take this as a hint that we should have written (better) code comments or docs. === Get in contact If you've got a big idea it's often good to https://plasmalang.org/lists/listinfo/dev[discuss it with us] before starting. We may be able to give you some pointers or let you know what kinds of problems you may encounter. For example we might not be interested n making the language weakly typed and discussing this beforehand may avoid disappointment later. Ultimately we want you to enjoy working with Plasma and that means making the most of your development time. == How to contribute We want to build a great language and we also want you/us to have a good time building a great language. These guidelines will make it easier for us to review and maintain your code, and hopefully for you to have a better experience during code-review. === Before beginning It is best to start each piece of work on a new git branch. Create a branch off of master and commit your changes there as you go. Open/comment on/assign yourself on an issue. Let us know what you want to work as part of github's issue tracking (see above). We can add you to the Plasma project so that you can be assigned to an issue, then we know who is working on it. === Making your changes If you're making a series of patches, try to organise the patches so that each patch makes sense on its own. Git has many features for doing this including cherry picking and rebasing. Code contributions should follow the style guides as much as possible. Deviations that make code more readable are permitted. The guides are https://plasmalang.org/docs/Mercury_style.html[Mercury style guide] and https://plasmalang.org/docs/C_style.html[C style guide]. TODO: Provide information about project structure. Spell check and test your work, use +make test+ for the latter. Each patch should, when applied in series, pass the test suite. === Documenting your changes User-visible changes including new options, features and behaviours should be documented. For now options are documented in the `--help` text of each program. While designs and concepts are documented in one of the files in the docs directory, these files are asciidoc text files. === Submitting your changes All code contributions must be made under the appropriate license: * Code: MIT * Docs: CC BY-SA 4.0 * Build scripts, tests, and sample code: Unlicense No transfer of copyright or other rights or permissions is required. Log messages should follow the style: [component(s)] Title Description Any other changes including changes that were needed to support this change or followed as a concequence of this change. We provide a +.gitmessage+ in the root of the repository. Run this command to start using the new commit message template: git config --local commit.template /path/to/repo/.gitmessage _components_ is one or more parts of the system. This helps people identify (in mailing lists, change logs etc) what kind of change has been made at a glace. It also helps people and software search for changes. Current components are: * *pz*: the PZ file format, * *rt*: the runtime generally, * *rt/interp*: the bytecode interpreter, * *rt/gc*: the garbage collector, * *asm*: the PZ assembler, * *compiler*: the compiler generally, * *compiler/parse*: the first phase: parsing. * *compiler/ast*: the second phase: the AST and operations on it, * *compiler/pre*: the third phase: the pre-core representation and operations, * *compiler/core*: the fourth phase: the core representation and operations, * *compiler/pz*: the fitht phase: the PZ code generator, * *compiler/util*: other utility code in the compiler, * *build*: the build system, * *docs*: documentation, * *scripts*: the build system and other scripts, * *tests*: the test suite, Sometimes it makes sense to pick the component with the most significant changes rather than listing all of them. This is typical for changes to the compiler. Each patch should contain a single change and changes required by that change (should compile and pass tests). Changes may be rolled together when they're trivial related changes (eg, multiple spelling fixes). Also, not a real component: * *merge*: for merge commits (See the link:maintainers.html[Maintainer's guide]) We accept contributions via pull request on github, or via e-mailed patches. If you choose to use e-mailed patches then the +git format-patchi+ and/or +git send-email+ tools can generate nice e-mails, however this is not required, +diff -uNr+ is sufficient. E-mailed patches should be sent to the https://www.plasmalang.org/lists/listinfo/dev[dev] mailing list. TODO: Provide suitable step-by-step instructions. === Our review policy We aim to act on your changes reasonably quickly. However this is something people do in their spare time, they may be busy with other aspects of their lives and not reply for several days. We will provide feedback and guidance where applicable. We want you to enjoy working with Plasma and that means we will try to help you make the most of your development time. A reviewer accepting your code will ask themselves "Does this change make Plasma better?" if the answer is yes and you're a first time contributor, they'll click the merge button and might follow-up with some further changes of their own (eg for style). If you're more experienced they'll be a greater expectation on you to confirm to style and cover edge cases. == Further documentation Documentation on specific topics of interest to Plasma implementors can be found here. link:dev_howto_make_pr.html[How to make a pull request] link:dev_compiler_internals.html[Compiler structure/internals] link:dev_testing.html[Plasma test suite] link:dev_style_mercury.html[Mercury style guide] link:dev_style_c.html[C and C++ style guide] link:dev_mercury_grades.html[Mercury grades] For maintainers: link:dev_maintainers.html[Plasma maintainer's guide] link:dev_bugtracking.html[Bugtracking] Language design: link:design_principles.html[Language design principles] link:design_concept_map.html[Plasma Syntax to Concept Map] link:design_types.html[Type System Design] link:design_ideas.html[Ideas for Plasma] link:references.html[References and Links] Plasma bytecode and abstract machine (PZ): link:pz_machine.html[Plasma Abstract Machine] https://github.com/PlasmaLang/plasma/blob/master/runtime/pz_format.h[Plasma Bytecode Format] == Getting help If you're stuck and the https://plasmalang.org/docs/[Documentation] doesn't contain the answer or clue you need, or you're struggling to find it. Please ask for help. The https://plasmalang.org/contact.html[Contact] page of the website lists all the ways you can get in touch. In particular the https://plasmalang.org/lists/listinfo/help[Plasma Help mailing list] and https://discord.gg/x4g83w7tKh[Discord server] are the best resources for help. For bugs or missing information please https://github.com/PlasmaLang/plasma/issues/new[file a bug]. // vim: set syntax=asciidoc: ================================================ FILE: docs/css/asciidoc.css ================================================ /* Shared CSS for AsciiDoc xhtml11 and html5 backends */ /* Copyright (C) 2000-2007 Stuart Rackham */ /* Copyright (C) Plasma Team (adapted for plasmalang.org) */ /* License: GPL2 or later */ /* Default font. */ body { font-family: Georgia,serif; } .content h1, .content h2, .content h3 { border-bottom: 2px solid silver; } h2 { padding-top: 0.5em; } h3 { float: left; } h3 + * { clear: left; } h5 { font-size: 1.0em; } .monospaced, code, pre { font-family: "Courier New", Courier, monospace; font-size: inherit; color: navy; padding: 0; margin: 0; } pre { white-space: pre-wrap; } #author { font-weight: bold; font-size: 1.1em; } #email { } #revnumber, #revdate, #revremark { } #footer { font-size: small; border-top: 2px solid silver; padding-top: 0.5em; margin-top: 4.0em; } #footer-text { float: left; padding-bottom: 0.5em; } #footer-badges { float: right; padding-bottom: 0.5em; } #preamble { margin-top: 1.5em; margin-bottom: 1.5em; } div.imageblock, div.exampleblock, div.verseblock, div.quoteblock, div.literalblock, div.listingblock, div.sidebarblock, div.admonitionblock { margin-top: 1.0em; margin-bottom: 1.5em; } div.admonitionblock { margin-top: 2.0em; margin-bottom: 2.0em; margin-right: 10%; color: #606060; } /* Block element titles. */ div.title, caption.title { font-weight: bold; text-align: left; margin-top: 1.0em; margin-bottom: 0.5em; } div.title + * { margin-top: 0; } td div.title:first-child { margin-top: 0.0em; } div.content div.title:first-child { margin-top: 0.0em; } div.content + div.title { margin-top: 0.0em; } div.sidebarblock > div.content { background: #ffffee; border: 1px solid #dddddd; border-left: 4px solid #f0f0f0; padding: 0.5em; } div.listingblock > div.content { border: 1px solid #dddddd; border-left: 5px solid #f0f0f0; background: #f8f8f8; padding: 0.5em; } div.quoteblock, div.verseblock { padding-left: 1.0em; margin-left: 1.0em; margin-right: 10%; border-left: 5px solid #f0f0f0; color: #888; } div.quoteblock > div.attribution { padding-top: 0.5em; text-align: right; } div.verseblock > pre.content { font-family: inherit; font-size: inherit; } div.verseblock > div.attribution { padding-top: 0.75em; text-align: left; } /* DEPRECATED: Pre version 8.2.7 verse style literal block. */ div.verseblock + div.attribution { text-align: left; } div.admonitionblock .icon { vertical-align: top; font-size: 1.1em; font-weight: bold; text-decoration: underline; padding-right: 0.5em; } div.admonitionblock td.content { padding-left: 0.5em; border-left: 3px solid #dddddd; } div.exampleblock > div.content { border-left: 3px solid #dddddd; padding-left: 0.5em; } div.imageblock div.content { padding-left: 0; } span.image img { border-style: none; vertical-align: text-bottom; } a.image:visited { color: white; } dl { margin-top: 0.8em; margin-bottom: 0.8em; } dt { margin-top: 0.5em; margin-bottom: 0; font-style: normal; } dd > *:first-child { margin-top: 0.1em; } ul, ol { list-style-position: outside; } ol.arabic { list-style-type: decimal; } ol.loweralpha { list-style-type: lower-alpha; } ol.upperalpha { list-style-type: upper-alpha; } ol.lowerroman { list-style-type: lower-roman; } ol.upperroman { list-style-type: upper-roman; } div.compact ul, div.compact ol, div.compact p, div.compact p, div.compact div, div.compact div { margin-top: 0.1em; margin-bottom: 0.1em; } tfoot { font-weight: bold; } td > div.verse { white-space: pre; } div.hdlist { margin-top: 0.8em; margin-bottom: 0.8em; } div.hdlist tr { padding-bottom: 15px; } dt.hdlist1.strong, td.hdlist1.strong { font-weight: bold; } td.hdlist1 { vertical-align: top; font-style: normal; padding-right: 0.8em; color: navy; } td.hdlist2 { vertical-align: top; } div.hdlist.compact tr { margin: 0; padding-bottom: 0; } .comment { background: yellow; } .footnote, .footnoteref { font-size: 0.8em; } span.footnote, span.footnoteref { vertical-align: super; } #footnotes { margin: 20px 0 20px 0; padding: 7px 0 0 0; } #footnotes div.footnote { margin: 0 0 5px 0; } #footnotes hr { border: none; border-top: 1px solid silver; height: 1px; text-align: left; margin-left: 0; width: 20%; min-width: 100px; } div.colist td { padding-right: 0.5em; padding-bottom: 0.3em; vertical-align: top; } div.colist td img { margin-top: 0.3em; } @media print { #footer-badges { display: none; } } #toc { margin-bottom: 2.5em; } #toctitle { font-size: 1.1em; font-weight: bold; margin-top: 1.0em; margin-bottom: 0.1em; } div.toclevel0, div.toclevel1, div.toclevel2, div.toclevel3, div.toclevel4 { margin-top: 0; margin-bottom: 0; } div.toclevel2 { margin-left: 2em; font-size: 0.9em; } div.toclevel3 { margin-left: 4em; font-size: 0.9em; } div.toclevel4 { margin-left: 6em; font-size: 0.9em; } span.aqua { color: aqua; } span.black { color: black; } span.blue { color: blue; } span.fuchsia { color: fuchsia; } span.gray { color: gray; } span.green { color: green; } span.lime { color: lime; } span.maroon { color: maroon; } span.navy { color: navy; } span.olive { color: olive; } span.purple { color: purple; } span.red { color: red; } span.silver { color: silver; } span.teal { color: teal; } span.white { color: white; } span.yellow { color: yellow; } span.aqua-background { background: aqua; } span.black-background { background: black; } span.blue-background { background: blue; } span.fuchsia-background { background: fuchsia; } span.gray-background { background: gray; } span.green-background { background: green; } span.lime-background { background: lime; } span.maroon-background { background: maroon; } span.navy-background { background: navy; } span.olive-background { background: olive; } span.purple-background { background: purple; } span.red-background { background: red; } span.silver-background { background: silver; } span.teal-background { background: teal; } span.white-background { background: white; } span.yellow-background { background: yellow; } span.big { font-size: 2em; } span.small { font-size: 0.6em; } span.underline { text-decoration: underline; } span.overline { text-decoration: overline; } span.line-through { text-decoration: line-through; } div.unbreakable { page-break-inside: avoid; } /* * html5 specific * * */ table.tableblock { margin-top: 1.0em; margin-bottom: 1.5em; } thead, p.tableblock.header { font-weight: bold; color: #527bbd; } p.tableblock { margin-top: 0; } table.tableblock { border-width: 3px; border-spacing: 0px; border-style: solid; border-collapse: collapse; } th.tableblock, td.tableblock { border-width: 1px; padding: 4px; border-style: solid; } table.tableblock.frame-topbot { border-left-style: hidden; border-right-style: hidden; } table.tableblock.frame-sides { border-top-style: hidden; border-bottom-style: hidden; } table.tableblock.frame-none { border-style: hidden; } th.tableblock.halign-left, td.tableblock.halign-left { text-align: left; } th.tableblock.halign-center, td.tableblock.halign-center { text-align: center; } th.tableblock.halign-right, td.tableblock.halign-right { text-align: right; } th.tableblock.valign-top, td.tableblock.valign-top { vertical-align: top; } th.tableblock.valign-middle, td.tableblock.valign-middle { vertical-align: middle; } th.tableblock.valign-bottom, td.tableblock.valign-bottom { vertical-align: bottom; } ================================================ FILE: docs/css/docs-offline.css ================================================ /* * Copyright (C) Plasma Team * Licensed as CC BY-NC-ND 4.0 */ @import url(https://fonts.googleapis.com/css?family=Source+Code+Pro:400,700|Roboto:400,400italic,700,700italic); body { font-family: Roboto, Arial, Sans-serif; margin: 0px; font-size: 14pt; } .content, div.banner h1, div.menu ul { margin: 0px auto; width: 90%; max-width: 900px; } @media screen and (max-width: 360px) { h1 { text-align: center; } } @media screen and (max-width: 800px) { #hardwork { display: none; } } div.banner h1 { font-weight: bold; margin-top: 0px; margin-bottom: 0px; padding-top: 16px; padding-bottom: 16px; font-size: 48pt; } div.banner h1 img { vertical-align: bottom; } div.banner { background: black; color: yellow; } div.menu { background: black; /* border-top: 2px solid red; border-bottom: 2px solid red; */ padding-bottom: 16px; } div.menu-gap { height: 48px; background: -webkit-linear-gradient(black, white); /* Safari 5.1 to 6.0 */ background: -o-linear-gradient(black, white); /* Opera 11.1 to 12.0 */ background: -moz-linear-gradient(black white); /* Firefox 3.6 to 15 */ background: linear-gradient(black, white) grey; background-repeat: no-repeat; /* fix for prince & okular */ } div.menu ul { padding-left: 0px; } div.menu ul li { display: inline-block; padding: 0.2em; font-size: 110%; color: yellow; } div.menu ul li a { color: yellow; text-decoration: none; } div.content { margin-top: 24px; } div.figure { float: right; border: 1px solid black; margin: 10px; } div.figure p.caption { margin: 10px; } dt { margin-bottom: 0.5em; font-style: italic; } dd { margin-bottom: 1em; } ol.milestones li ul { list-style-type: none; } ol.milestones li ul li:before { margin-left: -40px; width: 40px; text-align: center; display: inline-block; background-repeat: no-repeat; background-position: center; margin-top: 1px; margin-bottom: -4px; height: 21px; content: " "; } ol.milestones li ul li.status-done:before { background-image: url(images/icons/done-21.png); } ol.milestones li ul li.status-todo:before { background-image: url(images/icons/todo-21.png); } ol.milestones li ul li.status-wip:before { background-image: url(images/icons/wip-21.png); } ol.milestones li ul li.status-blocked:before { background-image: url(images/icons/blocked-21.png); } code, pre, .monospaced { font-family: 'Source Code Pro', "Courier New", Courier, monospace; } td > p { margin-bottom: 0; } ================================================ FILE: docs/design_concept_map.txt ================================================ Plasma Syntax to Concept Map ============================ :Author: Paul Bone :Email: paul@plasmalang.org :Date: April 2017 :Copyright: Copyright (C) Plasma Team :License: CC BY-SA 4.0 :toc: The purpose of this document is to show for each syntax-ish thing, what the underlying concept is. This should help us design the language on a coherent way. It is not intended as user documentation. == Brackets .Brackets |=== |Brackets | Concept(s) | Comment | +( )+ | Expression grouping, parameter lists (functions, types & structs) | Familiar to many programmers | +{ }+ | Code | | +[ ]+ | Lists (arbitrary size) | Lists, for loop parameters (unimplemented), *array indexing*. | +[- -]+ or +[~ ~]+ | Streams | Future, maybe use the ~ or - to denote whether it's a lazy list or a parallel stream (channel). | +[: :]+ | Arrays (fixed size sequences) | | +[% %]+ or +[# #]+ or something else? | Dictionariies, | |=== == Symbols .Symbols |=== |Symbol | Concept(s) | Comment | +//+ | Comment | | +/\*+ +*/+ | Comment | | +_+ (underscore) | Wildcard | Used instead of variables in patterns, arguments and the LHS of assignments | +\*+, +/+, +%+, +++, +\-+ | Arithmetic operators | | '-' | Unary minus | Similar concept as subtraction | +<+, +>+, +<=+, +>=+, +==+, +!=+ | Comparison operators | | +and+, +or+, +not+ | Logical operators | Not really "symbols" in the character ranges meaning of the word, but included here alongside other operators. | ++ | Concatenation operator | | +,+ | Parameter separation | in function results, argument lists (functions and types) and field lists, loop dot products. | +*+ | Wildcard (in import/export lists), Multiplication | | +\|+ | "or" in structure and type alternatives, "join" in lists and other structures. | | +&+ | "and" cross product in loop inputs. | Future, maybe, "and" doesn't mean "cross" or "by". | +:+ | "has type" | | +.+ | Scope qualification (access something from within another scope) | | +\->+ | "results in" | Used to separates a function's return values from its inputs, may be used in lambda expressions also. | +\<-+ | "gets", different from "let" | Part of loop syntax, unimplemented. | +=+ | "let" | The LHS (a new variable) is given the value of the RHS (also in struct construction and deconstruction). Or in type declarations, the type name on the LHS has the set of values from the RHS. Or in list outputs and reductions (unimplemented). In all of these cases the meaning is "let". | +:=+ | "store" or "write" | The value on the LHS is updated with the RHS, this makes sense for arrays. | +!+ | Side-effect | added to a function call to indicate that it uses or observers a resource. | +..+ | "to" | Future: For ranges, eg in array slicing. | +\+ | "lambda" | Future | +$+ | | Future: state variable syntax | +@+ | "at" | Reserved in case I ever want to add pointer manipulation a la PAWNS. | +#+ | | Unused | +%+ | | Unused: Maybe string formatting? |=== == Issues .Issues |=== |Symbol | Issue | +[ ]+ | This usually means a sequence but is also used for array indexing. That appears to be in conflict, however using +[ ]+ for lists and array indexing will be familiar from other languages. | +\|+ | Used in type and structure expressions to mean "or" and struct, list etc manipulation to mean "join". | +{}+, +_()+ and +{: :}+ | Minor issue, I kinda like {} for code and dictionaries and structures. But (so far) I've chosen to avoid these conflicts. |=== // vim: set syntax=asciidoc: ================================================ FILE: docs/design_ideas.txt ================================================ Plasma Language Ideas ===================== :Author: Paul Bone :Email: paul@plasmalang.org :Date: October 2017 :Copyright: Copyright (C) Plasma Team :License: CC BY-SA 4.0 == Ideas to consider Many of these should also wait until later. But this category is separate as I'm not sure that these are good ideas. GC:: * Regions * Mark-compact for acyclic objects Optimisations:: * Convert ANF to relaxed ANF then to PZ. Use the relaxed ANF to find single use variables and optimize them away to generate more efficient PZ. Do some other def-use analysis too, including for parallel tasks. Types:: * Use structural matching to some degree, an instance can implement more than one interface, and may define more than an interface requires. * When supporting interfaces, maybe they can be integrated with the package system in a kind-of "does this package provide X?" * Evaluate HKTs. * Refinement types / path-aware constraints. * Use symbols like ? for maybe and | for or, like Flow Types. * Consider safe/unsafe integer operations such as overflows, division by zero etc. Allow checking for error to be done at the end of a complex calculation or by throwing an exception. + When implementing more subtyping, during an ambigious type which the value of a match expression, prefer the type (if there is one) that allows the match to "cover" the whole type, and provide that as guidance to the solver. Syntax:: * Add field update and conditional field update syntax. * Maybe remove parens from if-then-else conditions and other places such as match parameters. * Guards on cases * Disjunctive patterns on cases * SISAL allows "masks" (like guards or filters) on returns clauses of loops. This looks pretty powerful. * More succinct loop syntax, for simpler loops. * Maybe allow simple loop outputs to be specified in the loop "head". * Consider different syntax & and ,? for combining multiple loop inputs in lockstep or Cartesian combinations. * List, array and sequence comprehensions. * Add a scope statement that contains a block allowing shadowing of some variables, and hiding of any produced variables. * Add let expressions? * Add something to allow statements within expressions? * Probably drop { } for dictionary constants in favor of [ ] with a => to separate keys from values. + Add more logical operators to the langauge, maybe xor and implication, probably via keywords or functions rather than symbols. Semantics:: * Predicate expressions as a syntax sugar for applicative. * https://plasmalang.org/list-archives/dev/2019-October/000033.html[Language "levels"] * Various ideas around resources and higher-order code: ** https://plasmalang.org/list-archives/dev/2018-January/000026.html[Most recent post] ** https://plasmalang.org/list-archives/dev/2017-September/000021.html[Earlier thread] Other:: * Read about Facebook reason wrt naming things and syntax. * Use command line parsing as example code for language & library. // vim: set syntax=asciidoc: ================================================ FILE: docs/design_principles.txt ================================================ Plasma Language Design Principles ================================= :Author: Paul Bone :Email: paul@plasmalang.org :Date: June 2021 :Copyright: Copyright (C) Plasma Team :License: CC BY-SA 4.0 :toc: Plasma is designed and implemented with these principals in mind. By documenting this it not only gives us something to refer to but makes decisions more conscious, leading to a more consistent language. The first section (The big ones) is especially important and contains: 1. Easy reasoning 2. Familiar syntax and terminology 3. Cutting-edge concurrency and parallelism These three are mostly relevant when making big decisions about the language, while the remaining principals are more relevant for smaller choices and implementation details, including development of the tools & ecosystem. Many of these will be described with anti-examples ("don't"). I'd prefer to use positive examples of how Plasma avoids these problems, and will try to, however most can only be recognised with these "don't" examples. == The big ones These principals are the big ones, they define how we blend declarative and imperative programming among other things, and shoot towards our goal of better concurrent and parallel programming. === Easy reasoning Declarative programming can make it easier to reason about a program, particularly large programs and at a large scale (the scale of modules, functions and how they interact). For example a Plasma function's signature tells you everything you need to know about that function, not only the data types it'll work with but what data it can access and what resources (eg files, network sockets) it can manipulate. Plasma is a side-effect free language and borrows a lot from other declarative languages including its type system. This also means that semantics should generally be easy to follow, the language should avoid UB or non-determinism. But we can't solve non-termination without solving the halting problem and otherwise maintain expressitivity so we're not going to try. (TODO: explain why exceptions are okay / when they're okay.) This benefits humans, who spend more time reading code than writing it, and more effort debugging. A human can read function signatures and know whether their bug may be or won't be within that function. It also benefits tools, specifically the compiler. By making effects clear the compiler can perform more aggressive optimisations such as reordering or parallelising code. === Familiar syntax and terminology There are two aspects to familiarity. One is generally using syntax that'll be more familiar to a majority of programmers in 2021. We're assuming people coming to Plasma have at least two years experience programming and they may be "functionally curious". By being familiar where we can it makes learning Plasma easier, and people can spend more of their energy learning the parts of Plasma that are different (usually by necessity). We make a number of choices about syntax that will be more familiar to most programmers. For example Functions and blocks use curly-brace syntax of C-like languages and the body of a function or block is a series of statements. Likewise we use terminology and names that are going to be more familiar. What Haskell calls "Functor" we shall call "Mappable". We know this isn't as accurate as "Functor", but we're willing to lose some of that accuracy for more familiarity for more people. Documentation will usually explain these kinds of choices, eg: "If you've used Haskell you may be used to calling these Functors, which is more accurate". Which also makes it clear to people with that background exactly what they're looking at. Sometimes something is familiar to a smaller group of people. Like ADTs, we use the Haskell syntax for ADTs because that's the syntax that's familiar to the largest group of people. Likewise some concepts have no familiar meaning (eg Monad). We carefully weigh whether to include that concept at all. For example monads are very useful so we will support but de-emphasise them. While GADTs are more specialised in their use cases and those cases can also be solved in other ways so we will not support GADTs. === Cutting-edge concurrency and parallelism One of Plasma's major goals is a language that does not restrict expression of concurrency or parallelism, and enables automatic parallelisation. And does all of this safely. Many other language features are designed with this in mind. For example by making loops part of the language (rather than using recursion in a declarative language) programmers will naturally tell the compiler where loops are and this will aid automatic parallelisation. Likewise part of the reason the resource system is granular is to be able to expose more parallelism. === No paradigm is superior in all situations Both declarative and imperative programming have a lot to offer. We choose language features from both of these groups. Neither one is purely superior. == Language syntax === Basic consistency C structs, and C++ classes, must be followed by a semicolon. But functions don't need to be. Haskell uses square brackets for lists: * +[]+ * +[1, 2, 3]+ * +[a]+ (as a type expression) But it also uses : for the cons operator, and when pattern matching with lists code looks like: ---- length [] = 0 length (x:xs) = (length xs) + 1 ---- This is inconsistent. Plasma has chosen the Prolog syntax for "cons" (+[x | xs]+). There may be "consistent" reasons why C/C++ and Haskell make these choices. Indeed +:+ is an operator in Haskell while +[]+ and +[1, 2, 3]+ aren't. Likewise struct declarations end in a semicolon in C otherwise the next identifier would be an instance of that struct. Nevertheless this is inconsistent _from the point of view of the programmer_. We will try to avoid inconsistency, and may need to do this by changing other parts of the language (if Plasma was C we'd avoid conflating structure definitions with definitions of struct instances). === Things should look like what they are / mean what they look like. The following Mercury code ---- ( X = a, ... ; X = b, ... ) ---- Could be a switch (with either 0 or 1 answers) a nondet disjunction (with any number of answers and hard to predict complexity). The exact meaning of this depends on the instantiation state of X which depends on the surrounding code. You can't tell by looking how this code will behave. Also in Mercury a goal such as: ---- A = foo(B, C) ---- Could be a test unification (semidet, very fast), a construction (det, with a memory allocation), a deconstruction (det or semidet), or a function call (could do anything, including not terminate). We will try to avoid these in Plasma. Plasma has no disjunction so the first is not a problem. But the second is currently avoided because data constructors begin with capital letters (this will change, so we may need to revisit this). We've been creating a link:concept_map.html[syntax to concept map] we're trying to avoid overloading symbols (where possible). For example + means addition and concatenation in many languages, but in Plasma (like Haskell and Mercury) ++ means concatenation. === The same thing, should behave the same way in different contexts What people think of as application or systems languages make this error, and scripting languages get it right, although the difference is hard to notice because it's so great. A language like python allows nested functions. ---- def foo(...): x = ... def bar(...): ... x ... return bar ---- But this is not legal in C and C++, or even a managed language like Java. This is legal in Plasma (with Plasma's syntax). We add the additional constraint that nested functions should behave like functions at the top-level, they must behave the same and for example support mutual recursion. Where this is not true is that other statements are not allowed at the top level, doing so would create problems for module loading order. So functions will have to behave with respect to other statements within functions, and this may make them appear to behave differently. This is unfortunate but better than creating module initialisation order problems. === Make parsing simple, for machines and humans To simplify parsing, both for machines and humans, all declarations/definitions and many statements can be recognised by their first token. All type definitions begin with the keyword +type+ all functions with +func+ etc. Statements can begin with +if+, +match+, +return+, +var+ or similar, and those that don't belong to a small set containing only: * Assignment * Array assignment * Call (with effect) Which can be disambiguated by the first 2 tokens. We assume that this also makes it easy for humans to recognise the type of each statement, at least provided they find the beginning of a statement which is (by convention, not syntax) at the beginning of a line or on the same line following a +{+. This is also related to things being what they look like. === Choose the more restrictive alternative There are many cases where we are unable to decide what is best for the language, particularly without experience using it in anger. In these cases given two or more choice we should choose the most restrictive. It will be more pleasant later if we change to a less restrictive option, rather than _from_ a less restrictive option to a more restrictive one. For example https://plasmalang.org/list-archives/dev/2018-January/000026.html[resources and higher-order code] was a fairly major choice we we've picked one of the more restrictive options, and might find we need to relax it later. == Other === Principle of least surprise This is written about elsewhere online. Given two alternatives, choose the one that surprises people the least (when other factors are equal). You can see that some of the above principles are specific examples of this one. == TODO * What are the principals for how we're writing the Plasma tools? // vim: set syntax=asciidoc: ================================================ FILE: docs/design_types.txt ================================================ Plasma Type System Design ========================= :Author: Paul Bone :Email: paul@plasmalang.org :Date: April 2017 :Copyright: Copyright (C) Plasma Team :License: CC BY-SA 4.0 :toc: This is a design/set of ideas that I'm considering for Plasma's type system. It is very much a draft. It is more or less an aide to help me write down my ideas, work them through and eventually refine then and make them part of the link:plasma_ref.html[reference manual]. Starting with a type system such as the basic parts of Haskell's or Mercury's specifically: * Discriminated unions / ADTs * Polymorphism * Abstract types * Existential types (later) * More kinds (later) Starting with this I have been considering the kinds of subtyping that OCaml can do, it's pretty neat. But recently I read a link:https://futhark-lang.org/blog/2017-03-06-futhark-record-system.html[blog post] by Troels Henriksen about structural typing and record syntax for Futhark. It made me consider this more deeply, and now I have the following design in mind. == Basic stuff We can define our own types, such as enums: ---- type Suit = Hearts | Diamonds | Spades | Clubs ---- Or structures, this type has a single struct with named fields. ---- type PlayingCard = Card ( suit : Suit, number : Number ) ---- A combination of the above, a PlayingCard is either an ordinary card or a joker. An ordinary card has fields. ---- type PlayingCard = OrdinaryCard ( suit : Suit, number : Number ) | Joker ---- Types are polymorphic, they may take type parameters. Identifiers beginning with upper case letters denote type names and constructor names. Identifiers beginning with lower-case letters denote type variables. ---- type Tree(k, v) = EmptyTree | Node ( key : k, value : v, left : Tree(k, v), right : Tree(k, v) ) ---- A type alias, ID is now another word for Int. (XXX this needs revisiting). ---- type_alias ID = Int ---- It's often more useful to alias something more complex. ---- type_alias Name = String type_alias NameMap = Map(ID, Name) ---- Type aliases can take parameters: ---- type_alias IDMap(x) = Map(ID, x) ---- == Terminology Before we can go further, I want to pin down some terminology. A type has a name and some parameters. Eg +Int+ or +Map(k, v)+ A type declaration has multiple parts: ---- type Tree(k, v) = EmptyTree | Node ( key : k, value : v, left : Tree(k, v), right : Tree(k, v) ) ---- A type declaration is made of a left hand side and a right hand side (either side of the +=+). The left-hand-side contains a type name +Tree+ it's parameters +k+ and +v+ which creates the type +Tree(k, v)+. This is also a type expression but we'll get to that later. TODO: kinds. The right hand side is a structure expression. A structure expression is normally made up of structures structures separated by +|+ symbols (meaning "or"). But could be made of other things such as a reference to another type (+type(TypeExpr)+). Each structure is made up of an optional structure (the bit in the parens) and a tag (its name). The structure is optional, if there are no fields then one should not write empty parens. An untagged structure, which we will see later, is written with the +_+ for its tag. When an untagged structure is used, there must be exactly one structure in the type. Other languages often call the tagged structures data constructors, and the untagged ones tuples, but I hope that calling them both structures, and allowing untagged structures to use field names and share some syntax will be good. NOTE: The word tag is overloaded, it also refers to an implementation detail for discriminated unions, that's not what we're referring to here. Each field in the structure has a name and a type. The type is any type expression. The field name is optional. Finally type expressions refer either a type like +Map(k, v)+ (including abstract types), or multiple type expressions separated by +|+, or arbitrary structure expressions when wrapped in +struct()+. The +struct()+ wrapper avoids ambiguity between tags and types. Likewise, and not mentioned above, structure expressions can refer to whole types with +type()+. Any type variables appearing in structures (on the RHS of the = in the type declaration, must appear exactly once on the LHS. This may need to change for existential types (TODO). == Ranged numeric types It is sometimes desirable to specify the size of a numeric type. Eg uint16_t. That's great if you're thinking "this should fit in 16 bits". But if what you're thinking is "I want to count numbers 0 to 200" it's more human to specify a range (see Ada). This could mean storing more, than the range when that's easier, or checked arithmetic. Likewise floating point numbers could be specified by how many sagnificant digits are important. Also consider an integer type with modulo (probably power-of-two) arithmetic. == Subtyping / constructors are "shared" ---- type TypeA = A | B type TypeB = A | B | C ---- A function that accepts parameters of type +TypeA+, cannot be passed values of +TypeB+. But a function accepting parameters of type +TypeB+ can be passed values of +TypeA+. This works along with type inference. This function: ---- func my_func() -> _ { return A } ---- Is known to return +A+ which is covered by either +TypeA+ or +TypeB+. This functions inferred return type will be +struct(A)+. Which we know we can pass as either TypeA or TypeB. Care will need to be taken when generating error messages. Likewise, if +my_func+ was defined as: ---- func my_func(...) -> _ { if (...) { return A } else { return B } } ---- Then it would be inferred as returning +TypeA+ since we already have a name for +struct(A | B)+. Types defined in separate modules outside the view of each-other can't share tags. This is not the limitation it seems, since usually when such a feature is required it is to extend, or in some cases reduce, the constructor symbols of an existing known type. ---- type AdvancedNode(a) = type(BasicNode(a)) | AdvancedStruct ( ... ) ---- NOTE: See below for how recursive types are handled. TODO: it may be useful to let a type explicitly specify that it extends/subtypes an earlier type. This may match more with programmer intentions. == Magic type tagging. I think I saw this in Perl 6. ---- func do_something(...) -> Result | Error { ... } ---- That's easy provided that both these types have all their structures tagged, but Ints, Strings, etc don't work like that (each Int, String etc is like an alternative tag in an infinite or really large set of tags). Where all the types in a type expression are named, then they may also be switched by type, rather than just value. (the compiler tags and probably boxes them internally). ---- func print(x : Int | String) -> String { return switch_type(x) { Int -> int_to_string(x) String -> "\"" ++ x ++ "\"" } } ---- == Ordering This kind of subtyping must work via an ordering. There is a partial ordering over all types, types that refer to something _more specific_ are _greater_ in this ordering. Therefore: +A | B+ > +A | B | C+. Being a partial ordering some types cannot be compared, eg: +A | B+ and +B | C+. This means that neither is a subtype of the other. == Adding fields. This can vary depending upon how programmers express deconstructions. Usually a deconstruction is (semantically) a match statement. ---- match (a) { A (x) -> { return x } } ---- The equivlient deconstruction might look like: ---- A(x) = a return x ---- This matches A with a single field. It would also match any A with at least one field, extracting only the first. Let's make a new structure expression for that: +A/1+, this kind of type expression wont appear in programs or even error messages, but we need it here to discuss subtyping and ordering. But fields can also be extracted or structures can be matched using field names. ---- # Field selection. return a.field1 # Match with fields. match (a) { A(x = field1) -> { return x } } ---- Therefore we also need to talk about subtyping with regard to fields and their types. We write the type of a in these as: +struct(A(field1 : t))+ (t is currently abstract). It's more correct to say that the first is +struct(_(field1 : t))+ since the constructor symbol isn't mentioned. Any use of a constructor, such as the match statement but not the field selection, requires a type to have already been declared. This will make more sense later with tagless structures. For now lets just say we require a type to exist. For example, either +TypeA+ or +TypeB+ match the above usages. ---- type TypeA = A ( field1 : Int ) type TypeB = A ( field1 : Int, field2 : String ) ---- == Ordering with fields A structure expression with more fields is greater than one with fewer: +struct(A/2)+ > +struct(A/1)+. A structure expression with a superset anther's fields is greater: +struct(A( field1 : Int, field2 : String ))+ > +struct(A ( field1 : Int ))+, Or: +TypeB+ > +TypeA+ A structure expression with a constructor and with the same or a superset of anothers fields is greater: +struct(A( field1 : Int ))+ > +struct(_(field1 : Int))+, Fields are compared by name and type. A field whose type is greater than the corresponding field of another type, is greater. This makes ordering composable, and work as desired on recursive types. Structures whose fields are neither a set or superset cannot be ordered. Structure expressions with numbers cannot be ordered with those by types. Widening is performed when a type or a constructor symbol is named, or if no ordering is found between two types, they are widened in an attempt to find a common type. Widening allows more programs to be well typed, makes the type system easier to use, however it makes type more specific than strictly necessary. A type expression such as the above is widened to the disjunction of the equal-least specific types matching the expression. Nevertheless we discussed ordering of these expressions so that we can determine ordering of types and which type an expression may be widened to. Widening must also respect the types created by type expressions the developer writes, such as in the declaration of a function: ---- func do_something(...) -> Result | Error { ... } ---- In this case +Result | Error+ is considered for widening. == Untagged structures An untagged structure can be used, but without any other structures within the same type. The missing tag must be written with +_+. ---- type TypeC = _( field1: Int, field3: Bool ) ---- Uses of untagged structures are not widened unless combined with a named structure or type containing a named structure. This makes them feel more "dynamic" although they simply use type inference heavily. For example: ---- dict_from_kv_list(map(\x -> _( key = get_id(x), value = x ), list)) ---- TODO: I think +:+ is the best operator here, but it conflicts badly with "has type". +=+ is also okay. Arrows can be a problem as the directions matter, and sometimes you want them one way or the other. Without needing to declare a type, using an untagged structure like this implicitly creates one for us. == Syntax We've already seen some syntax above. But I'd like to expand on that now. Type structures use parentheses +( )+, fields are separated by commas and the tag may either be an identifier starting with a capital letter or the +_+ symbol. Each field separates it's field name from the field type (in declarations) with a +:+ (meaning "type of"). Deconstructions may be done with fields (using a =, with the new variable on the left) or by position. Constructions are done either positionally or with the field name on the left. Selection is performed using the +.+ operator, the general scoping operator. ---- x = point.x ---- This may be chained for nested structures. ---- a = struct.field1.next_field.other_field ---- Field update (in an expression) is introduced via the join symbol: +|+ ---- new_struct = _( old_struct | field = new_value ) ---- Nested fields may also be updated, updating all the structures along the way. ---- new_struct = _( old_struct | field.next_field.following_field = new_value ) ---- Multiple fields may be updated in one expression. These expressions will introduce fields if necessary (subject to type checking). These will also work for tagged structs. A syntas sugar for state variables in statements will probably be introduced. === Syntax TODOs .Projection / Explosion / Filtering Additional syntax could be created to merge structs (exploding one into a series of updates to another). Filtering (technically projection) may also have some use, either to satisfy the type system or to free memory. .Lenses Lenses (optics?) provide some additional power not provided here. It'd be nice to handle that if possible. == Co-variance and contra-variance TODO: I will need to address this to support arrays. // vim: set syntax=asciidoc: ================================================ FILE: docs/dev_bugtracking.txt ================================================ Plasma Bugtracking ================== :Author: Paul Bone :Email: paul@plasmalang.org :Date: Feburary 2022 :Copyright: Copyright (C) Plasma Team :License: CC BY-SA 4.0 We use the github bugtracker, and while users/new contributors and such should be able to submit a bug without too much process. We need a little more process to decide which bugs are important and what we should be working on when. These guidelines might change a bit as we settle in and figure out what works. == Background === Roadmap The link:https://plasmalang.org/roadmap.html[Plasma Roadmap] is published on the website and gives a high-level overview of what we want to work on. It divides our progress into several milestones, each milestone is made of several features. === Releases & Versioning Plasma is currently not-quite usable (I must remember to update this doc when it is!) and so there are currently no version numbers or release schedule. Once it is I think it'd be fairly reasonable to manage two releases per year using something like a link:https://en.wikipedia.org/wiki/Software_release_train[train model] - because it's more important to release _something_ rather than have a release wait potentially indefinitely for a particular feature. It's my guess that twice yearly is not too fast that each release will have a reasonable number of new features, but not too slow that anyone feels they're waiting too long to get new features. Regarding bugs this means which version a feature _lands_ in is only meaningful with regard to relative priorities, and bugs/features don't need to be tagged with a version. That said, there will probably be meaningful versions such as "1.0" where we declare some API/language/library stability. === Github Github's bugtracker allows us to link:https://github.com/PlasmaLang/plasma/labels[label issues]. We already have several kinds of labels Type:: bug, enhancement, maintenance, optimisation Component:: build, compiler, runtime, gc, language, docs etc Skill:: C++, Mercury, Type system, etc Meta:: help-wanted, good-first-bug, no-domain-knowledge Status:: new, accepted, duplicate, invalid, wontfix, resolved Type:: bug, enhancement, maintenance, optimisation Other:: project We will extend these and probably rename a few of them. Github also supports a notion of milestones. I beleive these function like labels except that an issue may only belong to a single milestone. The link:https://github.com/PlasmaLang/plasma/milestones[Milestones view] has nice progress bars too. Github also supports project boards, Some large tasks have project boards (eg the module system). We may not always use github, TODO: find a way to download all this data from github. == Milestones & tasks the link:https://plasmalang.org/roadmap.html[roadmap] divides our work into milestones and tasks. Each roadmap task shall be a github milestone. For example, some current milestones are: * Testing * Interfaces * Text handling * Language groundwork * Ergonomics * Closures & functional features * Modules MVP * FFI * Standard library These should correspond to current roadmap items. Not all of them currently do. == Triaging & labelling Triaging is a process by someone looks at the issue and assigns various attributes to help with sorting/finding that issue later. It usually decides the issue's priority (in our case, milestone). Triaging is the responsibility of project maintainers, users do not need to worry about this. Each issue may have have one or more labels for skills, and usually one for component but this may be more if it's a cross-cutting issue or zero if it covers the project as a whole. Each issue should have exactly one type or be a project bug (bug, enhancement, maintainance task or optimisation). Each issue may belong in a milestone and/or a project board. Each issue should have a status, it should begin as "new". Untriaged bugs can be found with link:https://github.com/PlasmaLang/plasma/issues?utf8=%E2%9C%93&q=is%3Aopen+-label%3A%22meta%3A+triaged%22+[this search]. To summarise, to triage a bug assign: * The "status: new", * one type label, * probably one component or feature label, maybe more, * any number of skill labels, * meta labels as appropriate, * if the bug is part of some larger goal it should have a milestone and possibly also belong to a project board. // vim: set syntax=asciidoc: ================================================ FILE: docs/dev_compiler_internals.txt ================================================ Plasma Compiler Structure / Internals ===================================== :Author: Paul Bone :Email: paul@plasmalang.org :Date: November 2019 :Copyright: Copyright (C) Plasma Team :License: CC BY-SA 4.0 :toc: == Compiler structure A compiler is typically organised in multiple passes that form a pipeline. Plasma is no different in this respect. Compilers also use one or more data structures that represent the code and other information during compilation. You may have heard of abstract syntax trees (ASTs) and immediate representation, these are similar concepts. We will say _representation_ and use it to mean any representation of a program in the computer's memory (not disk), and not worry about the specifics of definitions like ASTs. Some representations have "textbook" definitions, eg: single-assignment form (SSA) or a normal form (ANF). Each representation has strengths and weaknesses, compilers including Plasma also use their own unique representations. Plasma has four main representations used within the compiler: AST, Pre-core, Core and Plasma Abstract Machine (PZ). Compilation passes take in the program in a representation and return the modified program in the same representation, and sometimes in a different representation. Again some of these are "textbook" passes (inlining, register allocation) while others are unique to the compiler or language. An optimisation pass may operate on the core representation, returning the updated program in core representation. And a translation pass like code generation may take the core representation and return PZ. Some passes don't modify the program but annotate it with extra information, such as type inference. Some passes check the program for validity, like type checking. In Plasma type inference and type checking are the same pass. === Lexing & Parsing WIP === AST WIP === Pre-core The pre-core representation is a statements-and-expressions like representation (similar to the AST representation) however all symbols have been resolved. This means where a name appeared in the AST it has been resolved to what kind of symbol it is: a function, a variable etc, and an ID. (IDs are internally integers and allow for faster lookups). ==== Environment The environment is a non-tangible concept (it's computer science, none is really tangible) which means it does not appear in people's programs but it is a concept that programmers may experience. Defined functions, imported modules and their symbols, local variables are all part of the environment. Environments form a chain. Each new scope creates a new environment that refers to the previous one. During compilation the environment is real, specifically during the AST->Pre core translation. A chain of environments are created and used to resolve symbols. ==== Meta information Each statement (+pre_statement+ type) has some meta-information associated, this contains context information (source file and line number) plus other fields, see the +stmt_info+ type. This means that if a statement spans multiple lines we only record the context information for the beginning of the statement. A compilation error later in the statement will be reported for the first line. We can fix this later. ===== Def/use The initial AST->Pre-core pass populates populates def-use information on each statement. Every variable defined (assigned a value) by a statement will appear in that statement's _def_ set. Every variable referred to (excluding assignments) by a statement will appear in that statement's _use_ set. These sets are used later to check scoping and lifetimes (variables are not used before they're defined). ===== Reachability Code is annotated with this value to describe whether execution can reach its end, always, sometimes or never. This is then used to check that a variable is defined along all execution paths that reach their end. Reachability is computed as the 3rd pre-core phase. It is invalid until then. ==== Phases Only code is handled in the pre-core phases. Data types and other entries are translated straight from AST into core representation. The pre-core phases are executed from +ast_to_core_funcs+ in +pre.ast_to_core.m+, they are: 1. +func_to_pre+ translates AST functions into pre-core, this resolves symbols using the environment concept. It also populates def-use sets. 2. +compute_closures+ computes the captured variable sets by traversing the statements taking note of which variables are available, then when a closure is found calculating the variables captured by the closure. 3. +fix_branches+ fixes how variables are used in branching code, it: ** checks that used variables are always well defined (eg along all execution paths) ** Updates the reachability information for branches. Reachability information is incomplete until after type checking. ** Adds terminating "return" statements where needed. 4. +check_bangs+ checks that the ! symbols are used correctly. They must be used when required, must not be used when not required, and only one may be used per statement. 5. +pre_to_core+ translates the pre-core statement-oriented representation into the core representation (similar to ANF) which is expression oriented. Statements are translated out of order, with the statements following the current statement being translated first, as a continuation, then that expression is fed into the translation of the current statement. This helps translate something like a sequence of assignments into a set of nested let expressions. === Core WIP === PZ WIP // vim: set syntax=asciidoc: ================================================ FILE: docs/dev_howto_make_pr.txt ================================================ How to make a pull request ========================== :Author: Gert Meulyzer :Email: gert@plasmalang.org :Date: April 2019 :Copyright: Copyright (C) Plasm Team :License: CC BY-SA 4.0 * Show a real life example from start to finish on how to do a good PR. _Draft text follows!_ It's hard to start contributing to an open source project. Especially if it's your first one. We present a flow here for you to follow and will show an example of an actual commit to the codebase. (You can find the commit *here* and the PR *here*) This way of working should be good for most projects you commit to, but be sure to check the contribution guidelines for every project. Ours is in the https://github.com/PlasmaLang/plasma/blob/master/CONTRIBUTING.md[CONTRIBUTING.md] file. 1. Fixing the bug. We found a bug on line 81 of https://github.com/PlasmaLang/plasma/blob/master/runtime/pz_option.h#L81[runtime/pz_option.h]. There is one 'l' too many. We'll fix it up so it's spelt correctly and commit it to git. * Use the correct Git commit message structure * Show how to clean up your local branches afterwards when it gets accepted. * Show how to to additional modifications * Maybe some git rebase and squash stuff NOTE: https://github.com/PlasmaLang/plasma/blob/master/runtime/pz_option.h#L81 temporarily has too many 'l's. This is a good bug to fix and make a PR from. * The git message structure documentation is in: https://github.com/PlasmaLang/plasma/blob/master/CONTRIBUTING.md So make sure to put a reference to it there. * From CONTRIBUTING.MD: Log messages should follow the style: ``` [component(s)] Title Description Any other changes including changes that were needed to support this change or followed as a consequence of this change. ``` We provide a .gitmessage in the root of the repository. Run this command to start using the new commit message template: ``` git config --local commit.template /path/to/repo/.gitmessage ``` * Make sure to mention this and refer to the correct document to refer to in case of doubt. Who knows, this might change again in the future. * In CONTRIBUTING.md it says: “Each file should be listed with more detailed information. Take a look at previous changes for examples.” => We could go look for some good examples and show them in this document. This was removed you can list a summary of changes in each/some files if you think it may help whowever is reviewing your change. // vim: set syntax=asciidoc: ================================================ FILE: docs/dev_maintainers.txt ================================================ Plasma Maintainer's Guide ========================= :Author: Paul Bone :Email: paul@plasmalang.org :Date: July 2022 :Copyright: Copyright (C) Plasma Team :License: CC BY-SA 4.0 :toc: This is the maintainer's guide, it will contain procedures for maintainer's common tasks. However it is incomplete (Bug #48). == Merging changes Generally ongoing work should be done on a feature branch and merged to the main branch. These branches could be in ones own fork of the plasma repository or in this one, then be merged. At some stage we may use the bors tool to manage this for us. For now though it's manual. Make the commit using: git commit merge --no-ff --log=999 -S branch_name The commit message should be formatted like: [merge] Mutually importing modules works This patch series mainly gets mutually inclusive modules working, but does some other tidying up also. Fixes #123 * modules: [compiler/pre] Save types and resources' full names [compiler/pre] Module qualify definitions in interface files [compiler/ast] Move names out of ast_resource and ast_type A merge commit should also have some github Fixes directives. Eg "Fixes: #123" to say that the commits fix bug #123. If the author of the patches already included this directive within the patch series then it's not necessary in the merge commit. A pull request / patch series may fix more than one bug. == Copyright years At the beginning of each calendar year update the copyright statements in the following files: * LICENSE * README.md * runtime/pz_main.cpp * src/constant.m And the copyright statement on the website, in it's repository at: * _includes/footer.html Copyright statements with years in each source file don't need to be updated, and the year parts can now be phased out to read as: Copyright (C) Plasma Team // vim: set syntax=asciidoc: ================================================ FILE: docs/dev_mercury_grades.txt ================================================ Mercury Grades ============== :Author: Paul Bone :Email: paul@plasmalang.org :Date: March 2020 :Copyright: Copyright (C) Plasma Team :License: CC BY-SA 4.0 Plasma is written in Mercury (at least until we get to a https://plasmalang.org/roadmap.html[self hosting] stage) which means if you want to compile Plasma (to contribute to it) you may need to build Mercury from source, and that means navigating the Mercury grade system. Mercury supports many different "grades", each one is a collection of settings for how to build and link a Mercury program or library. Each grade is made out of many grade components separated by +.+ Alternatively you may be able to use one of these shortcuts or check out https://plasmalang.org/docs/getting_started.html[getting started with Plasma]. * If you just want to run Plasma, without compiling it, then try this https://plasmalang.org/plasma-static.tgz[static build] for Linux on x86_64. (TODO: https://github.com/PlasmaLang/plasma/issues/9[better static builds]). * If you want to build Plasma on x86 or x86_64 on a .deb based Linux system; then use the https://dl.mercurylang.org/deb/[Debian packages], see https://plasmalang.org/docs/getting_started.html[getting started] for more information. * If you want to run Plasma or if you want to develop for it, then there's also a https://plasmalang.org/docs/getting_started.html#_docker[docker image]. * If you want to build Plasma on a non-.deb system on x86 or x86_64 then you'll have to build Mercury. I suggest installing the +asm_fast.gc+ and +asm_fast.gc.decldebug.stseg+ grades. Remember to tell +./configure+ which grades you need otherwise it'll http://yfl.bahmanm.com/Members/ttmrichter/yfl-blog/mercury-time-to-hello-world[try to build all of them and could take a long time] (TODO: https://github.com/PlasmaLang/plasma/issues/8[provide detailed instructions]). * If you have some other type of system, or are building something other than Plasma but found this document, then read on. The Mercury project documents its grade components https://www.mercurylang.org/information/doc-latest/mercury_user_guide/Grades-and-grade-components.html#Grades-and-grade-components[here (retrieved 2018-03-04)], and I will be clarifying some points made there. This manual, when I retrieved it, mentioned a few grade components not worth attempting to use, these are: +hl+:: The +hl+ grade component is like the +hlc+ grade but uses a different format for data on the heap. It doesn't provide a significant advantage over +hlc+ so isn't useful. +il+:: A deleted .net backend. +agc+:: A bit-rotten garbage collector. +threadscope+:: A bit-rotted profiling system, the viewer component's latest version can no-longer open profiles generated by Mercury. +mm+ and probably others:: alternative evaluation strategies for logic programming, you probably don't need this and if you do, someone else will tell you. +rbmm+ region based memory management:: An advanced optimisation for memory allocation. AIUI it only works for single module programs and is exprimental. There are many other `secret' grade components not covered here or in the User's guide. They are mostly experimental and include grades like +rbmm+. If you think they should be documented here then please https://www.plasmalang.org/contact.html[let us know]. == Base grade Everything starts with a base grade. The base grade selects which compilation backend you wish to use. Some backend have more than one base grade, and there are two C backends. Exactly one base grade must be part of every valid grade string. Low-level C:: +none+, +reg+, +jump+, +asm_jump+, +fast+ or +asm_fast+ High-level C:: +hlc+ C#:: +csharp+ Java:: +java+ Erlang:: +erlang+ If you need to call C#, Java or Erlang foreign code then the choice is fairly obvious. If you need to work with C foreign code, as the Plasma compiler does, then things are more complicated. For a long time the Low-level C backend generated faster code than the High-level one, at least when comparing the +asm_fast+ and +hlc+ grades. These days, due to changes in the C compilers, it depends on the program being run. === Choosing a low-level C grade Assuming you might use the low-level C grade, read this section. The low-level C grade uses a combination of three optimisations ('hacks') provided by GCC. With all three disabled, the base grade is +none+, with all three enabled it's +asm_fast+. .Low-level C Optimisations |======================== | Grade | GCC global registers | GCC Non-local GOTOs | ASM Labels | Useful | +none+ | N | N | N | Y | +reg+ | Y | N | N | Y | +jump+ | N | Y | N | N | +fast+ | Y | Y | N | N | +asm_jump+ | N | Y | Y | N | +asm_fast+ | Y | Y | Y | Y |========================================================================== Of course you want as much optimisation as possible, so choose +asm_fast+ but not all compilers (including GCC) fully support these GCC extensions so these grades may not work. Note that ASM labels cannot be used without GCC Non-local gotos, so there's no grades combining those. Note also that I've included a "Useful" column, these are the ones worth testing, the others are only of interest to researchers, since if they work, it's almost a certainty that +asm_fast+ works. So choose in order of preference: +asm_fast+, +reg+ then +none+. On x86 and x86_64 on Linux with GCC or Clang, +asm_fast+ works (but a future version of GCC or Clang could break this). On OS X I think only +none+ works, but I don't remember. == High level C As mentioned above, +hlc+ and +asm_fast+ are (IIRC) comparable performance-wise. Which one you choose will depend on whether your C compiler can handle +asm_fast+ and what other features you may need (see below). For example, if you want to use the declarative debugger, then you must use a low-level C grade, if that low-level C grade happens to be +none+, then that's the best you can do. == More grade components The complete grade is built by adding grade components to select different features, separated by periods. Garbage collection:: -- +gc+ or absent. +gc+ is Boehm GC, the only supported GC. Not including +gc+ means that a GC will not be built, but note that Java, C# and Erlang backends provide a GC anyway, and for them +gc+ does not make sense. (+agc+ bitrotted long ago, and +hgc+ was an experiment never completed.) You should always include +gc+ when using a C backend. Not including this is intended only for testing. -- Thread safety:: -- +par+ or absent Like the +gc+ option, this only makes sense on C grades. Grades that include +par+ are thread safe and support the functions in the thread module of the standard library. The Java, C# and Erlang grades support thread safety implicitly. Low level C:: The threading model is N:M with IO that can block a whole "engine" of workers. The parallel conjunction operator and the 'very' experimental https://paul.bone.id.au/pub/pbone-2012-thesis/[automatic parallelism] work are supported. This is the only combination of base grade and +par+ that support these features. High level C:: This uses the OS's native threads and IO works properly, but parallel conjunction is not supported. Plasma doesn't use thread-safety in any of its Mercury programs. -- Stack segmentation:: -- +stseg+ or absent Meaningful only on low-level C grades where Mercury manages its own stack. Use a segmented stack so that * The program is more tolerant of deep recursion s where TCO/LCO were not used/available. * The memory cost of a thread in +par+ grades is much cheaper. This is recommended when +par+ is used and can also help with debugging and deep profiling. The +trseg+ grade component looks similar and is described below. -- Single precision float:: -- +spf+ or absent Use +float+ for floating point numbers rather than +double+. Much faster on 32bit platforms where floats normally require boxing, but your program may have different results Only meaningful in C grades (I think). -- Debugging:: -- +debug+, +decldebug+, +ssdebug+ or absent Which type of debugging to support if any. Note that +decldebug+ is a superset of +debug+, you might as well use it instead of just +debug+. +ssdebug+ is a totally separate debugger suitable in the "MLDS" backends (high level C, C#, Java and Erlang). -- Profiling:: -- +prof+, +memprof+, +profdeep+ or absent What type of profiling to support if any. +prof+ and +memprof+ have a smiliar workflow. +profdeep+ is a https://mercurylang.org/documentation/papers.html#mu_01_24[very advanced profiler] and worth considering. These only make sense with low-level C grades. We're not concerned about Plasma's compiler's performance until well after bootstrapping, so you probably won't need this for Plasma. -- Trailing:: -- +tr+, +trseg+ or absent. Enable trailing support. Trailing is a technique for undoing destructive update on backtracking. If you don't know what it is then you probably don't need it. need this +tr+ is generally discouraged in favour of +trseg+. I believe this option is supported with all the C backends. -- == Grade compatibility .Grade component compatibility matrix |==================================== | | asm_fast1 | hlc | java | csharp | erlang | gc | par | stseg | tr/trseg | debug/decldebug | ssdebug | prof/memprof | profdeep | asm_fast | - | N | N | N | N | R | Y2 | Y | Y | Y | y | Y | Y | hlc | N | - | N | N | N | R | Y3 | N | Y | N | Y | y | N | java | N | N | - | N | N | n | n | N | ?D | N | Y | N | N | csharp | N | N | N | - | N | n | n | N | ?D | N | Y | N | N | erlang | N | N | N | N | - | n | n | N | ?D | N | Y | N | N | gc | Y | Y | n | n | n | - | Y | Y | Y | Y | y | Y | Y | par | Y2 | Y3 | n | n | n | Y | - | R | ? | ?D | ? | ?D | N | stseg | Y | N | N | N | N | Y | Y | - | Y | Y | y | y | Y | tr/trseg | Y | Y | ?D | ?D | ?D | Y | ? | Y | - | Y | ? | y | ? | debug/decldebug | Y | N | N | N | N | Y | ?D | R | Y | - | D | ?D | ?D | ssdebug | y | Y | Y | Y | y | y | y | y | y | D | - | ? | ? | prof/memprof | Y | ? | N | N | N | Y | ?D | y | y | ?D | ? | - | N | profdeep | Y | N | N | N | N | Y | N | R | ?D | ?D | ? | N | - |===== Y:: Compatible y:: Probably compatible N:: Not compatible n:: Not compatible, but implied support by the base grade ?:: Don't know. ?D:: Don't know, but I doubt it R:: Recommended to add the column grade component if you're using the row grade component 1:: asm_fast could mean any of the LLDS base grades, see table 1. 2:: asm_fast.par supports parallel conjunction and the experimental auto-parallelism. It uses green threads however IO will block an entire worker thread, you may be able to avoid that with spawn.native. 3:: hlc.par does not support parallel conjunction or auto-parallelism. It uses pthreads so works correctly with IO. == My favorite grades I use Linux on x86_64. Default:: +asm_fast.gc+, or maybe +hlc.gc+ Thread safety:: +asm_fast.par.gc.stseg+ Debugging:: +asm_fast.gc.decldebug.stseg+ Profiling:: +asm_fast.gc.profdeep.stseg+ // vim: set syntax=asciidoc: ================================================ FILE: docs/dev_style_c.txt ================================================ Plasma Development C and C++ Style Guide ======================================== :Author: Paul Bone :Email: pbone@plasmalang.org :Date: January 2019 :toc: This document describes our C and C++ programming style. While it's a good idea to conform to the project style, there may be exceptions where departing from the style produces more readable code. In brief, we use C99 and C++11 (no RTTI or exceptions) on POSIX, lines are no more than 77 columns long, indentation is made with four spaces and curly brackets appear at the end of the opening line except for functions. == General Project Contributing Guide For general information about contributing to Plasma please see link:contributing.html[our contributors' documentation]. == File organization === Modules and interfaces We follow a pattern on C to allow us to emulate (poorly) the modules of languages such as Ada and Modula-3. * Every +.c+/+.cpp+ file has a corresponding +.h+ file with the same base name. For example, +list.c+ and +list.h+. The exceptions are: ** The alternative interpreters are exceptions, they share the same header +pz_interp.h+ but have different implementations. ** Each interpreters implementation begins with the same prefix, such as +pz_generic_*.c+ which is the generic interpreter's files. ** +pz_main.cpp+ is also an exception, it only exports +main()+ which needs no declaration. ** Finally +pz_gc_layout.h+ is an exception, it provides the class eclarations for the GC's layout while other files contain the implemention organised by function. This organisation groups functions with related behaviours which makes more sense than by class. * Not all +.h+ files have a corresponding +.c+/+.cpp+ files. * We consider the +.c+/+.cpp+ file to be the module's implementation and the +.h+ file to be the module's interface. We'll just use the terms `source file' and `header'. C++ templates are an exception since their implementation must be in a header file, these headers have special names ending in +template.h+ * All items exported from a source file must be declared in the header. Declarations for variables (although rare) must use the +extern+ keyword, otherwise storage for the variable will be allocated in every source file that includes the header containing the variable definition. * All items not-exported from a module must be declared to be static. * We import a module by including its header. Never give +extern+ or forward declarations for imported functions in source files. Always include the header of the module instead. When C++ classes form cycles, forward declare one of the class names to break the cycle immediately before its use. * Each header must include any other headers on which it depends. Hence it's imperative every header be protected against multiple inclusion. Also, take care to avoid circular dependencies where possible. * Always include system headers using the angle brackets syntax, rather than double quotes. That is +#include +. Plasma-specific headers should be included using the double quotes syntax. That is +#include "pz_run.h"+ Do not put root-relative or `..'-relative directories in +#includes+. * Includes should be organised into 4 groups, separated by a blank line: +pz_common.h+, system includes, this module's header file, other Plasma includes. Each group should be sorted alphabetically where possible. === File names C/C++ language source and header files should begin with the prefix +pz_+. The C language does not have a namespace concept, prefixing C symbols with +pz_+ can make linking, and debugging linked programs easier. In C++ use the +pz+ namespace. === Organization within a file Sometimes a file (header or source file) will cover multiple concepts. In these cases the order above may be broken in order to keep things with the same concept together. For example, this may mean placing a +struct+ followed by the functions that operate on it, followed by a global variable, and the functions that operate on it. In some cases the environment may force a different order. For example C preprocessor macros may need to be placed in a specific order. Generally items within a file should be organised as follows: ==== Source files Items in source files should in general be in this order: . Prologue comment describing the module. . +#includes+ . Any local +#defines+. . Definitions of any local (that is, file-static) global variables. . Prototypes for any local (that is, file-static) functions. . Definitions of functions. Within each section, items should generally be listed in top-down order, not bottom-up. That is, if +foo()+ calls +bar()+, then the definition of +foo()+ should precede the definition of +bar()+. ==== Header files Items in headers should in general be in this order: typedefs, structs, unions, enums, extern variable declarations, function prototypes then #defines Every header should be protected against multiple inclusion using the following idiom: [source,c] ---- #ifndef MODULE_H #define MODULE_H /* body of module.h */ #endif // ! MODULE_H ---- [TODO] ==== Update headers to use the new style comment ==== == File encoding * Files should be saved as ascii or UTF-8 and must use unix style (LF) line endings. * Lines must not be more than 77 columns long. * Indentation is to be made with spaces, usually four spaces. * One line of vertical whitespace should usually be used to seperate top-level items and sections within an item. Two lines may be used at the type level to create more separation when desired. TODO editor hint for vim. === Long lines If a statement is too long, continue it on the next line indented two levels deeper (but less or more is okay depending on the situation). Break the line after an operator: [source,c] ---- int var = really really long expression + more of this expression; ---- And usually at an _outer_ element if possible, this could be the assignment operator itself. [source,c] ---- int var = (expr1 + expr2) * (expr3 + expr4); ---- Sometimes line-breaking can be done nicely by naming a sub-expression, give it a meaningful name: [source,c] ---- int sub_expr = some rather complex but separate expression; int var = foo(a + b, sub_expr); ---- You may choose to align sub-expressions during breaking. This is recommended when an expression is broken over several lines. Even though +name+ is short we give it its own line because the other expressions are long. [source,c] ---- int var = fprintf("%s: %d, %s\n", name, some detailed and rather long expression, a comment); ---- When things that may need wrapping occur at different depths within an expression then different levels of indentation can help convey that depth: [source,c] ---- int var = fprintf("%s: %d, %s\n", name, foo(some detailed and long expression, another detailed and long expression), a comment); ---- These two sub-expressions are aligned, but they don't have to be (see Tables below). Sometimes breaking early can allow you to align things towards the left and give them more room. For example we prefer: [source,c] ---- static PZ_Proc_Symbol builtin_setenv = { PZ_BUILTIN_C_FUNC, { .c_func = builtin_setenv_func }, false }; ---- While clang-format prefers: [source,c] ---- static PZ_Proc_Symbol builtin_setenv = { PZ_BUILTIN_C_FUNC, {.c_func = builtin_setenv_func}, false }; ---- == Naming conventions === Functions, function-like macros, and variables Use all lowercase with underscores to separate words. For instance, +soul_machine+. === Enumeration constants, +#define+ constants, and non-function-like macros Use all uppercase with underscores to separate words. For instance, MAX_HEADROOM. TODO: Maybe make function-like macros belong here. === Static data Static data should begin with s_ for both file-local and class members. === Typedefs Use first letter uppercase for each word, other letters lowercase and underscores to separate words. For instance, Directory_Entry. NOTE: this is rarely used and might become the same as classes and structs. === Structs and unions If something is both a struct and a typedef, the name for the struct should be formed by appending `_S' to the typedef name. This overrides the style for typedefs above: [source,c] ---- typedef struct DirectoryEntry_S { ... } DirectoryEntry; ---- For unions, append `_U' to the typedef name. === Classes Classes use CamelCaseWithInitialCap. === Member data Fields of classes (but not structs) should begin with m_, static data members should begin with s_. === Constexpr functions and variables, and const variables. These behave differently (better) than C macros. They don't need to look like C macros. Use _ to seperate words with initial capital letters. Eg: `My_Const_Expr' == Portability and Standards Our minimum requirements from the C and C++ environment is C99 (may move to C11 in the future) and C++11 on a POSIX.1-2008 environment, this may change as dependencies are added in this early stage of development, however those changes should be carefully reviewed, and if possible they should be optional. Differences between operating systems and the use of a tool like autoconf should be handled by having different configurations available via different Makefiles and header files. We will revisit this when development reaches that stage. Autoconf should be avoided, it brings only pain. While it's best to keep things portable, if you need a non-standard API, or an API that's different on each operating system. You should make it available by a macro or protecting it by #ifdefs. === Data types C99 provides many basic data types, +char+, +short+, +int+ etc. All being defined to be at least a certain size. These should be used when the size doesn't exactly matter. For example use +bool+ for booleans and +int+ or +unsigned+ when you're counting a _normal_ amount of something - you should not need to use the macros such as +INT_MAX+. When size matters the +inttypes.h+ types are strongly recommended, including the _fast_ types, eg: +uint_fast32_t+ and their macros. +float+ should be used in preference to +double+ which is seldom necessary and uses more memory. Don't rely on exact IEEE-754 semantics. Since C99 does not specify the representation of signed values, we will assume 2's complement arithmetic (we're not exactly C99 pure). Endianness and alignment must not be assumed. If laying out a structure manually align each member based on its size. === Operating system specifics Operating system APIs differ from platform to platform. Although most support standard POSIX calls such as +read+, +write+ and +unlink+, you cannot rely on the presence of, for instance, System V shared memory. Adhere to POSIX-supported operating system calls whenever possible since they are widely supported, even by Windows. The +CFLAGS+ variable in the +Makefile+ will request that modern C compilers fail to compile Plasma if it uses non-POSIX APIs. ---- CFLAGS=-std=c99 -D_POSIX_C_SOURCE=200809L -Wall -Werror ---- When POSIX doesn't provide the required functionality, ensure that the operating system specific calls are localised. === Compiler and C library specifics We require a C99 compiler. However many compilers often provide non-standard extensions. Ensure that any use of compiler extensions is localised and protected by #ifdefs. Don't rely on features whose behaviour is undefined according to the C99 standard. For that matter, don't rely on C arcana even if they are defined. For instance, +setjmp+/+longjmp+ and ANSI signals often have subtle differences in behaviour between platforms. If you write threaded code, make sure any non-reentrant code is appropriately protected via mutual exclusion. The biggest cause of non-reentrant (non-thread-safe) code is function or module-static data. Note that some C library functions may be non-reentrant. This may or may not be documented in the man pages. === C++ portability/standards In addition to sticking to C++11 (which is the minimum required for "modern C++"). We also forbid use of exceptions and RTTI, they're unnecessary and add too much magic. You should also be frugal with templates and vtables. You may follow guidelines for "good C++" from other sources, I've been reading the Essential C++ series and found it helpful. === Library standards including C/C++ standard library If you need a feature from a newer version of one of these standards, but we don't have the need to upgrade our minimum dependencies and the new feature is a change you can easily add as a utility function. Then add it to +pz_cxx_future.h/cpp+ (or create a new future file for other libraries), and indicate in a comment what version of the standard they're from. Then when we do update our dependencies we can look in these files to easily find what workarounds we can remove. This also applies to things that haven't been added to a standard but might be someday. === Environment specifics This is one of the most important sections in the coding standard. Here we mention what other tools Plasma may depend on. ==== Tools required for Plasma In order to build Plasma you need: * A POSIX (1-2008) system/environment. * A shell compatible with Bourne shell (sh) * GNU make * A C99/C++11 compiler * Mercury 14.01.1 or newer. ==== Documenting the tools If further tools or libraries are required, you should add them to the above list. And similarly, if you eliminate dependence on a tool, remove it from the above list. == Syntax Basic layout (line length, indentation etc) is covered above in File encoding. === General rules Clang-format has been configured and mostly does the right thing. But often doesn't. You could check "what would clang-format do" but it is not to be relyed on. ==== Curly brackets Curly brackets should be placed at the end of the opening line, and on a new line not-indented at the end: [source,c] ---- if (condition) { ... } ---- Except for functions and classes, which should have the opening curly on a new line. [source,c] ---- int foo(arg) { ... } ---- If the opening line is split between multiple lines, such as a long condition in an if-then-else, then place the opening curly on a new line to clearly separate the condition from the body: [source,c] ---- if (this_is_a_somewhat_long_conditional_test( in_the_condition_of_an + if_then)) { ... } ---- ==== Space between tokens There should be a space between the statement keywords like +if+, +while+, +for+ and +return+ and the next token. The return value should not be parenthesised. There should also be a space around an operator. There should be no space between the function-like keywords like +sizeof+ and their argument list. There also be no space between a cast and its argument. === Pointer declarations Place the pointer or reference qualifier between the type and the variable name. [source,c] ---- char * str1, * str2; ---- This avoids confusion that might occur when the pointer qualifier is attached to the type. [source,c] ---- char* str1, not_really_a_str; ---- TODO: find out if the same trap exists for C++ references. And makes the symbol easier to notice. === Statements Use one statement per line. ==== Large control-flow statements Use an +// end + comment if the if statement, switch or loop is quite large, particularly if there are multiple nested structures. It may be helpful to describe the condition of the branch in this comment. [source,c] ---- if (blah) { // Use curlies, even when there's only one statement in the block. ... // Imagine dozens of lines here. ... } // end if ---- ==== Tiny control-flow structures An exception to the above rule about always using curlies, is that an +if+ statement may omit the curlies if its body is a single +return+ or +goto+ instruction and is placed on the same line. [source,c] ---- file = fopen("file.txt", "r"); if (NULL != file) goto error; ---- or [source,c] ---- file = fopen("file.txt", "r"); if (NULL != file) { goto error; } ---- but not: [source,c] ---- file = fopen("file.txt", "r"); if (NULL != file) goto error; ---- and not: [source,c] ---- if (a_condition) do_action(); ---- Additionally, if one branch uses curlies then all must use curlies. Do not mix styles such as: [source,c] ---- if (a_condition) goto error; else { do_something(); } ---- And if the condition covers multiple lines, then the body must always appear within curlies (with the opening curly on its own line as noted above). [source,c] ---- if (0 == read_proc(file, imported, module, code_bytes, proc->code_offset, &block_offsets[i])) { goto end; } ---- ==== Conditions TODO: Consider removing this rule. To make clear your intentions, do not rely on the zero / no-zero boolean behaviour of C. This means explicitly comparing a value: [source,c] ---- if (NULL != file) goto error ---- If using the equality operator +==+, use a non-_lvalue_ on the left-hand-side if possible. This way the comparison can not be mistaken for an assignment. [source,c] ---- if (0 == result) { ... } ---- ==== Switch statements Case labels should be indented one level, which will indent the body by two levels. Switch statements should usually have a default case, even if it just calls +abort()+. If the switched-on value is an enum, the default may be omitted since the compiler will check that all the possible values are covered. ==== Fall through switch cases If a switch case falls through, add a comment to say that this is deliberately intended. [source,c] ---- switch (var) { case A: ... break; case B: ... // fall-through case C: ... break; } ---- ==== Curlies in cases If a case requires local variable declarations, place the curlies like this: [source,c] ---- ... case A: { int foo; ... break; } case B: ... ---- ==== Loops Loops that end in a non-obvious way, such as infinite while loops that use 'break' to end the loop. Should be documented. You'll need to use judgement about when this is needed. [source,c] ---- // Note that the loop will exit when ... while (true) { ... if (some condition) break; ... } ---- or [source,c] ---- while (everything_is_okay) { ... if (some condition) { // Exit the loop on the next iteration. everything_is_okay = false; } ... } ---- === Functions In argument lists, put space after commas. Include parameter names in the declaration as this can aid in documentation. Unlike other code blocks, the open-curly for a function should be placed on a new line. [source,c] ---- int rhododendron(int a, float b, double c) { ... } ---- If the parameter list is very long, then you may wish, particularly for long or complex parameter lists, place each parameter on a new line aligning them. Aligning names as in variable definition lists is also suggested but not required. [source,c] ---- int rhododendron(int a_long_parameter, struct AComplexType* b, double c) { ... } ---- === Variables Variable declarations shouldn't be flush left, however. [source,c] ---- int x = 0, y = 3, z; ---- ---- int a[] = { 1,2,3,4,5 }; ---- When defining multiple variables or structure fields or in some cases function parameters, then lining up their names is recommended. This also applies to structure and union fields. There should be one line of vertical space between the definition list and the next statement. [source,c] ---- char * some_string; int x; MyStructure * my_struct; if (...) { ---- === Enums or defines? Prefer enums to lists of #defines. Note that enums constants are of type int, hence if you want an enumeration of chars or shorts, then you must use lists of #defines. === Preprocessing ==== Nesting Nested #ifdefs, #ifndefs and #ifs should be indented by two spaces for each level of nesting. For example: [source,c] ---- #ifdef GUAVA #ifndef PAPAYA #else // PAPAYA #endif // PAPAYA #else // not GUAVA #endif // not GUAVA ---- ==== Multi-line macros When continuing a macro on an new line, line the +\+ up o the right in the same column. [source,c] ---- #define PZ_WRITE_INSTR_1(code, w1, tok) \ if (opcode == (code) && width1 == (w1)) { \ token = (tok); \ goto write_opcode; \ } ---- == Other implementation choices === C++ Class or Struct If a thing will have methods that act on instances, it is a class and should begin with the "class" keyword, and keep its data members private. Otherwise it is a struct and shell begin with a struct keyword.. === Bare Pointers Bare pointers aren't "modern C\+\+". However in Plasma's runtime system they show that the lifetime of the object is handled elsewhere. Either it is known to live a very long time and live in static data or on the C++ heap and destroyed when the program ends. Or it is a GC allocated object and we additionally guarantee that in the time while it's live (passed around) it's impossible for a GC to occur (there's also a NoGCScope present. TODO: Describe how we root GC pointers within runtime code. === C++ information hiding C++ exposes implementation details of classes in their declarations as private members. This means that changes to these internal details can cause unnecessary recompilation. On the other hand it allows the compiler to inline functions defined in the class definition that _do_ access private members. When the latter need is not great it can be good to avoid creating the former problem by hiding these details. There are a few different techniques The *pImpl* pattern is done where the class now contains a pointer to a class that contains the actual implementation. This pointer should be a +std::shared_ptr+ and the outer class is expected to be passed by value rather than by reference. While this still allows callers to use +object.method()+ style calls (which then forward), it breaks the normal expectations where "most objects should be passed by reference". Of course you _can_ pass them by reference but doing so creates an extra pointer indirection. Passing by value isn't great either, causing extra work in the +std::shared_ptr+ to maintain its reference count. There's *another pattern* where an abstract base class contains a virtual public interface and a private derived class containing the actual implementation. We avoid this because we want to avoid vtables when we can. Therefore the *pattern we use* in Plasma's runtime (when we choose to hide implementation details at all) is to forward declare the class, and define it in an implementation file or implementation-only header file. The public interface is defined as non-member forwarding functions. This pattern can be seen in https://github.com/PlasmaLang/plasma/blob/master/runtime/pz_gc.h[+pz_gc.h+] and https://github.com/PlasmaLang/plasma/tree/master/runtime/pz_gc.impl.h[+pz_gc.impl.h+]. == Comments === What should be commented ==== Functions Use your judgement for whether a function should be commented. Sometimes the function name and parameter names will provide a lot of information. However for more complex functions a comment will be necessary. Comments are strongly recommended when: * They have side-effects * They require an input to be sorted, non-null or similar. * They have different semantics when an input has a different value (they should be separate functions if they do a different _function_). * They allocate memory that the caller is now responsible for. * They return statically allocated memory (try to avoid this). * They free memory. * They return certain values (non-zero, -1 etc) for errors. * They ain't thread safe or reenterant. ==== Macros Each non-trivial macro should be documented just as for functions (see above). It is also a good idea to document the types of macro arguments and return values, e.g. by including a function declaration in a comment. Parameters to macros should be in parentheses. [source,c] ---- #define STREQ(s1,s2) (strcmp((s1),(s2)) == 0) ---- This ensures than when a complex expression is passed as a parameter that different operator precedence does not affect the meaning of the macro. ==== Headers Such function comments should be present in header files for each function exported from a source file. Ideally, a client of the module should not have to look at the implementation, only the interface. In C terminology, the header should suffice for working out how an exported function works. ==== Source files Every source file should have a prologue comment which includes: * Copyright notice. * License info * Short description of the purpose of the module. * Any design information or other details required to understand and maintain the module (may be links to other documents). [TODO] ==== Describe the exact format in use and ensure that all the C code conforms to this. ==== ==== Global variables Any global variable should be excruciatingly documented. This is especially true when globals are exported from a module. In general, there are very few circumstances that justify use of a global. === Comment style ==== Block comments. Use comments of this form: [source,c] ---- /* * This is a block comment, * it uses multiple lines. * It should have a blank line before it and it comments the declaration, * definition, block or group of statements immediately following it. */ ---- For annotations to a single line of code: [source,c] ---- i += 3; // Add 3. ---- Note that the +//+ comment is standard in C99, which we are using. If the comment fits on one line, even if it describes multiple lines, a single line comment is okay: [source,c] ---- // Add 3. i += 3; ---- However if the comment is important, or the thing it documents is significant. Then use a block comment. === Guidelines for comments ==== Revisits Any code that needs to be revisited because it is a temporary hack (or some other expediency) must have a comment of the form: [source,c] ---- /* * XXX: * - */ ---- The should explain the problem in a way that can be understood by developers other than the author of the comment. Also include the author of this comment so that a reader will know who to ask if they need further information. "TODO" and "Note" are also common revisit labels. Only "XXX" _requires_ the author's name. ==== Comments on preprocessor statements The +#ifdef+ constructs should be commented like so if they extend for more than a few lines of code: [source,c] ---- #ifdef SOME_VAR ... #else // ! SOME_VAR ... #endif // ! SOME_VAR ---- Similarly for +#ifndef+. Use the GNU convention of comments that indicate whether the variable is true in the +#if+ and +#else+ parts of an +#ifdef+ or +#ifndef+. For instance: [source,c] ---- #ifdef SOME_VAR #endif // SOME_VAR #ifdef SOME_VAR ... #else // ! SOME_VAR ... #endif // ! SOME_VAR #ifndef SOME_VAR ... #else // SOME_VAR ... #endif // SOME_VAR ---- == Using formatting tools Typing `make format` will run clang-format-10 on the C/C++ code. It mis-formats quite a few things so we don't yet use it automatically, or may do on a file-by-file basis some time. === Tables When code or data is tabular then using a tabular layout makes the most sense. This may be something formatters cannot handle, some will allow you to describe excisions. We don't have a good example of this in the code base, however the data in +pz_builtin.c+ could probably be set out in a table. If it were it might look like: [source,c] ---- static PZ_Proc_Symbol builtins[] = { { PZ_BUILTIN_C_FUNC, {.c_func = builtin_setenv_func}, false }, { PZ_BUILTIN_C_FUNC, {.c_func = builtin_free_func}, false } }; ---- == Defensive programming === Asserts and debug builds TODO === Statement macros must be single statements Macros should either be expressions (they have a value) or statements (they do not), this must always be clear. If necessary make a single statement using a block. The https://gcc.gnu.org/onlinedocs/cpp/Swallowing-the-Semicolon.html[do {} while (0)] pattern is not necessary since bodies of if statments may not be macros without their own curly brackets. [source,c] ---- #define PZ_WRITE_INSTR_1(code, w1, tok) \ if (opcode == (code) && width1 == (w1)) { \ token = (tok); \ goto write_opcode; \ } ---- === Macros should not evaluate parameters more than once C expressions may have side-effects, this is okay most of the time but can lead to confusion with macros. A macro can evaluate its parameters more than once. Avoid doing this in your macros, and if you must add a comment explaining that this can happen. === C++ type conversion It's very easy for C++ compilers to want to perform type conversions for you. This is frequently done via conversion operators and constructions that take a single argument. The later are easy to provide by mistake, therefore 1-arg constructors should be declared as explicit, which will prevent the compiler from using them automatically. ---- explicit MyType(const OtherType &other); ---- When implicit conversion is desired, add a comment to tell anyone reading your code that you didn't forget, that you _want_ it to be implicit. ---- // Implicit constructor Optional(T &other); ---- === C++ copy constructors C++ will create implicit copy constructors. These don't always do the right thing so it is best to either create them explicitly or tell C++ you don't want them. The same is true for copy assignment operators. ---- MyClass(const MyClass &) = delete; void operator=(const MyClass &) = delete ---- == Tips * Limit module exports to the absolute essentials. Make as much static (that is, local) as possible since this keeps interfaces to modules simpler. * Use typedefs to make code self-documenting. They are especially useful on structs, unions, and enums. Use them on the struct or union's forward declaration or header declaration when the definition is provided elsewhere. == Tracing macros TODO // vim: set syntax=asciidoc: ================================================ FILE: docs/dev_style_mercury.txt ================================================ Plasma Development Mercury Style Guide ====================================== :Author: Gert Meulyzer :Email: gert@plasmalang.org :Date: September 2015 :Copyright: Copyright (C) Plasma Team :License: CC BY-SA 4.0 :toc: // For the Mercury style guide: // https://mercurylang.org/development/developers/coding_standards.html // and for reference: // https://mercurylang.org/development/developer.html == General Project Contributing Guide For general information about contributing to Plasma please see link:contributing.html[our contributors' documentation]. == Documentation * Each module should contain header comments which state the module's name, a copyright notice, license info, main author(s), and purpose, and give an overview of what the module does, what are the major algorithms and data structures it uses, etc. * Everything that is exported from a module should have sufficient documentation that it can be understood without reference to the module's implementation section. * Each predicate other than trivial access predicates should have a short comment describing what the predicate is supposed to do, and what the meaning of the arguments are. Ideally this description should also note any conditions under which the predicate can fail or throw an exception. * There should be a comment for each field of a structure saying what the field represents. == Naming * Variables should always be given meaningful names, unless they are irrelevant to the code in question. For example, it is OK to use single-character names in an access predicate which just sets a single field of a structure, such as: ---- bar_set_foo(Foo, bar(A, B, C, _, E), bar(A, B, C, Foo, E)). ---- * Variables which represent different states or different versions of the same entity should be named Foo0, Foo1, Foo2, ..., Foo. * Predicates which get or set a field of a structure or ADT should be named bar_get_foo and bar_set_foo respectively, where bar is the name of the structure or ADT and foo is the name of the field. == Coding * Your code should make as much reuse of existing code as possible. "cut-and-paste" style reuse is highly discouraged. * No fixed limits please! (If you really must have a fixed limit, include detailed documentation explaining why it was so hard to avoid.) == Error handling * Code should check for both erroneous inputs from the user and also invalid data being passed from other modules. You should also always check to make sure that the routines that you call have succeeded; make sure you don't silently ignore failures. (This last point almost goes without saying in Mercury, but is particularly important to bear in mind if you are writing any C code or shell scripts, or if you are interfacing with the OS.) * Error messages should follow a consistent format. For compiler error messages, each line should start with the source file name and line number in "%s:%03d: " format. Error messages should be complete sentences. For error messages that are spread over more than one line (as are most of them), the second and subsequent lines should be indented two spaces. * Exceptions should usually be used for *exceptional* (eg unforeseen) things. However during early development exceptions are a suitable way to mark something that we intend to fix later. There are four types of exception used. ** +software_error+ (thrown by +unexpected+ and +error+). This is used when something truly unanticipated has occurred, such as an assertion of a state that should never happen. ** +compile_error_exception+ (thrown by +compile_error+). This is used when a compilation error is not properly handled. These should be converted to actual compiler errors in the future. ** +unimplemented_exception+ (thrown by +sorry+). This is used when a Plasma feature is not implemented yet. It is a case that we intend to handle in the future. ** +design_limitation_exception+ (thrown by +limitation+). This is used when some limitation is exceeded. These are thing that we think will never happen, and so have no plans to fix them. If they do happen, then we will attempt to fix them. == Layout * Each module should be indented consistently, with 4 spaces per level of indentation. The indentation should be consistently done with spaces. A tab character should always mean 4 spaces. Never under any circumstances mix tabs and spaces. Currently 100% of our development is done in vim, therefore it is trivial to use an editor hint to encourage this. Files should have something like this at the top, even before the copyright line: ---- % vim: ft=mercury ts=4 sw=4 et ---- Hints for other editors should be added as necessary. * No line should extend beyond 77 characters. We choose 77 characters to allow for one character to be used when creating diffs and two more characters to be used in e-mail replies duing code review. * Since "empty" lines that have spaces or tabs on them prevent the proper functioning of paragraph-oriented commands in vi, lines shouldn't have trailing white space. They can be removed with a vi macro such as the following. (Each pair of square brackets contains a space and a tab.) ---- map ;x :g/[ ][ ]*$/s///^M ---- * String literals that don't fit on a single line should be split by writing them as two or more strings concatenated using the "++" operator; the Mercury compiler will evaluate this at compile time, if --optimize-constant-propagation is enabled (i.e. at -O3 or higher). * Predicates that have only one mode should use predmode declarations rather than having a separate mode declaration. * If-then-elses should always be parenthesized, except that an if-then-else that occurs as the else part of another if-then-else doesn't need to be parenthesized. The condition of an if-then-else can either be on the same line as the opening parenthesis and the `->', ---- ( test1 -> goal1 ; test2 -> goal2 ; goal ) ---- or, if the test is complicated, it can be on a line of its own: ---- ( very_long_test_that_does_not_fit_on_one_line(VeryLongArgument1, VeryLongArgument2) -> goal1 ; test2a, test2b, -> goal2 ; test3 % would fit one one line, but separate for consistency -> goal3 ; goal ). ---- * Disjunctions should always be parenthesized. The semicolon of a disjunction should never be at the end of a line -- put it at the start of the next line instead. * Normally disjunctions place each semicolon on a new line ---- ( goal1, goal2 ; goal3 ; goal4, goal5 ). ---- * However simple disjunctions, such as those that attempt to unify a variable in each disjunct (which are also switches), may be formatted more concicely. ---- ( goal1 ; goal2 ; goal3 ), ---- * Switches may be formatted with the switched on variable sharing a line with the open-paren and each semicolon: ---- ( X = foo, goal1, goal2 ; X = bar, goal3 ). ---- Or the switched on variable may have a line of its own, as it would in a regular disjunction. * Predicates and functions implemented via foreign code should be formatted like this: ---- :- pragma foreign_proc("C", to_float(IntVal::in, FloatVal::out), [will_not_call_mercury, promise_pure], " FloatVal = IntVal; "). ---- * The predicate name and arguments should be on a line on their own, as should the list of annotations. The foreign code should also be on lines of its own; it shouldn't share lines with the double quote marks surrounding it. * Type definitions should be formatted in one of the following styles: ---- :- type my_type ---> my_type( some_other_type % comment explaining it ). :- type some_other_type == int. :- type foo ---> bar( int, % comment explaining it float % comment explaining it ) ; baz ; quux. ---- * If an individual clause is long, it should be broken into sections, and each section should have a "block comment" describing what it does; blank lines should be used to show the separation into sections. Comments should precede the code to which they apply, rather than following it. ---- % % This is a block comment; it applies to the code in the next % section (up to the next blank line). % blah, blah, blahblah, blah, ---- If a particular line or two needs explanation, a "line" comment ---- % This is a "line" comment; it applies to the next line or two % of code blahblah or an "inline" comment blahblah % This is an "inline" comment ---- should be used. == Structuring * Code should generally be arranged so that procedures (or types, etc.) are listed in top-down order, not bottom-up. * Code should be grouped into bunches of related predicates, functions, etc., and sections of code that are conceptually separate should be separated with dashed lines: ---- %---------------------------------------------------------------------------% ---- Ideally such sections should be identified by "section heading" comments identifying the contents of the section, optionally followed by a more detailed description. These should be laid out like this: ---- %---------------------------------------------------------------------------% % % Section title % % Detailed description of the contents of the section and/or % general comments about the contents of the section. % This part may go one for several lines. % % It can even contain several paragraphs. The actual code starts here. ---- For example ---- %---------------------------------------------------------------------------% % % Exception handling % % This section contains all the code that deals with throwing or catching % exceptions, including saving and restoring the virtual machine registers % if necessary. % % Note that we need to take care to ensure that this code is thread-safe! :- type foo ---> ... ---- Double-dashed lines, i.e. ---- %---------------------------------------------------------------------------% %---------------------------------------------------------------------------% ---- can also be used to indicate divisions into major sections. Note that these dividing lines should not exceed the 77 character limit (see above). == Module imports * Each group of :- import_module items should list only one module per line, since this makes it much easier to read diffs that change the set of imported modules. In the compiler, when e.g. an interface section imports modules from from the same program (the compiler) and other libraries, there should be two groups of imports, the imports from the program first and then the ones from the libraries. * Each group of import_module items should be sorted, since this makes it easier to detect duplicate imports and missing imports. It also groups together the imported modules from the same package. There should be no blank lines between the imports of modules from different packages, since this makes it harder to resort the group with a single editor command. // vim: set syntax=asciidoc: ================================================ FILE: docs/dev_testing.txt ================================================ Plasma Test Suite ================= :Author: Paul Bone :Email: paul@plasmalang.org :Date: September 2022 :Copyright: Copyright (C) Plasma Team :License: CC BY-SA 4.0 :toc: The Plasma test suite is located under tests/ but will also execute programs in examples/ to ensure they keep working. See tests/README.md for a description of the directory tree. == Running tests The test script looks for tests in the directories on its command line. $ ./tests/run-tests.lua examples tests Will execute all the tests in the examples and tests directories. == Adding a new test The test script searches for tests by looking for `*.exp` files within the `tests/` and `examples/` directories and their sub-directories. All tests have an `*.exp` file, this is the "expected output" of the test, what exactly "output" means depends on the type of the test. === Ordinary tests The test script will attempt to build and run these tests by either finding a `.build` file with the same name as the test (eg if `my_test.exp` exists then the script will look for `my_test.build`), or use a `BUILD.plz` file in the same directory which may be shared with multiple tests (see the `examples/` directory.) Once build the test script will expect to run a bytecode file with the same name, eg `my_test.pz`. It will run the test, optionally with input from a `my_test.in` file, and check the output against the expected output. For example for `my_test.exp` it will try to build/find `my_test.pz`. It will then run this file and gather the output. The test passes if exits with 0 for its exit code AND its output matches the contents of the `*.exp` file. Test output may include lines beginning with #, these will be ignored when comparing with the expected output. === compile_failure tests These tests will attempt to compile a program (using a matching `.build` file) and compare the compiler's output with the expected output. A test can be made a `compiler_failure` test using a test configuration line to specify the type as below. == Test configuration For each test the test script looks in the .p file to find lines containing `PLZTEST`. The next two whitespace seperated tokens on that line are configuration paramter and its value. For example: // PLZTEST build_type dev Sets the `build_type` parameter to `dev`. The recognised parameters are: **`build_type`**: Either `dev` or `rel`. In which build should this test be executed. If not set then the test runs in all builds. This is the same build type as set in `build.mk`. **`build_args`**: Arguments to pass to plzbuild during the build step of the test. **`returns`**: The expected exit code for a passing test. The default is 0. **`output`**: Which stream contains the output we wish to capture and compare. `stdout` (the default) or `stderr`. **`type`**: If specified it must be set to compile\_failure which indicates that the build step must fail and return the exit code 1 and the output of the compiler will be checked against the expected output file. If the test type is unspecified it defaults to 'run' (aka ordinary tests). === Building tests The script will attempt to build tests by checking for a `BUILD.plz` file in the same directory. If it finds one it knows it can build the test by executing `plzbuild` in that directory. It passes this step if plzbuild exits with 0. == Other rules * Don't name your test "plzbuild" that is reserved. // vim: set syntax=asciidoc: ================================================ FILE: docs/getting_started.txt ================================================ Getting started with Plasma =========================== :Author: Paul Bone :Email: paul@plasmalang.org :Date: Janurary 2023 :Copyright: Copyright (C) Plasma Team :License: CC BY-SA 4.0 :toc: Since we don’t have static builds yet, you’ll need to build Plasma from source. This file contains some instructions on setting up the prerequisites and building Plasma. Plasma has been tested on Linux, Windows subsystem for Linux 1 and 2 on x86_64. == Docker If you want to run Plasma in a Docker container (rather than the instructions below for Ubuntu Linux) the Dockerfile provided in https://github.com/PlasmaLang/plasma/tree/master/scripts/docker[scripts/docker] is available, It is also build and available on https://hub.docker.com/r/paulbone/plasma-dep[docker hub]. You can resume this "getting started" guide at the xref:_hello_world[Hello World] section below, you will still need to adapt some of the instructions for use with the container. == Dependencies You will need * GCC or Clang * GNU Make * git * Mercury (tested with 22.01) * ninja 1.10 or later Optionally for building documentation: * asciidoc * source-highlight Optionally to run the test suite: * lua * lua-file-system * lua-posix * diffutils * ncurses === C++ compiler, make and git Plasma has been tested with clang and gcc. On debian-based systems you can install a suitable compiler and GNU Make with the build-essential package. Install git at the same time. [source,bash] ---- sudo apt install build-essential git ---- === Mercury You’ll need another language, Mercury, since our compiler is written in it. A recent stable version is required (22.01.x), ROTD versions may also work. Plasma's CI currently tests with 22.01. Compiling Mercury from source can take a long time, but if you’re on Debian, Ubuntu or other derivative running on x86_64 then there are some packages! Read on or follow the instructions at https://dl.mercurylang.org/deb/ ==== For Ubuntu 20.04, this is what you need to do: To install Mercury you'll need to add a new package repository & GPG key. Download and trust Paul's GPG key: [source,bash] ---- cd /tmp wget https://paul.bone.id.au/paul.asc sudo cp paul.asc /etc/apt/trusted.gpg.d/paulbone.asc ---- Create a new file in /etc/apt/sources.list.d, name it mercury.list and paste in it: deb http://dl.mercurylang.org/deb/ focal main deb-src http://dl.mercurylang.org/deb/ focal main You may need to substitue focal for another name, see the https://dl.mercurylang.org/deb/[Mercury debian packages page]. .Now we can install: [source,bash] ---- sudo apt update sudo apt install mercury-rotd-recommended ---- === Asciidoc To optionally build the documentation, you need to install AsciiDoc and source-highlight: [source,bash] ---- sudo apt install asciidoc source-highlight ---- Beware, this is a very large installation, on a default Ubuntu installation this amounts to over 1 GB of space and a download of over 300MB. If AsciiDoc is not installed, documentation will not be built. === ninja Plasma's build tool `plzbuild` needs least version 1.10 of the ninja build tool. Ubuntu 20.04 has a suitable package. ---- sudo apt install ninja-build ---- Or install it yourself from a binary download: https://github.com/ninja-build/ninja/releases Or from source: https://github.com/ninja-build/ninja/ Or run these commands to install ninja 1.10.2 on your x86_64 Linux system: ---- cd /tmp wget https://github.com/ninja-build/ninja/releases/download/v1.10.2/ninja-linux.zip unzip ninja-linux.zip sudo cp ninja /usr/local/bin/ ---- Alpine Linux doesn't currently contain a recent enough version, you'll need to build ninja from source on Alpine. === Lua, diffutils and ncurses To run the test suite you will need * lua * lua-file-system * lua-posix * diffutils * ncurses Ubuntu 20.04 has a suitable package. ---- apt install lua5.3 lua-filesystem lua-posix diffutils ncurses-bin ---- == Compiling Plasma Now it’s time to clone the plasma repo: [source,bash] ---- git clone https://github.com/PlasmaLang/plasma.git ---- If you want or need to, you can configure Plasma's build settings by copying `template.mk` to `build.mk` and editing it. It contains some documentation for the build options. These include which C compiler to use, and compilation flags. The default build is reasonable if you have `gcc`. You may need to set the `PREFIX` variable to your desired installation directory, The Plasma compiler and other tools will be installed to `$PREFIX/bin/`, you will need to arrange for that to be in your shell interpreter's path (https://github.com/PlasmaLang/plasma/issues/325[bug #325] will remove this requirement). Then run `make` and it will build you the plasma compiler (`src/plzc`) and the runtime (`runtime/plzrun`). Set `MAKEFLAGS` to build the C++ code in parallel, or set it in your `~/.bashrc`. ---- NPROC=$(nproc) export MAKEFLAGS="-j$NPROC -l$NPROC" make ---- The `make test` command will execute the test suite. Be sure to take a look at the example programs in https://github.com/PlasmaLang/plasma/tree/master/examples[`examples/`]. == Installing Plasma The `make install` command will now install the Plasma tools into the `$PREFIX` path you set in `build.mk` in the previous step. The compiler and other tools are now available under `$PREFIX/bin/`. Enjoy! == Hello world So you've got Plasma installed, it's time to take it for a test-drive. In a new directory create a `BUILD.plz` project file, it should contain: ---- [hello] type = program modules = [ Hello ] ---- Create a `hello.p` file to contain the `Hello` module, it should contain: ---- module Hello entrypoint func hello() uses IO -> Int { print!("Hello world\n") return 0 } ---- Then use the `plzbuild` program to build the program: ---- $ plzbuild ---- This will create a `hello.pz` file in the current directory containing the program's bytecode. Run it with: ---- $ plzrun hello.pz Hello world ---- == vim customisation If you want to write some Plasma programs and you use vim. You may wish to use the https://github.com/PlasmaLang/vim[vim editor support]. == Getting help If you're stuck and the https://plasmalang.org/docs/[Documentation] doesn't contain the answer or clue you need or you're struggling to find it. Please ask for help. The https://plasmalang.org/contact.html[Contact] page of the website lists all the ways you can get in touch. In particular the https://plasmalang.org/lists/listinfo/help[Plasma Help mailing list] and https://discord.gg/x4g83w7tKh[Discord server] are the best resources for help. For bugs or missing information please https://github.com/PlasmaLang/plasma/issues/new[file a bug]. // vim: set syntax=asciidoc: ================================================ FILE: docs/index.txt ================================================ Plasma Language Documentation ============================= :Author: Paul Bone :Email: paul@plasmalang.org :Date: March 2021 :Copyright: Copyright (C) Plasma Team :License: CC BY-SA 4.0 link:getting_started.html[Getting Started with Plasma]:: The getting started guide is your first step to working with Plasma. It covers installation, writing your first program, and where to look next. link:user_guide.html[User's Guide]:: The user's guide describes how to use the Plasma tools to work with your programs. link:plasma_ref.html[Plasma Language Reference]:: The language reference documents the language in a reference-style. It's useful if you want to lookup some detail. It's not a guide and not ideal for teaching the language. We have guide-like documentation other than the getting started guide. link:contributing.html[Contributing to Plasma]:: Information about contributing to Plasma. This covers necessary stuff like your first pull request but also links to further information like nitty-gritty compiler internals. link:https://plasmalang.org/about.html#Publications[Publications]:: List of publications. // vim: set syntax=asciidoc: ================================================ FILE: docs/plasma_ref.txt ================================================ Plasma Language Reference ========================= :Author: Paul Bone :Email: paul@plasmalang.org :Date: January 2025 :Copyright: Copyright (C) Plasma Team :License: CC BY-SA 4.0 :toc: As the language is under development this is a working draft. Many choices may be described only as bullet points. As the language develops these will be filled out and terms will be clarified. == Lexical analysis and parsing The "front end" passes of Plasma compilation work as follows: * Tokenisation converts a character stream into a token stream. * Parsing converts the token stream into an AST. * AST->Core transformation converts the AST into the core representation. This phase also performs symbol resolution, converting textual identifiers in the AST into unique references. === Lexical analysis * Input files are UTF-8 * Comments begin with a +//+ and extend to the end of the line, or are delimited by +/\*+ and +\*/+ and may cover multiple lines. Note that comments ending in +**/+ aren't currently supported as they confuse our limited tokeniser. * Curly braces for blocks/scoping * Whitespace is only significant when it separates two tokens what would otherwise form a single token * Statements and declarations are not delimited. The end of a statement can be determined by the statement alone. Therefore: there are no statement terminators or separators (such as semicolons in C) nor significant whitespace (as in Python or Haskell). * String constants are surrounded by double quotes and may contain the following escapes. +\n \r \t \v \f \b \\+. Escaping the double quote character is not currently supported, using character codes is not currently supported. Escaping any other character prints that character as is; this allows +\'+ to work as many programmers may expect, even though it's not necessary. === Parsing Plasma's grammar is given in pieces throughout this document as concepts are introduced. However the top level and some shared definitions are given here. In the grammar definitions I use ( and ) to denote groups and ? + and * to denote optional, one or more, and zero or more. ---- Plasma := ModuleDecl ToplevelItem* ToplevelItem := ImportDirective | TypeDefinition | ResourceDefinition | FuncDefinition | Pragma ModuleQualifiers := ( ident . )* QualifiedIdent := ModuleQualifiers ident IdentList := ident ( , ident )* QualifiedIdentList := QualifiedIdent ( , QualifiedIdent )* ---- === A note on case and style. It is desirable to use case to distinguish symbols in different namespaces that may appear in the same expression. It should never be required since there are scripts that do not have a notion of case. This is the suggested convention: |=== | | Suggestion | Notes | Variable | lower_case | | Function Name | lower_case | | Module Name | UpperCase | Case insensitive | Type Name | UpperCase | | Type Variable | lower_case | will use the +'+ sigil to disambiguate from types | Data constructor | UpperCase | to distinguish construction from function application or variable use. | Field selector | lower_case | Must be the same as function names. | Interface | UpperCase | | Instance | lower_case | not first class, but may appear in exp | Resources | lower_case | |=== Note that there may be more symbol namespaces in the future. The general rationale for these suggestions is that things that are different should look different. .Variables, functions and field selectors The most common symbols should be in lower case and use '_' to separate words are preferred, but not enforced. .Modules, types and constructors It is useful to visually distinguish these more _meta_ symbols. They're part of the organisation of the program but not really part of the program. .Interfaces and instances I'm unsure what's best here. We may wish to make them distinct so that instanced and module qualification do not overlap. .Types and type variables Type variables must be distinguished from types. This is because free type variables can appear in type expressions without being introduced and we'd like to distinguish free type variables from misspelt type names. So that Plasma can be used in scripts without lower and upper case we use a sigil. Type variables are always proceeded by a +'+ (apostrophe) sigil. A list of values of any type +t+ (but it must be the same type for each element): ---- List('t) ---- A list of +t+, that is values whose type is +t+, a defined type. ---- List(t) ---- [[environment]] == Environment The _environment_ is a concept we will consider for Plasma's scoping rules. The environment maps symbols to their underlying items (modules, types, functions, variables etc). Even though no environment exists at runtime, and the compile-time structure is an implementation detail of the compiler (+pre.env+), it is useful to think of scoping in these terms, as it explains most scoping behaviours. Some languages allow overloading of symbols, usually based on a symbol's type and sometimes on it's arity. Plasma does not support any overloading. === Scopes When a new name is defined it is added to the current environment. ---- print!(x) # x does not exist. var x = "hello" # x (a variable) is added to the environment. print!(x) # We may now refer to x. ---- When a nested block starts, it creates a new environment based upon the old environment. ---- var x = "hello" if (...) { print!(x) # Ok } ---- When a nested block ends, the original environment is restored. ---- if (...) { var x = "Hello" print!(x) # Ok } print!(x) # Error ---- === Shadowing Shadowing refers to a new binding with the same name as an old binding being permitted and dominant in an _inner_ or _later_ scope. Shadowing is not permitted for variables at all. It is permitted for other symbols. NOTE: TODO: Decide on rules for a symbol of one type overriding a symbol of another type. For example it should probably be an error for a module import to shadow an interface declaration. But it's probably okay for a variable to overload a function, unless that function is defined within another function (a closure). ==== Variables A variable cannot shadow another variable. ---- var x = 3 var x = 4 # Error if (...) { var x = 5 # Error } ---- NOTE: We are considering a special syntax to use with variables that allows shadowing. ==== Other symbols Symbols other than variables allow shadowing, for example module imports can create shadowing of their contents (types, functions etc). Including when import is used with a wildcard. Therefore we can use a different +Set+ implementation in the inner scope: ---- import SortedListSet as Set ... # some code ... { import RBTreeSet as Set ... # some code using RBTreeSets ... } ... # back to SortedListSet ... ---- (Yes, module imports may appear within function bodies and so-on.) However, a binding that cannot be observed such as: ---- import SortedListSet as Set import RBTreeSet as Set ---- Doesn't make sense, and the compiler should generate a warning. TODO: Figure out if context always tells us enough about the role of a symbol that modules do not need to shadow types and constructors. I suspect this is true but I'll have to define the rest of the language first. === Namespaces The environment maps names to items. Names might be qualified and if so the qualifier is required to refer to that name. For example. ---- import Set my_set1 = Set.new # Ok my_set2 = new # Undefined symbol ---- TODO: Probably need to create a new keyword to introduce these, the equivalent of +var+. Or they can be unqualified ---- import Set.new my_set1 = Set.new # Undefined symbol Set my_set2 = new # Ok ---- The name within the namespace does not need to correspond to the name as it was defined. ---- import Set.new as new_set my_set = new_set # Ok ---- This applies to all symbols except for variables, which can never be qualified. There is no syntax that would allow a variable to be defined with a qualifier. == Modules Each file is a module, the file name must match the module name (case insensitive, with - and _ characters stripped). By convention CamelCase is used. Each module begins with a module declaration. ---- ModuleDecl := 'module' QualifiedIdent ---- For example. ---- module MyModule ---- Modules may be organised into a heirachy by placing dots between identifiers to create the heirachy. Imagine a set of modules for networking such as: ---- Net.HTTP Net.HTTP.Extension // Some custom extension Net.Common // Common code used internally by the Net libraries Net.FTP Net.SSH ---- Each of these will have it's fully qualified name in the module declaration at the beginning of its file. Future work: * link:https://github.com/PlasmaLang/plasma/issues/316[Bug 316 - Support for libraries] * link:https://github.com/PlasmaLang/plasma/issues/352[Bug 352 - Package local modules] (To implement modules not available outside a "package" like the Common module in the example above). === Exports Resources, types and functions (all below) can all be exported from a module by placing the `export` keyword in front of them: ---- export resource MyRes from IO export type MyMaybe('x) = Nothing | Some(x : 'x) export func myFunc() uses IO { print!("Hello from a foreign module!\n") } ---- Types may additionally be opaque-exported: ---- export opaque type Tree('k, 'v) = Empty | Node( k : 'k, v : 'v, l : Tree('k, 'v), r : Tree('k, 'v) ) ---- which exports the type name but not how it is constructed. The above can export a tree without exposing the detail that it is a binary tree and ensuring that all the code for keeping the tree ordered correctly or balanced is in a single module. An exported thing may only refer to types and resources that are also exported. More precisely. a non-opaque exported thing may only refer, in its declaration but not its body, to types and resources that are either exported. For example: ---- resource A from IO export resource B from A export func foo() uses A { ... } ---- `B` and `foo` cannot be exported because A is not exported. Likewise: ---- type A = ... export opauqe type B = ... export type C = C(a : A) export type D = D(b : B) ---- `C` cannot be exported because `A` is not exported. `D` may be exported because `A` ls /opaque exported/. Future work: * link:https://github.com/PlasmaLang/plasma/issues/360[Abstract/opaque resources] == Imports ---- ImportDirective := 'import' QualifiedIdent | 'import' QualifiedIdent as ident ---- Modules may be imported with an import declaration. ---- import RBTreeMap import RBTreeMap as Map ---- +import+ imports a module. Lines one and two add a module name (+RBTreeMap+ or +Map+, respectively) to the current environment. For now all references to symbols from other modules must be module qualified. This is either with the module's name (e.g: +RBTreeMap+) or with a renaming of the module (e.g: +Map+), A module cannot be used without an +import+ declaration. == Types The Plasma type system supports: * Algebraic types * parametric polymorphism (aka generics) * Abstract types * Other features may be considered for a later version * Type variables begin with a +`+ sigil, * By convention type variables a lower case while type names begin with an uppercase letter. See also link:types.html[Type system design] which reflects more up-to-date ideas. Type expressions refer to types. ---- TypeExpr := TypeName ( '(' TypeExpr ( ',' TypeExpr )* ')' )? | 'func' '(' ( TypeExpr ( ',' TypeExpr )* )? ')' Uses* RetTypes? | '\'' TypeVar # Uses denotes which resources a function may use. Uses := 'uses' QualifiedIdent | 'uses' '(' QualifiedIdentList ')' | 'observes' QualifiedIdent | 'observes' '(' QualifiedIdentList ')' RetTypes := '->' TypeExpr | '->' '(' TypeExpr ( ',' TypeExpr )* ')' TypeName := QualifiedIdent TypeVar := ident ---- We can define new types using type definitions ---- TypeDefinition := ('export' 'opaque'?)? 'type' ident TypeParams? = OrTypeDefn ( '|' OrTypeDefn )* TypeParams := '(' ( '\'' Ident )* ')' OrTypeDefn := ConstructorName | ConstructorName '(' TypeField ( , TypeField )+ ')' TypeField := FieldName ':' TypeExpr | TypeExpr # Not supported ConstructorName := ident FieldName := ident ---- +TypeParams+ is a comma separated list of lowercase identifiers. +TypeField+ will need lookahead, so for now all fields must be named, but the anonymous name (+_+) is supported. TODO: We use vertical bars to separate or types. Vertical bars mean "or" and are used in Haskell, but in C commas (for enums) and semicolons (for unions) are used. Which is best? Mercury uses semicolons as these mean "or" in Mercury. TODO: We use parens around the arguments of constructors, like Mercury, and because fancy brackets aren't required. However curly braces would be more familiar to C programmers. === Builtin types How "builtin" these are varies. +Ints+ are completely builtin and handled by the compiler where as a List has some compiler support (for special symbols & no imports required to say "List(t)") but operations may be via library calls. * Int * Uint * Int8, Int16, Int32, Int64 * Uint8, UInt16, UInt32, UInt64 * CodePoint (a unicode codepoint) * Float (NIY) * Array('t) * List('t) * String (neither a CString or a list of chars). * Function types These types are implemented in the standard library. * CString * Map('t) * Set('t) * etc... === User types User defined types support discriminated unions (here a +Map+ is either a +Node+ or +Empty+), and generics (+'k+ and +'v+ are type parameters). ---- type Map('k, 'v) = Node( m_key : 'k, m_value : 'v, m_left : Map('k, 'v), m_right : Map('k, 'v) ) | Empty ---- TODO: Syntax will probably change, I don't like +,+ as a separator, I prefer a terminator, or nothing to match the rest of the language. Curly braces? +|+ is also used as a separator here. Types may also be defined opaquely, with their details hidden behind module abstraction. [[interfaces]] == Interfaces Interfaces are a lot like OCaml modules. They are not like OO classes and only a little bit like Haskell typeclasses. Interfaces are used to say that some type and/or code behaves in a particular way. The +Ord+ interface says that values of type +Ord.t+ are totally ordered and provides a generic comparison function for +Ord.t+. ---- type CompareResult = LessThan | EqualTo | GreaterThan interface Ord { type t func compare(t, t) -> CompareResult } ---- +t+ is not a type parameter but +Ord+ itself may be a parameter to another interface, which is what enables +t+ to represent different types in different situations; +compare+ may also represent different functions in different situations. We can create instances of this interface. ---- instance ord_int : Ord { type t = Int func compare(a : Int, b : Int) -> CompareResult { if (a < b) { LessThan } else if (a > b) { GreaterThan } else { EqualTo } } } ---- Note that in this case each member has a definition. This is what makes this an interface instance (plus the different keyword), rather than an (abstract) interface. The importance of this distinction is that interfaces cannot be used by code directly, instances can. Code can now use this instance. ---- r = ord_int.compare(3, 4) ---- Interfaces can also be used as parameter types for other interfaces. Here we define a sorting algorithm interface using an instance (+o+) of the +Ord+ interface. ---- interface Sort { type t func sort(List(t)) -> List(t) } instance merge_sort(o : Ord) : Sort { type t = o.t func sort(l : List(t)) -> List(t) { ... } } ---- +merge_sort+ is an instance, each of its members has a definition, but it cannot be used without passing an argument (an instance of the +Ord+ interface). A list of +Int+s can now be sorted using: ---- sorted_list = merge_sort(ord_int).sort(unsorted_list) ---- NOTE: This example is somewhat contrived, I think it'd be more convenient for sort to take a higher order parameter. But the example is easy to follow. +merge_sort(ord_int)+ is an instance expression, so is +ord_int+ in the example above. Instance expressions will also allow developers to name and reuse specific interfaces, for example: ---- instance s = merge_sort(ord_int) sorted_list = s.sort(unsorted_list) ---- More powerful expressions may also be added. Instances can also be made implicit within a context: ---- implicit_instance merge_sort(ord_int) sorted_list = sort(unsorted_list) ---- This is useful when an instance defines one or more operators, it makes using the interface more convenient. Suitable instances for the basic types such as Int are implicitly made available in this way. Only one implicit instance for the given interface and types may be used at a time. == Resources ---- ResourceDefinition := ('export' 'opaque'?)? 'resource' Ident 'from' QualifiedIdent ---- This defines a new resource. The resource has the given name and is a child resource of the specified resource. +SuperRes+ is the ultimate resource and is already defined, along with it's child resource such as +IO+. See 'Handling effects' below. == Code === Functions ---- FuncDefinition := FuncExport 'func' ident '(' ( Param ( ',' Param )* )? ')' Uses* RetTypes? Block FuncExport := 'export' 'entrypoint'? | 'entrypoint' 'export'? | Param := ident ':' TypeExpr | '_' : TypeExpr | TypeExpr (Only in interfaces) RetTyes := '->' TypeExpr | '->' '(' TypeExpr ( ',' TypeExpr )* ')' Block := '{' BlockThing* Return? '}' BlockThing := Statement | Definition ---- Uses is defined above in the type declarations section. TODO: Probably add support for naming return parameters TODO: Consider adding optional perens to enclose return parameters. TODO: More expressions and statements Code is organised into functions. A function has the following form. ---- func Name(arg1 : type1, arg2 : type2, ...) -> ret_type1, ret_type2 Resources? Block ---- In the future if the types are omitted from a non-exported function's argument list the compiler will attempt to infer them. For now all types are required. TODO: Find a way that return parameters can be named. This will change the behaviour of functions WRT having the value of their last statement. TODO: What if neither the name or type of a return value is specified? Resources is optional and may either or both "uses" or "observes" clauses, which are either the uses or observes keywords followed by a list of one or more comma separated resource names. The special symbol +_+ can be used as a parameter to ignore any arguments passed in that position, the type is still enforced. Note that function bodies may contain definitions. Allowing functions to be nested and in the future other definitions may be scoped within function bodies. If the definition is preceeded by +export+ then the function is made available to other modules. === Statements ---- Statement := FuncDefinition | VarDeclaration | Assignment | Call | MatchStemt ---- ==== Nested functions Plasma supports nested functions, which may also be closures. ---- var greeting = "Hello " func hi(name : String) -> String { return greeting ++ name ++ "\n" } print!(hi("Paul")) ---- Other than being able to close over other values, the only difference is that these functions do not (yet) support mutual recursion (bug https://github.com/PlasmaLang/plasma/issues/177[#177]). In the future we also intend to support lambda expressions (bug https://github.com/PlasmaLang/plasma/issues/165[#165]) and partial application (bug https://github.com/PlasmaLang/plasma/issues/164[#164]). ==== Variable declaration ---- VarDeclaration := 'var' Ident ---- This syntax declares a variable without giving it a value. It may be given a value with an assignment later. This is useful if a variable is given a value within branches of an if statement but it needs to be visible outside that statement. For example: ---- var variable ---- Declares a new uninitislised variable. ==== Assignment ---- Assignment := Pattern ( ',' Pattern )* '=' TupleExpr Pattern := Number | '[' ']' | '[' Pattern '|' Pattern ']' | 'var' Ident | '_' | QualifiedIdent ( '(' Pattern ',' ( Pattern ',' )+ ')' )? ---- The right-hand-side (RHS) of an assignment is a series of expressions separated by commas (a +TupleExpr+). More than one expression is used when there is more than one pattern on the left-hand-side. Sometimes a single expression is used when that expression's arity matches the number of patterns (eg: a call that returns multiple values). Plasma is a single assignment language. Variables have two possible states, uninitialised and initialised (aka assigned). Each variable can only be initialised once along any execution path, and must be initialised on each execution path that falls-through (see <>). In an assignment a pattern must be irrefutable (always matches), this means that only the last three syntactic forms of +Pattern+ make sense in an assignment. The first may also be used if we allow refutable patterns in some contexts in the future. Identifiers in the pattern must be, and are checked in this order: * Data constructors if followed by `(`. * New variables appearing fresh in the pattern (have the +var+ keyword). * Uninitialised variables declared ahead of the pattern. * Data constructors (constants). This is sound because (TODO): * The compiler will warn if a programmer shadows a constructor with a new variable. * The compiler will warn (lint level) if the programmer didn't need to separate variable declaration from initialisation. Examples: ---- variable = expr ---- Initialise a previously declared variable. ---- var variable = expr ---- Declares and initialises a new variable (this is preferred where possible). ---- var var1, var var2 = expr1, expr2 ---- Both variables are declared, `var1` is initialised to the value of `expr1` and `var2` to `expr2`. ---- var var1, var var2 = expr ---- The expression returns two values, `var1` takes the first value and `var2` the second. ---- var div, _ = div_and_quot(7, 5) ---- The wildcard symbol '_' matches everything and is used to ignore the some values. The function call returns two values but only the first is captured. ---- Point(var x, var y) = expr ---- The expression returns the data constructor Point (irrefutably). Point is deconstructed and `x` and `y` are new variables that take the values from the Point. You may also use the wildcard `_` and other constructors (provided they're irrefutable within a pattern. ---- var x Point(x, _) = expr ---- The first statement declares the variable `x` and the second statement binds it. ---- Point(x, _) = expr ---- `x` is not a variable in this context and therefore it must be a data constructor, and must be matched irrefutably. ---- _ = close!(file) ---- Ignores the result of a function call that affects a resource. ==== Function call ---- Call := ExprPart1 '!'? '(' Expr ( , Expr )* ')' ---- Function calls often return values, however functions that do not return anything can be called as a statement. Such a function only makes sense if effects a resource, and therefore will have a '!'. However the grammar and semantics allow functions that don't have an affect (the compiler will almost certainly optimize these away). ---- function_name!(arg1, arg2) ---- Calls may also be expressions (see below), as an expression a call might still use or observe some resource. However only one call per statement may observe the same or a related resource, this ensures that effects happen in a clear order. ==== Return ---- Return := 'return' TupleExpr | 'return' ---- For example: ---- # Return one thing return expr # Return two things return expr1, expr2 # Return nothing return ---- A function that returns a one or more values must always end in a return statement, or a branching statement that (indirectly) ends in a return statement on each branch. TODO: This will need to be relaxed for code that aborts. TODO: Named returns. Functions that return nothing may optional use a return statement, this can be used to implement early return. Functions and blocks do not have values. This is deliberate to keep functions and expressions _semantically_ separate. This means that the last statement of a block does not have any special significance as it does in some other languages. ==== Pattern matching ---- MatchStmt := 'match' Expr '{' Case+ '}' Case := Pattern '->' Block ---- Pattern matching is a statement (as well as an expression). Cases are tried in the order they are written, the compiler should provide a warning if a case will never be executed, or a value is not covered by any cases. ---- var beer match (n) { 0 -> { beer = "There's no beer!" } 1 -> { beer = "There's only one beer" } var m -> { beer = "There are " ++ show(m) ++ " bottles of beer" } } print!(beer) ---- If a variable declared outside the match is assigned by one of the cases (like +beer+) then it must be assigned by every case (see <>). Currently either all cases must have a return statement or none of them. TODO Matches where some return and others do not will be added in the future. Note that a pattern match can bind a variable declared in the outer scope: ---- var x match (...) { ... x -> { ... } } // x is now set. ---- ==== If-then-else ---- ITEStmt := 'if' Expr Block 'else' ElsePart ElsePart := ITEStmt | Block ---- ---- if (expr) { statements } else if (expr) { statements } else { statements } ---- Note: the parens around the condition are optional. There may be zero or more else if parts. Plasma's single-assignment rules imply that if the "then" part of an if-then-else binds a non-local variable, then there must be an else part that also binds the variable (or does not fall-through). Else branches aren't required if the then branch does not fall-through or does not bind anything (it may have an effect). [[loops]] ==== Loops NOTE: Not implemented yet. NOTE: I'm seeking feedback on this section in particular. ---- # Loop over both structures in a pairwise way. for [var x <- xs, var y <- ys] { # foo0 and foo form an accumulator starting at 0. The value of foo # becomes the value of foo0 in the next iteration. accumulator foo0 foo initial 0 # The loop body. var z = f(x, y) foo = foo0 + bar(x) # This loop has three outputs. "list" and "sum" are names of # reductions. Reductions are instances of the reduction # interfaces. They "reduce" the values produced by each iteration # into a single value. output zs = list of z output sum = sum of x # foo is not visible outside the loop, an output is required to # expose it. value is a keyword, it is handled specially and # simply takes the last value encountered. output foo_final = value of foo } ---- NOTE: the accumulator syntax will probably change after the introduction of some kind of state variable notation. TODO: Introduce a more concise syntax for one-liners and expressions, like list comprehensions (see 'Generators' below). The loop will iterate over corresponding items from multiple inputs. When they're not of equal length the loop will stop after the shortest one is exhausted. This decision allows them to be used with a mix of finite and infinite sequences. Looping over the Cartesian combination of all items should also be supported (syntax not yet defined, maybe use +&+). This is equivalent to using nested loops in many other languages. Valid input structures are: lists, arrays and sequences. Sequences are coroutines and therefore can be used to iterate over the keys and values of a dictionary, or generate a list of numbers. TODO: Possibly allow this to work on keys and values in dictionaries. If the keys are unmodified during the loop then the output dictionary can be rebuilt more easily, its structure doesn't need to change. Lua has the ability to require keys to be sorted, or to drop this requirement. The output declarations include a reduction. This is how the loop should build the result. TODO: Reduction isn't a good word for it, since the output type can be either a scalar or a vector. The reduction can be completely different from the type of any of the inputs. This builds an array from a list (or other ADT). This uses the +array+ reduction. ---- for [var x <- xs] { var y = f(x) output ys = array of y } ---- Many reductions will be possible: +array+, +list+, +sequence+, +min+, +max+, +sum+, +product+, +concat_list+. Developers will be able to create their own as these are interfaces. Loops are implemented in terms of coroutines. Coroutines return the values for the inputs and the loop body and coroutines handle building the value of the outputs (list and sum are coroutines above). Coroutines offer the most flexibility as some of their state is kept on the stack. Simpler implementations should be used as an optimisation when it is possible. In these cases some loops may be optimised to calls to map or foldl, or even simpler inline code. Auto-parallelisation (a future goal) will work better with reductions that are known to be either: - Order independent - Associative / commutative, but whose input type is the same as the output - Mergable, with a known identity value. Accumulators are implemented more directly (not coroutines). However they require the iterations to be processed in a specific order and may inhibit parallelisation. A dependency analysis on the body and separating out the code for each accumulator may mitigate this, especially if it can be combined with the same analyses as reductions above. TODO: Consider allowing for loops as expressions, maybe a simplified case. This will be similar to a list comprehension. Note that Plasma's for loops may be similar to some language's query syntax like LINQ. TODO: Look there for other ideas. TODO: skip statements. A `skip` statement is like the opposite of the `where` part in some language's list comprehensions, but perhaps more flexible like C's `continue` statement. Technically if we can support this then we can also support `break`, but I don't like it because it doesn't encourage a preferred style. Furthermore if we go this far it's a simple step to use any generator (below) with `break` to create something as general as a while loop. It may even look very similar to a while loop with the right sugar. TODO: Consider also the "scan" or "search" loop pattern, where once we find what we're looking for we break, maybe potentially removing the item from a collection? Is filter part of the scan pattern or the fold pattern? === Expressions Expressions are broken into two parts. This allows us to parse call expressions properly, with the correct precedence and without a left recursive grammar. Binary operators are described as a left recursive grammar, but are not implemented this way, their precedence rules are documented below. ---- TupleExpr := Expr ( ',' Expr )* Expr := 'match' Expr '{' (Pattern '->' TupleExpr)+ '}' | 'if' Expr 'then' TupleExpr 'else' TupleExpr | Expr BinOp Expr | UOp Expr | ExprPart1 '!'? '(' Expr ( , Expr )* ')' % A call or % construction | ExprPart1 '[' '-'? Expr ( '..' '-'? Expr )? ']' % array access | ExprPart1 ExprPart1 := '(' Expr ')' | '[' ListExpr ']' | '[:' TupleExpr? ':]' # An array | QualifiedIdent # A value | Const # A constant value BinOp := '+' | '-' | '*' | '/' | '%' | '++' | '>' | '<' | '>=' | '<=' | '==' | '!=' | 'and' | 'or' UOp := '-' # Minus | 'not' # Logical negation ---- UOp operators have higher precedence than BinOp, BinOp precidence is as follows, group 1: * / %, group 2: + - group 3: < > <= >= == !=, group: 4-7: and or ++ , See <>. Lists have the following syntax (within square brackets) ---- ListExpr := e | Expr ( ',' Expr )* ( '|' Expr )? ---- Examples of lists are: ---- # The empty list [] # A cons cell [ head | tail ] # A list 1, 2, and 3 are "consed" onto the empty list. [ 1, 2, 3 ] # Consing multiple items at once onto a list. [ 1, 2, 3 | list ] ---- Arrays elements may be access by _subscripting_ the array. Eg +a[3]+ will retrieve the 3rd element (1-based). A dash before the subscript expression will count backwards from the end of the array, +a[-2]+ is the second last element. This syntax currently clashes with unary minus and so is currently unimplemented. Array slices will use the +..+ token and are also unimplemented. TODO: Arrays may also be typed and subscripted to work with a particular enum (See the Ada programming language). This should include a different range (maybe dynamic) than the full enum's range. Any control-flow statement is also an expression. ---- x = if (...) then expr else expr ---- Or ---- x = case (expr) { Leaf(var k, var v) = ... Node(var l, var k, var v, var r) = ... } ---- === Streams/Generators TODO: This whole section Plasma will support coroutines that can be used for generators. It may be useful for list/array comprehensions if we choose to add those. But also to support loops above. Some things to support with generators are: * Generate a sequence from the items of an enum type (see Ada). * Generate a sequence from integers / floats with some step, (a special case of enums) * Generate a shortened sequence, 7..21 or Monday..Friday * Use guards to select which items are included. * Create generators from for loops, enabling the use of an accumulator. This will make them almost like list comprehensions except as statements. * Consider syntax sugar when the generator is a function: ---- var array = [\x -> case x of Sat..Sun -> 2 _ -> 8 for x <- enum(Days)] // could be: var array = [Sat..Sun -> 2 others -> 8] ---- This hides both the lambda expression and the pattern match. Note that lambda or generator syntax is not specified yet so this may be different in reality, or not implemented at all. == Pragmas ---- Pragma := 'pragma' Ident '(' PragmaArgs? ')' PragmaArgs := PragmaArg (',' PragmaArg)* PragmaArg = String ---- Pragmas provide a way for the programmer to communicate something "out of bound" to the compiler/other tools. This is usually not something that's part of the program's meaning, but how it should be interpreted. For example what library to include or how to compile something. They take the form above with the identifier being the name of the pragma which the compiler or other tools will use as a first step to interpret the pragma. Pragmas will generally have the form: ---- pragma Verb(Noun0, Noun1 ... NounN) ---- There may be any number of nouns including zero. A Plasma implementation will define what verbs are meaningful and which nouns (if any) are meaningful for that verb. A Plasma implementation *should* issue a warning but *must not* issue an error (except for a warnings-as-errors mode) for a pragma it doesn't understand. This Plasma implementation understand the following pragma: ---- pragma foreign_include(String) ---- Which says that the foreign code elsewhere in this file requires the foreign (C language) header file named by the string literal. == Ideas These are just ideas at this stage, they are probably bad ideas. If a multi-return expression is used as a sub-expression in another context then that expression is in-turn duplicated. ---- var x, y = multi_value_expr + 3 ---- is ---- var x0, y0 = multi_value_expr var x = x0 + 3 var y = y0 + 3 ---- Therefore calls involved in these expressions must not "use resources". Another idea to consider is that a multiple return expression in the context of function application applies as many arguments as values it returns. We probably won't do this. ---- ... = bar(foo(), z); ---- Is the same as ---- var x, y = foo(); ... = bar(x, y, z); ---- [[resources]] == Handling effects (IO, destructive update) Plasma is a pure language, we need a way to handle effects like IO and destructive update. This is called resources. A function call that uses a resource (such as +print()+), may only be called from functions that declare that they use a resource. This means that a callee cannot use a resource that a caller doesn't expect (resource usage is transitive) and anyone looking at a functions' signature can tell that it might use a resource. A resource usage declaration looks like: ---- func main() -> Int uses IO ---- Here +main()+ declares that it uses (technically _may use_) the +IO+ resource. Resources can be either _used_ or _observed_; and a function may use or observe any number of resources (decided statically). An observed resource may be read but is never updated, a used resource may be read or updated. This distinction allows two observations of a resource to commute (code may be re-arranged during optimisation), but two uses of a resource may not commute. Developers may declare new resources, the standard library will provide some resources including the +IO+ resource. Examples of +IO+ 's children might be +Filesystem+ and +Time+, +Filesystem+ might have children for open files (WIP), although none of these have been decided / implemented. A call is valid if: |=== | | Callee is Pure | Callee may Observe | Callee may Use | Caller is Pure | Y | N | N | Caller may Observe | Y | Y | N | Caller may Use | Y | Y | Y |=== You'll find that this is very intuitive. It's shown in a table for completeness. === Resource hierarchy Resources form a hierarchy (not yet defined). For a call to be valid either the resource, or its parent must be available in the caller. For example if +mkdir()+ uses the +Filesystem+ resource, which is a child of +IO+ then any caller that +uses IO+ can call +mkdir()+. === Temporary resources (NIY) Some resources can be creating and destroyed, and rather than being a part of their parent always (+Filesystem+ is always a part of +IO+) they are subsumed by their parent instead. For example an array uses some memory as its resource, that memory is allocated and freed when the array is initialised and then goes out of scope (it is unique). But if that the memory resource is created and destroyed within the same function, it's caller does not need the uses declaration, memory and possibly some other resources are special cases. === Resources in statements Every call that uses a resource must have the +!+ suffix. For example: ---- print!("Hello world\n") ---- This makes it clear to anyone reading the code to *beware* something _happens_, _changes_ or might be _observed_ to have happened or have changed. This is also the entire reason to have it in the language, it serves no other function, but the compiler will make sure that it is present on every call that either uses or observes something. Multiple calls with +!+ may be used in the same statement, provided that their resources do not overlap, or they are all observing the resource and not modifying it. (Note that we are debating) this at the moment). === Commutativity of resources Optimisation may cause code to be executed in a different order than written. The following reorderings of two related (ancestor/descendant) resources are legal. |=== | | None | Observe | Use | None | Y | Y | Y | Observe | Y | Y | N | Use | Y | N | N |=== Non-related resources may be reordered freely. === Higher order code This aspect of Plasma is under consideration and may change in the future. The concerns are: * Higher order functions need to handle resources, otherwise their usefulness is reduced. * Resource usage from such code needs to be safe (WRT order of operations). * We want to encourage polymorphism here, otherwise people will write higher-order abstractions that can't be used with resources. * We'd prefer to make code concise that isn't intended to be used with resources, but ought to be resource-capable anyway. ==== Current behaviour (WIP) Higher order values may have +uses+/+observes+ declarations (added to their type) values without such declarations are pure. All higher order calls have the usual +!+ sigil and the statement rules apply. Map over list looks like: ---- func map(f : 'a -> 'b uses r, l : List('a)) -> List('b) uses r { switch (l) { case [] -> { return [] } case [var x0 | var xs0] -> { var x = f!(x0) var xs = map!(f, xs0) return [x | xs] } } } ---- Note that the calls to +f+ and +map+ must be in separate statements. This has the disadvantage that it is not as concise, and that people who aren't planning to use resources, won't write resource-capable code, if that code is in a library it may be annoying to modify if it needs to be used with a resource later. NOTE: This is almost implemented, polymorphic resources are not yet implemented. ==== Other proposals There are several other ideas and their combinations that may help. * All higher order code implicitly uses resources, a function like map therefore also uses that resource since it contains such calls. When a higher order value doesn't mention resources it is implied to use some polymorphic resource set. To say that no resources are involved and ordering is not important the +pure+ keyword may be used in place of a +uses+ or +observes+ clause. Type inference may help make this easier. * Require all higher-order code to handle resources, users may feel that the compiler is being overly-pedantic. * Higher order calls are exempt from the one-resource-per-statement rule. Making the code more concise (it still includes a !). ** Either expressions have a well-ordered declarative semantics or ** resources must be declared as 'don't-care' ordering so they can be placed in the same statements. === Linking to and storing as data (NIY) Linking a resource with a _real_ piece of data, such as a file descriptor, is highly desirable. Likewise putting such data inside a structure to be used later, such as a pool of warmed-up database connections, will be necessary. There are a couple of ideas. We could add information to the types to say that they are resources and what their parent resource type is. So that the variable can stand-in for the resource. ---- type Fd = resource from Filesystem func write(Fd, ...) uses Fd ---- == Builtins These builtin operations are always available, they don't need to be imported from a module. // This documentation should be kept in-sync with tests/builtin/ // and tests/language/operators.p `type Maybe('v)`:: A maybe type, defined as: ---- type Maybe('v) = Some('v) | None ---- === Integers `type Int`:: A signed 2's compliment integer, its width is at least 32 bits and implementation defined. `Int + Int -> Int`:: Addition (also `func Builtin.int_add(a : Int, b : Int) -> Int`) `Int - Int -> Int`:: Subtraction (also `func Builtin.int_sub(a : Int, b : Int) -> Int`) `Int * Int -> Int`:: Multiplication (also `func Builtin.int_mul(a : Int, b : Int) -> Int`) `Int / Int -> Int`:: Division (also `func Builtin.int_div(a : Int, b : Int) -> Int`) `Int % Int -> Int`:: Modulo/Remainder (link:https://github.com/PlasmaLang/plasma/issues/378[#378, which one?]) (also `func Builtin.int_mod(a : Int, b : Int) -> Int`) `- Int -> Int`:: Unary minus (prefix operator, takes only one argument). (also `func Builtin.int_minus(a : Int) -> Int`) `func Builtin.int_lshift(a : Int, b : Int) -> Int`:: Left shift `a` by `b` bits. `func Builtin.int_rshift(a : Int, b : Int) -> Int`:: Right shift `a` by `b` bits. `func Builtin.int_and(a : Int, b : Int) -> Int`:: Bitwise and. `func Builtin.int_or(a : Int, b : Int) -> Int`:: Bitwise or. `func Builtin.int_xor(a : Int, b : Int) -> Int`:: Bitwise exclusive-or. `func Builtin.int_comp(Int) -> Int`:: One's compliment (flip all the bits). `func int_to_string(Int) -> String`:: Return a string representation of the number. No nice formatting is attempted. Future work: * TODO: Use interfaces to provide many of these operations to a group of types. Eg many integer operations will apply to all numbers. Same with the relational operators below. * TODO: Once there is an Int module move the builtin Int functions to it. * TODO: The bitwise functions should be for sized integers only. === Bools `type Bool`:: Is defined as: ---- type Bool = False | True ---- `Int > Int -> Bool`:: Greater than (also `func Builtin.int_gt(a : Int, b : Int) -> Int`) `Int < Int -> Bool`:: Lesser than (also `func Builtin.int_lt(a : Int, b : Int) -> Int`) `Int >= Int -> Bool`:: Greater than or equal to (also `func Builtin.int_gteq(a : Int, b : Int) -> Int`) `Int <= Int -> Bool`:: Less than or equal to (also `func Builtin.int_lteq(a : Int, b : Int) -> Int`) `Int == Int -> Bool`:: Equal (also `func Builtin.int_eq(a : Int, b : Int) -> Int`) `Int != Int -> Bool`:: Not-equal (also `func Builtin.int_neq(a : Int, b : Int) -> Int`) `Bool and Bool -> Bool`:: Logical add (also `func Builtin.bool_and(a : Bool, b : Bool) -> Bool`) `Bool or Bool -> Bool`:: Logical or (also `func Builtin.bool_or(a : Bool, b : Bool) -> Bool`) `not Bool -> Bool`:: Unary not (prefix operator, takes only one argument) (also `func Builtin.bool_not(a : Bool) -> Bool`) `func bool_to_string(Bool) -> String`:: Return one of the strings "True" or "False". === Strings `type String`:: A character string. `type CodePoint`:: A Unicode Codepoint (see https://unicode.org/glossary/#code_point). `type CodepointCategory`:: The general category of a Unicode codepoint (see https://unicode.org/glossary/#general_category). Is defined as: ---- type CodepointCategory = Whitespace | Other ---- `type StringPos`:: A position within a string, a `StringPos` always points to the edge between characters, or before the first character or after the last. This makes substring operations clearer. `String ++ String -> String`:: String concatenation (also `func Builtin.string_concat(a : String, b : String) -> String`). `func codepoint_category(CodePoint) -> CodepointCategory`:: Return the class of a character. `func codepoint_to_string(CodePoint) -> String`:: Return a string containing only this codepoint. `func codepoint_to_number(CodePoint) -> Int`:: Return the codepoint number for this codepoint. `func Builtin.int_to_codepoint(Int) -> CodePoint`:: Make a codepoint from this integer. `func string_begin(String) -> StringPos`:: Return a `StringPos` of before the beginning of the string. `func string_end(String) -> StringPos`:: Return a `StringPos` of after the end of the string. `func string_substring(StringPos, StringPos) -> String`:: Return the string between the two `StringPos` parameters. The two parameters must have been created from the same string (runtime checked). `func string_equals(String, String) -> Bool`:: Return `True` if the strings are equal. `func strpos_forward(StringPos) -> StringPos`:: Return a `StringPos` moved one character forward. The `StringPos` must not be at the end of the string (Runtime check). `func strpos_backward(StringPos) -> StringPos`:: Return a `StringPos` moved one character backward. The `StringPos` must not be at the beginning of the string (Runtime check). `func strpos_next(StringPos) -> Maybe(CodePoint)`:: Return the next char in the string after `StringPos`. If `StringPos` is at the end of the string then `None` is returned. `func strpos_prev(StringPos) -> Maybe(CodePoint)`:: Return the previous char in the string before `StringPos`. If `StringPos` is at the beginning of the string then `None` is returned. === Lists ---- type List('t) = ['t | List('t)] | [] ---- The list data type. This is recursively defined to either be a single element (the head) appended on to another list (the tail); or the empty list. The fields of the concatentation constructor (head and tail) have names internal to the compiler, TODO: maybe expose them in a list module if fields are permitted to be used as functions in the future. '[]':: The empty list. (also `func Builtin.list_nil() -> List('t)`). '[x | xs]':: 'x' appended to the front of 'xs'. (also `func BUiltin.list_cons('t, List('t)) -> List('t)`). === Misc `resource IO`:: The uber-resource, it covers all potential effects. `resource Time from IO`:: A resource to query the current time with `gettimeofday`. `resource Environment from IO`:: A resource to set the environment with `setenv`. `type IOResult('t)`:: A result type for many IO operations that may return end-of-file. type IOResult('t) = Ok('t) | EOF `func print(String) uses IO`:: Write the string to standard out. `func readline() uses IO -> IOResult(String)`:: Read a line from standard in, the newline character is not returned. Aborts the program (TODO) on error. `func Builtin.set_parameter(String, Int) uses IO -> Bool`:: Set a parameter for the runtime system. There are currently no settable parameters so this always returns false. `func Builtin.get_parameter(String) observes IO -> Bool, Int`:: Get a parameter, if the parameter exists returns `True, value`, otherwise returns `False, 0`. The parameters are: `heap_usage`::: The used memory in the heap. `heap_collections`::: The number of garbage collections that have occurred so far. `func setenv(String, String) uses Environment -> Bool`:: Calls `setenv` on POSIX. `func Builtin.gettimeofday() observes Time -> Bool, Int, Int`:: Calls `gettimeofday` and returns `True, secs, usecs` on success. `func Builtin.die(String)`:: Abort the program with the given message. A lot of these (eg `die`, `setenv`) exist for testing and will likely change or be part of a different module in the future. [[precedence]] === Operator precedence .Operator precedence [options="header"] |========================== |Operator 2+| Level | `*` | 1 | Associates most tightly | `\` | 1 | Associates most tightly | `%` | 1 | Associates most tightly | `+` | 2 | | `-` | 2 | | `<` | 3 | | `>` | 3 | | `<=` | 3 | | `>=` | 3 | | `==` | 3 | | `!=` | 3 | | `and` | 4 | | `or` | 5 | | `++` | 6 | Associates least tightly |========================== Operators within the same level bind left-to-right, For example: `1 * 2 / 3` is `(1 * 2) / 3` // vim: set syntax=asciidoc: ================================================ FILE: docs/pz_machine.txt ================================================ Plasma Abstract Machine ======================= :Author: Paul Bone :Email: paul@plasmalang.org :Date: October 2018 :Copyright: Copyright (C) Plasma Team :License: CC BY-SA 4.0 :toc: This document describes the behaviour of the Plasma Abstract Machine (PZ Machine). The PZ file format is described in link:pz_format.html[PZ Bytecode Format]. Implementations of the PZ abstract machine are shall be discussed elsewhere (TODO) In this document we use the textual version of the .pz files for illustrative purposes. However the textual format is never used as an interchange format and rarely used as a language so it does not need or have a specification. == Basic data types The abstract machine supports words of varying sizes, with the symbols representing them. - 8bit (+w8+) - 16bit (+w16+) - 32bit (+w32+) - 64bit (+w64+) - fast word width (+w+) - a word width the same width as a pointer (+wptr+) - a pointer (+ptr+) A fast word width is a width that should be the fasted word width for integers on the platform. This may take into account register size, memory usage and maybe implementation convenience. A word with the same width as a pointer and a pointer differ only in whether the garbage collector may trace them. Which is significant in some contexts (like structures) but not in others (like instruction parameter widths). .TODO: Polymorphism NOTE: Handle polymorphism for +wptr+/+ptr+. We'll probably remove wptr and handle the pointer vs non-pointer distinction another way. Some instructions only make sense with either signed or unsigned data, this is up to individual instructions, the PZ format and abstract machine don't care. This way "move a 32bit word" makes sense regardless of whether the word is signed, unsigned, or something else (float, bitfield etc). The PZ machine also supports structures and arrays, more on those later. == Registers The PZ Machine is a stack based machine, it has two registers: * the instruction pointer (aka program counter) (+IP+) and * the environment pointer (+ENV+) the instruction pointer "points to" the next instruction to execute. While the environment pointer points to the current environment which is used by closures to refer to their environment. == Stacks The basic abstract machine is a stack machine with two stacks. A return stack and an expression stack. The return stack is used to handle procedure call and return including saved closure environments. Very little control of the return stack is available. Both basic instructions and procedures are a transformation of the top of the expression stack. == Notation A procedure or instruction's signature may look like: add (w w - w) This describes the instruction + as taking two words from the top of stack and replacing them with a word. Calling conventions for procedures work the same way. The expression stack is used for argument passing and temporary storage. fibs (w - w) From a callee's perspective, there is little difference between an instruction and a call. If an instruction is available for all word sizes it may be written as: add (* * - *) This is a convention only, there is no support for polymorphism. When using the textual format for PZ, you may disambiguate which instruction you need with a suffix. eg: add:8 add:16 add:32 add:64 add:w (fast word width) add (no suffix also means fast word width) add:ptr (pointer word width) This works similarly for literal data. This is a byte containing the number 23. 23:8 This is only available for instructions, not calls. Also in our notation we indicate immediate data with CamelCase, and in the case of calls and literal data, the instruction name is not provided. The instruction to use is available via context. == High level bytecode items Each item in a bytecode file belongs in one of four types and is referred to by a 32bit ID. Each item type has its own ID-space. In other words data item 5 and procedure 5 are separate. Names are used in .pzt files but are discarded when these are compiled to .pz files. The exceptions are imported items, exported items (TODO), and in the future some names and other information may be stored for debugging. === Imports Each import is a fully qualified reference to a closure in another module. The list of imports is provided so that .pz files can then refer to each import by an Import ID. The import section of the .pz file maps these IDs to names for looking up in other module's symbol tables. === Structs A struct is a record type, and has a lot in common with a C struct. Each struct has a fixed number of fields and each field has a width (as above). Structs allow the bytecode interpreter to make its own data layout decisions. Which it may do differently on different platforms. .Example usage of this information TIP: When a program is loaded and the loader reads a struct type. For that struct type it computes offsets for each of the fields, computes the total size. === Data Data items come in three types: * Basic data: a single data item of a specific width. * Array data: a number of data items of the same width, usually packed together. * Structure data: a structure of data, the data item provides the struct ID and the value of each field. Structure fields may contain: ** Basic data (like above) ** A reference to another data structure ** A reference to an imported closure ** (more to come) === Procedures Procedures contain executable code. A procedure's signature is a "stack transformation" it represents the top of stack values before and after a call to this procedure. This is explained above. Procedures are made up of blocks which are used for control flow. The first block in each procedure is executed when the procedure is called. Within each procedure blocks are numbered sequentially starting at 0. Jump instructions refer to their destination by block ID. Note that execution can never "fall through" a block, the last instruction in every block must be an unconditional control flow instruction. === Closures Closures can be created by code by bundling a procedure reference with an environment. The environment is a heap allocated struct. See +make_closure+ below. When calling a closure the environment is placed into the +ENV+ register and the previous one is pushed onto the stack to be restored after the procedure call. Closures are also created with the closure declaration, the procedure and data ids are specified. === Options The PZ format also contains options. Only one option of each type is allowed, and the only type (now) is the entrypoint. The entrypoint option specifies the ID of the closure that should be executed to run the module. == Instructions Each instruction is made from an opcode, between zero and two operand widths and optionally an immediate value. === Zero extend, Sign extend and Truncate ze (* - *) se (* - *) trunc (* - *) Zero extends, sign extends or truncates the value on the top of the stack. By truncate we mean discard the most significant bytes. While most instructions work on a single operand width, these instructions use two operand widths. For example. ze (w16 - w32) Note that it is not necessary (or advised) to use these instructions to convert to and from pointer data, for example to manipulate tagged pointers. === Arithmetic add (* * - *) sub (* * - *) mul (* * - *) div (* * - *) mod (* * - *) Integer addition, subtraction, multiplication, division and modulus. lshift (* w8 - *) rshift (* w8 - *) and (* * - *) or (* * - *) xor (* * - *) Bitwise operations. Note that right shift is unsigned. A signed version will be added later. not (* - *) Logical negation === Comparison lt_u (* * - w) lt_s (* * - w) gt_u (* * - w) gt_s (* * - w) eq (* * - w) Less than and greater than on unsigned and signed data. Note that the result is always fast word width. Likewise conditional instructions always take their argument in the fast word width. === Stack manipulation Stack manipulation instructions don't care about data width, the machine conceptually places all data in the same sized slots. drop N Drop the top _N_ items from the stack. roll N Rotate the top _N_ items on the stack. The top _N_-1 items move to the down, the lowest item becomes the highest. Note that +roll 2+ is the same as +swap+. pick N Push the _N_th item on the stack to the top of the stack. Note that +pick 1+ is the same as "dup" === Calls call ClosureId (-) call ImportId (-) call ProcId (-) call_ind (ptr -) Call the given item as follows: . Push the value of the instruction pointer and environment pointer onto the return stack. . If indirect version: .. Pop the top-of-stack and let this be the closure in the next stanza. . If closure, import or indirect version: .. Deconstruct the closure that ClosureId/ImportId refers to. .. Load the instruction pointer with the address of the first instruction in the first block of the procedure the closure references. .. Load the environment register with the environment referred to by the clousre. . If proc version: .. Load the instruction pointer with the address of the first instruction in the first block of the procedure that ProcId. The order of the return address and environment on the stack are not specified, provided that the call instructions and +ret+ instruction agree about the order. Because the Proc version does not change the +ENV+ register, it is slightly faster. It is only possible for intra-module calls. There are tailcall versions of each of the above: tcall ClosureId (-) tcall ImportId (-) tcall ProcId (-) tcall_ind (ptr -) These are defined the same as above except they skip step 1. ret (-) Pop two values off the return stack, place the return address into the instruction pointer register, and the saved environment in the environment address register. === Jumps: jmp, cjmp jmp BlockId (-) Jump unconditionally to the indicated block by loading the address of the first instruction of the block into the instruction pointer. Note that only blocks can be the target of jump instructions, this way all jmp targets are known. cjmp BlockId (w -) Pop a value of the expression stack, if it is non-zero load the address of the first instruction of the given block into the instruction pointer. Note that this instruction always consumes the value on the stack. TODO: indirect jumps or some mechanism for computed gotos. === Make closure make_closure ProcId (ptr - ptr) Form a closure from the given procedure and the structure pointed to by the TOS. Return the new closure on the TOS. It would be possible to make closures a special type of struct, such as a struct whose first argument is a function pointer. This would use less memory and could be used by further optimisations. However we've chosen to get closures working with this more naive method and probably change it later. Also, closures could be implemented entirely within the compiler. However by making them a PZ machine construct we can take advantage of them for code loading and potentially other things. === Loops TODO: Some loops may be handled differently than using blocks and jumps, === Data ==== Load immediate number N (- *) Loads the immediate value onto the expression stack. (N is any value). ==== Load code reference ImportId (- ptr) AKA: load_named, Loads the address of the closure referenced by ImportId. ==== Load and store memory load StructId FieldNum (ptr - * ptr) Read the value of a field from the object at the given address. _StructId_ and _FieldNum_ are literal. store StructId FieldNum (* ptr - ptr) Store a value into the field of an object at the given address. TODO: Make sure that we can easily handle memory barriers for GC. TODO: Ordinary and array loads and stores. ==== Memory allocation alloc StructId (- ptr) alloc_mutable StructId (- ptr) alloc_array ElementWidth (w - ptr) alloc_array_mutable ElementWidth (w - ptr) The contents of structures and arrays are initialised with the store instruction, including immutable structures and arrays. Immutability is not yet enforced or even used, in the future we may add a "fix" operation to say that we're done initialising a structure, or otherwise require this implicity before the next allocation or call occurs. The GC among other things will use immutability information to optimise its algorithms. Plasma will use immutable structures more often than mutable ones, so immutable is the "normal" type, and a mutable type has not yet been introduced. ==== Retrive environment The environment is a pointer to a struct stored in the +ENV+ register. The register can be read with: get_env (- ptr) Then the resulting pointer can be used as a regular struct. == Garbage collection The Garbage Collector must be aware of which values are pointers and which are not. Above we explained how information about structures can be used to calculate this for typical heap cells. This information must also be available for stack frames. There are multiple ways to make this available at runtime. One simple solution is at each GC save point execute code that updates a word in the stack frame containing a bitfield that specifies which stack slots contain a pointer into the heap. We will probably require .pz programs to provide such bitfields within their instruction streams. Since we use separate expression and return stacks it will need to include information about how many of the top stack values belong to the current procedure. .TODO: Polymorphism NOTE: Any polymorphic values will need their "is a pointer" bit filled in at runtime. We can generate runtime code that takes an argument and constructs the bit field. This information can be passed to the procedure by adding extra argument(s) to the procedure, which is how polymorphism transformations work in general. === Optimisations The objects' bitfields can easily be stored together, as mark bits are already stored in a GC. To save further on memory usage objects with particular layouts can be allocated in particular heap regions. These heap regions themselves provide this information. If a heap layout stores object sizes with the object, the bitfields for most object sizes could easily be packed with the object size. Some of the information required for stack frames is implicit within the instruction stream. Requiring it to be made explicit makes writing +pzrun+ easier, but some of it could be omitted in a later version. == Builtin operations See runtime/pz_builtin.c .Misc ---- print (ptr -) int_to_string (w - ptr) die () ---- .Pointer tagging ---- // Combine a pointer and a tag into a tagged pointer make_tag (ptr ptr - ptr) // Combine a word and a tag into a tagged word (shifting the word) shift_make_tag (ptr ptr - ptr) // Extract the pointer and tag from a tagged pointer break_tag (ptr - ptr ptr) // Extract the word and tag from a tagged word (shifting the word) break_shift_tag (ptr - ptr ptr) // Unshift a tagged value unshift_value (ptr - ptr) ---- .Deprecated ---- concat_string (w w - w) ---- == Linking to other modules TODO == Working with foreign code TODO == Using PZ === A note about data The stack cannot be used to store complex data, neither can it be intermediate in the instruction stream. Complex data (structs and arrays) must be either statically allocated or allocated on the heap. In either case the PZ machine needs to know about the structure or array being used. // vim: set syntax=asciidoc: ================================================ FILE: docs/references.txt ================================================ Plasma Language References ========================== :Author: Paul Bone :Email: paul@plasmalang.org: :Date: May 2018 :Copyright: Copyright (C) Plasma Team :License: CC BY-SA 4.0 References to 3rd-party papers and software that we are using or that may be helpful at some point. == Papers, Books & other ideas === Closures * https://pdfs.semanticscholar.org/28b6/d269ebee933c378e539f1c378740d409330d.pdf[Luca Cardelli: Compiling a Functional Language] * https://www.cs.indiana.edu/~dyb/pubs/closureopt.pdf[Andrew Keep, Alex Hearn, R. Kent Dybvig: Optimising Closures in O(0) time] * http://flint.cs.yale.edu/flint/publications/escc.html[Zhong Shao, Andrew Appel: Efficient and Safe for space closure conversion] My own blog articles, the second one discusses the two above papers: * https://paul.bone.id.au/2017/12/03/compiling-closures/[Compiling closures] * https://paul.bone.id.au/2017/12/10/compiling-closures2/[More on closures] === Continuations Implementation Strategies for First-class continuations:: http://lampwww.epfl.ch/teaching/archive/advanced_compiler/2006/assignments/part5/continuations.pdf === GC References The Garbage Collection Handbook:: http://www.amazon.com/Garbage-Collection-Handbook-Management-Algorithms/dp/1420082795/ref=sr_1_1?s=books&ie=UTF8&qid=1437385704&sr=1-1&keywords=garbage+collection Potentially useful references from this book:: * Appel 1989b, Goldberg 1991 about pointer finding * Looks like Appel has several good papers about GC * Tarditi Compressing stack maps. http://research.microsoft.com/pubs/68937/ismm-2000b.pdf * Doligez and Leroy 1993 and other papers pp107 http://gallium.inria.fr/~xleroy/publi/concurrent-gc.pdf * Halsteed 1985 concurrent copying * Marlow 2008 * Train collector Richard Jones' GC Page:: http://www.cs.kent.ac.uk/people/staff/rej/gc.html Richard Jones' GC Bibiliography:: http://www.cs.kent.ac.uk/people/staff/rej/gcbib/gcbib.html Memory Management Reference:: http://www.memorymanagement.org/ Data structures for GC:: * http://www.gii.upv.es/tlsf/[TLSF] - a data structure for fast, constant time allocation. === Type systems * https://www.mpi-sws.org/~rossberg/1ml/[1ML] is an ML language with the module language and value language unified into one language (I think) I need to read more. * http://arxiv.org/pdf/1512.01895.pdf[Modular Implicits] is an extension to OCaml to add ad-hoc polymorphism to the language. This is similar to my vague ideas about implicit link:plasma_ref.html#_interfaces[interfaces], and I will probably use this in some way. * https://www.koterpillar.com/talks/instances-for-everyone/#18 Alexy's talk about deriving things like Eq, Ord etc in Haskell/GHC. Contains further links at the end. === Optimiation and code gneeration * Frances Allen, 1971: A cataloge of Optimizing Transformations". Inline, Unroll, CSE, DCE, Code Motion, Constant Fold, Peephole. Alledgedly these give 80% of the best case of all optimisations. Unfortunately I couldn't find this paper. The referece came from a slide deck by Gradon Hoare. * http://www.agner.org/optimize/ Software optimization resources * https://www.microsoft.com/en-us/research/wp-content/uploads/2016/02/compilingml.pdf Compiling a Functional Language. * Open Watcom code generator is said to be well documented: https://github.com/open-watcom/open-watcom-v2/tree/master/bld/cg === Concurrency and parallelism * "nurseries" idea for making concurrency more structured, examples in Python: https://vorpus.org/blog/notes-on-structured-concurrency-or-go-statement-considered-harmful/ * Pi-Calculus: * On wikipedia * A book: The π-calculus: A Theory of Mobile Processes by Davide Sangiorgi & David Walker. * Languages with parallelism ideas we might be able to borrow: ** Chapel language is a parallel programming language for HPC and may have some ideas / optimisations we can borrow: https://chapel-lang.org ** http://www2.cmp.uea.ac.uk/~jrwg/Sisal/00.Contents.html[SISAL] rivaled Fortran's performance and included parallel support for array computations. === Text handling Unicode.org:: https://unicode.org/ Unicode standardisation happens here. I've found the https://unicode.org/glossary/[Unicode glossary] especially useful, the https://www.unicode.org/ucd/[Unicode database] may also be helpful. The UTF-8 Manifesto:: https://utf8everywhere.org/ Not a library, but a description of some best practices and calls out some worst-practices also. == Libraries === Message Passing Nanomsg:: http://nanomsg.org/ + Nanomsg is a C library for message passing. It exposes a BSD sockets style API. === Profiling SHIM:: https://github.com/ShimProfiler/SHIM SHIM is a tool for high-resolution sampling of CPU performance counters. It may be more useful as a basis of our own implementation than useful as-is. === Text handling libunistring:: https://www.gnu.org/software/libunistring/[libunistring] is the Unicode library with the clearest documentation. It might not do everything that we eventually want but it looks like the best place to start. == Tools === Build systems Autosetup:: http://msteveb.github.io/autosetup/ Autosetup is an alternative to autoconf, it is written in Tcl. ninja:: https://ninja-build.org Ninja is a build system (like make) but more principled. It requires build files to (almost) fully describe the dependency graph (no implicit rules/wildcards). This makes things more predictable and faster - but the build files are usually generated. The `plzbuild` tool writes ninja build files and calls to ninja to perform the actual build. Tup:: http://gittup.org/tup/index.html Tup is an alternative to Make. It looks like it avoids a lot of Make's problems. === Testing Hyperfine:: https://github.com/sharkdp/hyperfine Hyperfine is a benchmarking tool. TAP:: https://testanything.org/ Test anything protocol a format and set of libraries for test output. Allowing a test suite to interact with CI. === Git/Project hosting gitlab:: Software. gitgud.io:: Gitlab hosted service. gogs.io:: Git oriented project hosting written in Go. === C Static analysis splint:: http://www.splint.org/ == Formats We use the https://toml.io/en/[TOML] file format for Plasma BUILD.plz files. == Algorithms === PRNGs A table of some http://www.pcg-random.org/[PRNGs]. == Related programming languages Plasma is implemented in https://mercurylang.org[Mercury]. Plasma is inspired by many other languages, some of them are: * https://mercurylang.org[Mercury] is a logic/functional language that I also work on. I developed an auto-parallelisation system for Mercury and plan to implement one for Plasma. After 7 years contributing to Mercury I'm sure other aspects of it will also influence Plasma. * https://en.wikipedia.org/wiki/Hope_%28programming_language%29[Hope] influenced Plasma indirectly. Hope is the first language with abstract data types. * http://ocaml.org[OCaml]'s parametric modules are the inspiration for Plasma's interfaces. Several other imperative/declarative languages like Plasma include: * http://www2.cmp.uea.ac.uk/~jrwg/Sisal/00.Contents.html[SISAL] * http://mars-lang.appspot.com/[Mars] * Wybe: https://github.com/pschachte/wybe[on github] or http://people.eng.unimelb.edu.au/schachte/papers/wybeintro.pdf[a slide deck] * http://people.eng.unimelb.edu.au/lee/src/pawns/[Pawns] Disclosure: Mars, Wybe and Pawns are all developed by colleagues of mine. Other parallel languages: * http://www2.cmp.uea.ac.uk/~jrwg/Sisal/00.Contents.html[SISAL] is an applicative single-assignment language, like Plasma it has declarative semantics and an imperative-ish style. It supported auto-parallelisation based on loops and streams and rivaled Fortran form performance. * http://futhark-lang.org[Futhark] is an array based language (like APL) for GPGPU programming. I don't know much about it at the moment but will be reading their papers and following their work. * http://halide-lang.org/ A Data-parallel eDSL embedded in C++ * http://parasail-lang.org/ Looks like an implicitly-parallel language. * https://docs.alan-lang.org/about_alan.html[Alan] is a almost Turing-complete language with array loops and auto parallelism. // vim: set syntax=asciidoc: ================================================ FILE: docs/user_guide.txt ================================================ Plasma User's Guide =================== :Author: Paul Bone :Email: paul@plasmalang.org :Date: March 2021 :Copyright: Copyright (C) Plasma Team :License: CC BY-SA 4.0 :toc: The user's guide describes how to use the Plasma tools to work with your programs. == Organising your program Plasma programs are made up of modules. Each module corresponds to a file and also (in our implementation) a compilation unit. When someone says "Plasma module" or "Plasma file" you can assume they mean the same thing. === Filenames A Plasma file ends with the extension `.p` and the filename must correspond to the module name. Files are checked for modules by ignoring case and the hyphen (`-`) and underscore (`_`) symbols. In other words, `my_module.p`, `my-module.p`, `mymodule.p`, `MyModule.p` and `My_-_Mo-Du-Le.p` are all legal file names for `MyModule`. Likewise the file `my_module.p` could contain any of `MyModule`, `my_module`, `mY_MoD_ule` etc. While `my_file.p` does not match `my_module`. The exception is that `-` is not legal in module names since in Plasma code it represents subtraction. [NOTE] .Why does Plasma match filenames loosely? ==== Some file systems are case sensitive and others are case insensitive, in different ways (storing filenames with case but matching them insensitively). Meanwhile not all writing systems have a concept of case. Rather than make separate rules for different situations so that we can support different file systems and writing systems; it is simpler to avoid making case meaningful. ==== By convention module names should be in `UpperCase` and their filenames in `snake_case`. These give the best clarity in code and the most compatibility on filesystems. === Programs A plasma program must have at least one module and a `BUILD.plz` file to describe what's required to build it. The `BUILD.plz` file is a https://toml.io/en/[TOML]-ish file containing one or more TOML tables. For example: ---- [hello] type = program modules = [ Hello ] ---- Line one gives the name of the program (as the name of the TOML table). This is the name of the bytecode object that will be produced by `plzbuild`. The table has two keys, `type` and `modules`. The `type` key must be set to the string `program` or Plasma will not recognise it as a program. The `modules` key lists the modules that make up the program. It is an error to import (in source code) a module that's not listed here. [NOTE] .Why does Plasma require this? ==== This gives you one place where you can get an idea of how big and complex your program is, which becomes harder to tell if there are many programs sharing the same directory. ==== The following example shows a program with multiple modules: ---- [my_example] type = program modules = [ ModuleExample, ModuleToImport ] ---- A `BUILD.plz` file may describe more than one program. Plasma will check the `BUILD.plz` file for tables whose `type` key matches `program` and interpret each one as a program. This allows the source for multiple programs to live in the same directory. For example. ---- [program_1] type = program modules = [ Prog1, SharedCode ] [program_2] type = program modules = [ Prog2, SharedCode ] ---- They may even share modules, as the above programs both use the `SharedCode` module which is compiled once and used by the two programs. In the future Plasma will also support libraries, but the ability to share code between programs in this way will always be provided. This also means that if `SharedCode` imports another module `CommonStuff`, then `CommonStuff` must be in the modules lists of *all* the programs that include `SharedCode`. [NOTE] .Why share code like this when libraries are more flexible? ==== Sharing code between multiple related programs can be useful when distributing a library is inconvenient (static linking is another solution) or when the shared code is too small to worry about (some utility code). ==== Future work: * link:https://github.com/PlasmaLang/plasma/issues/345[Bug 345 - Don't require a BUILD.plz for single-module programs] * link:https://github.com/PlasmaLang/plasma/issues/344[Bug 344 - Real TOML support] * link:https://github.com/PlasmaLang/plasma/issues/316[Bug 316 - Support for libraries] === Program entrypoints Programs must have exactly one entrypoint. This is specified in the source code by placing the `entrypoint` keyword in front of a function definition. ---- entrypoint func hello() uses IO -> Int { ... return 0 } ---- The chosen function must take zero arguments and return an integer. Following UNIX convention returning 0 from this function means the program ran successfully and any other value means it failed. The entrypoint function's name is irrelevant. There is no need to name your function `main` or `WinMain`. It is syntactically possible to put the entrypoint specifier in front of multiple functions. In the future the linker will be able to choose the actual entrypoint from these candidates, but for now this is unsupported. Future work: * https://github.com/PlasmaLang/plasma/issues/283[#283 - Support command line arguments in entrypoints] * https://github.com/PlasmaLang/plasma/issues/346[#346 - Specify entrypoint in `BUILD.plz`] == Building programs Programs are compiled form source code to bytecode using the `plzbuild` tool. Each module is compiled separately and then linked together to create a bytecode file for each program. Running `plzbuild` with no command line arguments will build every program in the current directory's `BUILD.plz` file. It will only rebuild the files/modules as necessary. ---- $ plzbuild ninja: Entering directory `_build' [4/4] Copying hello bytecode ---- [NOTE] .The hidden details ==== `plzbuild` doesn't do its work on its own. It calls upon the services of another program, a ninja, the http://ninja-build.org[the ninja build system] to do the dirty work. `plzbuild` creates a `_build` directory and places files in there for `ninja`. It then executes `ninja` to calculate dependencies and execute the compiler and linker with the right arguments to build your programs. ==== `ninja` (invoked by `plzbuild`) prints out a description of each command as it runs on a status line. The examples here show the last command to run (copying a bytecode file). `plzbuild` can be given the names of programs to build, and options from the table below. .plzbuild Options |========================================================================== | -v, --verbose | Write verbose output | --rebuild | Regenerate/rebuild everything regardless of timestamps | --report-timing | Report the CPU & elapsed time for each build step |========================================================================== To build the `fib` and `hello` programs while ignoring any others (eg in the Plasma examples): ---- $ plzbuild hello fib ninja: Entering directory `_build' [8/8] Copying fib bytecode ---- == Running programs Plasma bytecode can be interpreted by the `plzrun` program: ---- $ plzrun hello.pz Hello world ---- If your program dynamically links with other bytecode libraries load them with `-l`. ---- $ plzrun -l my_library.pz -l another_library.pz my_program.pz ---- Future work: * https://github.com/PlasmaLang/plasma/issues/347[#347 - plzrun should automatically locate libraries] * https://github.com/PlasmaLang/plasma/issues/348[#348 - Allow direct execution of bytecode files] // vim: set syntax=asciidoc: ================================================ FILE: examples/.gitignore ================================================ *.diff *.log *.out *.outs *.pzo *.pz *.plasma-dump* _build ================================================ FILE: examples/BUILD.plz ================================================ # This is free and unencumbered software released into the public domain. # See ../LICENSE.unlicense # # This is a Plasma build file, it will tell Plasma about the programs in # this directory and what modules they're made from. # [ackermann] type = program modules = [ Ackermann ] [change] type = program modules = [ Change, String, Util ] [fib] type = program modules = [ Fib ] [hello] type = program modules = [ Hello ] [modules] type = program modules = [ ModuleExample, ModuleToImport ] [mr4] type = program modules = [ Mr4 ] [readline] type = program modules = [ Readline, String, Util ] [temperature] type = program modules = [ Temperature ] [types] type = program modules = [ Types, Set ] ================================================ FILE: examples/Makefile ================================================ # # This is free and unencumbered software released into the public domain. # See ../LICENSE.unlicense # # vim: noet sw=4 ts=4 # TOP=.. .PHONY: all all: $(wildcard *.p) $(TOP)/src/plzbuild $(TOP)/src/plzc $(TOP)/src/plzlnk $(TOP)/src/plzbuild change.pz: all touch $@ fib.pz: all touch $@ hello.pz: all touch $@ modules.pz: all touch $@ mr4.pz: all touch $@ readline.pz: all touch $@ temperature.pz: all touch $@ types.pz: all touch $@ .PHONY: %.test %.test : %.exp %.outs diff -u $^ %.outs : %.out grep -v '^#' < $< | sed -e 's/#.*$$//' > $@ %.out : %.pz $(TOP)/runtime/plzrun $(TOP)/runtime/plzrun $< > $@ change.out : change.pz $(TOP)/runtime/plzrun echo "1234\n 4321 \n7" | $(TOP)/runtime/plzrun $< > $@ readline.out : readline.pz $(TOP)/runtime/plzrun echo "Paul Bone\n\n \nI am a fish \n FISH" | $(TOP)/runtime/plzrun $< > $@ .PHONY: clean clean: rm -rf *.pz *.out *.outs *.diff *.log _build .PHONY: realclean realclean: clean rm -rf *.plasma-dump_* ================================================ FILE: examples/README.md ================================================ # Plasma Example Programs * [fib](fib.p) - Fibonacci program demonstrating control flow * [hello](hello.p) - Hello World * [mr4](mr4.p) - Mr 4's first computer program * [types](types.p) - Some example type declarations * [temperature](temperature.p) - Basic expressions * [sequences](sequences.p) - How to use sequences (lists, arrays and streams) in plasma * modules - An example of importing a module from another, and building a multi-module program. Made of [module\_example.p](module_example.p) and [module\_to\_import.p](module_to_import.p). ================================================ FILE: examples/ackermann.exp ================================================ ack(3, 9) = 4093 ================================================ FILE: examples/ackermann.p ================================================ /* * vim: ft=plasma * This is free and unencumbered software released into the public domain. * See ../LICENSE.unlicense */ module Ackermann entrypoint func main() uses IO -> Int { test_ack!(3, 9) return 0 } func test_ack(m : Int, n : Int) uses IO { var ans = ack(m, n) var m_str = int_to_string(m) var n_str = int_to_string(n) var ans_str = int_to_string(ans) print!("ack(" ++ m_str ++ ", " ++ n_str ++ ") = " ++ ans_str ++ "\n") } func ack(m : Int, n : Int) -> Int { return if m == 0 then n + 1 else if n == 0 then ack(m - 1, 1) else ack(m - 1, ack(m, n - 1)) } ================================================ FILE: examples/change.exp ================================================ Type a number of cents to give as change: Trimmed string is: 1234. Which is the value: $12.34 To give this amount in /perfect/ change you should give: 6 x $2 1 x 20c 1 x 10c 4 x 1c Type a number of cents to give as change: Trimmed string is: 4321. Which is the value: $43.21 To give this amount in /perfect/ change you should give: 21 x $2 1 x $1 1 x 20c 1 x 1c Type a number of cents to give as change: Trimmed string is: 7. Which is the value: $0.07 To give this amount in /perfect/ change you should give: 1 x 5c 2 x 1c Type a number of cents to give as change: ================================================ FILE: examples/change.in ================================================ 1234 4321 7 ================================================ FILE: examples/change.p ================================================ /* * vim: ft=plasma * This is free and unencumbered software released into the public domain. * See ../LICENSE.unlicense */ module Change import String import Util entrypoint func main() uses IO -> Int { // Plasma should add while loops as well as the planned for loops. This // is a good example of where a while loop would be helpful. func loop() uses IO -> Bool { print!("Type a number of cents to give as change: ") match (readline!()) { Ok(var line) -> { var str = String.trim(line) if (not string_equals(str, "")) { print!("Trimmed string is: " ++ str ++ ".\n") var num = String.str_to_num(str) print!("Which is the value: " ++ currency_str(num) ++ "\n") var coins = change(num) print!("To give this amount in /perfect/ change you " ++ "should give:\n") Util.do_for!(print_coin, coins) return True } else { return False } } EOF -> { return False } } } Util.while!(loop) return 0 } func currency_str(num : Int) -> String { var cents = num % 100 var dollars = num / 100 return "$" ++ int_to_string(dollars) ++ "." ++ (if cents < 10 then "0" else "") ++ int_to_string(cents) } type CoinNum = CoinNum ( c : Coin, n : Int ) type Coin = c1 | c5 | c10 | c20 | c50 | d1 | d2 func change(n : Int) -> List(CoinNum) { if (n < 1) { return [] } else { var coin var value if n >= 200 { coin = d2 value = 200 } else if n >= 100 { coin = d1 value = 100 } else if n >= 50 { coin = c50 value = 50 } else if n >= 20 { coin = c20 value = 20 } else if n >= 10 { coin = c10 value = 10 } else if n >= 5 { coin = c5 value = 5 } else { coin = c1 value = 1 } var num = n / value var rem = n - value * num return [CoinNum(coin, num) | change(rem)] } } func coin_name(coin : Coin) -> String { return match (coin) { c1 -> "1c" c5 -> "5c" c10 -> "10c" c20 -> "20c" c50 -> "50c" d1 -> "$1" d2 -> "$2" } } func print_coin(c : CoinNum) uses IO { CoinNum(var coin, var num) = c print!(int_to_string(num) ++ " x " ++ coin_name(coin) ++ "\n") } ================================================ FILE: examples/fib.exp ================================================ fib1(16) = 1597 fib2(16) = 1597 fib3(16) = 1597 fib4(16) = 1597 fib5(16) = 1597 fib6(16) = 1597 ================================================ FILE: examples/fib.p ================================================ /* * vim: ft=plasma * This is free and unencumbered software released into the public domain. * See ../LICENSE.unlicense */ /* * This example shows conditional statements and expressions, using * if-then-elses and pattern matches. */ module Fib entrypoint func main() uses IO -> Int { var n = 16 var n_str = int_to_string(n) func label(m : Int) -> String { return "fib" ++ int_to_string(m) ++ "(" ++ n_str ++ ") = " } print!(label(1) ++ int_to_string(fib1(n)) ++ "\n") print!(label(2) ++ int_to_string(fib2(n)) ++ "\n") print!(label(3) ++ int_to_string(fib3(n)) ++ "\n") print!(label(4) ++ int_to_string(fib4(n)) ++ "\n") print!(label(5) ++ int_to_string(fib5(n)) ++ "\n") print!(label(6) ++ int_to_string(fib6(n)) ++ "\n") return 0 } func fib1(n : Int) -> Int { if (n <= 1) { return 1 } else { return fib1(n-1) + fib1(n-2) } } // Or branches can set a variable: func fib2(n : Int) -> Int { var r if (n <= 1) { r = 1 } else { r = fib2(n-1) + fib2(n-2) } return r } // Or if-then-else can be an expression: func fib3(n : Int) -> Int { return if (n <= 1) then 1 else fib3(n-1) + fib3(n-2) } // Or, using pattern matching: func fib4(n : Int) -> Int { match (n) { 0 -> { return 1 } 1 -> { return 1 } // Any symbols here must be constructor symbols or free variables. var m -> { return fib4(m-1) + fib4(m-2) } } } // Or, using pattern matching that sets a value: func fib5(n : Int) -> Int { var r match (n) { 0 -> { r = 1 } 1 -> { r = 1 } // Any symbols here must be constructor symbols or free variables. var m -> { r = fib5(m-1) + fib5(m-2) } } return r } // Or, pattern matching can be an expression. func fib6(n : Int) -> Int { return match (n) { 0 -> 1 1 -> 1 // Any symbols here must be constructor symbols or free variables. var m -> fib6(m-1) + fib6(m-2) } } // // Pattern matching can also include guards. // func fib7(n : Int) -> Int { // return match (n) { // m | m < 2 -> 1 // m | otherwise -> fib7(m-1) + fib7(m-2) // } // } ================================================ FILE: examples/hello.exp ================================================ Hello world ================================================ FILE: examples/hello.p ================================================ /* * vim: ft=plasma * This is free and unencumbered software released into the public domain. * See ../LICENSE.unlicense */ // Module declaration, this sets the name of the module. module Hello // The entrypoint function, there's multiple things in the signature: // * It has zero parameters but in the future in the future it will // probably take an argument for command line options. // * It returns Int. // * It uses the IO resource. // * It is marked as an entrypoint, rather than in C and many other // languages it doesn't need a special name. entrypoint func hello() uses IO -> Int { // the ! indicates that this call uses a resource, which resource is // determined automatically. print!("Hello world\n") // 0 is the operating system's exit code for success. This should be // symbolic in the future. return 0 } ================================================ FILE: examples/module_example.p ================================================ /* * vim: ft=plasma * This is free and unencumbered software released into the public domain. * See ../LICENSE.unlicense */ // The filename is module_example, note that they don't have to match by case // or underscores. module ModuleExample // Import a module import ModuleToImport entrypoint func main() uses IO -> Int { ModuleToImport.test!() return 0 } ================================================ FILE: examples/module_to_import.p ================================================ /* * vim: ft=plasma * This is free and unencumbered software released into the public domain. * See ../LICENSE.unlicense */ // The filename is module_example, note that they don't have to match by case // or underscores. module ModuleToImport // Resources may be exported export resource MyRes from IO // Types may be exported (the constructors and fields are exported too) export type MyMaybe('x) = Nothing | Some(x : 'x) // Or opaque-exported (the constructors and fields are not exported) export opaque type Tree('k, 'v) = Empty | Node( k : 'k, v : 'v, l : Tree('k, 'v), r : Tree('k, 'v) ) // Functions may be exported. export func test() uses IO { print!("Hello from ModuleToImport\n") } ================================================ FILE: examples/modules.exp ================================================ Hello from ModuleToImport ================================================ FILE: examples/mr4.exp ================================================ Hello Mr 4 Goodbye Mr 4 Hello Daddy Goodbye Daddy Hello Mummy Goodbye Mummy ================================================ FILE: examples/mr4.p ================================================ /* * vim: ft=plasma * This is free and unencumbered software released into the public domain. * See ../LICENSE.unlicense */ module Mr4 /* * This is Mr 4's first computer program, 2019-12-01. Okay so he had some * help but I'm still impressed that he understood variables (but not * functions). */ entrypoint func main() uses IO -> Int { func greeting(name : String) uses IO { print!("Hello " ++ name ++ "\n") print!("Goodbye " ++ name ++ "\n") } // Name redacted until he can consent to internet privacy. greeting!("Mr 4") greeting!("Daddy") greeting!("Mummy") return 0 } ================================================ FILE: examples/readline.exp ================================================ What's your name (empty to exit)? Hello Paul Bone. What's your name (empty to exit)? Hello . What's your name (empty to exit)? Hello . What's your name (empty to exit)? Hello I am a fish. What's your name (empty to exit)? Hello FISH. What's your name (empty to exit)? Some trim examples: Trim of '' is '' Trim of ' ' is '' Trim of ' Paul' is 'Paul' Trim of 'Paul ' is 'Paul' Trim of ' Paul Bone ' is 'Paul Bone' Trim of ' a quick brown fox ' is 'a quick brown fox' ================================================ FILE: examples/readline.in ================================================ Paul Bone I am a fish FISH ================================================ FILE: examples/readline.p ================================================ /* * vim: ft=plasma * This is free and unencumbered software released into the public domain. * See ../LICENSE.unlicense */ module Readline import String import Util entrypoint func hello() uses IO -> Int { func loop() uses IO -> Bool { print!("What's your name (empty to exit)? ") // Readline returns a line from standard input without the newline // character. var name_res = readline!() match (name_res) { Ok(var name) -> { print!("Hello " ++ String.trim(name) ++ ".\n") return True } EOF -> { return False } } } Util.while!(loop) print!("Some trim examples:\n") func do_ex(s : String) uses IO { print!("Trim of '" ++ s ++ "' is '" ++ String.trim(s) ++ "'\n") } map!(do_ex, ["", " ", " Paul", "Paul ", " Paul Bone ", " \na quick brown fox \t "]) // 0 is the operating system's exit code for success. This should be // symbolic in the future. return 0 } func map(f : func('x) uses IO, l : List('x)) uses IO { match (l) { [] -> {} [var x | var xs] -> { f!(x) map!(f, xs) } } } ================================================ FILE: examples/sequences.p ================================================ # vim: ft=plasma # This is free and unencumbered software released into the public domain. # See ../LICENSE.unlicense # This example of lists, streams and arrays is not yet supported. module Sequences export main import io func main() uses IO -> Int { print!("lists\n") list = [1, 2, 3, 4] list2 = [0 | list] # cons several items at once. list3 = [-2, -1, 0 | list] # for x in list2 { # print!(show(x) ++ "\n") # } print!("arrays\n") array = [: 1, 2, 3, 4 :] # for x in array { # ! print(show(x) ++ "\n") # } # An array can be subscripted (1-based). print!("The second element in the array is: " ++ show(array[2]) ++ "\n") # including assignment (array must be unique) array[2] <= 23 # And indexed from the end. # print!("the second last element is: " ++ show(array[-2]) ++ "\n") # BUT the - symbol in the subscript is special, it means "count from the # end" and not "minus". The actual expression must be an unsigned # integer type. This cannot be implemented with the current parser. # # Or sliced (the syntax is Expr? '..' Expr? # array2 = array[1..3] # first two elements. # array3 = array[2..4] # 2nd and 3rd elements from the middle of the # # array # array4 = array[3..] # 3rd element to the end. # array5 = array[..3] # first two elements # # Minuses can be used to position from the end. # array6 = array[-3..] # 3rd last to end elements # array7 = array[..-1] # All but the last element # array8 = array[-3..-1] # 3rd and 2nd last elements # ! print("streams\n") # A stream may be part of a producer/consumer parallelism, maybe being # produced by another thread. Or it may be lazy, being produced by # evaluating thunks in this thread, or already evaluated. # Streams do not need a syntax for constants the way lists and arrays # do, since they are either created lazily or concurrently. Likewise # streams are usually consumed with a loop. So I haven't defined any # syntax for them yet. However I'm considering using [- -] symbols for # streams, possibly with comprehensions. # TODO: some stream examples.. # Lists, arrays and streams can all be concatenated with sequences of # the same time (eg lists and lists) using the ++ operator. list4 = list ++ list2 # I believe I will use the { } brackets for dictionaries. # Another idea, maybe N..M is syntax for a sequence of N to M # inclusive. It could either be polymorphic (returning the sequence of # the desired type) or be used within brackets eg for a list: [ 1..10 ]. # The latter makes things clear but the former looks good in # comprehensions. I will decide later. return 0 } ================================================ FILE: examples/set.p ================================================ // vim: ft=plasma // This is free and unencumbered software released into the public domain. // See ../LICENSE.unlicense module Set export type Set('t) = Set(items : List('t)) ================================================ FILE: examples/string.p ================================================ /* * vim: ft=plasma * This is free and unencumbered software released into the public domain. * See ../LICENSE.unlicense */ module String export func trim(s : String) -> String { return trim_right(trim_left(s)) } /* * This might be how we implement this in the future, but we lack the * language features: * * while loops * * state variables * * object.func() syntax */ /* func trim_left(s : String) -> String { var $pos = s.begin() while not $pos.at_end() { if $pos.next_char().class() != WHITESPACE break $pos = $pos.next() } return string_substring($pos, s.end()) } */ func trim_left(s : String) -> String { func loop(pos : StringPos) -> String { match (strpos_next(pos)) { Some(var c) -> { match codepoint_category(c) { Whitespace -> { return loop(strpos_forward(pos)) } Other -> { return string_substring(pos, string_end(s)) } } } None -> { // We're at the end of the string return "" } } } return loop(string_begin(s)) } func find_last(test : func(CodePoint) -> Bool, string : String) -> StringPos { func loop(pos : StringPos) -> StringPos { // We can't fold these tests into one because Plasma's || isn't // necessarily short-cutting. match (strpos_prev(pos)) { Some(var c) -> { if test(c) { return pos } else { return loop(strpos_backward(pos)) } } None -> { return pos } } } return loop(string_end(string)) } func trim_right(s : String) -> String { func is_not_whitespace(c : CodePoint) -> Bool { return match (codepoint_category(c)) { Whitespace -> False Other -> True } } return string_substring(string_begin(s), find_last(is_not_whitespace, s)) } export func str_to_num(s : String) -> Int { var base = 10 func loop(pos : StringPos, num : Int) -> Int { var maybe_cp = strpos_next(pos) match (maybe_cp) { None -> { // End of input. return num } Some(var cp) -> { var maybe_digit = codepoint_to_digit(cp) match (maybe_digit) { Some(var digit) -> { return loop(strpos_forward(pos), num * base + digit) } None -> { // Could make this function return a maybe. Builtin.die("Bad number") return 0 } } } } } return loop(string_begin(s), 0) } func codepoint_to_digit(cp : CodePoint) -> Maybe(Int) { var num = codepoint_to_number(cp) // Recognise the digits range within ASCII, I don't know if there are // other ranges for numbers in Unicode. if num <= 57 and num >= 48 { return Some(num - 48) } else { return None } } ================================================ FILE: examples/temperature.exp ================================================ 26c is 78f 38c is 100f 0c is 32f 100c is 212f -40c is -40f ================================================ FILE: examples/temperature.p ================================================ /* * vim: ft=plasma * This is free and unencumbered software released into the public domain. * See ../LICENSE.unlicense */ module Temperature entrypoint func main() uses IO -> Int { run!(26) run!(38) run!(0) run!(100) run!(-40) return 0 } func run(c : Int) uses IO { var f = c_to_f(c) print!(int_to_string(c) ++ "c is " ++ int_to_string(f) ++ "f\n") } func c_to_f(c : Int) -> Int { return c * 9 / 5 + 32 } ================================================ FILE: examples/types.exp ================================================ Types example doesn't actually do anything with the types ================================================ FILE: examples/types.p ================================================ // vim: ft=plasma // This is free and unencumbered software released into the public domain. // See ../LICENSE.unlicense module Types /* * This example doesn't yet compile. The uncommented code requires a type * alias for Number and the module system and a Set module. */ // We can define our own types. // A simple enum type Suit = Hearts | Diamonds | Spades | Clubs type Number = Ace | One | Two | Three | Four | Five | Six | Seven | Eight | Nine | Ten | Jack | Queen | King // A structure: a single constructor with fields. type PlayingCard = Card ( suit : Suit, number : Number ) // A combination of the above, a PlayingCard is either an ordinary card or a // joker. An orderinary card has fields. type PlayingCardOrJoker = OrdinaryCard ( suit : Suit, number : Number ) | Joker // Types are polymorphic, they may take type parameters. type Tree('k, 'v) = EmptyTree | Node ( key : 'k, value : 'v, left : Tree('k, 'v), right : Tree('k, 'v) ) // Test that module qualifiers work on type expressions. import Set type MyType = MyConstr ( field : Set.Set(Int) ) // // Type Aliases // // //# A type alias, ID is now another word for Int. //type_alias ID = Int // //# It's often more useful to alias something more complex. //type_alias Name = String //type_alias NameMap = Map(ID, Name) // //# Type aliases can take parameters: //type_alias IDMap(x) = Map(ID, x) // // Empty main function. entrypoint func main() uses IO -> Int { print!("Types example doesn't actually do anything with the types\n") return 0 } ================================================ FILE: examples/util.p ================================================ /* * vim: ft=plasma * This is free and unencumbered software released into the public domain. * See ../LICENSE.unlicense */ module Util export func while(f : func() uses IO -> Bool) uses IO { var res = f!() if (res) { while!(f) } else { } } export func do_for(f : func('x) uses IO, l : List('x)) uses IO { match (l) { [] -> {} [var x | var xs] -> { f!(x) do_for!(f, xs) } } } ================================================ FILE: runtime/.gitignore ================================================ *.o plzrun tags pz_config.h ================================================ FILE: runtime/README.md ================================================ # Plasma Runtime System Plasma uses a byte code interpreter. One basic interpreter and runtime system is currently under development but this could change in the future, including the addition of native code generation. ## Files The runtime is mostly C++ with small bits of C, some care needs to be taken with header files. C++ may call C (and include its headers) but C may not call C++ or include its headers (without wrappers). These files break the rule about having matching implementation/header files for each module. Since for these headers, multiple alternative files could provide different implementations. * [pz\_interp.h](pz\_interp.h) - The header file for the core of the interpreter * [pz\_closure.h](pz\_closure.h) - Header file with closure related declrations. The implementation is in the interpreter files themselves. * [pz\_generic.cpp](pz\_generic.cpp) - The architecture independent (and only) implementation of the interpreter * pz\_generic\_\*.{cpp,h} - Other parts of the generic interpreter. Only files in this group may include other headers in this group, there must be no coupling with the rest of the system other than trhough pz_interp.h * [pz\_generic\_run.cpp](pz\_generic\_run.cpp)/[pz\_generic\_run.h](pz\_generic\_run.h) - The main loop of the interpreter. * [pz\_generic\_builtin.cpp](pz\_generic\_builtin.cpp)/[pz\_generic\_builtin.h](pz\_generic\_builtin.h) - The implementation of the builtins. Other files that may be interesting are: * [pz\_main.cpp](pz\_main.cpp) - The entry point for pzrun * [pz\_option.cpp](pz\_option.cpp) - Option processing for pzrun * [pz\_instructions.h](pz\_instructions.h) and [pz\_instructions.c](pz\_instructions.c) Instruction data for the bytecode format * [pz.h](pz.h)/[pz.cpp](pz.cpp), [pz\_code.h](pz\_code.h)/[pz\_code.cpp](pz\_code.cpp) and [pz\_data.h](pz\_data.h)/[pz\_data.cpp](pz\_data.cpp) - Structures used by pzrun * [pz\_gc.h](pz\_gc.h) and other pz\_gc\* files - The garbage collector is across several files here. - [pz\_gc\_util.h](pz\_gc\_util.h) contains an API that allows the GC to find roots in C++ code and determine when GC is safe. - [pz\_gc\_layout.h](pz\_gc\_layout.h) declares the heap structure. * [pz\_format.h](pz\_format.h) - Constants for the PZ bytecode format * [pz\_read.h](pz\_read.h)/[pz\_read.cpp](pz\_read.cpp) - Code for reading the PZ bytecode format ## Build Options * PZ\_DEV - Enable developer build which makes the PZ\_RUNTIME\_DEV\_OPTS below available. * DEBUG - Enable runtime assertions. ## Runtime Options Runtime options are specified using environment variables. They're each interpreted as comma-seperated, case-sensative tokens. * PZ\_RUNTIME\_OPTS for general runtime options. * load\_verbose - verbose loading messages * fast\_exit=[ yes | no ] - exit without freeing resources. * PZ\_RUNTIME\_DEV\_OPTS for developer runtime options. These require PZ\_DEV to be defined during compile time. * interp\_trace - tracing of PZ bytecode interpreter * gc\_zealous - Make the GC zealously perform a GC before every allocation. To test this mode run: ( cd tests; ./run-tests.sh gc ) ================================================ FILE: runtime/pz.cpp ================================================ /* * Plasma in-memory representation * vim: ts=4 sw=4 et * * Copyright (C) Plasma Team * Distributed under the terms of the MIT license, see ../LICENSE.code */ #include "pz_common.h" #include #include #include "pz_code.h" #include "pz_data.h" #include "pz_interp.h" #include "pz.h" namespace pz { /* * PZ Programs *************/ PZ::PZ(const Options & options, Heap & heap) : AbstractGCTracer(heap) , m_options(options) , m_program(nullptr) {} // Defined here rather than the header even though it's a default destructor // so that it can access the heap destructor. PZ::~PZ() {} Library * PZ::new_library(const String name, GCCapability & gc_cap) { assert(!m_libraries[name]); m_libraries[name] = new (gc_cap) Library(); return m_libraries[name]; } void PZ::add_library(const String name, Library * library) { assert(!m_libraries[name]); m_libraries[name] = library; } Library * PZ::lookup_library(const String name) { auto iter = m_libraries.find(name); if (iter != m_libraries.end()) { return iter->second; } else { return nullptr; } } void PZ::add_program_lib(Library * program) { assert(nullptr == m_program); m_program = program; } void PZ::do_trace(HeapMarkState * marker) const { for (auto m : m_libraries) { marker->mark_root(m.first.ptr()); marker->mark_root(m.second); } if (m_program) { marker->mark_root(m_program); } } } // namespace pz ================================================ FILE: runtime/pz.h ================================================ /* * Plasma in-memory representation * vim: ts=4 sw=4 et * * Copyright (C) Plasma Team * Distributed under the terms of the MIT license, see ../LICENSE.code */ #ifndef PZ_H #define PZ_H #include "pz_common.h" #include #include #include #include "pz_library.h" namespace pz { /* * PZ Programs */ class PZ : public AbstractGCTracer { private: const Options & m_options; std::unordered_map m_libraries; Library * m_program; public: explicit PZ(const Options & options, Heap & heap); ~PZ(); Library * new_library(const String name, GCCapability & gc_cap); const Options & options() const { return m_options; } /* * Add a library to the program. * * The main program library (it is a Library class) is not added in this * way. * * The name will be coppied and the caller remains responsible for * the original name. The module will be freed by pz_free(). */ void add_library(const String name, Library * library); Library * lookup_library(const String name); void add_program_lib(Library * module); Library * program_lib() const { return m_program; } PZ(const PZ &) = delete; void operator=(const PZ &) = delete; void do_trace(HeapMarkState * marker) const override; }; } // namespace pz #endif /* ! PZ_H */ ================================================ FILE: runtime/pz_array.h ================================================ /* * Plasma GC-compatible bounds-checked array * vim: ts=4 sw=4 et * * Copyright (C) Plasma Team * Distributed under the terms of the MIT license, see ../LICENSE.code */ #ifndef PZ_ARRAY_H #define PZ_ARRAY_H #include "string.h" #include "pz_gc_util.h" namespace pz { template class Array : public GCNew { private: /* * The array data is stored seperately. Array types can be * passed-by-value and easilly embeded within other values. */ size_t m_len; T * m_data; public: Array(NoGCScope & gc, size_t len) : m_len(len) { assert(m_len > 0); m_data = new (gc) T[len]; } const T & operator[](size_t offset) const { assert(offset < m_len); return m_data[offset]; } T & operator[](size_t offset) { assert(offset < m_len); return m_data[offset]; } void zerofill() { memset(m_data, 0, sizeof(T) * m_len); } /* * These are deleted until they're needed (and can be tested) later. */ Array(const Array &) = delete; void operator=(const Array &) = delete; }; } // namespace pz #endif /* ! PZ_ARRAY_H */ ================================================ FILE: runtime/pz_builtin.cpp ================================================ /* * Plasma builtins * vim: ts=4 sw=4 et * * Copyright (C) Plasma Team * Distributed under the terms of the MIT license, see ../LICENSE.code */ #include "pz_common.h" #include "pz_builtin.h" #include "pz_closure.h" #include "pz_code.h" #include "pz_gc_util.h" #include "pz_interp.h" #include "pz_util.h" namespace pz { template static void builtin_create(Library * library, const String name, unsigned (*func_make_instrs)(uint8_t * bytecode, T data), T data, GCCapability & gccap); static void builtin_create_c_code(Library * library, String name, pz_foreign_c_func c_func, GCCapability & gccap); static void builtin_create_c_code_alloc(Library * library, String name, pz_foreign_c_alloc_func c_func, GCCapability & gccap); static void builtin_create_c_code_special(Library * library, String name, pz_foreign_c_special_func c_func, GCCapability & gccap); static unsigned make_ccall_instr(uint8_t * bytecode, pz_foreign_c_func c_func); static unsigned make_ccall_alloc_instr(uint8_t * bytecode, pz_foreign_c_alloc_func c_func); static unsigned make_ccall_special_instr(uint8_t * bytecode, pz_foreign_c_special_func c_func); static unsigned builtin_make_tag_instrs(uint8_t * bytecode, std::nullptr_t data) { unsigned offset = 0; /* * Take a word and a primary tag and combine them, this is pretty * simple. * * ptr tag - tagged_ptr */ offset = write_instr(bytecode, offset, PZI_OR, PZW_PTR); offset = write_instr(bytecode, offset, PZI_RET); return offset; } static unsigned builtin_shift_make_tag_instrs(uint8_t * bytecode, std::nullptr_t data) { unsigned offset = 0; ImmediateValue imm = {.word = 0}; /* * Take a word shift it left and combine it with a primary tag. * * word tag - tagged_word */ imm.uint8 = 2; offset = write_instr(bytecode, offset, PZI_ROLL, IMT_8, imm); imm.uint8 = num_tag_bits; offset = write_instr( bytecode, offset, PZI_LOAD_IMMEDIATE_NUM, PZW_PTR, IMT_8, imm); offset = write_instr(bytecode, offset, PZI_LSHIFT, PZW_PTR); offset = write_instr(bytecode, offset, PZI_OR, PZW_PTR); offset = write_instr(bytecode, offset, PZI_RET); return offset; } static unsigned builtin_break_tag_instrs(uint8_t * bytecode, std::nullptr_t data) { unsigned offset = 0; ImmediateValue imm = {.word = 0}; /* * Take a tagged pointer and break it into the original pointer and tag. * * tagged_ptr - ptr tag */ imm.uint8 = 1; offset = write_instr(bytecode, offset, PZI_PICK, IMT_8, imm); // Make pointer imm.uint32 = ~0 ^ tag_bits; offset = write_instr( bytecode, offset, PZI_LOAD_IMMEDIATE_NUM, PZW_32, IMT_32, imm); if (WORDSIZE_BYTES == 8) { offset = write_instr(bytecode, offset, PZI_SE, PZW_32, PZW_64); } offset = write_instr(bytecode, offset, PZI_AND, PZW_PTR); imm.uint8 = 2; offset = write_instr(bytecode, offset, PZI_ROLL, IMT_8, imm); // Make tag. imm.uint32 = tag_bits; offset = write_instr( bytecode, offset, PZI_LOAD_IMMEDIATE_NUM, PZW_PTR, IMT_32, imm); offset = write_instr(bytecode, offset, PZI_AND, PZW_PTR); offset = write_instr(bytecode, offset, PZI_RET); return offset; } static unsigned builtin_break_shift_tag_instrs(uint8_t * bytecode, std::nullptr_t data) { unsigned offset = 0; ImmediateValue imm = {.word = 0}; /* * Take a tagged word and break it into the original word which is * shifted to the right and tag. * * tagged_word - word tag */ imm.uint8 = 1; offset = write_instr(bytecode, offset, PZI_PICK, IMT_8, imm); // Make word imm.uint32 = ~0 ^ tag_bits; offset = write_instr( bytecode, offset, PZI_LOAD_IMMEDIATE_NUM, PZW_32, IMT_32, imm); if (WORDSIZE_BYTES == 8) { offset = write_instr(bytecode, offset, PZI_SE, PZW_32, PZW_64); } offset = write_instr(bytecode, offset, PZI_AND, PZW_PTR); imm.uint8 = num_tag_bits; offset = write_instr( bytecode, offset, PZI_LOAD_IMMEDIATE_NUM, PZW_PTR, IMT_8, imm); offset = write_instr(bytecode, offset, PZI_RSHIFT, PZW_PTR); imm.uint8 = 2; offset = write_instr(bytecode, offset, PZI_ROLL, IMT_8, imm); // Make tag. imm.uint32 = tag_bits; offset = write_instr( bytecode, offset, PZI_LOAD_IMMEDIATE_NUM, PZW_PTR, IMT_32, imm); offset = write_instr(bytecode, offset, PZI_AND, PZW_PTR); offset = write_instr(bytecode, offset, PZI_RET); return offset; } static unsigned builtin_unshift_value_instrs(uint8_t * bytecode, std::nullptr_t data) { unsigned offset = 0; ImmediateValue imm = {.word = 0}; /* * Take a word and shift it to the right to remove the tag. * * word - word */ imm.uint8 = num_tag_bits; offset = write_instr( bytecode, offset, PZI_LOAD_IMMEDIATE_NUM, PZW_PTR, IMT_8, imm); offset = write_instr(bytecode, offset, PZI_RSHIFT, PZW_PTR); offset = write_instr(bytecode, offset, PZI_RET); return offset; } void setup_builtins(Library * library, GCCapability & gccap) { // clang-format off builtin_create_c_code(library, String("print"), pz_builtin_print_func, gccap); builtin_create_c_code_alloc(library, String("readline"), pz_builtin_readline_func, gccap); builtin_create_c_code_alloc(library, String("int_to_string"), pz_builtin_int_to_string_func, gccap); builtin_create_c_code(library, String("setenv"), pz_builtin_setenv_func, gccap); builtin_create_c_code(library, String("gettimeofday"), pz_builtin_gettimeofday_func, gccap); builtin_create_c_code_alloc(library, String("string_concat"), pz_builtin_string_concat_func, gccap); builtin_create_c_code(library, String("die"), pz_builtin_die_func, gccap); builtin_create_c_code_special(library, String("set_parameter"), pz_builtin_set_parameter_func, gccap); builtin_create_c_code_special(library, String("get_parameter"), pz_builtin_get_parameter_func, gccap); builtin_create_c_code(library, String("codepoint_category"), pz_builtin_codepoint_category, gccap); builtin_create_c_code_alloc(library, String("codepoint_to_string"), pz_builtin_codepoint_to_string, gccap); builtin_create_c_code_alloc(library, String("strpos_forward"), pz_builtin_strpos_forward, gccap); builtin_create_c_code_alloc(library, String("strpos_backward"), pz_builtin_strpos_backward, gccap); builtin_create_c_code_alloc(library, String("strpos_next"), pz_builtin_strpos_next_char, gccap); builtin_create_c_code_alloc(library, String("strpos_prev"), pz_builtin_strpos_prev_char, gccap); builtin_create_c_code_alloc(library, String("string_begin"), pz_builtin_string_begin, gccap); builtin_create_c_code_alloc(library, String("string_end"), pz_builtin_string_end, gccap); builtin_create_c_code_alloc(library, String("string_substring"), pz_builtin_string_substring, gccap); builtin_create_c_code(library, String("string_equals"), pz_builtin_string_equals, gccap); builtin_create(library, String("make_tag"), builtin_make_tag_instrs, nullptr, gccap); builtin_create(library, String("shift_make_tag"), builtin_shift_make_tag_instrs, nullptr, gccap); builtin_create(library, String("break_tag"), builtin_break_tag_instrs, nullptr, gccap); builtin_create(library, String("break_shift_tag"), builtin_break_shift_tag_instrs, nullptr, gccap); builtin_create(library, String("unshift_value"), builtin_unshift_value_instrs, nullptr, gccap); // clang-format on } template static void builtin_create(Library * library, const String name, unsigned (*func_make_instrs)(uint8_t * bytecode, T data), T data, GCCapability & gccap) { // We forbid GC in this scope until the proc's code and closure are // reachable from module. We will check for OOM before using any // allocation results and abort if we're OOM. GCTracer gc(gccap); // If the proc code area cannot be allocated this is GC safe because it // will trace the closure. It would not work the other way around (we'd // have to make it faliable). unsigned size = func_make_instrs(nullptr, nullptr); Root proc(gc); { NoGCScope nogc(gc); proc = new (nogc) Proc(nogc, name, true, size); nogc.abort_if_oom("setting up builtins"); } func_make_instrs(proc->code(), data); Root closure(gc, new (gc) Closure(proc->code(), nullptr)); RootString full_name(gc, String::append(gc, String("Builtin."), name)); library->add_symbol(full_name, closure.ptr()); } static void builtin_create_c_code(Library * library, String name, pz_foreign_c_func c_func, GCCapability & gccap) { builtin_create( library, name, make_ccall_instr, c_func, gccap); } static void builtin_create_c_code_alloc(Library * library, String name, pz_foreign_c_alloc_func c_func, GCCapability & gccap) { builtin_create( library, name, make_ccall_alloc_instr, c_func, gccap); } static void builtin_create_c_code_special(Library * library, String name, pz_foreign_c_special_func c_func, GCCapability & gccap) { builtin_create( library, name, make_ccall_special_instr, c_func, gccap); } static unsigned make_ccall_instr(uint8_t * bytecode, pz_foreign_c_func c_func) { ImmediateValue immediate_value; unsigned offset = 0; immediate_value.word = (uintptr_t)c_func; offset += write_instr(bytecode, offset, PZI_CCALL, IMT_PROC_REF, immediate_value); offset += write_instr(bytecode, offset, PZI_RET); return offset; } static unsigned make_ccall_alloc_instr(uint8_t * bytecode, pz_foreign_c_alloc_func c_func) { ImmediateValue immediate_value; unsigned offset = 0; immediate_value.word = (uintptr_t)c_func; offset += write_instr( bytecode, offset, PZI_CCALL_ALLOC, IMT_PROC_REF, immediate_value); offset += write_instr(bytecode, offset, PZI_RET); return offset; } static unsigned make_ccall_special_instr(uint8_t * bytecode, pz_foreign_c_special_func c_func) { ImmediateValue immediate_value; unsigned offset = 0; immediate_value.word = (uintptr_t)c_func; offset += write_instr( bytecode, offset, PZI_CCALL_SPECIAL, IMT_PROC_REF, immediate_value); offset += write_instr(bytecode, offset, PZI_RET); return offset; } } // namespace pz ================================================ FILE: runtime/pz_builtin.h ================================================ /* * Plasma builtins * vim: ts=4 sw=4 et * * Copyright (C) Plasma Team * Distributed under the terms of the MIT license, see ../LICENSE.code */ #ifndef PZ_BUILTIN_H #define PZ_BUILTIN_H #include "pz.h" #include "pz_gc.h" namespace pz { void setup_builtins(Library * library, GCCapability & gccap); } #endif /* ! PZ_BUILTIN_H */ ================================================ FILE: runtime/pz_closure.h ================================================ /* * Plasma bytecode code structures and functions * vim: ts=4 sw=4 et * * Copyright (C) Plasma Team * Distributed under the terms of the MIT license, see ../LICENSE.code */ #ifndef PZ_CLOSURE_H #define PZ_CLOSURE_H // Redirect to the closure code for the generic interpreter. This would // have to be changed/preprocessed when we add other interpreter types. #include "pz_generic_closure.h" #endif // ! PZ_CLOSURE_H ================================================ FILE: runtime/pz_code.cpp ================================================ /* * Plasma bytecode code structures and functions * vim: ts=4 sw=4 et * * Copyright (C) Plasma Team * Distributed under the terms of the MIT license, see ../LICENSE.code */ #include "pz_common.h" #include "pz_code.h" #include "pz_gc.h" namespace pz { Proc::Proc(NoGCScope & gc_cap, String name, bool is_builtin, unsigned size) : m_code_size(size) , m_name(name) , m_is_builtin(is_builtin) , m_contexts(gc_cap, 0) { m_code = (uint8_t *)gc_cap.alloc_bytes(size, META); heap_set_meta_info(&gc_cap.heap(), code(), this); } void Proc::add_context(GCCapability & gc_cap, unsigned offset, String filename, unsigned line) { if (m_filename.hasValue()) { assert(m_filename.value().equals(filename)); } else { m_filename.set(filename); } set_context(gc_cap, offset, line); } void Proc::add_context(GCCapability & gc_cap, unsigned offset, unsigned line) { assert(m_filename.hasValue()); set_context(gc_cap, offset, line); } void Proc::no_context(GCCapability & gc_cap, unsigned offset) { set_context(gc_cap, offset, 0); } void Proc::set_context(GCCapability & gc_cap, unsigned offset, unsigned value) { bool res = m_contexts.append(gc_cap, OffsetContext(offset, value)); // We expect the return code to be true unless GCCapability is a // NoGCScope, and it probably isn't. if (!res) { assert(res); } // Check that this isn't a NoGCScope so we know to fix the above // assumption if that changes. assert(gc_cap.can_gc()); } unsigned Proc::line(unsigned offset, unsigned * last_lookup) const { unsigned start; if (*last_lookup == 0 || m_contexts[*last_lookup - 1].offset > offset) { start = 0; } else { start = *last_lookup - 1; } /* * The loop condition is such that i and i+1 are both within the bounds * of m_contexts. */ for (unsigned i = start; i + 1 < m_contexts.size(); i++) { // If the current offset is between this and the next. if ((m_contexts[i].offset <= offset) && (m_contexts[i+1].offset > offset)) { *last_lookup = i; return m_contexts[i].line; } } if (m_contexts.size() > 0 && m_contexts.back().offset <= offset) { *last_lookup = m_contexts.size() - 1; return m_contexts.back().line; } return 0; } } // namespace pz ================================================ FILE: runtime/pz_code.h ================================================ /* * Plasma bytecode code structures and functions * vim: ts=4 sw=4 et * * Copyright (C) Plasma Team * Distributed under the terms of the MIT license, see ../LICENSE.code */ #ifndef PZ_CODE_H #define PZ_CODE_H #include "pz_cxx_future.h" #include "pz_gc_util.h" #include "pz_string.h" #include "pz_vector.h" namespace pz { struct OffsetContext { OffsetContext() : offset(0), line(0) {} OffsetContext(unsigned offset_, unsigned line_) : offset(offset_) , line(line_) {} unsigned offset; unsigned line; }; /* * Code layout in memory * *************************/ class Proc : public GCNew { private: uint8_t *m_code; unsigned m_code_size; String m_name; bool m_is_builtin; Optional m_filename; Vector m_contexts; public: Proc(NoGCScope & gc_cap, const String name, bool is_builtin, unsigned size); void set_name(String name) { m_name = name; } String name() const { return m_name; } uint8_t * code() const { return m_code; } unsigned size() const { return m_code_size; } bool is_builtin() const { return m_is_builtin; } Proc() = delete; Proc(const Proc &) = delete; void operator=(const Proc & other) = delete; // Add context information for this and the following code offsets. void add_context(GCCapability & gc_cap, unsigned offset, String filename, unsigned line); void add_context(GCCapability & gc_cap, unsigned offset, unsigned line); // This and the following code offsets have no context infomation. void no_context(GCCapability & gc_cap, unsigned offset); Optional filename() const { return m_filename; } unsigned line(unsigned offset, unsigned * last_lookup) const; private: void set_context(GCCapability & gc_cap, unsigned offset, unsigned value); }; } // namespace pz #endif /* ! PZ_CODE_H */ ================================================ FILE: runtime/pz_common.h ================================================ /* * Plasma bytecode comon includes * vim: ts=4 sw=4 et * * Copyright (C) Plasma Team * Distributed under the terms of the MIT license, see ../LICENSE.code */ #ifndef PZ_COMMON_H #define PZ_COMMON_H #include "pz_config.h" #include #include #include #include #include #endif /* ! PZ_COMMON_H */ ================================================ FILE: runtime/pz_config.h.in ================================================ /* * Plasma bytecode execution configuration. * vim: ts=4 sw=4 et * * Copyright (C) 2015, 2021 Plasma Team * Distributed under the terms of the MIT license, see ../LICENSE.code */ #ifndef PZ_CONFIG_H #define PZ_CONFIG_H #define PLASMA_VERSION @VERSION@ #if PLASMA_VERSION == dev #define PLASMA_VERSION_STRING "development version" #else #define PLASMA_VERSION_STRING "@VERSION@" #endif /* * Either 32 or 64 bit */ #define PZ_FAST_INTEGER_WIDTH 32 #define PZ_FAST_INTEGER_TYPE int32_t #define PZ_FAST_UINTEGER_TYPE uint32_t /* * Debugging */ #ifdef DEBUG #else #define NDEBUG #endif /* * Runtime error exit codes */ // Fatal errors, the program didn't run or was aborted. #define PZ_EXIT_RUNTIME_ERROR 255 // Non-fatal, the program terminated but there was a warning or error during // clean-up. #define PZ_EXIT_RUNTIME_NONFATAL 254 #endif /* ! PZ_CONFIG_H */ ================================================ FILE: runtime/pz_cxx_future.h ================================================ /* * PZ C++ future library functions. * vim: ts=4 sw=4 et * * Copyright (C) Plasma Team * Distributed under the terms of the MIT license, see ../LICENSE.code * * This file contains library code that has been added to a more recent C++ * version than the one we've standardised on (C++11) or features that we * might reasonably expect to be added to a future version. If/when we move * to a newer standard we can delete entries here and update code as * necessary. */ #ifndef PZ_CXX_FUTURE_H #define PZ_CXX_FUTURE_H #include #include /* * C++17 libraries don't seem to be on my dev system, * other people might also be missing them. So just implement this * ourselves. */ template class Optional { private: bool m_present = false; /* * AlaskanEmily suggested this trick, allocate space for T here and use * placement new below so that T's without default constructors can be * used. */ static_assert(sizeof(T) >= 1, "T must have non-zero size"); alignas(alignof(T)) char m_data[sizeof(T)] = {0}; public: constexpr Optional() {} // Implicit constructor Optional(const T & val) { set(val); } Optional(T && val) : m_present(true) { value() = std::move(val); } Optional(const Optional & other) { if (other.hasValue()) { set(other.value()); } } Optional(Optional && other) { if (other.hasValue()) { set(other.release()); } } ~Optional() { clear(); } Optional & operator=(const Optional & other) { if (this != &other) { if (other.hasValue()) { set(other.value()); } else { clear(); } } return *this; } Optional & operator=(Optional && other) { if (this != &other) { if (other.hasValue()) { set(other.release()); } else { clear(); } } return *this; } static constexpr Optional Nothing() { return Optional(); } bool hasValue() const { return m_present; } void set(const T & val) { clear(); new (m_data) T(val); m_present = true; } void set(T && val) { clear(); new (m_data) T(std::move(val)); m_present = true; } T & value() { assert(m_present); return raw(); } const T & value() const { assert(m_present); return raw(); } T && release() { assert(m_present); m_present = false; return std::move(raw()); } void clear() { if (m_present) { raw().~T(); } m_present = false; } private: // Access the storage as the correct type without an assertion. T & raw() { return reinterpret_cast(m_data); } const T & raw() const { return reinterpret_cast(m_data); } }; class ScopeExit { public: explicit ScopeExit(std::function && f) : m_f(f) {} ~ScopeExit() { m_f(); } private: std::function m_f; }; #endif // ! PZ_CXX_FUTURE_H ================================================ FILE: runtime/pz_data.cpp ================================================ /* * Plasma bytecode data and types loading and runtime * vim: ts=4 sw=4 et * * Copyright (C) Plasma Team * Distributed under the terms of the MIT license, see ../LICENSE.code */ #include #include #include "pz_common.h" #include "pz_data.h" #include "pz_util.h" /* * Structs * **********/ namespace pz { void Struct::calculate_layout() { #ifdef PZ_DEV assert(!m_layout_calculated); m_layout_calculated = true; #endif unsigned size = 0; for (unsigned i = 0; i < num_fields(); i++) { unsigned field_size = width_to_bytes(m_fields[i].width); size = AlignUp(size, field_size); m_fields[i].offset = size; size += field_size; } m_total_size = size; } /* * Data * **********/ void * data_new_array_data(GCCapability & gc_tracer, PZ_Width width, uint32_t num_elements) { return gc_tracer.alloc_bytes(width_to_bytes(width) * num_elements); } void * data_new_struct_data(GCCapability & gc_tracer, size_t size) { // TODO: Use this during execution of PZT_ALLOC. return gc_tracer.alloc_bytes(size); } /* * Functions for storing data in memory ***************************************/ void data_write_normal_uint8(void * dest, uint8_t value) { *((uint8_t *)dest) = value; } void data_write_normal_uint16(void * dest, uint16_t value) { *((uint16_t *)dest) = value; } void data_write_normal_uint32(void * dest, uint32_t value) { *((uint32_t *)dest) = value; } void data_write_normal_uint64(void * dest, uint64_t value) { *((uint64_t *)dest) = value; } void data_write_fast_from_int32(void * dest, int32_t value) { *((PZ_FAST_INTEGER_TYPE *)dest) = (PZ_FAST_INTEGER_TYPE)value; } void data_write_wptr(void * dest, intptr_t value) { *((intptr_t *)dest) = value; } Optional width_from_int(uint8_t w) { switch (w) { case PZW_8: return PZW_8; case PZW_16: return PZW_16; case PZW_32: return PZW_32; case PZW_64: return PZW_64; case PZW_FAST: return PZW_FAST; case PZW_PTR: return PZW_PTR; default: return Optional::Nothing(); } } PZ_Width width_normalize(PZ_Width width) { switch (width) { case PZW_FAST: switch (PZ_FAST_INTEGER_WIDTH) { case 32: return PZW_32; case 64: return PZW_64; default: fprintf(stderr, "PZ_FAST_INTEGER_WIDTH has unanticipated value\n"); abort(); } break; case PZW_PTR: switch (sizeof(intptr_t)) { case 4: return PZW_32; case 8: return PZW_64; default: fprintf(stderr, "Unknown pointer width\n"); abort(); } break; default: return width; } } unsigned width_to_bytes(PZ_Width width) { width = width_normalize(width); switch (width) { case PZW_8: return 1; case PZW_16: return 2; case PZW_32: return 4; case PZW_64: return 8; default: fprintf(stderr, "Width should have been normalized"); abort(); } } } // namespace pz ================================================ FILE: runtime/pz_data.h ================================================ /* * Plasma bytecode data and types loading and runtime * vim: ts=4 sw=4 et * * Copyright (C) Plasma Team * Distributed under the terms of the MIT license, see ../LICENSE.code */ #ifndef PZ_DATA_H #define PZ_DATA_H #include #include "pz_cxx_future.h" #include "pz_format.h" #include "pz_gc_util.h" namespace pz { struct Struct_Field : public GCNew { private: PZ_Width width; uint16_t offset; Struct_Field(){}; explicit Struct_Field(PZ_Width w) : width(w) {} friend class Struct; }; class Struct : public GCNew { private: // TODO Create an array class that wraps C arrays, performs bounds // checking and is GC allocatable. Struct_Field * m_fields; unsigned m_num_fields; unsigned m_total_size; #ifdef PZ_DEV bool m_layout_calculated; #endif public: Struct() = delete; explicit Struct(NoGCScope & gc_cap, unsigned num_fields) : m_num_fields(num_fields) #ifdef PZ_DEV , m_layout_calculated(false) #endif { m_fields = new (gc_cap) Struct_Field[num_fields]; } unsigned num_fields() const { return m_num_fields; } unsigned total_size() const { return m_total_size; } uint16_t field_offset(unsigned num) const { #ifdef PZ_DEV assert(m_layout_calculated); #endif assert(num < m_num_fields); return m_fields[num].offset; } void set_field(unsigned i, PZ_Width width) { m_fields[i] = Struct_Field(width); } void calculate_layout(); Struct(const Struct &) = delete; void operator=(const Struct & other) = delete; }; Optional width_from_int(uint8_t w); PZ_Width width_normalize(PZ_Width w); unsigned width_to_bytes(PZ_Width w); /* * Data * *******/ /* * Allocate space for array data. If the width is 0 then the array contains * references to other data, and each element should be machine word sized. */ void * data_new_array_data(GCCapability & gc_tracer, PZ_Width width, uint32_t num_elements); /* * Allocate space for struct data. */ void * data_new_struct_data(GCCapability & gc_tracer, size_t size); /* * Functions for storing data in memory ***************************************/ /* * Write the given value into the data object. */ void data_write_normal_uint8(void * dest, uint8_t value); void data_write_normal_uint16(void * dest, uint16_t value); void data_write_normal_uint32(void * dest, uint32_t value); void data_write_normal_uint64(void * dest, uint64_t value); /* * Write the given value into the data object. The value will be sign * extended to the "fast" width. */ void data_write_fast_from_int32(void * dest, int32_t value); void data_write_wptr(void * dest, intptr_t value); } // namespace pz #endif /* ! PZ_DATA_H */ ================================================ FILE: runtime/pz_foreign.cpp ================================================ /* * Plasma foreign code linker * vim: ts=4 sw=4 et * * Copyright (C) Plasma Team * Distributed under the terms of the MIT license, see ../LICENSE.code */ #include "pz_common.h" #include #include #include #include #include #include #include #include "pz_cxx_future.h" #include "pz_string.h" #include "pz_gc_util.h" #include "pz_foreign.h" #define PZ_INIT_FOREIGN_CODE "pz_init_foreign_code" namespace pz { Foreign::Foreign(void * handle, foreign_library_cxx_function init_fn) : m_handle(handle) , m_init_fn(init_fn) {} static std::string safe_getcwd() { size_t len = 64; std::unique_ptr buffer(new char[len]); char * result = getcwd(buffer.get(), len); // Try again with a larger buffer while (!result && errno == ERANGE) { len *= 2; buffer = std::unique_ptr(new char[len]); result = getcwd(buffer.get(), len); } if (!result) { perror("getcwd()"); exit(1); } return std::string(result); } Foreign::~Foreign() { if (m_handle) { dlclose(m_handle); } } // static bool Foreign::maybe_load(const std::string & filename, GCTracer &gc, Root &foreign) { // Check that the library file exists, we need to do this ourselves // because dlload won't tell us. struct stat statbuf; if (-1 == stat(filename.c_str(), &statbuf)) { if (errno == ENOENT) { // The file doesn't exist return false; } // Some other error, perror(filename.c_str()); } // The file probably exists, construct a path. std::string path; if (filename.length() > 0 && filename[0] == '/') { path = filename; } else { path = safe_getcwd() + "/" + filename; } // XXX: Use lazy resolution in release builds. void * handle = dlopen(path.c_str(), RTLD_NOW | RTLD_LOCAL); if (!handle) { fprintf(stderr, "%s\n", dlerror()); return false; } dlerror(); // Clear the error state. foreign_library_cxx_function init_fn = reinterpret_cast( dlsym(handle, PZ_INIT_FOREIGN_CODE)); if (!init_fn) { const char * error = dlerror(); if (error) { fprintf(stderr, "%s\n", error); } else { fprintf(stderr, "%s: Initial function is null\n", filename.c_str()); } return false; } foreign = new(gc) Foreign(handle, init_fn); return true; } bool Foreign::init(GCTracer & gc) { assert(m_init_fn); return m_init_fn(this, &gc); } Closure * Foreign::lookup_foreign_proc(String module_name, String closure_name) const { auto module = m_closures.find(module_name); if (module == m_closures.end()) { return nullptr; } auto closure = module->second.find(closure_name); if (closure == module->second.end()) { return nullptr; } return closure->second; } static unsigned make_ccall_instr(uint8_t * bytecode, pz_foreign_c_func c_func) { ImmediateValue immediate_value; unsigned offset = 0; immediate_value.word = (uintptr_t)c_func; offset += write_instr(bytecode, offset, PZI_CCALL, IMT_PROC_REF, immediate_value); offset += write_instr(bytecode, offset, PZI_RET); return offset; } static void make_foreign(String name, pz_foreign_c_func c_func, GCTracer & gc, Foreign *foreign, Root &closure) { unsigned size = make_ccall_instr(nullptr, nullptr); Root proc(gc); { NoGCScope nogc(gc); proc = new (nogc) Proc(nogc, name, true, size); nogc.abort_if_oom("setting up foreign code"); } make_ccall_instr(proc->code(), c_func); // Use foreign as the closure's unused data pointer to ensure that the // Foreign object is referenced while closures may still point to its // code. closure = new (gc) Closure(proc->code(), foreign); } void Foreign::do_trace(HeapMarkState * marker) const { for (auto m : m_closures) { marker->mark_root(m.first.ptr()); for (auto c : m.second) { marker->mark_root(c.first.ptr()); marker->mark_root(c.second); } } } bool Foreign::register_foreign_code(String module, String proc, pz_foreign_c_func c_func, GCTracer & gc) { Root closure(gc); make_foreign(proc, c_func, gc, this, closure); m_closures[module][proc] = closure.ptr(); return true; } } // namespace pz ================================================ FILE: runtime/pz_foreign.h ================================================ /* * Plasma foreign code linker * vim: ts=4 sw=4 et * * Copyright (C) Plasma Team * Distributed under the terms of the MIT license, see ../LICENSE.code */ #ifndef PZ_FOREIGN_H #define PZ_FOREIGN_H #include #include "pz_cxx_future.h" #include "pz_interp.h" namespace pz { class Foreign; typedef bool (*foreign_library_cxx_function)(Foreign * foreign, GCTracer * gc); class Foreign : public GCNewTrace { private: void * m_handle; foreign_library_cxx_function m_init_fn; std::unordered_map> m_closures = std::unordered_map>(1); Foreign(void * handle, foreign_library_cxx_function init_fn); public: ~Foreign(); static bool maybe_load(const std::string & filename, GCTracer &gc, Root &foreign); bool init(GCTracer & gc); // Not copyable since it has unique resource ownership. Foreign(const Foreign &) = delete; Foreign(Foreign && other) = delete; const Foreign & operator=(const Foreign &) = delete; const Foreign & operator=(Foreign && other) = delete; Closure * lookup_foreign_proc(String module, String proc) const; void do_trace(HeapMarkState * marker) const override; /* * These functions help setup foreign code. */ bool register_foreign_code(String module, String proc, pz_foreign_c_func c_func, GCTracer & gc); }; } // namespace pz #endif /* ! PZ_FOREIGN_H */ ================================================ FILE: runtime/pz_format.h ================================================ /* * Plasma bytecode format constants * vim: ts=4 sw=4 et * * Copyright (C) Plasma Team * Distributed under the terms of the MIT license, see ../LICENSE.code * * This file is used by both the tools in runtime/ and src/ */ #ifndef PZ_FORMAT_H #define PZ_FORMAT_H #ifdef __cplusplus extern "C" { #endif /* * The PZ format is a binary format. No padding is used and all numbers are * unsigned integers in little-endian format unless otherwise specified. */ /* * PZ Syntax description * ===================== * * The PZ file begins with a magic number, a description string whose prefix * is given below (suffix & length don't matter allowing an ascii version * number to be provided), a 16 bit version number, an options entry then * the file's entries. * * PZ ::= Magic(32bit) DescString VersionNumber(16bit) Options * NumNames(32bit) ModuleName(String)* * NumImports(32bit) NumStructs(32bit) NumDatas(32bit) * NumProcs(32bit) NumClosures(32bit) NumExports(32bit) * ImportRef* StructEntry* DataEntry* ProcEntry* * ClosureEntry* ExportRef* * * Options * ------- * * All option entries begin with a 16 bit type and a 16 bit length. The * length gives the length of the value and the type says how to interpret * it. * * Options ::= NumOptions(16bit) OptionEntry* * * OptionEntry ::= OptionType(16bit) Len(16bit) OptionValue * * Procedure and data entries are each given a unique 32bit procedure or * data ID. To clarify, procedures and data entries exist in seperate ID * spaces. The IDs start at 0 for the first entry and are given * sequentially in file order. IDs are used for example in the call * instruction which must specify the callee. * * Imports & Exports * ----------------- * * Import refs map IDs onto closure names to be provided by other modules. * Imported closures are identified by a high 31st bit. * * Import names are split into module and symbol parts so that the check * for the module and the check for whether the module contains the symbol * are easily seperated as they can produce different errors. * * ImportRef ::= ImportType(8bit) ModuleName(String) SymbolName(String) * * Export refs map fully qualified names onto closure Ids. All the symbols * listed are exported. * * ExportRef ::= SymbolName(String) ClosureId(32Bit) * * Struct information * ------------------ * * StructEntry ::= NumFields(32bit) Width* * * Constant data * ------------- * * A data entry is a data type followed by the data (numbers and * references). The number and in-memory widths of each number are given * by the data type. The on disk widths/encodings are given in each value. * * Data references may not form cycles, and the referred-to data items must * occur before the referred-from items. * * DataEntry ::= DATA_ARRAY(8) NumElements(16) Width DataEnc DataValue* * | DATA_STRUCT(8) StructRef DataEncValue* * | DATA_STRING(8) NumElements(16) DataEnc DataValue* * * Note that an array of structs is acheived by an array o pointers to * pre-defined structs. (TODO: it'd be nice to support other data layouts * like an array of structs.) * * Which data value depends upon context. * * DataEncValue ::= DataEnc DataValue * * DataEnc ::= ENC_NORMAL NumBytes * | ENC_FAST 4 * | ENC_WPTR 4 * | ENC_DATA 4 * | ENC_IMPORT 4 * | ENC_CLOSURE 4 * * The encoding type and number of bytes are a single byte made up by * PZ_MAKE_ENC below. Currently fast words and pointer-sized words are * always 32bit. * * DataValue ::= Byte* * | DataIndex(32bit) * | ImportIndex(32bit) * | ClosureIndex(32bit) * * Code * ---- * * ProcEntry ::= Name(String) NumBlocks(32bit) Block+ * Block ::= NumInstrObjs(32bit) InstrObj+ * * InstrObj ::= CODE_INSTR(8) Instruction * | MetaItem * Instruction ::= Opcode(8bit) WidthByte{0,2} Immediate? * InstructionStream? * * MetaItem ::= CODE_META_CONTEXT(8) FileName(DataIndex) LineNo(32bit) * | CODE_META_CONTEXT_SHORT(8) LineNo(32bit) * | CODE_META_CONTEXT_NIL(8) * * Closures * -------- * * ClosureEntry ::= ProcId(32bit) DataId(32bit) * * Shared items * ------------ * * Widths are a single byte defined by the Width enum. Note that a data * width (a width for data items) is a seperate thing, and encoded * differently. They may be: * PZW_8, * PZW_16, * PZW_32, * PZW_64, * PZW_FAST, efficient integer width * PZW_PTR, native pointer width * * Strings are encoded with a number of bytes giving the length followed by * the string's bytes. * * String ::= Length(16bit) Bytes* * */ #define PZ_OBJECT_MAGIC_NUMBER 0x505A4F00 // PZ0 #define PZ_PROGRAM_MAGIC_NUMBER 0x505A5000 // PZP #define PZ_LIBRARY_MAGIC_NUMBER 0x505A4C00 // PZL #define PZ_OBJECT_MAGIC_STRING "Plasma object" #define PZ_PROGRAM_MAGIC_STRING "Plasma program" #define PZ_LIBRARY_MAGIC_STRING "Plasma library" #define PZ_FORMAT_VERSION 0 #define PZ_OPT_ENTRY_CLOSURE 0 /* * Value: * 8bit number giving the signature of the entry closure. * 32bit number of the program's entry closure */ #define PZ_OPT_ENTRY_CANDIDATE 1 /* * Value: * 8bit number giving the signature of the entry closure. * 32bit number of the program's entry closure (must be an exported * closure). */ enum PZOptEntrySignature { PZ_OPT_ENTRY_SIG_PLAIN, PZ_OPT_ENTRY_SIG_ARGS, PZ_OPT_ENTRY_SIG_LAST = PZ_OPT_ENTRY_SIG_ARGS }; enum PZ_Import_Type { PZ_IMPORT_IMPORT, PZ_IMPORT_FOREIGN, PZ_IMPORT_LAST = PZ_IMPORT_FOREIGN }; /* * The width of data, either as an operand or in memory such as in a struct. */ enum PZ_Width { PZW_8, PZW_16, PZW_32, PZW_64, PZW_FAST, // efficient integer width PZW_PTR, // native pointer width }; #define PZ_NUM_WIDTHS (PZW_PTR + 1) #define PZ_DATA_ARRAY 0 #define PZ_DATA_STRUCT 1 #define PZ_DATA_STRING 2 /* * The high bits of a data width give the width type. Width types are: * - Pointers: 32-bit references to some other * value, updated on load. * - Words with pointer width: 32-bit values zero-extended to the width of * a pointer. * - Fast words: Must be encoded with 32bits. * - Normal: Encoded and in-memory width are the same. * * The low bits give the width for normal-width values. Other values are * always encoded as 32bit. (TODO: maybe this can be changed with a PZ file * option.) */ #define PZ_DATA_ENC_TYPE_BITS 0xF0 #define PZ_DATA_ENC_BYTES_BITS 0x0F #define PZ_DATA_ENC_TYPE(byte) \ (enum pz_data_enc_type)((byte)&PZ_DATA_ENC_TYPE_BITS) #define PZ_DATA_ENC_BYTES(byte) ((byte)&PZ_DATA_ENC_BYTES_BITS) #define PZ_MAKE_ENC(type, bytes) ((type) | (bytes)) enum pz_data_enc_type { pz_data_enc_type_normal = 0x00, pz_data_enc_type_fast = 0x10, pz_data_enc_type_wptr = 0x20, pz_data_enc_type_data = 0x30, pz_data_enc_type_import = 0x40, pz_data_enc_type_closure = 0x50, }; #define PZ_LAST_DATA_ENC_TYPE pz_data_enc_type_closure; enum PZ_Code_Item { PZ_CODE_INSTR, PZ_CODE_META_CONTEXT, PZ_CODE_META_CONTEXT_SHORT, PZ_CODE_META_CONTEXT_NIL, }; #define PZ_NUM_CODE_ITEMS (PZ_CODE_META_CONTEXT_NIL + 1) #ifdef __cplusplus } // extern "C" #endif #endif /* ! PZ_FORMAT_H */ ================================================ FILE: runtime/pz_gc.cpp ================================================ /* * Plasma garbage collector * vim: ts=4 sw=4 et * * Copyright (C) Plasma Team * Distributed under the terms of the MIT license, see ../LICENSE.code */ #include "pz_common.h" #include #include #include #include #include "pz_util.h" #include "pz_gc.h" #include "pz_gc_util.h" #include "pz_gc.impl.h" #include "pz_gc_layout.h" #include "pz_gc_layout.impl.h" /* * Plasma GC * --------- * * We want a GC that provides enough features to meet some MVP-ish goals. It * only needs to be good enough to ensure we recover memory. It is * currently a little bit better than that. * * * Mark/Sweep * * Non-moving * * Conservative * * Interior pointers (up to 7 byte offset) * * Block based, each block contains cells of a particular size, a marking * bitmap and free list pointer (the free list is made of unused cell * contents. * * Blocks are allocated from Chunks. We allocate chunks from the OS. * * This GC is fairly simple. There are a few changes we could make to * improve it in the medium term: * * https://github.com/PlasmaLang/plasma/labels/component%3A%20gc * * In the slightly longer term we should: * * * Use accurate pointer information and test it by adding compaction. * * In the long term, and with much tweaking, this GC will become the * tenured and maybe the tenured/mutable part of a larger GC with more * features and improvements. */ namespace pz { /*************************************************************************** * * These procedures will likely move somewhere else, but maybe after some * refactoring. */ size_t heap_get_usage(const Heap * heap) { return heap->usage(); } unsigned heap_get_collections(const Heap * heap) { return heap->collections(); } void heap_set_meta_info(Heap * heap, void * obj, void * meta) { heap->set_meta_info(obj, meta); } void * heap_interior_ptr_to_ptr(const Heap * heap, void * ptr) { return heap->interior_ptr_to_ptr(ptr); } void * Heap::interior_ptr_to_ptr(void * iptr) const { CellPtrBOP cellb = ptr_to_bop_cell_interior(iptr); if (cellb.is_valid()) { return cellb.pointer(); } else { CellPtrFit cellf = ptr_to_fit_cell_interior(iptr); if (cellf.is_valid()) { return cellf.pointer(); } } return nullptr; } void * heap_meta_info(const Heap * heap, void * obj) { return heap->meta_info(obj); } bool ChunkBOP::is_empty() const { for (unsigned i = 0; i < m_wilderness; i++) { if (m_blocks[i].is_in_use()) return false; } return true; } bool ChunkFit::is_empty() { CellPtrFit cell = first_cell(); return !cell.is_allocated() && cell.size() == ((Payload_Bytes - CellPtrFit::CellInfoOffset) / WORDSIZE_BYTES); } /***************************************************************************/ Heap::Heap(const Options & options) : m_options(options) , m_chunk_bop("GC BOP") , m_chunk_fit("GC fit") , m_threshold(GC_Initial_Threshold) {} Heap::~Heap() { assert(!m_chunk_bop.is_mapped()); assert(!m_chunk_fit.is_mapped()); } bool Heap::init() { assert(!m_chunk_bop.is_mapped()); if (m_chunk_bop.allocate(GC_Chunk_Size)) { new (m_chunk_bop.ptr()) ChunkBOP(this); } else { return false; } assert(!m_chunk_fit.is_mapped()); if (m_chunk_fit.allocate(GC_Chunk_Size)) { new (m_chunk_fit.ptr()) ChunkFit(this); } else { return false; } return true; } bool Heap::finalise(bool fast) { if (fast) { m_chunk_bop.forget(); m_chunk_fit.forget(); return true; } bool result = true; if (m_chunk_bop.is_mapped()) { if (!m_chunk_bop.release()) { result = false; } } if (m_chunk_fit.is_mapped()) { // sweeping first ensures we run finalisers. m_chunk_fit->sweep(m_options); if (!m_chunk_fit.release()) { result = false; } } return result; } /***************************************************************************/ Block::Block(const Options & options, size_t cell_size_) : m_header(cell_size_) { assert(cell_size_ >= GC_Min_Cell_Size); memset(m_header.bitmap, 0, GC_Cells_Per_Block * sizeof(uint8_t)); #if PZ_DEV if (options.gc_poison()) { memset(m_bytes, Poison_Byte, Payload_Bytes); } #endif sweep(options); } /***************************************************************************/ size_t Block::usage() { return num_allocated() * size() * WORDSIZE_BYTES; } unsigned Block::num_allocated() { unsigned count = 0; for (unsigned i = 0; i < num_cells(); i++) { CellPtrBOP cell(this, i); if (cell.is_allocated()) { count++; } } return count; } size_t ChunkBOP::usage() { size_t usage = 0; for (unsigned i = 0; i < m_wilderness; i++) { if (m_blocks[i].is_in_use()) { usage += m_blocks[i].usage(); } } return usage; } size_t ChunkFit::usage() { size_t size = 0; CellPtrFit cell = first_cell(); while (cell.is_valid()) { if (cell.is_allocated()) { size += cell.size() * WORDSIZE_BYTES + CellPtrFit::CellInfoOffset; } cell = cell.next_in_chunk(); } return size; } /***************************************************************************/ void Heap::set_meta_info(void * obj, void * meta) { CellPtrFit cell = ptr_to_fit_cell(obj); assert(cell.is_valid()); *cell.meta() = meta; } void * Heap::meta_info(void * obj) const { CellPtrFit cell = ptr_to_fit_cell(obj); assert(cell.is_valid()); return *cell.meta(); } } // namespace pz /*************************************************************************** * * Check arhitecture assumptions */ // 8 bits per byte static_assert(WORDSIZE_BYTES * 8 == WORDSIZE_BITS, "8 bits in a byte"); // 32 or 64 bit. static_assert(WORDSIZE_BITS == 64 || WORDSIZE_BITS == 32, "Either 32 or 64bit wordsize"); ================================================ FILE: runtime/pz_gc.h ================================================ /* * Plasma garbage collector * vim: ts=4 sw=4 et * * Copyright (C) Plasma Team * Distributed under the terms of the MIT license, see ../LICENSE.code */ #ifndef PZ_GC_H #define PZ_GC_H #include "pz_option.h" #include "pz_util.h" namespace pz { /* * The GC recognised pointers even with one high tag bit (for strings) and 2 * or 3 low tag bits. The implementation uses these values to remove tags * from pointers, but users may also depend on them to remove tags. */ constexpr uintptr_t HIGH_TAG_SHIFT = WORDSIZE_BITS-1; constexpr uintptr_t HIGH_TAG_MASK = static_cast(1)< m_chunk_bop; Memory m_chunk_fit; size_t m_usage = 0; size_t m_threshold; unsigned m_collections = 0; // May be null if uninitalised AbstractGCTracer * m_trace_global_roots = nullptr; public: Heap(const Options & options); ~Heap(); bool init(); void set_roots_tracer(AbstractGCTracer & trace_global_roots) { m_trace_global_roots = &trace_global_roots; } // Call finalise to run any objects' finalisers and unmap the "mmaped" // memory. Or if you're going to exit the program immediately pass // (fast=true) to zero things while skipping the cleanup. // Be aware the destructor will not do this cleanup. bool finalise(bool fast); const Options & options() const { return m_options; }; void * alloc(size_t size_in_words, GCCapability & gc_cap, AllocOpts opts = AllocOpts::NORMAL); void * alloc_bytes(size_t size_in_bytes, GCCapability & gc_cap, AllocOpts opts = AllocOpts::NORMAL); /* * Note that usage is an over-estimate, it can contain block-internal * fragmentation. */ size_t usage() const { return m_usage; }; unsigned collections() const { return m_collections; } Heap(const Heap &) = delete; Heap & operator=(const Heap &) = delete; void set_meta_info(void * obj, void * meta); void * meta_info(void * obj) const; private: void collect(const AbstractGCTracer * thread_tracer); bool is_empty() const { return usage() == 0; }; // Returns the number of cells marked recursively. template unsigned mark(Cell & cell); unsigned mark_field(void * ptr); // Specialised for marking specific cell types. Returns the size of the // cell. static unsigned do_mark(CellPtrBOP & cell); static unsigned do_mark(CellPtrFit & cell); unsigned do_mark_special_field(CellPtrBOP & cell); unsigned do_mark_special_field(CellPtrFit & cell); void sweep(); void * try_allocate(size_t size_in_words, AllocOpts opts); void * try_small_allocate(size_t size_in_words); void * try_medium_allocate(size_t size_in_words, AllocOpts opts); Block * get_block_for_allocation(size_t size_in_words); Block * allocate_block(size_t size_in_words); /* * Although these two methods are marked as inline they are defined in * pz_gc_layout.h with other inline functions. */ // The address points to memory within the heap (is inside the payload // of an actively used block). inline bool is_heap_address(void * ptr) const; // An address can be converted to a cell here, or Invalid() if the // address isn't the first address of a valid cell. CellPtrBOP ptr_to_bop_cell(void * ptr) const; CellPtrBOP ptr_to_bop_cell_interior(void * ptr) const; CellPtrFit ptr_to_fit_cell(void * ptr) const; CellPtrFit ptr_to_fit_cell_interior(void * ptr) const; friend class HeapMarkState; public: void * interior_ptr_to_ptr(void * ptr) const; #ifdef PZ_DEV private: void check_heap() const; void print_usage_stats(size_t initial_usage) const; /* * This is not used anywhere, it's included so it can be run from gdb to * help with debugging. */ void print_addr_info(void * addr) const; #endif }; } // namespace pz #endif // ! PZ_GC_IMPL_H ================================================ FILE: runtime/pz_gc_alloc.cpp ================================================ /* * Plasma garbage collector collection procedures * vim: ts=4 sw=4 et * * Copyright (C) Plasma Team * Distributed under the terms of the MIT license, see ../LICENSE.code */ #include "pz_common.h" #include #include "pz_util.h" #include "pz_gc.h" #include "pz_gc_util.h" #include "pz_gc.impl.h" #include "pz_gc_layout.h" #include "pz_gc_layout.impl.h" namespace pz { void * Heap::alloc(size_t size_in_words, GCCapability & gc_cap, AllocOpts opts) { assert(size_in_words > 0); bool should_collect = false; #ifdef PZ_DEV if (m_options.gc_zealous() && gc_cap.can_gc() && !is_empty()) { // Force a collect before each allocation in this mode. should_collect = true; } #endif if (gc_cap.can_gc() && m_usage + size_in_words * WORDSIZE_BYTES > m_threshold) { should_collect = true; } if (should_collect) { collect(&gc_cap.tracer()); } void * cell = try_allocate(size_in_words, opts); if (cell) { return cell; } if (gc_cap.can_gc() && !should_collect) { collect(&gc_cap.tracer()); cell = try_allocate(size_in_words, opts); if (cell) { return cell; } } gc_cap.oom(size_in_words * WORDSIZE_BYTES); return nullptr; } void * Heap::alloc_bytes(size_t size_in_bytes, GCCapability & gc_cap, AllocOpts opts) { size_t size_in_words = AlignUp(size_in_bytes, WORDSIZE_BYTES) / WORDSIZE_BYTES; return alloc(size_in_words, gc_cap, opts); } void * Heap::try_allocate(size_t size_in_words, AllocOpts opts) { switch (opts) { case NORMAL: if (size_in_words <= GC_Small_Alloc_Threshold) { return try_small_allocate(size_in_words); } else { return try_medium_allocate(size_in_words, opts); } case META: case TRACE: { return try_medium_allocate(size_in_words, opts); } default: fprintf(stderr, "Allocation options is invalid\n"); abort(); } } void * Heap::try_small_allocate(size_t size_in_words) { if (size_in_words < GC_Min_Cell_Size) { size_in_words = GC_Min_Cell_Size; } else if (size_in_words <= 16) { size_in_words = RoundUp(size_in_words, size_t(2)); } else { size_in_words = RoundUp(size_in_words, size_t(4)); } /* * Try the free list */ Block * block = get_block_for_allocation(size_in_words); if (!block) { block = allocate_block(size_in_words); if (!block) { #ifdef PZ_DEV if (m_options.gc_trace2()) { fprintf(stderr, "Heap full for allocation of %ld words\n", size_in_words); } #endif return nullptr; } } CellPtrBOP cell = block->allocate_cell(); if (!cell.is_valid()) return nullptr; #ifdef PZ_DEV if (m_options.gc_poison()) { memset(cell.pointer(), Poison_Byte, block->size() * WORDSIZE_BYTES); } if (m_options.gc_trace2()) { fprintf(stderr, "Allocated %p from free list\n", cell.pointer()); } #endif m_usage += block->size() * WORDSIZE_BYTES; return cell.pointer(); } Block * Heap::get_block_for_allocation(size_t size_in_words) { return m_chunk_bop->get_block_for_allocation(size_in_words); } Block * ChunkBOP::get_block_for_allocation(size_t size_in_words) { for (unsigned i = 0; i < m_wilderness; i++) { Block * block = &(m_blocks[i]); if (block->is_in_use() && block->size() == size_in_words && !block->is_full()) { return block; } } return nullptr; } Block * Heap::allocate_block(size_t size_in_words) { Block * block; block = m_chunk_bop->allocate_block(); if (!block) return nullptr; #ifdef PZ_DEV if (m_options.gc_trace()) { fprintf(stderr, "Allocated new block for %ld cells\n", size_in_words); } #endif new (block) Block(m_options, size_in_words); return block; } Block * ChunkBOP::allocate_block() { for (unsigned i = 0; i < m_wilderness; i++) { if (!m_blocks[i].is_in_use()) { // TODO https://github.com/PlasmaLang/plasma/issues/191 return &m_blocks[i]; } } if (m_wilderness >= GC_Block_Per_Chunk) return nullptr; return &m_blocks[m_wilderness++]; } CellPtrBOP Block::allocate_cell() { assert(is_in_use()); if (m_header.free_list < 0) return CellPtrBOP::Invalid(); CellPtrBOP cell(this, m_header.free_list); assert(!cell.is_allocated()); m_header.free_list = cell.next_in_list(); assert(m_header.free_list == Header::Empty_Free_List || (m_header.free_list < static_cast(num_cells()) && m_header.free_list >= 0)); cell.allocate(); return cell; } void * Heap::try_medium_allocate(size_t size_in_words, AllocOpts opts) { CellPtrFit cell = m_chunk_fit->allocate_cell(size_in_words); #ifdef PZ_DEV if (cell.is_valid() && m_options.gc_poison()) { memset(cell.pointer(), Poison_Byte, cell.size() * WORDSIZE_BYTES); } #endif /* * TODO: we could allow both meta and trace at the same time, there's * currently no limitation for that since we're using C++ virtual * methods to find the trace code and finaliser. */ *cell.meta() = nullptr; switch (opts) { case NORMAL: case META: break; case TRACE: cell.set_flags(CellPtrFit::CF_TRACE_AND_FINALISE); break; } m_usage += cell.size() * WORDSIZE_BYTES + CellPtrFit::CellInfoOffset; return cell.pointer(); } constexpr size_t CellSplitThreshold = Block::Max_Cell_Size + CellPtrFit::CellInfoOffset; CellPtrFit ChunkFit::allocate_cell(size_t size_in_words) { CellPtrFit cell = m_header.free_list; while (cell.is_valid()) { if (cell.size() >= size_in_words) { m_header.free_list = cell.next_in_list(); // Should we split the cell? if (cell.size() >= size_in_words + CellSplitThreshold) { CellPtrFit new_cell = cell.split(size_in_words); new_cell.set_next_in_list(m_header.free_list); m_header.free_list = new_cell; } cell.set_allocated(); return cell; } cell = cell.next_in_list(); } return CellPtrFit::Invalid(); } ChunkFit::ChunkFit(Heap * heap) : Chunk(heap, CT_FIT) { CellPtrFit singleCell = first_cell(); singleCell.init((Payload_Bytes - CellPtrFit::CellInfoOffset) / WORDSIZE_BYTES); m_header.free_list = singleCell; } CellPtrFit CellPtrFit::split(size_t new_size) { assert(size() >= 1 + CellPtrFit::CellInfoOffset + new_size); #ifdef PZ_DEV void * end_of_cell = next_by_size(size()); #endif CellPtrFit new_cell(m_chunk, next_by_size(new_size)); size_t rem_size = size() - new_size - CellPtrFit::CellInfoOffset / WORDSIZE_BYTES; set_size(new_size); new_cell.init(rem_size); #ifdef PZ_DEV assert(new_cell.pointer() == next_in_chunk().pointer()); assert(end_of_cell == new_cell.next_by_size(new_cell.size())); check(); new_cell.check(); #endif return new_cell; } } // namespace pz ================================================ FILE: runtime/pz_gc_collect.cpp ================================================ /* * Plasma garbage collector collection procedures * vim: ts=4 sw=4 et * * Copyright (C) Plasma Team * Distributed under the terms of the MIT license, see ../LICENSE.code */ #include "pz_common.h" #include #include "pz_util.h" #include "pz_gc.h" #include "pz_gc_util.h" #include "pz_gc.impl.h" #include "pz_gc_layout.h" #include "pz_gc_layout.impl.h" namespace pz { // TODO: This can't be constexpr due to the casts. It'd be nice if it could // be. void * REMOVE_TAG(void * tagged_ptr) { return reinterpret_cast(reinterpret_cast(tagged_ptr) & (~0 ^ TAG_BITS)); } void Heap::collect(const AbstractGCTracer * trace_thread_roots) { HeapMarkState state(this); // There's nothing to collect, the heap is empty. if (is_empty()) return; #ifdef PZ_DEV size_t initial_usage = usage(); if (m_options.gc_slow_asserts()) { check_heap(); } #endif #ifdef PZ_DEV if (m_options.gc_trace()) { fprintf(stderr, "Tracing from global roots\n"); } #endif assert(m_trace_global_roots); m_trace_global_roots->do_trace(&state); #ifdef PZ_DEV if (m_options.gc_trace()) { fprintf(stderr, "Done tracing from global roots\n"); } #endif #ifdef PZ_DEV if (m_options.gc_trace()) { fprintf(stderr, "Tracing from thread roots (eg stacks)\n"); } #endif assert(trace_thread_roots); trace_thread_roots->do_trace(&state); #ifdef PZ_DEV if (m_options.gc_trace()) { fprintf(stderr, "Done tracing from stack\n"); } #endif #ifdef PZ_DEV if (m_options.gc_trace()) { state.print_stats(stderr); } #endif sweep(); m_collections++; #ifdef PZ_DEV if (m_options.gc_slow_asserts()) { check_heap(); } if (m_options.gc_usage_stats()) { print_usage_stats(initial_usage); } #endif } template unsigned Heap::mark(Cell & cell) { unsigned num_marked = 0; size_t cell_size; assert(cell.is_valid()); cell_size = do_mark(cell); num_marked++; if (cell.is_fit_cell()) { num_marked += do_mark_special_field(cell); // We shouldn't need to reconstruct the cell because this function // is templated. there's probably some template-fu for this. CellPtrFit cell_fit = ptr_to_fit_cell(cell.pointer()); assert(cell_fit.is_valid()); if (cell_fit.flags() & CellPtrFit::CF_TRACE_AND_FINALISE) { GCNewTrace * obj = (GCNewTrace *)cell.pointer(); HeapMarkState ms(this); obj->do_trace(&ms); num_marked += ms.get_total_marked(); return num_marked; } } void ** ptr = cell.pointer(); for (unsigned i = 0; i < cell_size; i++) { num_marked += mark_field(REMOVE_TAG(ptr[i])); } return num_marked; } unsigned Heap::mark_field(void * cur) { CellPtrBOP field_bop = ptr_to_bop_cell(cur); if (field_bop.is_valid()) { /* * Note that because we use conservative we may find values that * exactly match valid but unallocated cells. Therefore we also * test is_allocated(). */ if (field_bop.is_allocated() && !field_bop.is_marked()) { return mark(field_bop); } } else { CellPtrFit field_fit = ptr_to_fit_cell(cur); if (field_fit.is_valid()) { /* * We also test is_allocated() here, see the above comment. */ if (field_fit.is_allocated() && !field_fit.is_marked()) { return mark(field_fit); } } } return 0; } unsigned Heap::do_mark_special_field(CellPtrBOP & cell) { return 0; } unsigned Heap::do_mark_special_field(CellPtrFit & cell) { return mark_field(*cell.meta()); } unsigned Heap::do_mark(CellPtrBOP & cell) { cell.mark(); return cell.block()->size(); } unsigned Heap::do_mark(CellPtrFit & cell) { cell.mark(); return cell.size(); } void Heap::sweep() { m_chunk_bop->sweep(m_options); m_chunk_fit->sweep(m_options); m_usage = m_chunk_bop->usage() + m_chunk_fit->usage(); m_threshold = size_t(m_usage * GC_Threshold_Factor); } void ChunkBOP::sweep(const Options & options) { for (unsigned i = 0; i < m_wilderness; i++) { if (m_blocks[i].sweep(options)) { m_blocks[i].make_unused(); } } } bool Block::sweep(const Options & options) { if (!is_in_use()) return true; int free_list = Header::Empty_Free_List; unsigned num_used = 0; for (unsigned i = 0; i < num_cells(); i++) { CellPtrBOP cell(this, i); if (cell.is_marked()) { // Cell is marked, clear the mark bit, keep the allocated bit. cell.unmark(); num_used++; } else { // Free the cell. cell.unallocate(); #if PZ_DEV if (options.gc_poison()) { memset(cell.pointer(), Poison_Byte, size() * WORDSIZE_BYTES); } #endif cell.set_next_in_list(free_list); free_list = cell.index(); } } m_header.free_list = free_list; return num_used == 0; } void Block::make_unused() { m_header.block_type_or_size = Header::Block_Empty; } void ChunkFit::sweep(const Options & options) { for (CellPtrFit cell = first_cell(); cell.is_valid(); cell = cell.next_in_chunk()) { if (cell.is_marked()) { cell.unmark(); } else if (cell.is_allocated()) { if (cell.flags() & CellPtrFit::CF_TRACE_AND_FINALISE) { GCNewTrace * obj = reinterpret_cast(cell.pointer()); obj->~GCNewTrace(); } // TODO: this does not free the cell in the sense that it won't // be reused later. It marks it as free only. cell.set_free(); #ifdef PZ_DEV // TODO Implement https://github.com/PlasmaLang/plasma/issues/196 if (options.gc_poison()) { memset(cell.meta(), Poison_Byte, sizeof(*cell.meta())); // We cannot poison the first word of the cell since that // contains the next pointer. memset(reinterpret_cast(cell.pointer()) + WORDSIZE_BYTES, Poison_Byte, (cell.size() - 1) * WORDSIZE_BYTES); } cell.check(); #endif } } } /****************************************************************************/ CellPtrBOP Heap::ptr_to_bop_cell(void * ptr) const { if (m_chunk_bop->contains_pointer(ptr)) { Block * block = const_cast(m_chunk_bop.ptr())->ptr_to_block(ptr); if (block && block->is_in_use() && block->is_valid_address(ptr)) { return CellPtrBOP(block, block->index_of(ptr), ptr); } else { return CellPtrBOP::Invalid(); } } else { return CellPtrBOP::Invalid(); } } CellPtrBOP Heap::ptr_to_bop_cell_interior(void * ptr) const { if (m_chunk_bop->contains_pointer(ptr)) { Block * block = const_cast(m_chunk_bop.ptr())->ptr_to_block(ptr); if (block && block->is_in_use()) { // Compute index then re-compute pointer to find the true // beginning of the cell. unsigned index = block->index_of(ptr); ptr = block->index_to_pointer(index); return CellPtrBOP(block, index, ptr); } else { return CellPtrBOP::Invalid(); } } else { return CellPtrBOP::Invalid(); } } CellPtrFit Heap::ptr_to_fit_cell(void * ptr) const { if (m_chunk_fit->contains_pointer(ptr)) { // TODO Speed up this search with a crossing-map. for (CellPtrFit cell = const_cast(m_chunk_fit.ptr())->first_cell(); cell.is_valid(); cell = cell.next_in_chunk()) { if (cell.pointer() == ptr) { return cell; } else if (cell.pointer() > ptr) { // The pointer points into the middle of a cell. return CellPtrFit::Invalid(); } } return CellPtrFit::Invalid(); } else { return CellPtrFit::Invalid(); } } CellPtrFit Heap::ptr_to_fit_cell_interior(void * ptr) const { if (m_chunk_fit->contains_pointer(ptr)) { // TODO Speed up this search with a crossing-map. CellPtrFit prev = CellPtrFit::Invalid(); for (CellPtrFit cell = const_cast(m_chunk_fit.ptr())->first_cell(); cell.is_valid(); cell = cell.next_in_chunk()) { if (cell.pointer() == ptr) { return cell; } else if (cell.pointer() > ptr) { if (prev.is_valid()) { return prev; } else { return CellPtrFit::Invalid(); } } prev = cell; } return CellPtrFit::Invalid(); } else { return CellPtrFit::Invalid(); } } /***************************************************************************/ void HeapMarkState::mark_root(CellPtrBOP & cell_bop) { assert(cell_bop.is_valid()); if (cell_bop.is_allocated() && !cell_bop.is_marked()) { num_marked += heap->mark(cell_bop); num_roots_marked++; } } void HeapMarkState::mark_root(CellPtrFit & cell_fit) { assert(cell_fit.is_valid()); if (cell_fit.is_allocated() && !cell_fit.is_marked()) { num_marked += heap->mark(cell_fit); num_roots_marked++; } } void HeapMarkState::mark_root(void * heap_ptr) { CellPtrBOP cell_bop = heap->ptr_to_bop_cell(heap_ptr); if (cell_bop.is_valid()) { mark_root(cell_bop); return; } CellPtrFit cell_fit = heap->ptr_to_fit_cell(heap_ptr); if (cell_fit.is_valid()) { mark_root(cell_fit); return; } } void HeapMarkState::mark_root_interior(void * heap_ptr) { // This actually makes the pointer aligned to the GC's alignment. We // should have a different macro for this particular use. (issue #154) heap_ptr = REMOVE_TAG(heap_ptr); CellPtrBOP cell_bop = heap->ptr_to_bop_cell_interior(heap_ptr); if (cell_bop.is_valid()) { mark_root(cell_bop); return; } CellPtrFit cell_fit = heap->ptr_to_fit_cell_interior(heap_ptr); if (cell_fit.is_valid()) { mark_root(cell_fit); return; } } void HeapMarkState::mark_root_conservative(void * root, size_t len_bytes) { // Mark from the root objects. for (void ** p_cur = (void **)root; p_cur < (void **)((uint8_t *)root + len_bytes); p_cur++) { mark_root(REMOVE_TAG(*p_cur)); } } void HeapMarkState::mark_root_conservative_interior(void * root, size_t len_bytes) { // Mark from the root objects. for (void ** p_cur = (void **)root; p_cur < (void **)((uint8_t *)root + len_bytes); p_cur++) { mark_root_interior(*p_cur); } } void HeapMarkState::print_stats(FILE * stream) { fprintf(stream, "Marked %d root pointers, marked %u pointers total\n", num_roots_marked, num_marked); } } // namespace pz ================================================ FILE: runtime/pz_gc_debug.cpp ================================================ /* * Plasma garbage collector - validation checks & dumping code. * vim: ts=4 sw=4 et * * Copyright (C) Plasma Team * Distributed under the terms of the MIT license, see ../LICENSE.code */ #include "pz_common.h" #include #include "pz_gc.h" #include "pz_gc.impl.h" #include "pz_gc_layout.h" #include "pz_gc_layout.impl.h" namespace pz { void Heap::check_heap() const { assert(m_chunk_bop.is_mapped()); const_cast(m_chunk_bop.ptr())->check(); const_cast(m_chunk_fit.ptr())->check(); } void ChunkBOP::check() { assert(m_wilderness < GC_Block_Per_Chunk); for (unsigned i = 0; i < m_wilderness; i++) { m_blocks[i].check(); } } void Block::check() { if (!is_in_use()) return; assert(size() >= GC_Min_Cell_Size); assert(size() <= Block::Max_Cell_Size); assert(num_cells() <= GC_Cells_Per_Block); unsigned num_free_ = 0; for (unsigned i = 0; i < num_cells(); i++) { CellPtrBOP cell(this, i); if (!cell.is_allocated()) { assert(!cell.is_marked()); // This is quadratic and should be replaced with an extra bit in the // cell header and using that to pass over the cells and the // free list once each. // https://github.com/PlasmaLang/plasma/issues/202 assert(is_in_free_list(cell)); num_free_++; } else { assert(!is_in_free_list(cell)); } } assert(num_free() == num_free_); assert(num_cells() == num_free_ + num_allocated()); } bool Block::is_in_free_list(CellPtrBOP & search) { int cur = m_header.free_list; while (cur != Header::Empty_Free_List) { assert(cur >= 0); CellPtrBOP cell(this, unsigned(cur)); if (search.index() == cell.index()) { return true; } cur = cell.next_in_list(); } return false; } unsigned Block::num_free() { int cur = m_header.free_list; unsigned num = 0; while (cur != Header::Empty_Free_List) { num++; assert(cur >= 0); CellPtrBOP cell(this, unsigned(cur)); cur = cell.next_in_list(); } return num; } void ChunkFit::check() { // Check the free list. bool free_list_valid = m_header.free_list.is_valid(); if (free_list_valid) { // Right now the free list isn't really a list. assert(!m_header.free_list.next_in_list().is_valid()); } CellPtrFit cell = first_cell(); while (cell.is_valid()) { assert(contains_pointer(cell.pointer())); cell.check(); if (!cell.is_allocated()) { assert(free_list_valid); } cell = cell.next_in_chunk(); } } void CellPtrFit::check() { assert(size() < ChunkFit::Payload_Bytes); switch (info_ptr()->state) { case CS_FREE: case CS_ALLOCATED: case CS_MARKED: break; default: fprintf(stderr, "Invalid cell state\n"); abort(); } } /****************************************************************************/ void Heap::print_usage_stats(size_t initial_usage) const { printf("\nHeap usage report\n=================\n"); printf("Usage: %ldKB -> %ldKB\n", initial_usage / 1024, usage() / 1024); m_chunk_bop->print_usage_stats(); m_chunk_fit->print_usage_stats(); printf("\n"); } void ChunkBOP::print_usage_stats() const { printf("\nChunkBOP\n--------\n"); printf("Num blocks: %d/%ld, %ldKB\n", m_wilderness, GC_Block_Per_Chunk, m_wilderness * GC_Block_Size / 1024); for (unsigned i = 0; i < m_wilderness; i++) { m_blocks[i].print_usage_stats(); } } void Block::print_usage_stats() const { if (is_in_use()) { unsigned cells_used = 0; for (unsigned i = 0; i < num_cells(); i++) { CellPtrBOP cell(const_cast(this), i); if (cell.is_allocated()) { cells_used++; } } printf("Block for %ld-word objects: %d/%d cells\n", size(), cells_used, num_cells()); } else { printf("Block out of use\n"); } } void ChunkFit::print_usage_stats() const { printf("\nChunkFit\n--------\n"); unsigned num_allocated = 0; unsigned num_cells = 0; size_t allocated = 0; CellPtrFit cell = const_cast(this)->first_cell(); while (cell.is_valid()) { if (cell.is_allocated()) { printf("Cell Allocated %ld\n", cell.size()); num_allocated++; allocated += cell.size(); } else { printf("Cell Free %ld\n", cell.size()); } num_cells++; cell = cell.next_in_chunk(); } printf("%d/%d cells, %ld/%ld words allocated\n", num_allocated, num_cells, allocated, Payload_Bytes / WORDSIZE_BYTES); } /****************************************************************************/ inline const char * bool_string(bool value) { return value ? "true" : "false"; } void Heap::print_addr_info(void * addr) const { CellPtrBOP cell_bop = ptr_to_bop_cell(addr); if (cell_bop.is_valid()) { fprintf(stderr, "Debug: %p is a BOP cell\n", addr); } else { cell_bop = ptr_to_bop_cell_interior(addr); if (cell_bop.is_valid()) { std::ptrdiff_t diff = (uint8_t *)cell_bop.pointer() - (uint8_t *)addr; fprintf(stderr, "Debug: %p is an interior pointer 0x%lx bytes into a " "BOP cell at %p", addr, diff, cell_bop.pointer()); } } if (cell_bop.is_valid()) { fprintf(stderr, "Debug: Cell is index %d in block %p, for size %ld\n", cell_bop.index(), cell_bop.block(), cell_bop.block()->size()); fprintf(stderr, "Debug: Allocated: %s, Marked: %s\n", bool_string(cell_bop.is_allocated()), bool_string(cell_bop.is_marked())); return; } CellPtrFit cell_fit = ptr_to_fit_cell(addr); if (cell_fit.is_valid()) { fprintf(stderr, "Debug: %p is a Fit cell\n", addr); } else { cell_fit = ptr_to_fit_cell_interior(addr); if (cell_fit.is_valid()) { std::ptrdiff_t diff = (uint8_t *)cell_fit.pointer() - (uint8_t *)addr; fprintf(stderr, "Debug: %p is an interior pointer (0x%lx bytes) to a " "Fit cell at %p", addr, diff, cell_fit.pointer()); } } if (cell_fit.is_valid()) { fprintf(stderr, "Debug: Size %ld, Allocated: %s, Marked: %s\n", cell_fit.size(), bool_string(cell_fit.is_allocated()), bool_string(cell_fit.is_marked())); if (*cell_fit.meta()) { fprintf(stderr, "Debug: Has meta info at %p\n", *cell_fit.meta()); } return; } fprintf(stderr, "Debug: %p is not a current GC cell\n", addr); } } // namespace pz ================================================ FILE: runtime/pz_gc_layout.h ================================================ /* * Plasma garbage collector memory layout * vim: ts=4 sw=4 et * * Copyright (C) Plasma Team * Distributed under the terms of the MIT license, see ../LICENSE.code */ #ifndef PZ_GC_LAYOUT_H #define PZ_GC_LAYOUT_H #include "pz_gc.h" #include "pz_gc.impl.h" namespace pz { constexpr uint8_t Poison_Byte = 0xF0; /* * These must be a power-of-two and mmap must align to them. 4K is the * default. */ static const unsigned GC_Block_Log = 13; static const size_t GC_Block_Size = 1 << (GC_Block_Log - 1); static const size_t GC_Block_Mask = ~(GC_Block_Size - 1); static const unsigned GC_Min_Cell_Size = 2; static const unsigned GC_Cells_Per_Block = GC_Block_Size / (GC_Min_Cell_Size * WORDSIZE_BYTES); /* * GC_Chunk_Size is also a power of two and is therefore a multiple of * GC_Block_Size. 4MB is the default. */ static const unsigned GC_Chunk_Log = 23; static const size_t GC_Chunk_Size = 1 << (GC_Chunk_Log - 1); static const size_t GC_Block_Per_Chunk = (GC_Chunk_Size / GC_Block_Size) - 1; #if PZ_DEV // Set this low for testing. static const size_t GC_Initial_Threshold = 8 * GC_Block_Size; #else static const size_t GC_Initial_Threshold = 64 * GC_Block_Size; #endif static const float GC_Threshold_Factor = 1.5f; // The threshold for small allocations in words. Allocations of less than // this many words are small allocations. static const size_t GC_Small_Alloc_Threshold = 64; static_assert(GC_Chunk_Size > GC_Block_Size, "Chunks must be larger than blocks"); /* * The heap is made out of blocks and chunks. A chunk contains multiple * blocks, which each contain multiple cells. */ enum CellType { // Used for Invalid cells or unallocated chunks. CT_INVALID, CT_BOP, CT_FIT }; /* * This class should be used by-value as a reference to a cell. */ class CellPtr { protected: void ** m_ptr; CellType m_type; constexpr CellPtr() : m_ptr(nullptr), m_type(CT_INVALID) {} public: constexpr explicit CellPtr(void * ptr, CellType type) : m_ptr(static_cast(ptr)) , m_type(type) {} void ** pointer() { return m_ptr; } bool is_valid() const { return m_ptr != nullptr; } bool is_bop_cell() const { return m_type == CT_BOP; } bool is_fit_cell() const { return m_type == CT_FIT; } }; /* * Chunks */ class Chunk { protected: Heap * m_heap; CellType m_type; private: Chunk(const Chunk &) = delete; void operator=(const Chunk &) = delete; Chunk(Heap * heap) : m_heap(heap), m_type(CT_INVALID) {} protected: Chunk(Heap * heap, CellType type) : m_heap(heap), m_type(type) {} public: /* * True if this pointer lies within the allocated part of this chunk. */ bool contains_pointer(void * ptr) const { return ptr >= this && ptr < (reinterpret_cast(this) + GC_Chunk_Size); }; }; } // namespace pz #include "pz_gc_layout_bop.h" #include "pz_gc_layout_fit.h" namespace pz { static_assert( GC_Small_Alloc_Threshold <= Block::Max_Cell_Size, "The small alloc threshold must be less than the maximum cell size"); } // namespace pz #endif // ! PZ_GC_LAYOUT_H ================================================ FILE: runtime/pz_gc_layout.impl.h ================================================ /* * Plasma garbage collector memory layout * vim: ts=4 sw=4 et * * Copyright (C) Plasma Team * Distributed under the terms of the MIT license, see ../LICENSE.code */ #ifndef PZ_GC_LAYOUT_IMPL_H #define PZ_GC_LAYOUT_IMPL_H #include "pz_gc_layout.h" namespace pz { /* * Definitions for some inline functions that must be defined here after * the class definitions. */ inline Block * ptr_to_block(void * ptr) { return reinterpret_cast(reinterpret_cast(ptr) & GC_Block_Mask); } bool Heap::is_heap_address(void * ptr) const { if (m_chunk_bop->contains_pointer(ptr)) { Block * block = const_cast(m_chunk_bop.ptr())->ptr_to_block(ptr); if (!block) return false; if (!block->is_in_use()) return false; return block->is_in_payload(ptr); } else if (m_chunk_fit->contains_pointer(ptr)) { return true; } else { return false; } } /**************************************************************************/ CellPtrBOP::CellPtrBOP(Block * block, unsigned index, void * ptr) : CellPtr(ptr, CT_BOP) , m_block(block) , m_index(index) {} CellPtrBOP::CellPtrBOP(Block * block, unsigned index) : CellPtr(block->index_to_pointer(index), CT_BOP) , m_block(block) , m_index(index) {} bool CellPtrBOP::is_allocated() const { return *block()->cell_bits(index()) & Bits_Allocated; } bool CellPtrBOP::is_marked() const { return *block()->cell_bits(index()) & Bits_Marked; } void CellPtrBOP::allocate() { assert(*block()->cell_bits(index()) == 0); *block()->cell_bits(index()) = Bits_Allocated; } void CellPtrBOP::unallocate() { assert(!is_marked()); *block()->cell_bits(index()) = 0; } void CellPtrBOP::mark() { assert(is_allocated()); *block()->cell_bits(index()) = Bits_Allocated | Bits_Marked; } void CellPtrBOP::unmark() { assert(is_allocated()); *block()->cell_bits(index()) = Bits_Allocated; } bool Block::is_valid_address(const void * ptr) const { assert(is_in_use()); return is_in_payload(ptr) && ((reinterpret_cast(ptr) - reinterpret_cast(m_bytes)) % (size() * WORDSIZE_BYTES)) == 0; } unsigned Block::index_of(const void * ptr) const { return (reinterpret_cast(ptr) - reinterpret_cast(m_bytes)) / (size() * WORDSIZE_BYTES); } void ** Block::index_to_pointer(unsigned index) { assert(index < num_cells()); unsigned offset = index * size() * WORDSIZE_BYTES; assert(offset + size() <= Payload_Bytes); return reinterpret_cast(&m_bytes[offset]); } Block * ChunkBOP::ptr_to_block(void * ptr) { if (ptr >= &m_blocks[0] && ptr < &m_blocks[m_wilderness]) { // This is a call to the outer ptr_to_block, not a recursive call. // It must have the pz:: qualifier. return pz::ptr_to_block(ptr); } else { return nullptr; } } /**************************************************************************/ CellPtrFit::CellPtrFit(ChunkFit * chunk, void * ptr) : CellPtr(reinterpret_cast(ptr), CT_FIT) , m_chunk(chunk) { assert(chunk->contains_pointer(ptr)); } void * CellPtrFit::next_by_size(size_t size) { return reinterpret_cast(pointer()) + size * WORDSIZE_BYTES + CellInfoOffset; } CellPtrFit CellPtrFit::next_in_chunk() { assert(size() > 0); void * next = next_by_size(size()); if (m_chunk->contains_pointer(next)) { return CellPtrFit(m_chunk, next); } else { return CellPtrFit::Invalid(); } } bool CellPtrFit::is_valid() { bool res = CellPtr::is_valid(); if (res) { assert(size() > 0); // TODO also check flags. } return res; } CellPtrFit CellPtrFit::next_in_list() { if (*pointer()) { return CellPtrFit(m_chunk, *pointer()); } else { return CellPtrFit::Invalid(); } } } // namespace pz #endif // ! PZ_GC_LAYOUT_IMPL_H ================================================ FILE: runtime/pz_gc_layout_bop.h ================================================ /* * Plasma garbage collector memory layout - bop allocation. * vim: ts=4 sw=4 et * * Copyright (C) Plasma Team * Distributed under the terms of the MIT license, see ../LICENSE.code */ #ifndef PZ_GC_LAYOUT_BOP_H #define PZ_GC_LAYOUT_BOP_H namespace pz { /* * A cell in the "bag of pages" storage class. */ class CellPtrBOP : public CellPtr { private: Block * m_block; unsigned m_index; constexpr CellPtrBOP() : m_block(nullptr), m_index(0) {} int * free_list_data() { return reinterpret_cast(m_ptr); } public: inline explicit CellPtrBOP(Block * block, unsigned index, void * ptr); inline explicit CellPtrBOP(Block * block, unsigned index); Block * block() const { return m_block; } unsigned index() const { return m_index; } void set_next_in_list(int next) { *free_list_data() = next; } int next_in_list() { return *free_list_data(); } static constexpr CellPtrBOP Invalid() { return CellPtrBOP(); } constexpr static uintptr_t Bits_Allocated = 0x01; constexpr static uintptr_t Bits_Marked = 0x02; inline bool is_allocated() const; inline bool is_marked() const; inline void allocate(); inline void unallocate(); inline void mark(); inline void unmark(); }; /* * Blocks */ class Block { private: struct Header { const static size_t Block_Empty = 0; size_t block_type_or_size; const static int Empty_Free_List = -1; int free_list; // Really a bytemap. uint8_t bitmap[GC_Cells_Per_Block]; explicit Header(size_t cell_size_) : block_type_or_size(cell_size_) , free_list(Empty_Free_List) { assert(cell_size_ >= GC_Min_Cell_Size); } Header() {} }; Header m_header; public: static constexpr size_t Header_Bytes = RoundUp(sizeof(m_header), WORDSIZE_BYTES); static constexpr size_t Payload_Bytes = GC_Block_Size - Header_Bytes; static constexpr size_t Max_Cell_Size = Payload_Bytes / WORDSIZE_BYTES; private: alignas(WORDSIZE_BYTES) uint8_t m_bytes[Payload_Bytes]; public: explicit Block(const Options & options, size_t cell_size_); // This constructor won't touch any memory and can be used to construct // uninitialised Blocks within Chunks. Block() {} Block(const Block &) = delete; void operator=(const Block &) = delete; // Size in words. size_t size() const { assert(is_in_use()); return m_header.block_type_or_size; } unsigned num_cells() const { unsigned num = Payload_Bytes / (size() * WORDSIZE_BYTES); assert(num <= GC_Cells_Per_Block); return num; } bool is_in_payload(const void * ptr) const { return ptr >= m_bytes && ptr < &m_bytes[Payload_Bytes]; } inline bool is_valid_address(const void * ptr) const; /* * Must also work for interior pointers. */ inline unsigned index_of(const void * ptr) const; inline void ** index_to_pointer(unsigned index); private: /* * TODO: Can the const and non-const versions somehow share an * implementation? Would that actually save any code lines? */ const uint8_t * cell_bits(unsigned index) const { assert(index < num_cells()); return &(m_header.bitmap[index]); } uint8_t * cell_bits(unsigned index) { assert(index < num_cells()); return &(m_header.bitmap[index]); } friend CellPtrBOP; public: bool is_full() const { assert(is_in_use()); return m_header.free_list == Header::Empty_Free_List; } bool is_in_use() const { return m_header.block_type_or_size != Header::Block_Empty; } unsigned num_allocated(); size_t usage(); // Returns true if the entire block is empty and may be reclaimed. bool sweep(const Options & options); void make_unused(); CellPtrBOP allocate_cell(); #ifdef PZ_DEV void print_usage_stats() const; void check(); private: bool is_in_free_list(CellPtrBOP & cell); // Calculate the number of free cells via the free list length. unsigned num_free(); #endif }; static_assert(sizeof(Block) == GC_Block_Size, "sizeof(Block) must match specified block size"); /* * ChunkBOP is a chunk containing BIBOP style blocks of cells. */ class ChunkBOP : public Chunk { private: uint32_t m_wilderness; alignas(GC_Block_Size) Block m_blocks[GC_Block_Per_Chunk]; public: ChunkBOP(Heap * heap) : Chunk(heap, CT_BOP), m_wilderness(0) {} /* * Get an unused block. * * The caller must initialise the block, this is require to ensure that * it is properly marked as allocated. */ Block * allocate_block(); /* * The size of the allocated portion of this Chunk. */ size_t usage(); bool is_empty() const; /* * If this pointer lies within the allocated part of this chunk then * return its block. */ inline Block * ptr_to_block(void * ptr); /* * Get an block for the given size that is not full (we want to * allocate a cell of this size). */ Block * get_block_for_allocation(size_t size_in_words); void sweep(const Options & options); #ifdef PZ_DEV void print_usage_stats() const; void check(); #endif }; static_assert(sizeof(ChunkBOP) == GC_Chunk_Size, "sizeof(ChunkBOP) must match specified chunk size"); } // namespace pz #endif // ! PZ_GC_LAYOUT_BOP_H ================================================ FILE: runtime/pz_gc_layout_fit.h ================================================ /* * Plasma garbage collector memory layout - fit allocation. * vim: ts=4 sw=4 et * * Copyright (C) Plasma Team * Distributed under the terms of the MIT license, see ../LICENSE.code */ #ifndef PZ_GC_LAYOUT_FIT_H #define PZ_GC_LAYOUT_FIT_H namespace pz { /* * A Fit-allocated cell */ class CellPtrFit : public CellPtr { private: ChunkFit * m_chunk; constexpr CellPtrFit() : CellPtr(nullptr, CT_INVALID), m_chunk(nullptr) {} enum CellState : uint8_t { CS_FREE, CS_ALLOCATED, CS_MARKED }; public: enum CellFlags : uint8_t { CF_NONE = 0x00, CF_TRACE_AND_FINALISE = 0x01 }; private: /* * We could pack size and flags into the same value, but that's a later * optimisation because it's tricky to do portably and still keep using * size_t which we use elsewhere (avoid losing data when casting). */ struct CellInfo { size_t size; CellState state; CellFlags flags; void * meta; }; public: static constexpr size_t CellInfoOffset = AlignUp(sizeof(CellInfo), WORDSIZE_BYTES); private: /* * The memory word before a cell contains the size and two flags in the * highest bits. */ CellInfo * info_ptr() { return reinterpret_cast( reinterpret_cast(pointer()) - CellInfoOffset); } void set_size(size_t new_size) { assert(new_size >= 1 && new_size < GC_Chunk_Size); info_ptr()->size = new_size; } public: inline explicit CellPtrFit(ChunkFit * chunk, void * ptr); constexpr static CellPtrFit Invalid() { return CellPtrFit(); } void init(size_t size) { info_ptr()->state = CS_FREE; set_size(size); clear_next_in_list(); } // This non-virtual override exists only to oppitunitistically provide an // assertion. inline bool is_valid(); size_t size() { return info_ptr()->size; } bool is_allocated() { return info_ptr()->state != CS_FREE; } bool is_marked() { return info_ptr()->state == CS_MARKED; } void mark() { assert(info_ptr()->state != CS_FREE); info_ptr()->state = CS_MARKED; } void unmark() { assert(is_marked()); info_ptr()->state = CS_ALLOCATED; } void set_allocated() { assert(info_ptr()->state == CS_FREE); info_ptr()->state = CS_ALLOCATED; info_ptr()->flags = CF_NONE; } void set_free() { assert(info_ptr()->state == CS_ALLOCATED); info_ptr()->state = CS_FREE; } void ** meta() { return &(info_ptr()->meta); } CellFlags flags() { return info_ptr()->flags; } void set_flags(CellFlags flags) { info_ptr()->flags = flags; } inline CellPtrFit next_in_list(); void set_next_in_list(CellPtrFit & next) { *pointer() = next.pointer(); } void clear_next_in_list() { *pointer() = nullptr; } inline void * next_by_size(size_t size); inline CellPtrFit next_in_chunk(); CellPtrFit split(size_t new_size); #ifdef PZ_DEV void check(); #endif }; /* * ChunkFit is a chunk for allocation of larger cells using best-fit with * cell splitting. */ class ChunkFit : public Chunk { private: struct Header { CellPtrFit free_list; Header() : free_list(CellPtrFit::Invalid()) {} }; public: static constexpr size_t Header_Bytes = RoundUp(sizeof(Chunk) + sizeof(Header), WORDSIZE_BYTES); static constexpr size_t Payload_Bytes = GC_Chunk_Size - Header_Bytes; private: Header m_header; alignas(WORDSIZE_BYTES) char m_bytes[Payload_Bytes]; public: ChunkFit(Heap * heap); /* * Bytes used in this chunk, including cell headers. */ size_t usage(); bool is_empty(); CellPtrFit allocate_cell(size_t size_in_words); CellPtrFit first_cell() { return CellPtrFit( this, reinterpret_cast(m_bytes) + CellPtrFit::CellInfoOffset); } void sweep(const Options & options); #ifdef PZ_DEV void check(); void print_usage_stats() const; #endif }; static_assert(sizeof(ChunkFit) == GC_Chunk_Size, "sizeof(ChunkFit) must match specified chunk size"); } // namespace pz #endif // ! PZ_GC_LAYOUT_FIT_H⎋ ================================================ FILE: runtime/pz_gc_util.cpp ================================================ /* * Plasma GC rooting, scopes & C++ allocation utilities * vim: ts=4 sw=4 et * * Copyright (C) Plasma Team * Distributed under the terms of the MIT license, see ../LICENSE.code */ #include "pz_common.h" #include "pz_util.h" #include "pz_gc.h" #include "pz_gc_util.h" #include "pz_gc.impl.h" namespace pz { void * GCCapability::alloc(size_t size_in_words, AllocOpts opts) { #ifdef PZ_DEV assert(m_is_top); #endif return m_heap.alloc(size_in_words, *this, opts); } void * GCCapability::alloc_bytes(size_t size_in_bytes, AllocOpts opts) { #ifdef PZ_DEV assert(m_is_top); #endif return m_heap.alloc_bytes(size_in_bytes, *this, opts); } const AbstractGCTracer & GCCapability::tracer() const { assert(can_gc()); return *static_cast(this); } bool GCCapability::can_gc() const { const GCCapability *cur = this; do { switch (cur->m_can_gc) { case IS_ROOT: assert(!cur->m_parent); // If this is the root, then we cannot GC because we cannot call // trace() on this GCCapability. return this != cur; case CANNOT_GC: return false; case CAN_GC: break; } cur = cur->m_parent; } while (cur); return true; } static void abort_oom(size_t size_bytes) { fprintf( stderr, "Out of memory, tried to allocate %lu bytes.\n", size_bytes); abort(); } void GCCapability::trace_parent(HeapMarkState * state) const { if (m_parent && m_parent->can_gc()) { m_parent->tracer().do_trace(state); } } void GCThreadHandle::oom(size_t size_bytes) { abort_oom(size_bytes); } void AbstractGCTracer::oom(size_t size_bytes) { abort_oom(size_bytes); } void GCTracer::do_trace(HeapMarkState * state) const { for (void * root : m_roots) { state->mark_root(*(void **)root); } trace_parent(state); } void GCTracer::add_root(void * root) { m_roots.push_back(root); } void GCTracer::remove_root(void * root) { assert(!m_roots.empty()); assert(m_roots.back() == root); m_roots.pop_back(); } NoGCScope::NoGCScope(GCCapability & gc_cap) : GCCapability(gc_cap, CANNOT_GC) #ifdef PZ_DEV , m_needs_check(true) #endif , m_did_oom(false) { } NoGCScope::~NoGCScope() { #ifdef PZ_DEV if (m_needs_check) { fprintf( stderr, "Caller did not check the NoGCScope before the destructor ran.\n"); abort(); } #endif if (m_did_oom) { fprintf(stderr, "Out of memory, tried to allocate %lu bytes.\n", m_oom_size); abort(); } } void NoGCScope::oom(size_t size_bytes) { if (!m_did_oom) { m_did_oom = true; m_oom_size = size_bytes; } } void NoGCScope::abort_for_oom_slow(const char * label) { assert(m_did_oom); fprintf(stderr, "Out of memory while %s, tried to allocate %ld bytes.\n", label, m_oom_size); abort(); } /****************************************************************************/ static void * do_new(size_t size, GCCapability & gc_cap, AllocOpts opts); /* * This is not exactly conformant to C++ normals/contracts. It doesn't call * the new handler when allocation fails which is what should normally * happen. However the GC's alloc_bytes function already makes an attempt to * recover memory via the GCCapability parameter. * * See: Scott Meyers: Effective C++ Digital Collection, Item 51 regarding * this behaviour. */ void * GCNew::operator new(size_t size, GCCapability & gc_cap) { return do_new(size, gc_cap, NORMAL); } void * GCNewTrace::operator new(size_t size, GCCapability & gc_cap) { return do_new(size, gc_cap, TRACE); } static void * do_new(size_t size, GCCapability & gc_cap, AllocOpts opts) { if (0 == size) { size = 1; } void * mem = gc_cap.alloc_bytes(size, opts); if (!mem) { fprintf(stderr, "Out of memory in operator new!\n"); abort(); } return mem; } } // namespace pz void * operator new[](size_t size, pz::GCCapability & gc_cap) { return pz::do_new(size, gc_cap, pz::NORMAL); } ================================================ FILE: runtime/pz_gc_util.h ================================================ /* * Plasma GC rooting, scopes & C++ allocation utilities * vim: ts=4 sw=4 et * * Copyright (C) Plasma Team * Distributed under the terms of the MIT license, see ../LICENSE.code */ #ifndef PZ_GC_UTIL_H #define PZ_GC_UTIL_H #include #include "pz_gc.h" namespace pz { // Forward declarations. class AbstractGCTracer; /* * This is the base class that the GC will use to determine if its legal to * GC. Do not create subclasses of this, use only AbstractGCTracer. */ class GCCapability { public: enum CanGC { IS_ROOT, CAN_GC, CANNOT_GC }; private: Heap &m_heap; #ifdef PZ_DEV GCCapability *m_parent; #else const GCCapability *m_parent; #endif const CanGC m_can_gc; #ifdef PZ_DEV bool m_is_top = true; #endif protected: GCCapability(Heap & heap, CanGC can_gc) : m_heap(heap) , m_parent(nullptr) , m_can_gc(can_gc) {} // TODO: Check heirachy. GCCapability(GCCapability & gc_cap, CanGC can_gc) : m_heap(gc_cap.heap()) , m_parent(&gc_cap) , m_can_gc(can_gc) { #ifdef PZ_DEV gc_cap.m_is_top = false; #endif } #ifdef PZ_DEV ~GCCapability() { assert(m_is_top); if (m_parent) { assert(!m_parent->m_is_top); m_parent->m_is_top = true; } } #endif public: void * alloc(size_t size_in_words, AllocOpts opts = AllocOpts::NORMAL); void * alloc_bytes(size_t size_in_bytes, AllocOpts opts = AllocOpts::NORMAL); Heap & heap() const { return m_heap; } bool can_gc() const; // Called by the GC if we couldn't allocate this much memory. virtual void oom(size_t size_bytes) = 0; /* * This casts to AbstractGCTracer whenever can_gc() returns true, so * AbstractGCTracer must be the only subclass that overrides can_gc() to * return true. */ const AbstractGCTracer & tracer() const; protected: void trace_parent(HeapMarkState *) const; }; // Each thread gets one of these. Do not create more than one per thread. class GCThreadHandle : public GCCapability { public: GCThreadHandle(Heap & heap) : GCCapability(heap, IS_ROOT) {} void oom(size_t size_bytes) override; }; /* * AbstractGCTracer helps the GC find the roots, it traces in order to find * the GC roots. * * Roots are traced from two different sources (both use this class). * Global roots and thread-local roots. */ class AbstractGCTracer : public GCCapability { public: AbstractGCTracer(GCCapability & gc) : GCCapability(gc, CAN_GC) {} void oom(size_t size) override; virtual void do_trace(HeapMarkState *) const = 0; private: /* * A work-around for PZ */ AbstractGCTracer(Heap & heap) : GCCapability(heap, CAN_GC) { } friend class PZ; }; /* * GCTracer helps the GC find the roots, it traces in order to find the * GC roots. */ class GCTracer : public AbstractGCTracer { private: std::vector m_roots; public: GCTracer(GCCapability & gc_cap) : AbstractGCTracer(gc_cap) {} void add_root(void * root); /* * The roots must be removed in LIFO order. */ void remove_root(void * root); GCTracer(const GCTracer &) = delete; GCTracer & operator=(const GCTracer &) = delete; void do_trace(HeapMarkState * state) const override; }; template class Root { private: T * m_gc_ptr; GCTracer & m_tracer; public: explicit Root(GCTracer & t) : m_gc_ptr(nullptr), m_tracer(t) { m_tracer.add_root(&m_gc_ptr); } explicit Root(GCTracer & t, T * ptr) : m_gc_ptr(ptr), m_tracer(t) { m_tracer.add_root(&m_gc_ptr); } Root(const Root & r) : m_gc_ptr(r.m_gc_ptr), m_tracer(r.m_tracer) { m_tracer.add_root(&m_gc_ptr); } const Root & operator=(const Root & r) { m_gc_ptr = r.gc_ptr; } ~Root() { m_tracer.remove_root(&m_gc_ptr); } const Root & operator=(T * ptr) { m_gc_ptr = ptr; return *this; } T * operator->() const { return m_gc_ptr; } const T * ptr() const { return m_gc_ptr; } T * ptr() { return m_gc_ptr; } const T & get() const { return *m_gc_ptr; } T & get() { return *m_gc_ptr; } }; /* * Use this RAII class to create scopes where GC is forbidden. * * Needing to GC (due to memory pressure) is handled by returning nullptr * (normally allocation is infalliable). This class will return nullptr and * the require the caller to check either is_oom() or abort_if_oom() before * the end of the NoGCScope. You can allocate a series of things and * perform the check at the end of the scope. * * This is not C++ conformant. We'd need to use the C++ new handler or * exceptions or nothrow forms to do that. We could be tempting fate but it * seems that it's okay either to throw or use -fno-exceptions. See: * https://blog.mozilla.org/nnethercote/2011/01/18/the-dangers-of-fno-exceptions/ */ class NoGCScope final : public GCCapability { private: #ifdef PZ_DEV bool m_needs_check; #endif bool m_did_oom; size_t m_oom_size; public: // The constructor may use the tracer to perform an immediate // collection, or if it is a NoGCScope allow the direct nesting. NoGCScope(GCCapability & gc_cap); ~NoGCScope(); void oom(size_t size) override; // Assert if there was an OOM. This is available for inlining because // we don't want to leave the fast-path unless the test fails. void abort_if_oom(const char * label) { if (m_did_oom) { abort_for_oom_slow(label); } #if PZ_DEV // If there are further allocations this won't be reset before the // destructor runs. This isn't fool-proof. m_needs_check = false; #endif } bool is_oom() { #if PZ_DEV m_needs_check = false; #endif return m_did_oom; } protected: void abort_for_oom_slow(const char * label); }; class GCNew { public: /* * Operator new is infalliable, it'll abort the program if the * GC returns null, which it can only do in a NoGCScope. */ void * operator new(size_t size, GCCapability & gc_cap); // We don't need a placement-delete or regular-delete because we use GC. }; /* * A GC allocatable object with tracing and a finaliser. This is necessary * if the class uses the regular heap (eg via STL collections). */ class GCNewTrace : public GCNew { public: virtual ~GCNewTrace(){}; virtual void do_trace(HeapMarkState * marker) const = 0; void * operator new(size_t size, GCCapability & gc_cap); }; } // namespace pz // Array allocation for any type. Intended for arrays of primative types // like integers, floats and pointers. void * operator new[](size_t size, pz::GCCapability & gc_cap); #endif // ! PZ_GC_UTIL_H ================================================ FILE: runtime/pz_generic.cpp ================================================ /* * Plasma bytecode exection (generic portable version) * vim: ts=4 sw=4 et * * Copyright (C) Plasma Team * Distributed under the terms of the MIT license, see ../LICENSE.code */ #include "pz_common.h" #include #include #include "pz.h" #include "pz_code.h" #include "pz_cxx_future.h" #include "pz_interp.h" #include "pz_trace.h" #include "pz_util.h" #include "pz_generic_closure.h" #include "pz_generic_run.h" namespace pz { /* Must match or exceed ptag_bits from src/core.types.m */ const unsigned num_tag_bits = 2; const uintptr_t tag_bits = 0x3; /* * Run the program * ******************/ int run(PZ & pz, const Options & options, GCCapability &gc) { uint8_t * wrapper_proc = nullptr; unsigned wrapper_proc_size; int retcode = 0; ImmediateValue imv_none; assert(PZT_LAST_TOKEN < 256); Context context(gc); if (!context.allocate()) { fprintf(stderr, "Could not allocate context\n"); return PZ_EXIT_RUNTIME_ERROR; } ScopeExit finalise([&context, &retcode, &options]{ if (!context.release(options.fast_exit())) { fprintf(stderr, "Error releasing memory\n"); if (retcode == 0) { retcode = PZ_EXIT_RUNTIME_NONFATAL; } } }); /* * Assemble a special procedure that exits the interpreter and put its * address on the call stack. */ memset(&imv_none, 0, sizeof(imv_none)); wrapper_proc_size = write_instr(nullptr, 0, PZI_END); wrapper_proc = static_cast(context.alloc_bytes(wrapper_proc_size, META)); heap_set_meta_info(&context.heap(), wrapper_proc, nullptr); write_instr(wrapper_proc, 0, PZI_END); context.return_stack[0] = nullptr; // Wrapper proc is tracablo here. context.return_stack[1] = wrapper_proc; context.rsp = 1; // Determine the entry procedure. Library * program = pz.program_lib(); Closure * entry_closure = program ? program->entry_closure() : nullptr; if (!entry_closure) { fprintf(stderr, "No entry closure\n"); return PZ_EXIT_RUNTIME_ERROR; } PZOptEntrySignature entry_signature = program->entry_signature(); switch (entry_signature) { case PZ_OPT_ENTRY_SIG_PLAIN: break; case PZ_OPT_ENTRY_SIG_ARGS: fprintf(stderr, "Unsupported, cannot execute programs that " "accept command line arguments. (Bug #283)\n"); return PZ_EXIT_RUNTIME_ERROR; } #ifdef PZ_DEV trace_enabled = options.interp_trace(); #endif int program_retcode = generic_main_loop(context, &pz.heap(), entry_closure, pz); retcode = program_retcode ? program_retcode : retcode; return retcode; } Context::Context(GCCapability & gc) : AbstractGCTracer(gc) , ip(nullptr) , env(nullptr) , return_stack("return stack") , rsp(0) , expr_stack("expression stack") , esp(0) {} Context::~Context() { assert(!return_stack.is_mapped()); assert(!expr_stack.is_mapped()); } bool Context::allocate() { if (!return_stack.allocate_guarded(RETURN_STACK_SIZE * sizeof(uint8_t*))) { return false; } if (!expr_stack.allocate_guarded(EXPR_STACK_SIZE * sizeof(StackValue))) { return false; } return true; } bool Context::release(bool fast) { if (fast) { return_stack.forget(); expr_stack.forget(); return true; } bool result = true; if (!return_stack.release()) { result = false; } if (!expr_stack.release()) { result = false; } return result; } void Context::do_trace(HeapMarkState * state) const { /* * The +1 is required here because the callee will only mark the first N * bytes in these memory areas, and esp and rsp are zero-based indexes, * So if esp is 2, which means the 3rd (0-based) index is the * top-of-stack. Then we need (2+1)*sizeof(...) to ensure we mark all * three items. */ state->mark_root_conservative((void*)expr_stack.ptr(), (esp + 1) * sizeof(StackValue)); state->mark_root_conservative_interior((void*)return_stack.ptr(), (rsp + 1) * WORDSIZE_BYTES); state->mark_root_interior(ip); state->mark_root(env); } } // namespace pz ================================================ FILE: runtime/pz_generic_builder.cpp ================================================ /* * Plasma bytecode memory representation builder * vim: ts=4 sw=4 et * * Copyright (C) Plasma Team * Distributed under the terms of the MIT license, see ../LICENSE.code */ #include "pz_common.h" #include #include "pz_data.h" #include "pz_format.h" #include "pz_gc.h" #include "pz_instructions.h" #include "pz_util.h" #include "pz_generic_run.h" // Clang format doesn't do a great job on this file // clang-format off namespace pz { static unsigned write_opcode(uint8_t * proc, unsigned offset, InstructionToken token); static unsigned write_immediate(uint8_t * proc, unsigned offset, ImmediateType imm_type, ImmediateValue imm_value); /* * Instruction and intermedate data sizes, and procedures to write them. * *********************/ static unsigned immediate_size(ImmediateType imt) { switch (imt) { case IMT_NONE: return 0; case IMT_8: return 1; case IMT_16: case IMT_STRUCT_REF_FIELD: return 2; case IMT_32: return 4; case IMT_64: return 8; case IMT_CLOSURE_REF: case IMT_PROC_REF: case IMT_IMPORT_CLOSURE_REF: case IMT_STRUCT_REF: case IMT_LABEL_REF: return WORDSIZE_BYTES; } abort(); } #define SELECT_IMMEDIATE(type, value, result) \ switch (type) { \ case IMT_8: \ (result) = (value).uint8; \ break; \ case IMT_16: \ (result) = (value).uint16; \ break; \ case IMT_32: \ (result) = (value).uint32; \ break; \ case IMT_64: \ (result) = (value).uint64; \ break; \ default: \ fprintf(stderr, \ "Invalid immediate value for laod immediate number"); \ abort(); \ } unsigned write_instr(uint8_t * proc, unsigned offset, PZ_Opcode opcode) { #define PZ_WRITE_INSTR_0(code, tok) \ if (opcode == (code)) { \ return write_opcode(proc, offset, tok); \ } assert(0 == instruction_info[opcode].ii_num_width_bytes); assert(IMT_NONE == instruction_info[opcode].ii_immediate_type); PZ_WRITE_INSTR_0(PZI_DROP, PZT_DROP); PZ_WRITE_INSTR_0(PZI_CALL_IND, PZT_CALL_IND); PZ_WRITE_INSTR_0(PZI_TCALL_IND, PZT_TCALL_IND); PZ_WRITE_INSTR_0(PZI_RET, PZT_RET); PZ_WRITE_INSTR_0(PZI_GET_ENV, PZT_GET_ENV); PZ_WRITE_INSTR_0(PZI_END, PZT_END); #undef PZ_WRITE_INSTR_0 fprintf(stderr, "Bad or unimplemented instruction\n"); abort(); } unsigned write_instr(uint8_t * proc, unsigned offset, PZ_Opcode opcode, ImmediateType imm_type, ImmediateValue imm_value) { #define PZ_WRITE_INSTR_0(code, tok) \ if (opcode == (code)) { \ offset = write_opcode(proc, offset, tok); \ offset = write_immediate(proc, offset, imm_type, imm_value); \ return offset; \ } assert(0 == instruction_info[opcode].ii_num_width_bytes); assert(IMT_NONE != instruction_info[opcode].ii_immediate_type); if ((opcode == PZI_ROLL) && (imm_type == IMT_8) && (imm_value.uint8 == 2)) { /* Optimize roll 2 into swap */ return write_opcode(proc, offset, PZT_SWAP); } PZ_WRITE_INSTR_0(PZI_ROLL, PZT_ROLL); if ((opcode == PZI_PICK) && (imm_type == IMT_8) && (imm_value.uint8 == 1)) { /* Optimize pick 1 into dup */ return write_opcode(proc, offset, PZT_DUP); } PZ_WRITE_INSTR_0(PZI_PICK, PZT_PICK); PZ_WRITE_INSTR_0(PZI_CALL, PZT_CALL); PZ_WRITE_INSTR_0(PZI_CALL_IMPORT, PZT_CALL); PZ_WRITE_INSTR_0(PZI_CALL_PROC, PZT_CALL_PROC); PZ_WRITE_INSTR_0(PZI_TCALL, PZT_TCALL); PZ_WRITE_INSTR_0(PZI_TCALL_PROC, PZT_TCALL_PROC); PZ_WRITE_INSTR_0(PZI_JMP, PZT_JMP); PZ_WRITE_INSTR_0(PZI_ALLOC, PZT_ALLOC); PZ_WRITE_INSTR_0(PZI_MAKE_CLOSURE, PZT_MAKE_CLOSURE); PZ_WRITE_INSTR_0(PZI_CCALL, PZT_CCALL); PZ_WRITE_INSTR_0(PZI_CCALL_ALLOC, PZT_CCALL_ALLOC); PZ_WRITE_INSTR_0(PZI_CCALL_SPECIAL, PZT_CCALL_SPECIAL); #undef PZ_WRITE_INSTR_0 fprintf(stderr, "Bad or unimplemented instruction\n"); abort(); } unsigned write_instr(uint8_t * proc, unsigned offset, PZ_Opcode opcode, PZ_Width width1) { width1 = width_normalize(width1); #define PZ_WRITE_INSTR_1(code, w1, tok) \ if (opcode == (code) && width1 == (w1)) { \ return write_opcode(proc, offset, tok); \ } assert(1 == instruction_info[opcode].ii_num_width_bytes); assert(IMT_NONE == instruction_info[opcode].ii_immediate_type); PZ_WRITE_INSTR_1(PZI_ADD, PZW_8, PZT_ADD_8); PZ_WRITE_INSTR_1(PZI_ADD, PZW_16, PZT_ADD_16); PZ_WRITE_INSTR_1(PZI_ADD, PZW_32, PZT_ADD_32); PZ_WRITE_INSTR_1(PZI_ADD, PZW_64, PZT_ADD_64); PZ_WRITE_INSTR_1(PZI_SUB, PZW_8, PZT_SUB_8); PZ_WRITE_INSTR_1(PZI_SUB, PZW_16, PZT_SUB_16); PZ_WRITE_INSTR_1(PZI_SUB, PZW_32, PZT_SUB_32); PZ_WRITE_INSTR_1(PZI_SUB, PZW_64, PZT_SUB_64); PZ_WRITE_INSTR_1(PZI_MUL, PZW_8, PZT_MUL_8); PZ_WRITE_INSTR_1(PZI_MUL, PZW_16, PZT_MUL_16); PZ_WRITE_INSTR_1(PZI_MUL, PZW_32, PZT_MUL_32); PZ_WRITE_INSTR_1(PZI_MUL, PZW_64, PZT_MUL_64); PZ_WRITE_INSTR_1(PZI_DIV, PZW_8, PZT_DIV_8); PZ_WRITE_INSTR_1(PZI_DIV, PZW_16, PZT_DIV_16); PZ_WRITE_INSTR_1(PZI_DIV, PZW_32, PZT_DIV_32); PZ_WRITE_INSTR_1(PZI_DIV, PZW_64, PZT_DIV_64); PZ_WRITE_INSTR_1(PZI_MOD, PZW_8, PZT_MOD_8); PZ_WRITE_INSTR_1(PZI_MOD, PZW_16, PZT_MOD_16); PZ_WRITE_INSTR_1(PZI_MOD, PZW_32, PZT_MOD_32); PZ_WRITE_INSTR_1(PZI_MOD, PZW_64, PZT_MOD_64); PZ_WRITE_INSTR_1(PZI_LSHIFT, PZW_8, PZT_LSHIFT_8); PZ_WRITE_INSTR_1(PZI_LSHIFT, PZW_16, PZT_LSHIFT_16); PZ_WRITE_INSTR_1(PZI_LSHIFT, PZW_32, PZT_LSHIFT_32); PZ_WRITE_INSTR_1(PZI_LSHIFT, PZW_64, PZT_LSHIFT_64); PZ_WRITE_INSTR_1(PZI_RSHIFT, PZW_8, PZT_RSHIFT_8); PZ_WRITE_INSTR_1(PZI_RSHIFT, PZW_16, PZT_RSHIFT_16); PZ_WRITE_INSTR_1(PZI_RSHIFT, PZW_32, PZT_RSHIFT_32); PZ_WRITE_INSTR_1(PZI_RSHIFT, PZW_64, PZT_RSHIFT_64); PZ_WRITE_INSTR_1(PZI_AND, PZW_8, PZT_AND_8); PZ_WRITE_INSTR_1(PZI_AND, PZW_16, PZT_AND_16); PZ_WRITE_INSTR_1(PZI_AND, PZW_32, PZT_AND_32); PZ_WRITE_INSTR_1(PZI_AND, PZW_64, PZT_AND_64); PZ_WRITE_INSTR_1(PZI_OR, PZW_8, PZT_OR_8); PZ_WRITE_INSTR_1(PZI_OR, PZW_16, PZT_OR_16); PZ_WRITE_INSTR_1(PZI_OR, PZW_32, PZT_OR_32); PZ_WRITE_INSTR_1(PZI_OR, PZW_64, PZT_OR_64); PZ_WRITE_INSTR_1(PZI_XOR, PZW_8, PZT_XOR_8); PZ_WRITE_INSTR_1(PZI_XOR, PZW_16, PZT_XOR_16); PZ_WRITE_INSTR_1(PZI_XOR, PZW_32, PZT_XOR_32); PZ_WRITE_INSTR_1(PZI_XOR, PZW_64, PZT_XOR_64); PZ_WRITE_INSTR_1(PZI_LT_U, PZW_8, PZT_LT_U_8); PZ_WRITE_INSTR_1(PZI_LT_U, PZW_16, PZT_LT_U_16); PZ_WRITE_INSTR_1(PZI_LT_U, PZW_32, PZT_LT_U_32); PZ_WRITE_INSTR_1(PZI_LT_U, PZW_64, PZT_LT_U_64); PZ_WRITE_INSTR_1(PZI_LT_S, PZW_8, PZT_LT_S_8); PZ_WRITE_INSTR_1(PZI_LT_S, PZW_16, PZT_LT_S_16); PZ_WRITE_INSTR_1(PZI_LT_S, PZW_32, PZT_LT_S_32); PZ_WRITE_INSTR_1(PZI_LT_S, PZW_64, PZT_LT_S_64); PZ_WRITE_INSTR_1(PZI_GT_U, PZW_8, PZT_GT_U_8); PZ_WRITE_INSTR_1(PZI_GT_U, PZW_16, PZT_GT_U_16); PZ_WRITE_INSTR_1(PZI_GT_U, PZW_32, PZT_GT_U_32); PZ_WRITE_INSTR_1(PZI_GT_U, PZW_64, PZT_GT_U_64); PZ_WRITE_INSTR_1(PZI_GT_S, PZW_8, PZT_GT_S_8); PZ_WRITE_INSTR_1(PZI_GT_S, PZW_16, PZT_GT_S_16); PZ_WRITE_INSTR_1(PZI_GT_S, PZW_32, PZT_GT_S_32); PZ_WRITE_INSTR_1(PZI_GT_S, PZW_64, PZT_GT_S_64); PZ_WRITE_INSTR_1(PZI_EQ, PZW_8, PZT_EQ_8); PZ_WRITE_INSTR_1(PZI_EQ, PZW_16, PZT_EQ_16); PZ_WRITE_INSTR_1(PZI_EQ, PZW_32, PZT_EQ_32); PZ_WRITE_INSTR_1(PZI_EQ, PZW_64, PZT_EQ_64); PZ_WRITE_INSTR_1(PZI_NOT, PZW_8, PZT_NOT_8); PZ_WRITE_INSTR_1(PZI_NOT, PZW_16, PZT_NOT_16); PZ_WRITE_INSTR_1(PZI_NOT, PZW_32, PZT_NOT_32); PZ_WRITE_INSTR_1(PZI_NOT, PZW_64, PZT_NOT_64); #undef PZ_WRITE_INSTR_1 fprintf(stderr, "Bad or unimplemented instruction\n"); abort(); } unsigned write_instr(uint8_t *proc, unsigned offset, PZ_Opcode opcode, PZ_Width width1, ImmediateType imm_type, ImmediateValue imm_value) { width1 = width_normalize(width1); #define PZ_WRITE_INSTR_1(code, w1, tok) \ if (opcode == (code) && width1 == (w1)) { \ offset = write_opcode(proc, offset, tok); \ offset = write_immediate(proc, offset, imm_type, imm_value); \ return offset; \ } assert(1 == instruction_info[opcode].ii_num_width_bytes); assert(IMT_NONE != instruction_info[opcode].ii_immediate_type); if (opcode == PZI_LOAD_IMMEDIATE_NUM) { switch (width1) { case PZW_8: SELECT_IMMEDIATE(imm_type, imm_value, imm_value.uint8); offset = write_opcode(proc, offset, PZT_LOAD_IMMEDIATE_8); offset = write_immediate(proc, offset, IMT_8, imm_value); return offset; case PZW_16: SELECT_IMMEDIATE(imm_type, imm_value, imm_value.uint16); offset = write_opcode(proc, offset, PZT_LOAD_IMMEDIATE_16); offset = write_immediate(proc, offset, IMT_16, imm_value); return offset; case PZW_32: SELECT_IMMEDIATE(imm_type, imm_value, imm_value.uint32); offset = write_opcode(proc, offset, PZT_LOAD_IMMEDIATE_32); offset = write_immediate(proc, offset, IMT_32, imm_value); return offset; case PZW_64: SELECT_IMMEDIATE(imm_type, imm_value, imm_value.uint64); offset = write_opcode(proc, offset, PZT_LOAD_IMMEDIATE_64); offset = write_immediate(proc, offset, IMT_64, imm_value); return offset; default: goto error; } } PZ_WRITE_INSTR_1(PZI_CJMP, PZW_8, PZT_CJMP_8); PZ_WRITE_INSTR_1(PZI_CJMP, PZW_16, PZT_CJMP_16); PZ_WRITE_INSTR_1(PZI_CJMP, PZW_32, PZT_CJMP_32); PZ_WRITE_INSTR_1(PZI_CJMP, PZW_64, PZT_CJMP_64); PZ_WRITE_INSTR_1(PZI_LOAD, PZW_8, PZT_LOAD_8); PZ_WRITE_INSTR_1(PZI_LOAD, PZW_16, PZT_LOAD_16); PZ_WRITE_INSTR_1(PZI_LOAD, PZW_32, PZT_LOAD_32); PZ_WRITE_INSTR_1(PZI_LOAD, PZW_64, PZT_LOAD_64); PZ_WRITE_INSTR_1(PZI_STORE, PZW_8, PZT_STORE_8); PZ_WRITE_INSTR_1(PZI_STORE, PZW_16, PZT_STORE_16); PZ_WRITE_INSTR_1(PZI_STORE, PZW_32, PZT_STORE_32); PZ_WRITE_INSTR_1(PZI_STORE, PZW_64, PZT_STORE_64); #undef PZ_WRITE_INSTR_1 error: fprintf(stderr, "Bad or unimplemented instruction\n"); abort(); } unsigned write_instr(uint8_t * proc, unsigned offset, PZ_Opcode opcode, PZ_Width width1, PZ_Width width2) { InstructionToken token; width1 = width_normalize(width1); width2 = width_normalize(width2); #define PZ_WRITE_INSTR_2(code, w1, w2, tok) \ if (opcode == (code) && width1 == (w1) && width2 == (w2)) { \ token = (tok); \ return write_opcode(proc, offset, token); \ } assert(2 == instruction_info[opcode].ii_num_width_bytes); assert(IMT_NONE == instruction_info[opcode].ii_immediate_type); PZ_WRITE_INSTR_2(PZI_ZE, PZW_8, PZW_8, PZT_NOP); PZ_WRITE_INSTR_2(PZI_ZE, PZW_8, PZW_16, PZT_ZE_8_16); PZ_WRITE_INSTR_2(PZI_ZE, PZW_8, PZW_32, PZT_ZE_8_32); PZ_WRITE_INSTR_2(PZI_ZE, PZW_8, PZW_64, PZT_ZE_8_64); PZ_WRITE_INSTR_2(PZI_ZE, PZW_16, PZW_16, PZT_NOP); PZ_WRITE_INSTR_2(PZI_ZE, PZW_16, PZW_32, PZT_ZE_16_32); PZ_WRITE_INSTR_2(PZI_ZE, PZW_16, PZW_64, PZT_ZE_16_64); PZ_WRITE_INSTR_2(PZI_ZE, PZW_32, PZW_32, PZT_NOP); PZ_WRITE_INSTR_2(PZI_ZE, PZW_32, PZW_64, PZT_ZE_32_64); PZ_WRITE_INSTR_2(PZI_SE, PZW_8, PZW_8, PZT_NOP); PZ_WRITE_INSTR_2(PZI_SE, PZW_8, PZW_16, PZT_SE_8_16); PZ_WRITE_INSTR_2(PZI_SE, PZW_8, PZW_32, PZT_SE_8_32); PZ_WRITE_INSTR_2(PZI_SE, PZW_8, PZW_64, PZT_SE_8_64); PZ_WRITE_INSTR_2(PZI_SE, PZW_16, PZW_16, PZT_NOP); PZ_WRITE_INSTR_2(PZI_SE, PZW_16, PZW_32, PZT_SE_16_32); PZ_WRITE_INSTR_2(PZI_SE, PZW_16, PZW_64, PZT_SE_16_64); PZ_WRITE_INSTR_2(PZI_SE, PZW_32, PZW_32, PZT_NOP); PZ_WRITE_INSTR_2(PZI_SE, PZW_32, PZW_64, PZT_SE_32_64); PZ_WRITE_INSTR_2(PZI_TRUNC, PZW_8, PZW_8, PZT_NOP); PZ_WRITE_INSTR_2(PZI_TRUNC, PZW_16, PZW_16, PZT_NOP); PZ_WRITE_INSTR_2(PZI_TRUNC, PZW_16, PZW_8, PZT_TRUNC_16_8); PZ_WRITE_INSTR_2(PZI_TRUNC, PZW_32, PZW_32, PZT_NOP); PZ_WRITE_INSTR_2(PZI_TRUNC, PZW_32, PZW_16, PZT_TRUNC_32_16); PZ_WRITE_INSTR_2(PZI_TRUNC, PZW_32, PZW_8, PZT_TRUNC_32_8); PZ_WRITE_INSTR_2(PZI_TRUNC, PZW_64, PZW_64, PZT_NOP); PZ_WRITE_INSTR_2(PZI_TRUNC, PZW_64, PZW_32, PZT_TRUNC_64_32); PZ_WRITE_INSTR_2(PZI_TRUNC, PZW_64, PZW_16, PZT_TRUNC_64_16); PZ_WRITE_INSTR_2(PZI_TRUNC, PZW_64, PZW_8, PZT_TRUNC_64_8); #undef PZ_WRITE_INSTR_2 fprintf(stderr, "Bad or unimplemented instruction\n"); abort(); } static unsigned write_opcode(uint8_t *proc, unsigned offset, InstructionToken token) { if (proc != nullptr) { *((uint8_t *)(&proc[offset])) = token; } offset += 1; return offset; } static unsigned write_immediate(uint8_t *proc, unsigned offset, ImmediateType imm_type, ImmediateValue imm_value) { assert(imm_type != IMT_NONE); unsigned imm_size = immediate_size(imm_type); unsigned new_offset = AlignUp(offset, imm_size); if (proc) { /* * Zero-fill alignment padding for readability in debugging. * but also do this in non-dev builds. */ while (offset < new_offset) { proc[offset++] = 0; } } else { offset = new_offset; } if (proc != nullptr) { switch (imm_type) { case IMT_NONE: break; case IMT_8: *((uint8_t *)(&proc[offset])) = imm_value.uint8; break; case IMT_16: case IMT_STRUCT_REF_FIELD: *((uint16_t *)(&proc[offset])) = imm_value.uint16; break; case IMT_32: *((uint32_t *)(&proc[offset])) = imm_value.uint32; break; case IMT_64: *((uint64_t *)(&proc[offset])) = imm_value.uint64; break; case IMT_CLOSURE_REF: case IMT_PROC_REF: case IMT_IMPORT_CLOSURE_REF: case IMT_STRUCT_REF: case IMT_LABEL_REF: *((uintptr_t *)(&proc[offset])) = imm_value.word; break; } } offset += imm_size; return offset; } } // namespace pz ================================================ FILE: runtime/pz_generic_builtin.cpp ================================================ /* * Plasma bytecode exection (generic portable version) * vim: ts=4 sw=4 et * * Copyright (C) Plasma Team * Distributed under the terms of the MIT license, see ../LICENSE.code */ #include "pz_common.h" #include #include #include #include #include "pz_interp.h" #include "pz_gc.h" #include "pz_generic_run.h" #include "pz_string.h" namespace pz { template static uintptr_t Box(T v, GCCapability &gc) { T *ptr = reinterpret_cast(gc.alloc_bytes(sizeof(T))); *ptr = v; return reinterpret_cast(ptr); } /* * Imported procedures * **********************/ unsigned pz_builtin_print_func(void * void_stack, unsigned sp) { StackValue * stack = static_cast(void_stack); String::from_ptr(stack[sp--].ptr).print(); return sp; } unsigned pz_builtin_readline_func(void * void_stack, unsigned sp, AbstractGCTracer & gc_trace) { const uint32_t READLINE_BUFFER_SIZE = 128; StackValue * stack = static_cast(void_stack); NoGCScope nogc(gc_trace); bool got_eof = false; String str(""); do { FlatString *fs = FlatString::New(nogc, READLINE_BUFFER_SIZE); char *res = fgets(fs->buffer(), READLINE_BUFFER_SIZE, stdin); if (!res) { if (ferror(stdin)) { perror("stdin"); exit(PZ_EXIT_RUNTIME_ERROR); } else if (feof(stdin)) { got_eof = true; break; } // unreachable assert(false); } int read_len = strlen(fs->buffer()); if (read_len == 0) { // We don't need to process an empty string. break; } fs->fixSize(strlen(fs->buffer())); if (fs->length() > 0 && fs->buffer()[fs->length()-1] == '\n') { // Remove the newline character // TODO: If string had a way to set chars then we can simplify // this by doing the operation on string and having a single // call to append. fs->buffer()[fs->length()-1] = 0; fs->fixSize(fs->length()-1); str = String::append(nogc, str, String(fs)); break; } str = String::append(nogc, str, String(fs)); if (fs->length() != (READLINE_BUFFER_SIZE - 1)) { break; } } while(true); nogc.abort_if_oom("reading stdin"); sp++; if (got_eof && str.isEmpty()) { stack[sp].uptr = 0; return sp; } // Tag the pointer for the Ok constructor. stack[sp].uptr = Box(str.ptr(), nogc) | 1; return sp; } /* * Long enough for a 32 bit value, plus a sign, plus a null termination * byte. */ #define INT_TO_STRING_BUFFER_SIZE 11 unsigned pz_builtin_int_to_string_func(void * void_stack, unsigned sp, AbstractGCTracer & gc_trace) { StackValue * stack = static_cast(void_stack); int32_t num = stack[sp].s32; FlatString * string = FlatString::New(gc_trace, INT_TO_STRING_BUFFER_SIZE); int result = snprintf(string->buffer(), INT_TO_STRING_BUFFER_SIZE, "%d", (int)num); if ((result < 0) || (result > (INT_TO_STRING_BUFFER_SIZE - 1))) { stack[sp].ptr = NULL; } else { string->fixSize(result); stack[sp].ptr = string; } return sp; } unsigned pz_builtin_setenv_func(void * void_stack, unsigned sp) { StackValue * stack = static_cast(void_stack); const String value = String::from_ptr(stack[sp--].ptr); const String name = String::from_ptr(stack[sp--].ptr); int result = setenv(name.c_str(), value.c_str(), 1); stack[++sp].u32 = !result; return sp; } unsigned pz_builtin_gettimeofday_func(void * void_stack, unsigned sp) { StackValue * stack = static_cast(void_stack); struct timeval tv; int res = gettimeofday(&tv, NULL); stack[++sp].u32 = res == 0 ? 1 : 0; // This is aweful, but Plasma itself doesn't handle other inttypes yet. stack[++sp].u32 = (uint32_t)tv.tv_sec; stack[++sp].u32 = (uint32_t)tv.tv_usec; return sp; } unsigned pz_builtin_string_concat_func(void * void_stack, unsigned sp, AbstractGCTracer & gc_trace) { StackValue * stack = static_cast(void_stack); const String s2 = String::from_ptr(stack[sp--].ptr); const String s1 = String::from_ptr(stack[sp].ptr); String s = String::append(gc_trace, s1, s2); stack[sp].ptr = s.ptr(); return sp; } unsigned pz_builtin_die_func(void * void_stack, unsigned sp) { StackValue * stack = static_cast(void_stack); const String s = String::from_ptr(stack[sp].ptr); fprintf(stderr, "Die: %s\n", s.c_str()); exit(1); } unsigned pz_builtin_set_parameter_func(void * void_stack, unsigned sp, PZ & pz) { StackValue * stack = static_cast(void_stack); // int32_t value = stack[sp].s32; const String name = String::from_ptr(stack[sp - 1].ptr); /* * There are no parameters defined. */ fprintf(stderr, "No such parameter '%s'\n", name.c_str()); int32_t result = 0; sp--; stack[sp].sptr = result; return sp; } unsigned pz_builtin_get_parameter_func(void * void_stack, unsigned sp, PZ & pz) { StackValue * stack = static_cast(void_stack); const String name = String::from_ptr(stack[sp].ptr); int32_t result; int32_t value; if (name.equals(String("heap_usage"))) { value = heap_get_usage(&pz.heap()); result = 1; } else if (name.equals(String("heap_collections"))) { value = heap_get_collections(&pz.heap()); result = 1; } else { fprintf(stderr, "No such parameter '%s'.\n", name.c_str()); result = 0; value = 0; } stack[sp].sptr = result; stack[sp + 1].sptr = value; sp++; return sp; } unsigned pz_builtin_codepoint_category(void * void_stack, unsigned sp) { // TODO use a unicode library. While POSIX is locale-aware it does not // handle characters outside the current locale, but applications may // use more than a single langauge at a time. StackValue * stack = static_cast(void_stack); CodePoint32 c = stack[sp].u32; // TODO: Use a proper FFI so we don't need to guess type tags. stack[sp].uptr = isspace(c) ? 0 : 1; return sp; } unsigned pz_builtin_codepoint_to_string(void * void_stack, unsigned sp, AbstractGCTracer & gc) { StackValue * stack = static_cast(void_stack); CodePoint32 c = stack[sp].u32; FlatString *fs = FlatString::New(gc, 1); if (c > CHAR_MAX) { fprintf(stderr, "Unicode not supported yet\n"); abort(); } fs->buffer()[0] = c; stack[sp].ptr = String(fs).ptr(); return sp; } unsigned pz_builtin_strpos_forward(void * void_stack, unsigned sp, AbstractGCTracer &gc) { StackValue * stack = static_cast(void_stack); const StringPos* pos = reinterpret_cast(stack[sp].ptr); stack[sp].ptr = pos->forward(gc); return sp; } unsigned pz_builtin_strpos_backward(void * void_stack, unsigned sp, AbstractGCTracer &gc) { StackValue * stack = static_cast(void_stack); const StringPos* pos = reinterpret_cast(stack[sp].ptr); stack[sp].ptr = pos->backward(gc); return sp; } unsigned pz_builtin_strpos_next_char(void * void_stack, unsigned sp, AbstractGCTracer & gc) { StackValue * stack = static_cast(void_stack); const StringPos* pos = reinterpret_cast(stack[sp].ptr); // XXX add pointer tagging macros. if (pos->at_end()) { stack[sp].uptr = 0; } else { stack[sp].uptr = Box(pos->next_char(), gc) | 1; } return sp; } unsigned pz_builtin_strpos_prev_char(void * void_stack, unsigned sp, AbstractGCTracer & gc) { StackValue * stack = static_cast(void_stack); const StringPos* pos = reinterpret_cast(stack[sp].ptr); if (pos->at_beginning()) { stack[sp].uptr = 0; } else { stack[sp].uptr = Box(pos->prev_char(), gc) | 1; } return sp; } unsigned pz_builtin_string_begin(void * void_stack, unsigned sp, AbstractGCTracer & gc) { StackValue * stack = static_cast(void_stack); const String string = String::from_ptr(stack[sp].ptr); stack[sp].ptr = string.begin(gc); return sp; } unsigned pz_builtin_string_end(void * void_stack, unsigned sp, AbstractGCTracer & gc) { StackValue * stack = static_cast(void_stack); const String string = String::from_ptr(stack[sp].ptr); stack[sp].ptr = string.end(gc); return sp; } unsigned pz_builtin_string_substring(void * void_stack, unsigned sp, AbstractGCTracer & gc) { StackValue * stack = static_cast(void_stack); const StringPos* pos2 = reinterpret_cast(stack[sp--].ptr); const StringPos* pos1 = reinterpret_cast(stack[sp].ptr); const String str = String::substring(gc, pos1, pos2); stack[sp].ptr = str.ptr(); return sp; } unsigned pz_builtin_string_equals(void * void_stack, unsigned sp) { StackValue * stack = static_cast(void_stack); const String str1 = String::from_ptr(stack[sp--].ptr); const String str2 = String::from_ptr(stack[sp].ptr); stack[sp].uptr = str1.equals(str2); return sp; } } // namespace pz ================================================ FILE: runtime/pz_generic_closure.cpp ================================================ /* * Plasma closures * vim: ts=4 sw=4 et * * Copyright (C) Plasma Team * Distributed under the terms of the MIT license, see ../LICENSE.code */ #include "pz_common.h" #include "pz_closure.h" #include "pz_generic_closure.h" namespace pz { } // namespace pz ================================================ FILE: runtime/pz_generic_closure.h ================================================ /* * Plasma closures * vim: ts=4 sw=4 et * * Copyright (C) Plasma Team * Distributed under the terms of the MIT license, see ../LICENSE.code */ #ifndef PZ_GENERIC_CLOSURE_H #define PZ_GENERIC_CLOSURE_H #include "pz_gc_util.h" namespace pz { class Closure : public GCNew { private: void * m_code; void * m_data; public: Closure() : m_code(nullptr), m_data(nullptr) {} Closure(void * code, void * data) : m_code(code), m_data(data) {} void init(void * code, void * data) { assert(!m_code); m_code = code; m_data = data; } void * code() const { return m_code; } void * data() const { return m_data; } }; } // namespace pz #endif // !PZ_GENERIC_CLOSURE_H ================================================ FILE: runtime/pz_generic_run.cpp ================================================ /* * Plasma bytecode exection (generic portable version) * vim: ts=4 sw=4 et * * Copyright (C) Plasma Team * Distributed under the terms of the MIT license, see ../LICENSE.code */ #include "pz_common.h" #include "pz_gc.h" #include "pz_interp.h" #include "pz_trace.h" #include "pz_util.h" #include #include "pz_generic_closure.h" #include "pz_generic_run.h" namespace pz { int generic_main_loop(Context & context, Heap * heap, Closure * closure, PZ & pz) { int retcode; context.ip = static_cast(closure->code()); context.env = closure->data(); pz_trace_state(heap, context.ip, context.env, context.rsp, context.esp, (uint64_t *)context.expr_stack.ptr()); while (true) { InstructionToken token = (InstructionToken)(*(context.ip)); context.ip++; switch (token) { case PZT_NOP: pz_trace_instr(context.rsp, "nop"); break; case PZT_LOAD_IMMEDIATE_8: context.expr_stack[++context.esp].u8 = *context.ip; context.ip++; pz_trace_instr(context.rsp, "load imm:8"); break; case PZT_LOAD_IMMEDIATE_16: context.ip = (uint8_t *)AlignUp((size_t)context.ip, 2); context.expr_stack[++context.esp].u16 = *(uint16_t *)context.ip; context.ip += 2; pz_trace_instr(context.rsp, "load imm:16"); break; case PZT_LOAD_IMMEDIATE_32: context.ip = (uint8_t *)AlignUp((size_t)context.ip, 4); context.expr_stack[++context.esp].u32 = *(uint32_t *)context.ip; context.ip += 4; pz_trace_instr(context.rsp, "load imm:32"); break; case PZT_LOAD_IMMEDIATE_64: context.ip = (uint8_t *)AlignUp((size_t)context.ip, 8); context.expr_stack[++context.esp].u64 = *(uint64_t *)context.ip; context.ip += 8; pz_trace_instr(context.rsp, "load imm:64"); break; case PZT_ZE_8_16: context.expr_stack[context.esp].u16 = context.expr_stack[context.esp].u8; pz_trace_instr(context.rsp, "ze:8:16"); break; case PZT_ZE_8_32: context.expr_stack[context.esp].u32 = context.expr_stack[context.esp].u8; pz_trace_instr(context.rsp, "ze:8:32"); break; case PZT_ZE_8_64: context.expr_stack[context.esp].u64 = context.expr_stack[context.esp].u8; pz_trace_instr(context.rsp, "ze:8:64"); break; case PZT_ZE_16_32: context.expr_stack[context.esp].u32 = context.expr_stack[context.esp].u16; pz_trace_instr(context.rsp, "ze:16:32"); break; case PZT_ZE_16_64: context.expr_stack[context.esp].u64 = context.expr_stack[context.esp].u16; pz_trace_instr(context.rsp, "ze:16:64"); break; case PZT_ZE_32_64: context.expr_stack[context.esp].u64 = context.expr_stack[context.esp].u32; pz_trace_instr(context.rsp, "ze:32:64"); break; case PZT_SE_8_16: context.expr_stack[context.esp].s16 = context.expr_stack[context.esp].s8; pz_trace_instr(context.rsp, "se:8:16"); break; case PZT_SE_8_32: context.expr_stack[context.esp].s32 = context.expr_stack[context.esp].s8; pz_trace_instr(context.rsp, "se:8:32"); break; case PZT_SE_8_64: context.expr_stack[context.esp].s64 = context.expr_stack[context.esp].s8; pz_trace_instr(context.rsp, "se:8:64"); break; case PZT_SE_16_32: context.expr_stack[context.esp].s32 = context.expr_stack[context.esp].s16; pz_trace_instr(context.rsp, "se:16:32"); break; case PZT_SE_16_64: context.expr_stack[context.esp].s64 = context.expr_stack[context.esp].s16; pz_trace_instr(context.rsp, "se:16:64"); break; case PZT_SE_32_64: context.expr_stack[context.esp].s64 = context.expr_stack[context.esp].s32; pz_trace_instr(context.rsp, "se:32:64"); break; case PZT_TRUNC_64_32: context.expr_stack[context.esp].u32 = context.expr_stack[context.esp].u64 & 0xFFFFFFFFu; pz_trace_instr(context.rsp, "trunc:64:32"); break; case PZT_TRUNC_64_16: context.expr_stack[context.esp].u16 = context.expr_stack[context.esp].u64 & 0xFFFF; pz_trace_instr(context.rsp, "trunc:64:16"); break; case PZT_TRUNC_64_8: context.expr_stack[context.esp].u8 = context.expr_stack[context.esp].u64 & 0xFF; pz_trace_instr(context.rsp, "trunc:64:8"); break; case PZT_TRUNC_32_16: context.expr_stack[context.esp].u16 = context.expr_stack[context.esp].u32 & 0xFFFF; pz_trace_instr(context.rsp, "trunc:32:16"); break; case PZT_TRUNC_32_8: context.expr_stack[context.esp].u8 = context.expr_stack[context.esp].u32 & 0xFF; pz_trace_instr(context.rsp, "trunc:32:8"); break; case PZT_TRUNC_16_8: context.expr_stack[context.esp].u8 = context.expr_stack[context.esp].u16 & 0xFF; pz_trace_instr(context.rsp, "trunc:16:8"); break; #define PZ_RUN_ARITHMETIC(opcode_base, width, signedness, operator, op_name) \ case opcode_base##_##width: \ context.expr_stack[context.esp - 1].signedness##width = \ (context.expr_stack[context.esp - 1] \ .signedness##width \ operator context.expr_stack[context.esp] \ .signedness##width); \ context.esp--; \ pz_trace_instr(context.rsp, op_name); \ break // clang-format off #define PZ_RUN_ARITHMETIC1(opcode_base, width, signedness, operator, op_name) \ case opcode_base##_##width: \ context.expr_stack[context.esp].signedness##width = \ operator context.expr_stack[context.esp].signedness##width; \ pz_trace_instr(context.rsp, op_name); \ break // clang-format on PZ_RUN_ARITHMETIC(PZT_ADD, 8, s, +, "add:8"); PZ_RUN_ARITHMETIC(PZT_ADD, 16, s, +, "add:16"); PZ_RUN_ARITHMETIC(PZT_ADD, 32, s, +, "add:32"); PZ_RUN_ARITHMETIC(PZT_ADD, 64, s, +, "add:64"); PZ_RUN_ARITHMETIC(PZT_SUB, 8, s, -, "sub:8"); PZ_RUN_ARITHMETIC(PZT_SUB, 16, s, -, "sub:16"); PZ_RUN_ARITHMETIC(PZT_SUB, 32, s, -, "sub:32"); PZ_RUN_ARITHMETIC(PZT_SUB, 64, s, -, "sub:64"); PZ_RUN_ARITHMETIC(PZT_MUL, 8, s, *, "mul:8"); PZ_RUN_ARITHMETIC(PZT_MUL, 16, s, *, "mul:16"); PZ_RUN_ARITHMETIC(PZT_MUL, 32, s, *, "mul:32"); PZ_RUN_ARITHMETIC(PZT_MUL, 64, s, *, "mul:64"); PZ_RUN_ARITHMETIC(PZT_DIV, 8, s, /, "div:8"); PZ_RUN_ARITHMETIC(PZT_DIV, 16, s, /, "div:16"); PZ_RUN_ARITHMETIC(PZT_DIV, 32, s, /, "div:32"); PZ_RUN_ARITHMETIC(PZT_DIV, 64, s, /, "div:64"); PZ_RUN_ARITHMETIC(PZT_MOD, 8, s, %, "rem:8"); PZ_RUN_ARITHMETIC(PZT_MOD, 16, s, %, "rem:16"); PZ_RUN_ARITHMETIC(PZT_MOD, 32, s, %, "rem:32"); PZ_RUN_ARITHMETIC(PZT_MOD, 64, s, %, "rem:64"); PZ_RUN_ARITHMETIC(PZT_AND, 8, u, &, "and:8"); PZ_RUN_ARITHMETIC(PZT_AND, 16, u, &, "and:16"); PZ_RUN_ARITHMETIC(PZT_AND, 32, u, &, "and:32"); PZ_RUN_ARITHMETIC(PZT_AND, 64, u, &, "and:64"); PZ_RUN_ARITHMETIC(PZT_OR, 8, u, |, "or:8"); PZ_RUN_ARITHMETIC(PZT_OR, 16, u, |, "or:16"); PZ_RUN_ARITHMETIC(PZT_OR, 32, u, |, "or:32"); PZ_RUN_ARITHMETIC(PZT_OR, 64, u, |, "or:64"); PZ_RUN_ARITHMETIC(PZT_XOR, 8, u, ^, "xor:8"); PZ_RUN_ARITHMETIC(PZT_XOR, 16, u, ^, "xor:16"); PZ_RUN_ARITHMETIC(PZT_XOR, 32, u, ^, "xor:32"); PZ_RUN_ARITHMETIC(PZT_XOR, 64, u, ^, "xor:64"); PZ_RUN_ARITHMETIC(PZT_LT_U, 8, u, <, "ltu:8"); PZ_RUN_ARITHMETIC(PZT_LT_U, 16, u, <, "ltu:16"); PZ_RUN_ARITHMETIC(PZT_LT_U, 32, u, <, "ltu:32"); PZ_RUN_ARITHMETIC(PZT_LT_U, 64, u, <, "ltu:64"); PZ_RUN_ARITHMETIC(PZT_LT_S, 8, s, <, "lts:8"); PZ_RUN_ARITHMETIC(PZT_LT_S, 16, s, <, "lts:16"); PZ_RUN_ARITHMETIC(PZT_LT_S, 32, s, <, "lts:32"); PZ_RUN_ARITHMETIC(PZT_LT_S, 64, s, <, "lts:64"); PZ_RUN_ARITHMETIC(PZT_GT_U, 8, u, >, "gtu:8"); PZ_RUN_ARITHMETIC(PZT_GT_U, 16, u, >, "gtu:16"); PZ_RUN_ARITHMETIC(PZT_GT_U, 32, u, >, "gtu:32"); PZ_RUN_ARITHMETIC(PZT_GT_U, 64, u, >, "gtu:64"); PZ_RUN_ARITHMETIC(PZT_GT_S, 8, s, >, "gts:8"); PZ_RUN_ARITHMETIC(PZT_GT_S, 16, s, >, "gts:16"); PZ_RUN_ARITHMETIC(PZT_GT_S, 32, s, >, "gts:32"); PZ_RUN_ARITHMETIC(PZT_GT_S, 64, s, >, "gts:64"); PZ_RUN_ARITHMETIC(PZT_EQ, 8, s, ==, "eq:8"); PZ_RUN_ARITHMETIC(PZT_EQ, 16, s, ==, "eq:16"); PZ_RUN_ARITHMETIC(PZT_EQ, 32, s, ==, "eq:32"); PZ_RUN_ARITHMETIC(PZT_EQ, 64, s, ==, "eq:64"); PZ_RUN_ARITHMETIC1(PZT_NOT, 8, u, !, "not:8"); PZ_RUN_ARITHMETIC1(PZT_NOT, 16, u, !, "not:16"); PZ_RUN_ARITHMETIC1(PZT_NOT, 32, u, !, "not:16"); PZ_RUN_ARITHMETIC1(PZT_NOT, 64, u, !, "not:16"); #undef PZ_RUN_ARITHMETIC #undef PZ_RUN_ARITHMETIC1 #define PZ_RUN_SHIFT(opcode_base, width, operator, op_name) \ case opcode_base##_##width: \ context.expr_stack[context.esp - 1].u##width = \ (context.expr_stack[context.esp - 1] \ .u##width \ operator context.expr_stack[context.esp] \ .u8); \ context.esp--; \ pz_trace_instr(context.rsp, op_name); \ break PZ_RUN_SHIFT(PZT_LSHIFT, 8, <<, "lshift:8"); PZ_RUN_SHIFT(PZT_LSHIFT, 16, <<, "lshift:16"); PZ_RUN_SHIFT(PZT_LSHIFT, 32, <<, "lshift:32"); PZ_RUN_SHIFT(PZT_LSHIFT, 64, <<, "lshift:64"); PZ_RUN_SHIFT(PZT_RSHIFT, 8, >>, "rshift:8"); PZ_RUN_SHIFT(PZT_RSHIFT, 16, >>, "rshift:16"); PZ_RUN_SHIFT(PZT_RSHIFT, 32, >>, "rshift:32"); PZ_RUN_SHIFT(PZT_RSHIFT, 64, >>, "rshift:64"); #undef PZ_RUN_SHIFT case PZT_DUP: context.esp++; context.expr_stack[context.esp] = context.expr_stack[context.esp - 1]; pz_trace_instr(context.rsp, "dup"); break; case PZT_DROP: context.esp--; pz_trace_instr(context.rsp, "drop"); break; case PZT_SWAP: { StackValue temp; temp = context.expr_stack[context.esp]; context.expr_stack[context.esp] = context.expr_stack[context.esp - 1]; context.expr_stack[context.esp - 1] = temp; pz_trace_instr(context.rsp, "swap"); break; } case PZT_ROLL: { uint8_t depth = *context.ip; StackValue temp; context.ip++; switch (depth) { case 0: fprintf(stderr, "Illegal rot depth 0"); abort(); case 1: break; default: /* * subtract 1 as the 1st element on the stack is * context.esp - 0, not context.esp - 1 */ depth--; temp = context.expr_stack[context.esp - depth]; for (int i = depth; i > 0; i--) { context.expr_stack[context.esp - i] = context.expr_stack[context.esp - (i - 1)]; } context.expr_stack[context.esp] = temp; } pz_trace_instr2(context.rsp, "roll", depth + 1); break; } case PZT_PICK: { /* * As with PZT_ROLL we would subract 1 here, but we also * have to add 1 because we increment the stack pointer * before accessing the stack. */ uint8_t depth = *context.ip; context.ip++; context.esp++; context.expr_stack[context.esp] = context.expr_stack[context.esp - depth]; pz_trace_instr2(context.rsp, "pick", depth); break; } case PZT_CALL: { Closure * closure; context.ip = (uint8_t *)AlignUp((size_t)context.ip, WORDSIZE_BYTES); context.return_stack[++context.rsp] = static_cast(context.env); context.return_stack[++context.rsp] = context.ip + WORDSIZE_BYTES; closure = *(Closure **)context.ip; context.ip = static_cast(closure->code()); context.env = closure->data(); pz_trace_instr(context.rsp, "call"); break; } case PZT_CALL_IND: { Closure * closure; context.return_stack[++context.rsp] = static_cast(context.env); context.return_stack[++context.rsp] = context.ip; closure = (Closure *)context.expr_stack[context.esp--].ptr; context.ip = static_cast(closure->code()); context.env = closure->data(); pz_trace_instr(context.rsp, "call_ind"); break; } case PZT_CALL_PROC: context.ip = (uint8_t *)AlignUp((size_t)context.ip, WORDSIZE_BYTES); context.return_stack[++context.rsp] = static_cast(context.env); context.return_stack[++context.rsp] = context.ip + WORDSIZE_BYTES; context.ip = *(uint8_t **)context.ip; pz_trace_instr(context.rsp, "call_proc"); break; case PZT_TCALL: { Closure * closure; context.ip = (uint8_t *)AlignUp((size_t)context.ip, WORDSIZE_BYTES); closure = *(Closure **)context.ip; context.ip = static_cast(closure->code()); context.env = closure->data(); pz_trace_instr(context.rsp, "tcall"); break; } case PZT_TCALL_IND: { Closure * closure; closure = (Closure *)context.expr_stack[context.esp--].ptr; context.ip = static_cast(closure->code()); context.env = closure->data(); pz_trace_instr(context.rsp, "call_ind"); break; } case PZT_TCALL_PROC: context.ip = (uint8_t *)AlignUp((size_t)context.ip, WORDSIZE_BYTES); context.ip = *(uint8_t **)context.ip; pz_trace_instr(context.rsp, "tcall_proc"); break; case PZT_CJMP_8: context.ip = (uint8_t *)AlignUp((size_t)context.ip, WORDSIZE_BYTES); if (context.expr_stack[context.esp--].u8) { context.ip = *(uint8_t **)context.ip; pz_trace_instr(context.rsp, "cjmp:8 taken"); } else { context.ip += WORDSIZE_BYTES; pz_trace_instr(context.rsp, "cjmp:8 not taken"); } break; case PZT_CJMP_16: context.ip = (uint8_t *)AlignUp((size_t)context.ip, WORDSIZE_BYTES); if (context.expr_stack[context.esp--].u16) { context.ip = *(uint8_t **)context.ip; pz_trace_instr(context.rsp, "cjmp:16 taken"); } else { context.ip += WORDSIZE_BYTES; pz_trace_instr(context.rsp, "cjmp:16 not taken"); } break; case PZT_CJMP_32: context.ip = (uint8_t *)AlignUp((size_t)context.ip, WORDSIZE_BYTES); if (context.expr_stack[context.esp--].u32) { context.ip = *(uint8_t **)context.ip; pz_trace_instr(context.rsp, "cjmp:32 taken"); } else { context.ip += WORDSIZE_BYTES; pz_trace_instr(context.rsp, "cjmp:32 not taken"); } break; case PZT_CJMP_64: context.ip = (uint8_t *)AlignUp((size_t)context.ip, WORDSIZE_BYTES); if (context.expr_stack[context.esp--].u64) { context.ip = *(uint8_t **)context.ip; pz_trace_instr(context.rsp, "cjmp:64 taken"); } else { context.ip += WORDSIZE_BYTES; pz_trace_instr(context.rsp, "cjmp:64 not taken"); } break; case PZT_JMP: context.ip = (uint8_t *)AlignUp((size_t)context.ip, WORDSIZE_BYTES); context.ip = *(uint8_t **)context.ip; pz_trace_instr(context.rsp, "jmp"); break; case PZT_RET: context.ip = context.return_stack[context.rsp--]; context.env = context.return_stack[context.rsp--]; pz_trace_instr(context.rsp, "ret"); break; case PZT_ALLOC: { size_t size; void * addr; context.ip = (uint8_t *)AlignUp((size_t)context.ip, WORDSIZE_BYTES); size = *(size_t *)context.ip; context.ip += WORDSIZE_BYTES; // pz_gc_alloc uses size in machine words, round the value // up and convert it to words rather than bytes. addr = context.alloc((size + WORDSIZE_BYTES - 1) / WORDSIZE_BYTES); context.expr_stack[++context.esp].ptr = addr; pz_trace_instr(context.rsp, "alloc"); break; } case PZT_MAKE_CLOSURE: { void *code, *data; context.ip = (uint8_t *)AlignUp((size_t)context.ip, WORDSIZE_BYTES); code = *(void **)context.ip; context.ip = (context.ip + WORDSIZE_BYTES); data = context.expr_stack[context.esp].ptr; Closure * closure = new (context) Closure(static_cast(code), data); context.expr_stack[context.esp].ptr = closure; pz_trace_instr(context.rsp, "make_closure"); break; } case PZT_LOAD_8: { uint16_t offset; void * addr; context.ip = (uint8_t *)AlignUp((size_t)context.ip, 2); offset = *(uint16_t *)context.ip; context.ip += 2; /* (ptr - * ptr) */ addr = (uint8_t *)context.expr_stack[context.esp].ptr + offset; context.expr_stack[context.esp + 1].ptr = context.expr_stack[context.esp].ptr; context.expr_stack[context.esp].u8 = *(uint8_t *)addr; context.esp++; pz_trace_instr(context.rsp, "load_8"); break; } case PZT_LOAD_16: { uint16_t offset; void * addr; context.ip = (uint8_t *)AlignUp((size_t)context.ip, 2); offset = *(uint16_t *)context.ip; context.ip += 2; /* (ptr - * ptr) */ addr = (uint8_t *)context.expr_stack[context.esp].ptr + offset; context.expr_stack[context.esp + 1].ptr = context.expr_stack[context.esp].ptr; context.expr_stack[context.esp].u16 = *(uint16_t *)addr; context.esp++; pz_trace_instr(context.rsp, "load_16"); break; } case PZT_LOAD_32: { uint16_t offset; void * addr; context.ip = (uint8_t *)AlignUp((size_t)context.ip, 2); offset = *(uint16_t *)context.ip; context.ip += 2; /* (ptr - * ptr) */ addr = (uint8_t *)context.expr_stack[context.esp].ptr + offset; context.expr_stack[context.esp + 1].ptr = context.expr_stack[context.esp].ptr; context.expr_stack[context.esp].u32 = *(uint32_t *)addr; context.esp++; pz_trace_instr(context.rsp, "load_32"); break; } case PZT_LOAD_64: { uint16_t offset; void * addr; context.ip = (uint8_t *)AlignUp((size_t)context.ip, 2); offset = *(uint16_t *)context.ip; context.ip += 2; /* (ptr - * ptr) */ addr = (uint8_t *)context.expr_stack[context.esp].ptr + offset; context.expr_stack[context.esp + 1].ptr = context.expr_stack[context.esp].ptr; context.expr_stack[context.esp].u64 = *(uint64_t *)addr; context.esp++; pz_trace_instr(context.rsp, "load_64"); break; } case PZT_LOAD_PTR: { uint16_t offset; void * addr; context.ip = (uint8_t *)AlignUp((size_t)context.ip, 2); offset = *(uint16_t *)context.ip; context.ip += 2; /* (ptr - ptr ptr) */ addr = (uint8_t *)context.expr_stack[context.esp].ptr + offset; context.expr_stack[context.esp + 1].ptr = context.expr_stack[context.esp].ptr; context.expr_stack[context.esp].ptr = *(void **)addr; context.esp++; pz_trace_instr(context.rsp, "load_ptr"); break; } case PZT_STORE_8: { uint16_t offset; void * addr; context.ip = (uint8_t *)AlignUp((size_t)context.ip, 2); offset = *(uint16_t *)context.ip; context.ip += 2; /* (* ptr - ptr) */ addr = (uint8_t *)context.expr_stack[context.esp].ptr + offset; *(uint8_t *)addr = context.expr_stack[context.esp - 1].u8; context.expr_stack[context.esp - 1].ptr = context.expr_stack[context.esp].ptr; context.esp--; pz_trace_instr(context.rsp, "store_8"); break; } case PZT_STORE_16: { uint16_t offset; void * addr; context.ip = (uint8_t *)AlignUp((size_t)context.ip, 2); offset = *(uint16_t *)context.ip; context.ip += 2; /* (* ptr - ptr) */ addr = (uint8_t *)context.expr_stack[context.esp].ptr + offset; *(uint16_t *)addr = context.expr_stack[context.esp - 1].u16; context.expr_stack[context.esp - 1].ptr = context.expr_stack[context.esp].ptr; context.esp--; pz_trace_instr(context.rsp, "store_16"); break; } case PZT_STORE_32: { uint16_t offset; void * addr; context.ip = (uint8_t *)AlignUp((size_t)context.ip, 2); offset = *(uint16_t *)context.ip; context.ip += 2; /* (* ptr - ptr) */ addr = (uint8_t *)context.expr_stack[context.esp].ptr + offset; *(uint32_t *)addr = context.expr_stack[context.esp - 1].u32; context.expr_stack[context.esp - 1].ptr = context.expr_stack[context.esp].ptr; context.esp--; pz_trace_instr(context.rsp, "store_32"); break; } case PZT_STORE_64: { uint16_t offset; void * addr; context.ip = (uint8_t *)AlignUp((size_t)context.ip, 2); offset = *(uint16_t *)context.ip; context.ip += 2; /* (* ptr - ptr) */ addr = (uint8_t *)context.expr_stack[context.esp].ptr + offset; *(uint64_t *)addr = context.expr_stack[context.esp - 1].u64; context.expr_stack[context.esp - 1].ptr = context.expr_stack[context.esp].ptr; context.esp--; pz_trace_instr(context.rsp, "store_64"); break; } case PZT_GET_ENV: { context.expr_stack[++context.esp].ptr = context.env; pz_trace_instr(context.rsp, "get_env"); break; } case PZT_END: retcode = context.expr_stack[context.esp].s32; if (context.esp != 1) { fprintf(stderr, "Stack misaligned, esp: %d should be 1\n", context.esp); abort(); } pz_trace_instr(context.rsp, "end"); pz_trace_state(heap, context.ip, context.env, context.rsp, context.esp, (uint64_t *)context.expr_stack.ptr()); return retcode; case PZT_CCALL: { context.ip = (uint8_t *)AlignUp((size_t)context.ip, WORDSIZE_BYTES); pz_foreign_c_func callee = *reinterpret_cast(context.ip); context.esp = callee(context.expr_stack.ptr(), context.esp); context.ip += WORDSIZE_BYTES; pz_trace_instr(context.rsp, "ccall"); break; } case PZT_CCALL_ALLOC: { context.ip = (uint8_t *)AlignUp((size_t)context.ip, WORDSIZE_BYTES); pz_foreign_c_alloc_func callee = *reinterpret_cast(context.ip); context.esp = callee(context.expr_stack.ptr(), context.esp, context); context.ip += WORDSIZE_BYTES; pz_trace_instr(context.rsp, "ccall"); break; } case PZT_CCALL_SPECIAL: { context.ip = (uint8_t *)AlignUp((size_t)context.ip, WORDSIZE_BYTES); pz_foreign_c_special_func callee = *reinterpret_cast(context.ip); context.esp = callee(context.expr_stack.ptr(), context.esp, pz); context.ip += WORDSIZE_BYTES; pz_trace_instr(context.rsp, "ccall"); break; } #ifdef PZ_DEV case PZT_INVALID_TOKEN: fprintf(stderr, "Attempt to execute poisoned memory\n"); abort(); #endif default: fprintf(stderr, "Unknown opcode\n"); abort(); } pz_trace_state(heap, context.ip, context.env, context.rsp, context.esp, (uint64_t *)context.expr_stack.ptr()); } } } // namespace pz ================================================ FILE: runtime/pz_generic_run.h ================================================ /* * Plasma bytecode generic interpreter definitions * vim: ts=4 sw=4 et * * Copyright (C) Plasma Team * Distributed under the terms of the MIT license, see ../LICENSE.code */ #ifndef PZ_GENERIC_RUN_H #define PZ_GENERIC_RUN_H #include "pz.h" #include "pz_closure.h" #include "pz_gc.h" #include "pz_generic_closure.h" #include "pz_memory.h" namespace pz { /* * Tokens for the token-oriented execution. */ enum InstructionToken { PZT_NOP, PZT_LOAD_IMMEDIATE_8, PZT_LOAD_IMMEDIATE_16, PZT_LOAD_IMMEDIATE_32, PZT_LOAD_IMMEDIATE_64, PZT_ZE_8_16, PZT_ZE_8_32, PZT_ZE_8_64, PZT_ZE_16_32, PZT_ZE_16_64, PZT_ZE_32_64, PZT_SE_8_16, PZT_SE_8_32, PZT_SE_8_64, PZT_SE_16_32, PZT_SE_16_64, PZT_SE_32_64, PZT_TRUNC_64_32, PZT_TRUNC_64_16, PZT_TRUNC_64_8, PZT_TRUNC_32_16, PZT_TRUNC_32_8, PZT_TRUNC_16_8, PZT_ADD_8, PZT_ADD_16, PZT_ADD_32, PZT_ADD_64, PZT_SUB_8, PZT_SUB_16, PZT_SUB_32, PZT_SUB_64, PZT_MUL_8, PZT_MUL_16, PZT_MUL_32, PZT_MUL_64, PZT_DIV_8, PZT_DIV_16, PZT_DIV_32, PZT_DIV_64, PZT_MOD_8, PZT_MOD_16, PZT_MOD_32, PZT_MOD_64, PZT_LSHIFT_8, PZT_LSHIFT_16, PZT_LSHIFT_32, PZT_LSHIFT_64, PZT_RSHIFT_8, PZT_RSHIFT_16, PZT_RSHIFT_32, PZT_RSHIFT_64, PZT_AND_8, PZT_AND_16, PZT_AND_32, PZT_AND_64, PZT_OR_8, PZT_OR_16, PZT_OR_32, PZT_OR_64, PZT_XOR_8, PZT_XOR_16, PZT_XOR_32, PZT_XOR_64, PZT_LT_U_8, PZT_LT_U_16, PZT_LT_U_32, PZT_LT_U_64, PZT_LT_S_8, PZT_LT_S_16, PZT_LT_S_32, PZT_LT_S_64, PZT_GT_U_8, PZT_GT_U_16, PZT_GT_U_32, PZT_GT_U_64, PZT_GT_S_8, PZT_GT_S_16, PZT_GT_S_32, PZT_GT_S_64, PZT_EQ_8, PZT_EQ_16, PZT_EQ_32, PZT_EQ_64, PZT_NOT_8, PZT_NOT_16, PZT_NOT_32, PZT_NOT_64, PZT_DUP, PZT_DROP, PZT_SWAP, PZT_ROLL, PZT_PICK, PZT_CALL, PZT_CALL_IND, PZT_CALL_PROC, PZT_TCALL, PZT_TCALL_IND, PZT_TCALL_PROC, PZT_CJMP_8, PZT_CJMP_16, PZT_CJMP_32, PZT_CJMP_64, PZT_JMP, PZT_RET, PZT_ALLOC, PZT_MAKE_CLOSURE, PZT_LOAD_8, PZT_LOAD_16, PZT_LOAD_32, PZT_LOAD_64, PZT_LOAD_PTR, PZT_STORE_8, PZT_STORE_16, PZT_STORE_32, PZT_STORE_64, PZT_GET_ENV, PZT_END, // Not part of PZ format. PZT_CCALL, // Not part of PZ format. PZT_CCALL_ALLOC, // Not part of PZ format. PZT_CCALL_SPECIAL, // Not part of PZ format. PZT_LAST_TOKEN = PZT_CCALL_ALLOC, #ifdef PZ_DEV PZT_INVALID_TOKEN = 0xF0, #endif }; union StackValue { uint8_t u8; int8_t s8; uint16_t u16; int16_t s16; uint32_t u32; int32_t s32; uint64_t u64; int64_t s64; uintptr_t uptr; intptr_t sptr; void * ptr; }; #define RETURN_STACK_SIZE 2048*4 #define EXPR_STACK_SIZE 4096*4 struct Context final : public AbstractGCTracer { uint8_t * ip; void * env; Memory return_stack; unsigned rsp; Memory expr_stack; unsigned esp; Context(GCCapability & gc); ~Context(); bool allocate(); bool release(bool fast); void do_trace(HeapMarkState * state) const override; }; int generic_main_loop(Context &context, Heap *heap, Closure *closure, PZ &pz); } // namespace pz #endif // ! PZ_GENERIC_RUN_H ================================================ FILE: runtime/pz_instructions.cpp ================================================ /* * Plasma bytecode instructions * vim: ts=4 sw=4 et * * Copyright (C) Plasma Team * Distributed under the terms of the MIT license, see ../LICENSE.code */ #include "pz_common.h" #include "pz_instructions.h" namespace pz { /* * Instruction encoding * *************************/ InstructionInfo instruction_info[] = { /* PZI_LOAD_IMMEDIATE_NUM * XXX: The immediate value is always encoded as a 32 bit number but * this restriction should be lifted. */ {1, IMT_32}, /* PZI_ZE */ {2, IMT_NONE}, /* PZI_SE */ {2, IMT_NONE}, /* PZI_TRUNC */ {2, IMT_NONE}, /* PZI_ADD */ {1, IMT_NONE}, /* PZI_SUB */ {1, IMT_NONE}, /* PZI_MUL */ {1, IMT_NONE}, /* PZI_DIV */ {1, IMT_NONE}, /* PZI_MOD */ {1, IMT_NONE}, /* PZI_LSHIFT */ {1, IMT_NONE}, /* PZI_RSHIFT */ {1, IMT_NONE}, /* PZI_AND */ {1, IMT_NONE}, /* PZI_OR */ {1, IMT_NONE}, /* PZI_XOR */ {1, IMT_NONE}, /* PZI_LT_U, PZT_LT_S, PZT_GT_U and PZT_GT_S */ {1, IMT_NONE}, {1, IMT_NONE}, {1, IMT_NONE}, {1, IMT_NONE}, /* PZI_EQ */ {1, IMT_NONE}, /* PZI_NOT */ {1, IMT_NONE}, /* PZI_DROP */ {0, IMT_NONE}, /* PZI_ROLL */ {0, IMT_8}, /* PZI_PICK */ {0, IMT_8}, /* PZI_CALL */ {0, IMT_CLOSURE_REF}, /* PZI_CALL_IMPORT */ {0, IMT_IMPORT_CLOSURE_REF}, /* PZI_CALL_IND */ {0, IMT_NONE}, /* PZI_CALL_PROC */ {0, IMT_PROC_REF}, /* PZI_TCALL */ {0, IMT_CLOSURE_REF}, /* PZI_TCALL_IMPORT */ {0, IMT_IMPORT_CLOSURE_REF}, /* PZI_TCALL_IND */ {0, IMT_NONE}, /* PZI_TCALL_PROC */ {0, IMT_PROC_REF}, /* PZI_RET */ {0, IMT_NONE}, /* PZI_CJMP */ {1, IMT_LABEL_REF}, /* PZI_JMP */ {0, IMT_LABEL_REF}, /* PZI_ALLOC */ {0, IMT_STRUCT_REF}, /* PZI_MAKE_CLOSURE */ {0, IMT_PROC_REF}, /* PZI_LOAD */ {1, IMT_STRUCT_REF_FIELD}, /* PZI_STORE */ {1, IMT_STRUCT_REF_FIELD}, /* PZI_GET_ENV */ {0, IMT_NONE}, /* Non-encoded instructions */ /* PZI_END */ {0, IMT_NONE}, /* PZI_CCALL */ {0, IMT_PROC_REF}, /* PZI_CCALL_ALLOC */ {0, IMT_PROC_REF}, /* PZI_CCALL_SPECIAL */ {0, IMT_PROC_REF}}; } // namespace pz ================================================ FILE: runtime/pz_instructions.h ================================================ /* * Plasma bytecode instructions * vim: ts=4 sw=4 et * * Copyright (C) Plasma Team * Distributed under the terms of the MIT license, see ../LICENSE.code */ #ifndef PZ_INSTRUCTIONS_H #define PZ_INSTRUCTIONS_H /* * Instructions are made from an opcode (byte), then depending on the opcode * zero or more bytes describing the width of the operands, and zero or one * intermediate values. * * For example, PZI_CALL is followed by zero operand width bytes and one * intermediate value, the reference to the callee. Likewise, PZI_ADD is * followed by one operand width byte describing the width of the data used * in the addition (both inputs and the output). */ typedef enum { /* * These instructions may appear in bytecode. * XXX: Need a way to load immedate data with a fast opcode width but * whose static data may be some other size. */ PZI_LOAD_IMMEDIATE_NUM = 0, PZI_ZE, PZI_SE, PZI_TRUNC, PZI_ADD, PZI_SUB, PZI_MUL, /* * TODO: Check how signedness affects division/modulo. */ PZI_DIV, PZI_MOD, PZI_LSHIFT, /* * TODO: Right shift is unsigned, need to add a signed version. */ PZI_RSHIFT, PZI_AND, PZI_OR, PZI_XOR, PZI_LT_U, PZI_LT_S, PZI_GT_U, PZI_GT_S, PZI_EQ, PZI_NOT, PZI_DROP, /* * rotate N-1 items to the left, the leftmost item becomes the rightmost * item. */ PZI_ROLL, PZI_PICK, PZI_CALL, PZI_CALL_IMPORT, PZI_CALL_IND, PZI_CALL_PROC, PZI_TCALL, PZI_TCALL_IMPORT, PZI_TCALL_IND, PZI_TCALL_PROC, PZI_RET, PZI_CJMP, PZI_JMP, PZI_ALLOC, PZI_MAKE_CLOSURE, PZI_LOAD, PZI_STORE, PZI_GET_ENV, /* * These instructions do not appear in bytecode, they are implied by * other instructions during bytecode loading and inserted into the * instruction stream then. */ PZI_END, PZI_CCALL, PZI_CCALL_ALLOC, PZI_CCALL_SPECIAL, } PZ_Opcode; #define PZ_NUM_OPCODES (PZI_CCALL_SPECIAL + 1) #ifdef __cplusplus namespace pz { union ImmediateValue { uint8_t uint8; uint16_t uint16; uint32_t uint32; uint64_t uint64; uintptr_t word; }; enum ImmediateType { IMT_NONE, IMT_8, IMT_16, IMT_32, IMT_64, IMT_CLOSURE_REF, IMT_PROC_REF, IMT_IMPORT_CLOSURE_REF, IMT_STRUCT_REF, IMT_STRUCT_REF_FIELD, IMT_LABEL_REF }; struct InstructionInfo { unsigned ii_num_width_bytes; ImmediateType ii_immediate_type; }; /* * Instruction info is indexed by opcode */ extern InstructionInfo instruction_info[]; } // namespace pz #endif #endif /* ! PZ_INSTRUCTIONS_H */ ================================================ FILE: runtime/pz_interp.h ================================================ /* * Plasma bytecode exection * vim: ts=4 sw=4 et * * Copyright (C) Plasma Team * Distributed under the terms of the MIT license, see ../LICENSE.code */ #ifndef PZ_INTERP_H #define PZ_INTERP_H #include "pz.h" #include "pz_format.h" #include "pz_gc.h" #include "pz_instructions.h" #include "pz_option.h" /* * Run the program. * ******************/ namespace pz { int run(PZ & pz, const Options & options, GCCapability & gc); /* * Foreign functions. * * The exact meaning of the parameters depends upon implementation details * within pz_run_*.c. * ******************************/ typedef unsigned (*pz_foreign_c_func)(void * stack, unsigned sp); typedef unsigned (*pz_foreign_c_alloc_func)(void * stack, unsigned sp, AbstractGCTracer & gc_trace); typedef unsigned (*pz_foreign_c_special_func)(void * stack, unsigned sp, PZ & pz); unsigned pz_builtin_print_func(void * stack, unsigned sp); unsigned pz_builtin_readline_func(void * stack, unsigned sp, AbstractGCTracer & gc_trace); unsigned pz_builtin_int_to_string_func(void * stack, unsigned sp, AbstractGCTracer & gc_trace); unsigned pz_builtin_setenv_func(void * stack, unsigned sp); unsigned pz_builtin_gettimeofday_func(void * void_stack, unsigned sp); unsigned pz_builtin_string_concat_func(void * stack, unsigned sp, AbstractGCTracer & gc_trace); unsigned pz_builtin_die_func(void * stack, unsigned sp); unsigned pz_builtin_set_parameter_func(void * stack, unsigned sp, PZ & pz); unsigned pz_builtin_get_parameter_func(void * stack, unsigned sp, PZ & pz); unsigned pz_builtin_codepoint_category(void * stack, unsigned sp); unsigned pz_builtin_codepoint_to_string(void * stack, unsigned sp, AbstractGCTracer & gc); unsigned pz_builtin_strpos_forward(void * stack, unsigned sp, AbstractGCTracer & gc); unsigned pz_builtin_strpos_backward(void * stack, unsigned sp, AbstractGCTracer & gc); unsigned pz_builtin_strpos_next_char(void * stack, unsigned sp, AbstractGCTracer & gc); unsigned pz_builtin_strpos_prev_char(void * stack, unsigned sp, AbstractGCTracer & gc); unsigned pz_builtin_string_begin(void * stack, unsigned sp, AbstractGCTracer & gc); unsigned pz_builtin_string_end(void * stack, unsigned sp, AbstractGCTracer & gc); unsigned pz_builtin_string_substring(void * stack, unsigned sp, AbstractGCTracer & gc); unsigned pz_builtin_string_equals(void * stack, unsigned sp); /* * The size of "fast" integers in bytes. */ extern const unsigned fast_word_size; /* * The number of tag bits made available by the runtime. * Guarenteed to match or exceed ptag_bits from src/core_to_pz.data.m */ extern const unsigned num_tag_bits; extern const uintptr_t tag_bits; /* * Build the raw code of the program. * ************************************/ /* * Write the instruction into the procedure at the given offset. * Returns the new offset within the procedure for the next instruction. * If proc is NULL then nothing is written but a new offset is computed, * this can be used in a first pass to calculate the required size of the * procedure. * * If the immediate value needs extending to the operation width it will be * zero-extended. */ unsigned write_instr(uint8_t *proc, unsigned offset, PZ_Opcode opcode); unsigned write_instr(uint8_t *proc, unsigned offset, PZ_Opcode opcode, ImmediateType imm_type, ImmediateValue imm); unsigned write_instr(uint8_t *proc, unsigned offset, PZ_Opcode opcode, PZ_Width width1); unsigned write_instr(uint8_t *proc, unsigned offset, PZ_Opcode opcode, PZ_Width width1, ImmediateType imm_type, ImmediateValue imm); unsigned write_instr(uint8_t *proc, unsigned offset, PZ_Opcode opcode, PZ_Width width1, PZ_Width width2); } #endif /* ! PZ_INTERP_H */ ================================================ FILE: runtime/pz_io.cpp ================================================ /* * IO Utils. * vim: ts=4 sw=4 et * * Copyright (C) Plasma Team * Distributed under the terms of the MIT license, see ../LICENSE.code */ #include #include #include "pz_common.h" #include "pz_io.h" namespace pz { BinaryInput::~BinaryInput() { if (m_file) { assert(!m_filename.empty()); if (ferror(m_file)) { perror(m_filename.c_str()); } else if (feof(m_file)) { fprintf( stderr, "%s: Unexpected end of file.\n", m_filename.c_str()); } close(); } assert(!m_file); assert(m_filename.empty()); } bool BinaryInput::open(const std::string & filename) { assert(!m_file); assert(m_filename.empty()); m_file = fopen(filename.c_str(), "rb"); if (m_file) { m_filename = std::string(filename); return true; } else { return false; } } void BinaryInput::close() { assert(m_file); fclose(m_file); m_file = nullptr; assert(!m_filename.empty()); m_filename.clear(); } const std::string & BinaryInput::filename() const { return m_filename; } const char * BinaryInput::filename_c() const { return filename().c_str(); } bool BinaryInput::seek_set(long pos) { assert(pos >= 0); return fseek(m_file, pos, SEEK_SET) == 0; } bool BinaryInput::seek_cur(long pos) { return fseek(m_file, pos, SEEK_CUR) == 0; } Optional BinaryInput::tell() const { long pos = ftell(m_file); if (pos < 0) { return Optional::Nothing(); } else { return Optional(pos); } } bool BinaryInput::is_at_eof() { return !!feof(m_file); } bool BinaryInput::read_uint8(uint8_t * value) { return (1 == fread(value, sizeof(uint8_t), 1, m_file)); } bool BinaryInput::read_uint16(uint16_t * value) { uint8_t bytes[2]; if (!fread(bytes, sizeof(uint8_t), 2, m_file)) { return false; } *value = ((uint16_t)bytes[1] << 8) | (uint16_t)bytes[0]; return true; } bool BinaryInput::read_uint32(uint32_t * value) { uint8_t bytes[4]; if (!fread(bytes, sizeof(uint8_t), 4, m_file)) { return false; } *value = ((uint32_t)bytes[3] << 24) | ((uint32_t)bytes[2] << 16) | ((uint32_t)bytes[1] << 8) | (uint32_t)bytes[0]; return true; } bool BinaryInput::read_uint64(uint64_t * value) { uint8_t bytes[8]; if (!fread(bytes, sizeof(uint8_t), 8, m_file)) { return false; } *value = ((uint64_t)bytes[7] << 56) | ((uint64_t)bytes[6] << 48) | ((uint64_t)bytes[5] << 40) | ((uint64_t)bytes[4] << 32) | ((uint64_t)bytes[3] << 24) | ((uint64_t)bytes[2] << 16) | ((uint64_t)bytes[1] << 8) | (uint64_t)bytes[0]; return true; } Optional BinaryInput::read_len_string(GCCapability & gc_cap) { uint16_t len; if (!read_uint16(&len)) { return Optional::Nothing(); } return read_string(gc_cap, len); } Optional BinaryInput::read_string(GCCapability & gc_cap, uint16_t len) { FlatString *str; str = FlatString::New(gc_cap, len); if (len != fread(str->buffer(), sizeof(char), len, m_file)) { return Optional::Nothing(); } str->buffer()[len] = 0; return Optional(String(str)); } } // namespace pz ================================================ FILE: runtime/pz_io.h ================================================ /* * IO Utils. * vim: ts=4 sw=4 et * * Copyright (C) Plasma Team * Distributed under the terms of the MIT license, see ../LICENSE.code */ #ifndef IO_UTILS_H #define IO_UTILS_H #include #include "pz_cxx_future.h" #include "pz_gc_util.h" #include "pz_string.h" namespace pz { /* * A binary input file, this is a wrapper around a FILE pointer. Internally * we use the C API rather than C++ since the C one is simple to use for * binary data. * * Since it wraps the C FILE structure a failing operation will set errno. * Callers should check errno directly. */ class BinaryInput { private: FILE * m_file; std::string m_filename; public: BinaryInput() : m_file(nullptr), m_filename() {} /* * For normal/happy paths, you must call close() before the destructor * runs. The destructor will treat the file being open as an error and * report information about the file's state. */ ~BinaryInput(); /* * Open a file. */ bool open(const std::string & filename); /* * Close the file. */ void close(); /* * The current file's name. */ const std::string & filename() const; const char * filename_c() const; /* * Read an 8bit unsigned integer. */ bool read_uint8(uint8_t * value); /* * Read a 16bit unsigned integer. */ bool read_uint16(uint16_t * value); /* * Read a 32bit unsigned integer. */ bool read_uint32(uint32_t * value); /* * Read a 64bit unsigned integer. */ bool read_uint64(uint64_t * value); /* * Read a length (16 bits) followed by a string of that length. */ Optional read_len_string(GCCapability & gc_cap); /* * Read a string of the given length from the stream. */ Optional read_string(GCCapability & gc_cap, uint16_t len); /* * seek relative to beginning of file. */ bool seek_set(long pos); /* * seek relative to current position. */ bool seek_cur(long pos); Optional tell() const; bool is_at_eof(); BinaryInput(const BinaryInput &) = delete; void operator=(const BinaryInput &) = delete; }; } // namespace pz #endif /* ! IO_UTILS_H */ ================================================ FILE: runtime/pz_library.cpp ================================================ /* * Plasma in-memory representation * vim: ts=4 sw=4 et * * Copyright (C) Plasma Team * Distributed under the terms of the MIT license, see ../LICENSE.code */ #include "pz_common.h" #include #include #include #include "pz_closure.h" #include "pz_util.h" #include "pz_library.h" namespace pz { /* * LibraryLoading class **********************/ LibraryLoading::LibraryLoading(unsigned num_structs, unsigned num_data, unsigned num_procs, unsigned num_closures, NoGCScope & no_gc) : m_total_code_size(0) { m_structs.reserve(num_structs); m_datas.reserve(num_data); m_procs.reserve(num_procs); m_closures.reserve(num_closures); for (unsigned i = 0; i < num_closures; i++) { m_closures.push_back(new (no_gc) Closure()); } } Struct * LibraryLoading::new_struct(unsigned num_fields, GCCapability & gc_cap) { NoGCScope nogc(gc_cap); Struct * struct_ = new (nogc) Struct(nogc, num_fields); if (nogc.is_oom()) return nullptr; m_structs.push_back(struct_); return struct_; } void LibraryLoading::add_data(void * data) { m_datas.push_back(data); } Proc * LibraryLoading::new_proc(String name, unsigned size, bool is_builtin, GCCapability & gc_cap) { // Either the proc object, or the code area within it are untracable // while the proc is constructed. NoGCScope no_gc(gc_cap); Proc * proc = new (no_gc) Proc(no_gc, name, is_builtin, size); if (no_gc.is_oom()) return nullptr; m_procs.push_back(proc); m_total_code_size += proc->size(); return proc; } void LibraryLoading::add_symbol(String name, Closure * closure) { m_symbols.insert(std::make_pair(name, closure)); } void LibraryLoading::print_loaded_stats() const { printf("Loaded %d procedures with a total of %d bytes.\n", num_procs(), m_total_code_size); } void LibraryLoading::do_trace(HeapMarkState * marker) const { /* * This is needed in case we GC during loading, we want to keep this * module until we know we're done loading it. */ for (Struct * s : m_structs) { marker->mark_root(s); } for (void * d : m_datas) { marker->mark_root(d); } for (void * p : m_procs) { marker->mark_root(p); } for (void * c : m_closures) { marker->mark_root(c); } for (auto symbol : m_symbols) { marker->mark_root(symbol.first.ptr()); marker->mark_root(symbol.second); } } /* * Library class ***************/ Library::Library() : m_entry_closure(nullptr) {} Library::Library(LibraryLoading & loading) : m_symbols(loading.m_symbols) , m_entry_closure(nullptr) {} void Library::add_symbol(String name, Closure * closure) { m_symbols.insert(std::make_pair(name, closure)); } Optional Library::lookup_symbol(String name) const { auto iter = m_symbols.find(name); if (iter != m_symbols.end()) { return iter->second; } else { return Optional::Nothing(); } } void Library::do_trace(HeapMarkState * marker) const { for (auto symbol : m_symbols) { marker->mark_root(symbol.first.ptr()); marker->mark_root(symbol.second); } marker->mark_root(m_entry_closure); } } // namespace pz ================================================ FILE: runtime/pz_library.h ================================================ /* * Plasma in-memory representation (modules) * vim: ts=4 sw=4 et * * Copyright (C) Plasma Team * Distributed under the terms of the MIT license, see ../LICENSE.code */ #ifndef PZ_LIBRARY_H #define PZ_LIBRARY_H #include "pz_common.h" #include #include "pz_closure.h" #include "pz_code.h" #include "pz_data.h" #include "pz_gc_util.h" namespace pz { /* * This class tracks all the information we need to load a library, since * loading also includes linking. Once that's complete a lot of this can be * dropped and only the exported symbols need to be kept (anything they * point to will be kept by the GC). */ class LibraryLoading : public GCNewTrace { private: std::vector m_structs; std::vector m_datas; std::vector m_procs; unsigned m_total_code_size; std::vector m_closures; std::unordered_map m_symbols; friend class Library; public: LibraryLoading(unsigned num_structs, unsigned num_data, unsigned num_procs, unsigned num_closures, NoGCScope &no_gc); const Struct * struct_(unsigned id) const { return m_structs.at(id); } Struct * new_struct(unsigned num_fields, GCCapability & gc_cap); void * data(unsigned id) const { return m_datas.at(id); } void add_data(void * data); unsigned num_procs() const { return m_procs.size(); } const Proc * proc(unsigned id) const { return m_procs.at(id); } Proc * proc(unsigned id) { return m_procs.at(id); } Proc * new_proc(String name, unsigned size, bool is_builtin, GCCapability & gc_cap); Closure * closure(unsigned id) const { return m_closures.at(id); } void add_symbol(String name, Closure * closure); void print_loaded_stats() const; LibraryLoading(LibraryLoading & other) = delete; void operator=(LibraryLoading & other) = delete; void do_trace(HeapMarkState * marker) const override; }; class Library : public GCNewTrace { private: std::unordered_map m_symbols; PZOptEntrySignature m_entry_signature; Closure * m_entry_closure; public: Library(); Library(LibraryLoading & loading); Closure * entry_closure() const { return m_entry_closure; } PZOptEntrySignature entry_signature() const { return m_entry_signature; } void set_entry_closure(PZOptEntrySignature sig, Closure * clo) { m_entry_signature = sig; m_entry_closure = clo; } /* * Symbol names are fully qualified, since one Module class (which * really represents a library) may contain more than one modules. */ void add_symbol(String name, Closure * closure); Optional lookup_symbol(String name) const; void do_trace(HeapMarkState * marker) const override; Library(Library & other) = delete; void operator=(Library & other) = delete; }; } // namespace pz #endif // ! PZ_LIBRARY_H ================================================ FILE: runtime/pz_main.cpp ================================================ /* * Plasma bytecode execution * vim: ts=4 sw=4 et * * Copyright (C) Plasma Team * Distributed under the terms of the MIT license, see ../LICENSE.code * * This program executes plasma bytecode. */ #include #include "pz_common.h" #include "pz.h" #include "pz_builtin.h" #include "pz_gc.h" #include "pz_gc.impl.h" #include "pz_interp.h" #include "pz_option.h" #include "pz_read.h" #include "pz_util.h" using namespace pz; static int run(Options & options); static void help(const char * progname, FILE * stream); static void version(void); int main(int argc, char * const argv[]) { Options options; Options::Mode mode = options.parse(argc, argv); switch (mode) { case Options::Mode::HELP: help(argv[0], stdout); return EXIT_SUCCESS; case Options::Mode::VERSION: version(); return EXIT_SUCCESS; case Options::Mode::ERROR: if (options.error_message()) { fprintf(stderr, "%s: %s\n", argv[0], options.error_message()); } help(argv[0], stderr); return EXIT_FAILURE; case Options::Mode::NORMAL: return run(options); } } static bool setup_program(PZ & pz, Options & options, GCCapability & gc); static int run(Options & options) { MemoryBase::init_statics(); Heap heap(options); if (!heap.init()) { fprintf(stderr, "Couldn't initialise memory.\n"); return PZ_EXIT_RUNTIME_ERROR; } int retcode = 0; ScopeExit finalise([&heap, &options, &retcode] { if (!heap.finalise(options.fast_exit())) { if (retcode == 0) { retcode = PZ_EXIT_RUNTIME_NONFATAL; } } }); PZ pz(options, heap); heap.set_roots_tracer(pz); GCThreadHandle gc(heap); if (setup_program(pz, options, gc)) { int program_retcode = run(pz, options, gc); retcode = program_retcode ? program_retcode : retcode; } else { retcode = PZ_EXIT_RUNTIME_ERROR; } return retcode; } static void split_filenames(const std::string & filenames, std::string & bytecode, Optional & native) { size_t pos = filenames.find_first_of(':'); if (pos == std::string::npos) { bytecode = filenames; native = Optional(); } else { bytecode = filenames.substr(0, pos); native = Optional(filenames.substr(pos+1)); } } static bool setup_program(PZ & pz, Options & options, GCCapability & gc0) { GCTracer gc(gc0); Library * builtins = pz.new_library(String("Builtin"), gc); setup_builtins(builtins, pz); for (const std::string & filenames : options.pzlibs()) { std::string bytecode_filename; Optional native_filename; split_filenames(filenames, bytecode_filename, native_filename); Root> names(gc); { NoGCScope no_gc(gc); names = new(no_gc) Vector(no_gc); no_gc.abort_if_oom("setup_program"); } Root lib(gc); if (!read(pz, bytecode_filename, native_filename, lib, names.ptr(), gc)) { return false; } for (auto& name : names.get()) { pz.add_library(name, lib.ptr()); } } Root program(gc); std::string bytecode_filename; Optional native_filename; split_filenames(options.pzfile(), bytecode_filename, native_filename); if (!read(pz, bytecode_filename, native_filename, program, nullptr, gc)) { return false; } pz.add_program_lib(program.ptr()); return true; } static void help(const char * progname, FILE * stream) { fprintf(stream, "Plasma runtime\n\n"); fprintf(stream, " Run plasma bytecode programs\n\n"); fprintf(stream, "Usage:\n\n"); fprintf(stream, " %s [-v] (-l ) \n", progname); fprintf(stream, " %s -h\n", progname); fprintf(stream, " %s -V\n\n", progname); fprintf(stream, "Options:\n\n"); fprintf(stream, " -h Show the help message (this one).\n"); fprintf(stream, " -V Show version information.\n"); fprintf(stream, " -v Verbose bytecode loading.\n"); fprintf(stream, " -l Dynamic link this bytecode library.\n\n"); } static void version(void) { printf("Plasma Runtime, " PLASMA_VERSION_STRING "\n"); printf("https://plasmalang.org\n"); printf("Copyright (C) 2015-2025 The Plasma Team\n"); printf("Distributed under the MIT License\n"); } ================================================ FILE: runtime/pz_memory.cpp ================================================ /* * Plasma large memory region allocation * vim: ts=4 sw=4 et * * Copyright (C) Plasma Team * Distributed under the terms of the MIT license, see ../LICENSE.code */ #include "pz_common.h" #include #include #include #include #include #include "pz_memory.h" size_t MemoryBase::s_page_size = 0; MemoryBase* MemoryBase::s_root = nullptr; static void handler(int sig, siginfo_t *info, void *ucontext) { fprintf(stderr, "Caught signal "); switch (sig) { case SIGSEGV: fprintf(stderr, "SEGV"); break; case SIGBUS: fprintf(stderr, "BUS"); break; default: fprintf(stderr, "%d.\n", sig); return; } fprintf(stderr, " for address %p\n", info->si_addr); MemoryBase * zone = MemoryBase::search(info->si_addr); if (zone) { zone->fault_handler(info->si_addr); } else { fprintf(stderr, "The Plasma runtime doesn't know about this memory region.\n"); exit(PZ_EXIT_RUNTIME_ERROR); } } void MemoryBase::fault_handler(void * fault_addr) { const char * juxt; InZone in = is_in(fault_addr); switch (in) { case IZ_WITHIN: juxt = "within"; break; case IZ_GUARD_BEFORE: juxt = "in the guard page before"; break; case IZ_GUARD_AFTER: juxt = "in the guard page after"; break; case IZ_BEFORE: case IZ_AFTER: fprintf(stderr, "Fault is not in this zone (bad search result?)\n"); abort(); } fprintf(stderr, "The fault occured %s the %s region (%p - %p)\n", juxt, name(), first_address(), last_address()); if (is_stack() && in == IZ_GUARD_AFTER) { fprintf(stderr, "This is probably caused by unbounded recursion causing " "a stack overrun\n"); } else if (is_stack() && in == IZ_GUARD_BEFORE) { fprintf(stderr, "This could be a stack underrun, " "which is probably caused by a bug in the compiler"); } exit(PZ_EXIT_RUNTIME_ERROR); } MemoryBase::InZone MemoryBase::is_in(void * fault_addr) const { assert(s_page_size); void * guard_before; void * last_addr_plus_1 = reinterpret_cast( reinterpret_cast(m_pointer) + m_size); void * guard_after; if (m_has_guards) { guard_before = reinterpret_cast( reinterpret_cast(m_pointer) - s_page_size); guard_after = reinterpret_cast( reinterpret_cast(last_addr_plus_1) + s_page_size); } else { guard_before = m_pointer; guard_after = last_addr_plus_1; } assert(guard_before <= m_pointer); assert(m_pointer < last_addr_plus_1); assert(last_addr_plus_1 <= guard_after); if (fault_addr < guard_before) { return IZ_BEFORE; } else if (fault_addr < m_pointer) { return IZ_GUARD_BEFORE; } else if (fault_addr < last_addr_plus_1) { return IZ_WITHIN; } else if (fault_addr < guard_after) { return IZ_GUARD_AFTER; } else { return IZ_AFTER; } } // Ignores errors, because they're not fatal. static void setup_handler(int signal) { struct sigaction action; memset(&action, 0, sizeof(action)); action.sa_sigaction = handler; sigemptyset(&action.sa_mask); sigaddset(&action.sa_mask, SIGSEGV); sigaddset(&action.sa_mask, SIGBUS); action.sa_flags = SA_SIGINFO; if (0 != sigaction(signal, &action, nullptr)) { perror("sigaction"); } } void MemoryBase::init_statics() { if (s_page_size) { // Init is already done. return; } s_page_size = sysconf(_SC_PAGESIZE); setup_handler(SIGSEGV); setup_handler(SIGBUS); } bool MemoryBase::allocate(size_t size, bool guarded) { assert(s_page_size); size_t mmap_size = size; if (guarded) { mmap_size += s_page_size * 2; } void *ptr = mmap(NULL, mmap_size, PROT_READ | PROT_WRITE, MAP_PRIVATE | MAP_ANONYMOUS, -1, 0); if (MAP_FAILED == ptr) { return false; } if (guarded) { void * guard_address_1 = ptr; void * guard_address_2 = reinterpret_cast( reinterpret_cast(ptr) + s_page_size + size); ptr = reinterpret_cast( reinterpret_cast(ptr) + s_page_size); if (0 != mprotect(guard_address_1, s_page_size, PROT_NONE)) { return false; } if (0 != mprotect(guard_address_2, s_page_size, PROT_NONE)) { return false; } } m_pointer = ptr; m_size = size; m_has_guards = guarded; insert(); return true; } bool MemoryBase::release() { if (m_pointer) { remove(); void *ptr = m_pointer; size_t size = m_size; if (m_has_guards) { ptr = reinterpret_cast( reinterpret_cast(m_pointer) - s_page_size); size = m_size + s_page_size*2; } if (-1 == munmap(ptr, size)) { perror("munmap"); return false; } m_pointer = nullptr; } return true; } void MemoryBase::forget() { if (m_pointer) { remove(); m_pointer = nullptr; } } MemoryBase* MemoryBase::search(void * addr) { MemoryBase * cur = s_root; while (cur) { cur->check_node(); switch (cur->is_in(addr)) { case IZ_BEFORE: cur = cur->m_left; continue; case IZ_AFTER: cur = cur->m_right; continue; case IZ_WITHIN: case IZ_GUARD_BEFORE: case IZ_GUARD_AFTER: return cur; } } return nullptr; } void MemoryBase::insert() { MemoryBase **here = &s_root; MemoryBase *cur = s_root; MemoryBase *prev = nullptr; while (cur) { cur->check_node(); switch (cur->is_in(this->m_pointer)) { case IZ_BEFORE: prev = cur; here = &cur->m_left; cur = cur->m_left; continue; case IZ_AFTER: prev = cur; here = &cur->m_right; cur = cur->m_right; continue; case IZ_WITHIN: case IZ_GUARD_BEFORE: case IZ_GUARD_AFTER: fprintf(stderr, "Duplicate map\n"); abort(); } } *here = this; m_parent = prev; check_node(); } void MemoryBase::remove() { check_node(); MemoryBase **here; if (m_parent) { if (m_parent->m_left == this) { here = &m_parent->m_left; } else { here = &m_parent->m_right; } } else { here = &s_root; } if (!m_left && !m_right) { // A leaf node can be removed simply. *here = nullptr; } else if (!m_left && m_right) { // A node with only one child can be removed by replacing it with // its child. *here = m_right; m_right->m_parent = m_parent; } else if (m_left && !m_right) { // Ditto. *here = m_left; m_left->m_parent = m_parent; } else { // Find a node we can replace this node with. MemoryBase *cur = m_left; while (cur->m_right) { cur = cur->m_right; } // cur has no right branch, we can remove it from its position // easily. cur->remove(); // Now replace this with cur. cur->m_parent = m_parent; *here = cur; cur->m_left = m_left; cur->m_right = m_right; // Fix the backlinks assert(cur != this); // We'd have entered one of te branches above // if this were == if (m_parent) { if (m_parent->m_left == this) { m_parent->m_left = cur; } else { assert(m_parent->m_right == this); m_parent->m_right = cur; } } assert(m_left->m_parent == this); m_left->m_parent = cur; assert(m_right->m_parent == this); m_right->m_parent = cur; cur->check_node(); } m_parent = nullptr; m_left = nullptr; m_right = nullptr; } void MemoryBase::check_node() { if (!m_pointer) { assert(!m_left); assert(!m_right); assert(!m_parent); return; } // This is only called for a node in the tree, which means there is // always a non-null root node. assert(s_root); if (m_parent) { // check the relationship with our parent. assert(s_root != this); if (m_parent->m_left == this) { assert(m_parent->m_right != this); assert(m_pointer <= m_parent->m_pointer); } else { assert(m_parent->m_right == this); assert(m_parent->m_left != this); assert(m_parent->m_pointer <= m_pointer); } } else { assert(s_root == this); } if (m_left) { assert(m_left->m_parent == this); assert(m_left->m_pointer <= m_pointer); } if (m_right) { assert(m_right->m_parent == this); assert(m_pointer <= m_right->m_pointer); } } ================================================ FILE: runtime/pz_memory.h ================================================ /* * Plasma large memory region allocation * vim: ts=4 sw=4 et * * Copyright (C) Plasma Team * Distributed under the terms of the MIT license, see ../LICENSE.code */ #ifndef PZ_MEMORY_H #define PZ_MEMORY_H #include class MemoryBase { // Static stuff: private: static size_t s_page_size; public: static void init_statics(); // Per memory-mapping stuff: private: const char * m_name; void * m_pointer = nullptr; size_t m_size = 0; bool m_has_guards = false; // Memory mappings are arranged in a tree for signal handlers to find // them. MemoryBase * m_left = nullptr; MemoryBase * m_right = nullptr; MemoryBase * m_parent = nullptr; static MemoryBase * s_root; public: static MemoryBase * search(void * pointer); private: void insert(); void remove(); void check_node(); public: MemoryBase(const char * name) : m_name(name) {} ~MemoryBase() { release(); } bool is_mapped() const { return !!m_pointer; } protected: bool allocate(size_t size, bool guard); void * raw_pointer() const { return m_pointer; } public: // Release the memory back to the OS bool release(); // Forget the memory mapping, much faster, very leaky. void forget(); MemoryBase(MemoryBase && other) = delete; MemoryBase(const MemoryBase & other) = delete; void operator=(MemoryBase && other) = delete; void operator=(const MemoryBase & other) = delete; enum InZone { IZ_BEFORE, IZ_AFTER, IZ_WITHIN, IZ_GUARD_BEFORE, IZ_GUARD_AFTER, }; // Describe where this memory address lies compared with the mapped // memory region. InZone is_in(void * addr) const; void fault_handler(void * fault_addr); const char * name() const { return m_name; } void * first_address() const { return m_pointer; } void * last_address() const { if (m_pointer) { return reinterpret_cast( reinterpret_cast(m_pointer) + m_size - 1); } else { return nullptr; } } bool is_stack() const { // For now the only memory regions with guard pages are stacks. return m_has_guards; } }; /* * A memory region, the address of the region is the pointer to Memory * itself, */ template class Memory : public MemoryBase { public: Memory(const char *name) : MemoryBase(name) {} bool allocate(size_t size = sizeof(T)) { return MemoryBase::allocate(size, false); } // Allocate with guard pages before and after the allocation. bool allocate_guarded(size_t size = sizeof(T)) { return MemoryBase::allocate(size, true); } T * ptr() { return reinterpret_cast(raw_pointer()); } const T * ptr() const { return reinterpret_cast(raw_pointer()); } T * operator->() { return ptr(); } const T * operator->() const { return ptr(); } typedef typename std::remove_all_extents::type Elem; Elem& operator[](unsigned i) { return reinterpret_cast(ptr())[i]; } }; #endif /* ! PZ_MEMORY_H */ ================================================ FILE: runtime/pz_option.cpp ================================================ /* * Plasma bytecode execution * vim: ts=4 sw=4 et * * Copyright (C) Plasma Team * Distributed under the terms of the MIT license, see ../LICENSE.code */ #include "pz_common.h" #include #include // ?? #include #include "pz_option.h" namespace pz { Options::Mode Options::parse(int argc, char * const argv[]) { m_error_message = nullptr; Mode mode = parseCommandLine(argc, argv); if (mode == Mode::ERROR) return Mode::ERROR; parseEnvironment(); return mode; } #ifdef _GNU_SOURCE // Request POSIX behaviour #define OPTSTRING "+hl:vV" #else #define OPTSTRING "hl:vV" #endif Options::Mode Options::parseCommandLine(int argc, char * const argv[]) { int option = getopt(argc, argv, OPTSTRING); while (option != -1) { switch (option) { case 'h': return Mode::HELP; case 'l': m_pzlibs.emplace_back(optarg); break; case 'V': return Mode::VERSION; case 'v': m_verbose = true; break; case '?': return Mode::ERROR; } option = getopt(argc, argv, OPTSTRING); } if (optind < argc) { m_pzfile = argv[optind]; } else { m_error_message = "Expected one PZB file to execute"; return Mode::ERROR; } return Mode::NORMAL; } void Options::parseEnvironment() { if (char * opts = getenv("PZ_RUNTIME_OPTS")) { opts = strdup(opts); char * strtok_save; const char * token = strtok_r(opts, ",", &strtok_save); while (token) { if (strcmp(token, "load_verbose") == 0) { m_verbose = true; } else if (strncmp(token, "fast_exit", 9) == 0) { if (token[9] == '=') { if (strcmp(&token[10], "yes") == 0) { m_fast_exit = true; } else if (strcmp(&token[10], "no") == 0) { m_fast_exit = false; } else { fprintf( stderr, "PZ_RUNTIME_OPTS option fast_exit bad parameter " "'%s', expected 'yes' or 'no'.\n", &token[10]); } } else { fprintf(stderr, "PZ_RUNTIME_OPTS " "option fast_exit requires a parameter\n"); } } else { // This warning is non-fatal, so it doesn't set the // error_message_ property or return ERROR. fprintf(stderr, "Warning: Unknown PZ_RUNTIME_OPTS option: %s\n", token); } token = strtok_r(nullptr, ",", &strtok_save); } free(opts); } #ifdef PZ_DEV if (char * opts = getenv("PZ_RUNTIME_DEV_OPTS")) { opts = strdup(opts); char * strtok_save; const char * token = strtok_r(opts, ",", &strtok_save); while (token) { if (strcmp(token, "interp_trace") == 0) { m_interp_trace = true; } else if (strcmp(token, "gc_zealous") == 0) { m_gc_zealous = true; } else if (strcmp(token, "gc_usage_stats") == 0) { m_gc_usage_stats = true; } else if (strcmp(token, "gc_trace") == 0) { m_gc_trace = true; } else { // This warning is non-fatal, so it doesn't set the // error_message_ property or return ERROR. fprintf(stderr, "Warning: Unknown PZ_RUNTIME_DEV_OPTS option: %s\n", token); } token = strtok_r(nullptr, ",", &strtok_save); } free(opts); } #endif } } // namespace pz ================================================ FILE: runtime/pz_option.h ================================================ /* * Plasma runtime options * vim: ts=4 sw=4 et * * Copyright (C) Plasma Team * Distributed under the terms of the MIT license, see ../LICENSE.code */ #ifndef PZ_OPTIONS_H #define PZ_OPTIONS_H #include #include namespace pz { /* * Runtime options * * Options are specified by environment variable, see README.md in this * directory for the list of configurable options. * * Not all options may be specified, some are compiled in as can be seen in * their accessor functions below. * * TODO: probably integrate options that can change at runtime with this * class, such as the GC size. */ class Options { public: enum Mode { NORMAL, HELP, VERSION, ERROR, }; private: std::string m_pzfile; std::vector m_pzlibs; bool m_verbose; bool m_fast_exit; #ifdef PZ_DEV bool m_interp_trace; bool m_gc_zealous; bool m_gc_usage_stats; bool m_gc_trace; #endif // Non-null if parse returns Mode::ERROR const char * m_error_message; Mode parseCommandLine(int artc, char * const argv[]); void parseEnvironment(); public: Options() : m_verbose(false) #ifndef PZ_DEV , m_fast_exit(true) #else , m_fast_exit(false) , m_interp_trace(false) , m_gc_zealous(false) , m_gc_usage_stats(false) , m_gc_trace(false) #endif {} Mode parse(int artc, char * const argv[]); /* * Non-null if parse made an error message available. Even if an error * occurs, sometimes getopt will print the error message and this will * be null. */ const char * error_message() const { return m_error_message; } bool verbose() const { return m_verbose; } std::string pzfile() const { return m_pzfile; } const std::vector & pzlibs() const { return m_pzlibs; } bool fast_exit() const { return m_fast_exit; } #ifdef PZ_DEV bool interp_trace() const { return m_interp_trace; } bool gc_zealous() const { return m_gc_zealous; } bool gc_usage_stats() const { return m_gc_usage_stats; } // In the future make these false by default and allow them to be // changed at runtime. bool gc_slow_asserts() const { return true; } bool gc_poison() const { return true; } // Change temporarily to enable tracing. bool gc_trace() const { return m_gc_trace; } bool gc_trace2() const { return false; } #else bool interp_trace() const { return false; } #endif Options(const Options &) = delete; void operator=(const Options &) = delete; }; } // namespace pz #endif ================================================ FILE: runtime/pz_read.cpp ================================================ /* * Plasma bytecode reader * vim: ts=4 sw=4 et * * Copyright (C) Plasma Team * Distributed under the terms of the MIT license, see ../LICENSE.code */ #include #include #include "pz_common.h" #include "pz.h" #include "pz_closure.h" #include "pz_code.h" #include "pz_data.h" #include "pz_foreign.h" #include "pz_format.h" #include "pz_interp.h" #include "pz_io.h" #include "pz_read.h" #include "pz_string.h" #include "pz_util.h" namespace pz { struct Imported : public GCNewTrace { Imported(unsigned num_imports) { import_closures.reserve(num_imports); } std::vector import_closures; size_t num_imports() const { return import_closures.size(); } void do_trace(HeapMarkState * marker) const override { for (Closure *c : import_closures) { marker->mark_root(c); } } }; struct ReadInfo { PZ & pz; BinaryInput file; bool verbose; bool load_debuginfo; ReadInfo(PZ & pz_) : pz(pz_) , verbose(pz.options().verbose()) , load_debuginfo(pz.options().interp_trace()) {} }; /* * The closure id and signature type for the program's entrypoint */ struct EntryClosure { PZOptEntrySignature signature; uint32_t closure_id; EntryClosure(PZOptEntrySignature sig, uint32_t clo) : signature(sig) , closure_id(clo) {} }; static bool read_options(BinaryInput &file, Optional &entry_closure); static bool read_imports(ReadInfo &read, unsigned num_imports, Imported *imported, const Foreign *foreign, GCTracer &gc); static bool read_structs(ReadInfo &read, unsigned num_structs, LibraryLoading *library, GCCapability &gc); static bool read_data(ReadInfo &read, unsigned num_datas, LibraryLoading *library, Imported *imports, GCCapability &gc); static Optional read_data_width(BinaryInput &file); static bool read_data_slot(ReadInfo &read, enum pz_data_enc_type type, uint8_t enc_width, void *dest, LibraryLoading *library, Imported *imports); static bool read_code(ReadInfo &read, unsigned num_procs, LibraryLoading *library, Imported *imported, GCCapability &gc); static unsigned read_proc(ReadInfo &read, Imported *imported, LibraryLoading *library, Proc *proc, /* null for first pass */ unsigned **block_offsets, GCCapability &gc); static bool read_instr(BinaryInput &file, Imported *imported, LibraryLoading *library, uint8_t *proc_code, unsigned **block_offsets, unsigned &proc_offset); static bool read_meta(ReadInfo &read, LibraryLoading *library, Proc *proc, unsigned proc_offset, uint8_t meta_byte, GCCapability &gc); static bool read_closures(ReadInfo &read, unsigned num_closures, Imported *imported, LibraryLoading *library); static bool read_exports(ReadInfo &read, unsigned num_exports, LibraryLoading *library, GCTracer &gc); bool read(PZ &pz, const std::string &bytecode_filename, const Optional &native_filename, Root &library, Vector * names, GCTracer &gc) { ReadInfo read(pz); uint32_t magic; uint16_t version; uint32_t num_imports; uint32_t num_structs; uint32_t num_datas; uint32_t num_procs; uint32_t num_closures; uint32_t num_exports; if (!read.file.open(bytecode_filename)) { perror(bytecode_filename.c_str()); return false; } if (!read.file.read_uint32(&magic)) return false; switch (magic) { case PZ_OBJECT_MAGIC_NUMBER: fprintf(stderr, "%s: Cannot execute plasma objects, " "link objects into a program first.\n", bytecode_filename.c_str()); return false; case PZ_PROGRAM_MAGIC_NUMBER: case PZ_LIBRARY_MAGIC_NUMBER: break; // good, we continue default: fprintf(stderr, "%s: bad magic value, is this a PZ file?\n", bytecode_filename.c_str()); return false; } { Optional mb_string = read.file.read_len_string(gc); if (!mb_string.hasValue()) return false; RootString string(gc, mb_string.release()); if (!string.startsWith(String(PZ_PROGRAM_MAGIC_STRING), gc) && !string.startsWith(String(PZ_LIBRARY_MAGIC_STRING), gc)) { fprintf(stderr, "%s: bad version string, is this a PZ file?\n", bytecode_filename.c_str()); return false; } } if (!read.file.read_uint16(&version)) return false; if (version != PZ_FORMAT_VERSION) { fprintf(stderr, "Incorrect PZ version, found %d, expecting %d\n", version, PZ_FORMAT_VERSION); return false; } Optional entry_closure; if (!read_options(read.file, entry_closure)) return false; Root foreign(gc); if (native_filename.hasValue()) { if (!Foreign::maybe_load(native_filename.value(), gc, foreign) || !foreign->init(gc)) { fprintf(stderr, "Couldn't initialise foreign code\n"); return false; } } uint32_t num_names; if (!read.file.read_uint32(&num_names)) return false; for (unsigned i = 0; i < num_names; i++) { Optional maybe_name = read.file.read_len_string(gc); if (!maybe_name.hasValue()) return false; if (names) { RootString name(gc, maybe_name.release()); names->append(gc, name); } } if (!read.file.read_uint32(&num_imports)) return false; if (!read.file.read_uint32(&num_structs)) return false; if (!read.file.read_uint32(&num_datas)) return false; if (!read.file.read_uint32(&num_procs)) return false; if (!read.file.read_uint32(&num_closures)) return false; if (!read.file.read_uint32(&num_exports)) return false; Root lib_load(gc); { NoGCScope no_gc(gc); lib_load = new(no_gc) LibraryLoading(num_structs, num_datas, num_procs, num_closures, no_gc); no_gc.abort_if_oom("loading a module"); } Root imported(gc, new (gc) Imported(num_imports)); if (!read_imports(read, num_imports, imported.ptr(), foreign.ptr(), gc)) { return false; } if (!read_structs(read, num_structs, lib_load.ptr(), gc)) return false; /* * read the file in two passes. During the first pass we calculate the * sizes of datas and procedures and therefore calculating the addresses * where each individual entry begins. Then in the second pass we fill * read the bytecode and data, resolving any intra-module references. */ if (!read_data(read, num_datas, lib_load.ptr(), imported.ptr(), gc)) { return false; } if (!read_code(read, num_procs, lib_load.ptr(), imported.ptr(), gc)) { return false; } if (!read_closures(read, num_closures, imported.ptr(), lib_load.ptr())) { return false; } if (!read_exports(read, num_exports, lib_load.ptr(), gc)) { return false; } #ifdef PZ_DEV /* * We should now be at the end of the file, so we should expect to get * an error if we read any further. */ uint8_t extra_byte; if (read.file.read_uint8(&extra_byte)) { fprintf(stderr, "%s: junk at end of file\n", bytecode_filename.c_str()); return false; } if (!read.file.is_at_eof()) { fprintf(stderr, "%s: junk at end of file\n", bytecode_filename.c_str()); return false; } #endif read.file.close(); library = new (gc) Library(lib_load.get()); if (entry_closure.hasValue()) { library->set_entry_closure(entry_closure.value().signature, lib_load->closure(entry_closure.value().closure_id)); } return true; } static bool read_options(BinaryInput & file, Optional & mbEntry) { uint16_t num_options; if (!file.read_uint16(&num_options)) return false; for (unsigned i = 0; i < num_options; i++) { uint16_t type, len; if (!file.read_uint16(&type)) return false; if (!file.read_uint16(&len)) return false; switch (type) { case PZ_OPT_ENTRY_CLOSURE: { uint8_t entry_signature_uint; uint32_t entry_closure; if (len != 5) { fprintf(stderr, "%s: Corrupt file while reading options", file.filename_c()); return false; } if (!file.read_uint8(&entry_signature_uint)) return false; if (!file.read_uint32(&entry_closure)) return false; PZOptEntrySignature entry_signature = static_cast(entry_signature_uint); mbEntry.set(EntryClosure(entry_signature, entry_closure)); break; } default: if (!file.seek_cur(len)) return false; break; } } return true; } static bool read_imports(ReadInfo & read, unsigned num_imports, Imported * imported, const Foreign * foreign, GCTracer &gc) { for (uint32_t i = 0; i < num_imports; i++) { uint8_t type_; if (!read.file.read_uint8(&type_)) return false; if (type_ > PZ_IMPORT_LAST) return false; PZ_Import_Type type = static_cast(type_); Optional maybe_module_name = read.file.read_len_string(gc); if (!maybe_module_name.hasValue()) return false; RootString module_name(gc, maybe_module_name.release()); Optional maybe_name = read.file.read_len_string(gc); if (!maybe_name.hasValue()) return false; RootString name(gc, maybe_name.release()); switch (type) { case PZ_IMPORT_IMPORT: { Library * library = read.pz.lookup_library(module_name); if (!library) { fprintf(stderr, "Module not found: %s\n", module_name.c_str()); return false; } RootString module_dot(gc, String::append(gc, module_name, String("."))); RootString lookup_name(gc, String::append(gc, module_dot, name)); Optional maybe_export = library->lookup_symbol(lookup_name); if (maybe_export.hasValue()) { imported->import_closures.push_back(maybe_export.value()); } else { fprintf(stderr, "Procedure not found: %s\n", lookup_name.c_str()); return false; } break; } case PZ_IMPORT_FOREIGN: { if (!foreign) { fprintf(stderr, "No foreign code provided for %s\n", module_name.c_str()); return false; } Closure *closure = foreign->lookup_foreign_proc(module_name, name); if (!closure) { fprintf(stderr, "Foreign procedure not found: %s.%s\n", module_name.c_str(), name.c_str()); return false; } imported->import_closures.push_back(closure); break; } } } return true; } static bool read_structs(ReadInfo &read, unsigned num_structs, LibraryLoading *library, GCCapability &gc) { for (unsigned i = 0; i < num_structs; i++) { uint32_t num_fields; if (!read.file.read_uint32(&num_fields)) return false; Struct * s = library->new_struct(num_fields, gc); for (unsigned j = 0; j < num_fields; j++) { Optional mb_width = read_data_width(read.file); if (mb_width.hasValue()) { s->set_field(j, mb_width.value()); } else { return false; } } s->calculate_layout(); } return true; } static bool read_data(ReadInfo &read, unsigned num_datas, LibraryLoading *library, Imported *imports, GCCapability &gc) { unsigned total_size = 0; void * data = nullptr; for (uint32_t i = 0; i < num_datas; i++) { uint8_t data_type_id; if (!read.file.read_uint8(&data_type_id)) return false; switch (data_type_id) { case PZ_DATA_ARRAY: { uint16_t num_elements; if (!read.file.read_uint16(&num_elements)) return false; Optional maybe_width = read_data_width(read.file); if (!maybe_width.hasValue()) return false; PZ_Width width = maybe_width.value(); data = data_new_array_data(gc, width, num_elements); uint8_t *data_ptr = (uint8_t *)data; uint8_t raw_enc; if (!read.file.read_uint8(&raw_enc)) return false; enum pz_data_enc_type type = PZ_DATA_ENC_TYPE(raw_enc); uint8_t enc_width = PZ_DATA_ENC_BYTES(raw_enc); for (unsigned i = 0; i < num_elements; i++) { if (!read_data_slot(read, type, enc_width, data_ptr, library, imports)) { return false; } data_ptr += width_to_bytes(width); } total_size += width_to_bytes(width) * num_elements; break; } case PZ_DATA_STRUCT: { uint32_t struct_id; if (!read.file.read_uint32(&struct_id)) return false; const Struct * struct_ = library->struct_(struct_id); data = data_new_struct_data(gc, struct_->total_size()); for (unsigned f = 0; f < struct_->num_fields(); f++) { uint8_t raw_enc; if (!read.file.read_uint8(&raw_enc)) return false; enum pz_data_enc_type type = PZ_DATA_ENC_TYPE(raw_enc); uint8_t enc_width = PZ_DATA_ENC_BYTES(raw_enc); void * dest = reinterpret_cast(data) + struct_->field_offset(f); if (!read_data_slot(read, type, enc_width, dest, library, imports)) { return false; } } break; } case PZ_DATA_STRING: { uint16_t num_elements; if (!read.file.read_uint16(&num_elements)) return false; uint8_t raw_enc; if (!read.file.read_uint8(&raw_enc)) return false; enum pz_data_enc_type type = PZ_DATA_ENC_TYPE(raw_enc); uint8_t enc_width = PZ_DATA_ENC_BYTES(raw_enc); // TODO: We can check if the string is empty using // num_elements, but we can't perform a shortcut to use the // canonical empty string since that is the null pointer. // But PZ file reading assumes that other data items wont be // null (it thinks they're not filled in yet) (#392). // TODO: utf8 FlatString *s = FlatString::New(gc, num_elements); data = String(s).ptr(); uint8_t * data_ptr = reinterpret_cast(s->buffer()); for (unsigned i = 0; i < num_elements; i++) { if (!read_data_slot(read, type, enc_width, data_ptr, library, imports)) { return false; } data_ptr++; } total_size += s->storageSize(); break; } } library->add_data(data); data = nullptr; } if (read.verbose) { printf("Loaded %d data entries with a total of %d bytes\n", (unsigned)num_datas, total_size); } return true; } static Optional read_data_width(BinaryInput & file) { uint8_t raw_width; if (!file.read_uint8(&raw_width)) return Optional::Nothing(); return width_from_int(raw_width); } static bool read_data_slot(ReadInfo &read, enum pz_data_enc_type type, uint8_t enc_width, void *dest, LibraryLoading *library, Imported *imports) { switch (type) { case pz_data_enc_type_normal: switch (enc_width) { case 1: { uint8_t value; if (!read.file.read_uint8(&value)) return false; data_write_normal_uint8(dest, value); return true; } case 2: { uint16_t value; if (!read.file.read_uint16(&value)) return false; data_write_normal_uint16(dest, value); return true; } case 4: { uint32_t value; if (!read.file.read_uint32(&value)) return false; data_write_normal_uint32(dest, value); return true; } case 8: { uint64_t value; if (!read.file.read_uint64(&value)) return false; data_write_normal_uint64(dest, value); return true; } default: fprintf(stderr, "Unexpected data encoding %d.\n", (int)type); return false; } case pz_data_enc_type_fast: { uint32_t i32; /* * For these width types the encoded width is 32bit. */ if (!read.file.read_uint32(&i32)) return false; data_write_fast_from_int32(dest, i32); return true; } case pz_data_enc_type_wptr: { int32_t i32; /* * For these width types the encoded width is 32bit. */ if (!read.file.read_uint32((uint32_t *)&i32)) return false; data_write_wptr(dest, (uintptr_t)i32); return true; } case pz_data_enc_type_data: { uint32_t ref; void ** dest_ = (void **)dest; void * data; // Data is a reference, link in the correct information. // XXX: support non-data references, such as proc // references. if (!read.file.read_uint32(&ref)) return false; data = library->data(ref); if (data != nullptr) { *dest_ = data; } else { fprintf(stderr, "forward references arn't yet supported.\n"); abort(); } return true; } case pz_data_enc_type_import: { uint32_t ref; void ** dest_ = (void **)dest; Closure * import; // Data is a reference, link in the correct information. // XXX: support non-data references, such as proc // references. if (!read.file.read_uint32(&ref)) return false; assert(ref < imports->num_imports()); import = imports->import_closures[ref]; assert(import); *dest_ = import; return true; } case pz_data_enc_type_closure: { uint32_t ref; void ** dest_ = (void **)dest; if (!read.file.read_uint32(&ref)) return false; Closure * closure = library->closure(ref); assert(closure); *dest_ = closure; return true; } default: // GCC is having trouble recognising this complete switch. fprintf(stderr, "Unrecognised data item encoding.\n"); abort(); } } static bool read_code(ReadInfo &read, unsigned num_procs, LibraryLoading *library, Imported *imported, GCCapability &gc) { unsigned * block_offsets[num_procs]; memset(block_offsets, 0, sizeof(unsigned *) * num_procs); ScopeExit cleanup([&block_offsets, num_procs] { for (unsigned i = 0; i < num_procs; i++) { delete[] block_offsets[i]; } }); /* * We read procedures in two phases, once to calculate their sizes, and * label offsets, allocating memory for each one. Then the we read them * for real in the second phase when memory locations are known. */ if (read.verbose) { fprintf(stderr, "Reading procs first pass\n"); } auto file_pos = read.file.tell(); if (!file_pos.hasValue()) return false; for (unsigned i = 0; i < num_procs; i++) { unsigned proc_size; if (read.verbose) { fprintf(stderr, "Reading proc %d\n", i); } Optional name = read.file.read_len_string(gc); if (!name.hasValue()) return false; proc_size = read_proc(read, imported, library, nullptr, &block_offsets[i], gc); if (proc_size == 0) return false; library->new_proc(name.value(), proc_size, false, gc); } /* * Now that we've allocated memory for all the procedures, re-read them * this time writing them into that memory. We do this for all the * procedures at once otherwise calls in earlier procedures would not * know the code addresses of later procedures. */ if (read.verbose) { fprintf(stderr, "Beginning second pass\n"); } if (!read.file.seek_set(file_pos.value())) return false; for (unsigned i = 0; i < num_procs; i++) { if (read.verbose) { fprintf(stderr, "Reading proc %d\n", i); } // Read but don't use the name, it's already set. Optional name = read.file.read_len_string(gc); if (!name.hasValue()) return false; if (0 == read_proc(read, imported, library, library->proc(i), &block_offsets[i], gc)) { return false; } } if (read.verbose) { library->print_loaded_stats(); } return true; } static unsigned read_proc(ReadInfo &read, Imported *imported, LibraryLoading *library, Proc *proc, unsigned **block_offsets, GCCapability &gc) { uint32_t num_blocks; bool first_pass = (proc == nullptr); unsigned proc_offset = 0; BinaryInput & file = read.file; /* * XXX: Signatures currently aren't written into the bytecode, but * here's where they might appear. */ if (!file.read_uint32(&num_blocks)) return 0; if (first_pass) { /* * This is the first pass - set up the block offsets array. */ *block_offsets = new unsigned[num_blocks]; } for (unsigned i = 0; i < num_blocks; i++) { uint32_t num_instructions; if (first_pass) { /* * Fill in the block_offsets array */ (*block_offsets)[i] = proc_offset; } if (!file.read_uint32(&num_instructions)) return 0; for (uint32_t j = 0; j < num_instructions; j++) { uint8_t byte; if (!file.read_uint8(&byte)) return false; if (PZ_CODE_INSTR == byte) { if (!read_instr(file, imported, library, proc ? proc->code() : nullptr, block_offsets, proc_offset)) { return 0; } } else { if (!read_meta(read, library, proc, proc_offset, byte, gc)) { return 0; } } } } return proc_offset; } static bool read_instr(BinaryInput &file, Imported *imported, LibraryLoading *library, uint8_t *proc_code, unsigned **block_offsets, unsigned &proc_offset) { uint8_t byte; PZ_Opcode opcode; Optional width1, width2; ImmediateType immediate_type; ImmediateValue immediate_value; bool first_pass = (proc_code == nullptr); /* * Read the opcode and the data width(s) */ if (!file.read_uint8(&byte)) return false; opcode = static_cast(byte); if (instruction_info[opcode].ii_num_width_bytes > 0) { width1 = read_data_width(file); if (instruction_info[opcode].ii_num_width_bytes > 1) { width2 = read_data_width(file); } } /* * Read any immediate value */ immediate_type = instruction_info[opcode].ii_immediate_type; switch (immediate_type) { case IMT_NONE: memset(&immediate_value, 0, sizeof(ImmediateValue)); break; case IMT_8: if (!file.read_uint8(&immediate_value.uint8)) return false; break; case IMT_16: if (!file.read_uint16(&immediate_value.uint16)) return false; break; case IMT_32: if (!file.read_uint32(&immediate_value.uint32)) return false; break; case IMT_64: if (!file.read_uint64(&immediate_value.uint64)) return false; break; case IMT_CLOSURE_REF: { uint32_t closure_id; if (!file.read_uint32(&closure_id)) return false; if (!first_pass) { immediate_value.word = (uintptr_t)library->closure(closure_id); } else { immediate_value.word = 0; } break; } case IMT_PROC_REF: { uint32_t proc_id; if (!file.read_uint32(&proc_id)) return false; if (!first_pass) { immediate_value.word = (uintptr_t)library->proc(proc_id)->code(); } else { immediate_value.word = 0; } break; } case IMT_IMPORT_CLOSURE_REF: { uint32_t import_id; if (!file.read_uint32(&import_id)) return false; immediate_value.word = (uintptr_t)imported->import_closures.at(import_id); break; } case IMT_LABEL_REF: { uint32_t imm32; if (!file.read_uint32(&imm32)) return false; if (!first_pass) { immediate_value.word = (uintptr_t)&proc_code[(*block_offsets)[imm32]]; } else { immediate_value.word = 0; } break; } case IMT_STRUCT_REF: { uint32_t imm32; if (!file.read_uint32(&imm32)) return false; immediate_value.word = library->struct_(imm32)->total_size(); break; } case IMT_STRUCT_REF_FIELD: { uint32_t imm32; uint8_t imm8; if (!file.read_uint32(&imm32)) return false; if (!file.read_uint8(&imm8)) return false; immediate_value.uint16 = library->struct_(imm32)->field_offset(imm8); break; } } if (width1.hasValue()) { if (width2.hasValue()) { assert(immediate_type == IMT_NONE); proc_offset = write_instr( proc_code, proc_offset, opcode, width1.value(), width2.value()); } else { if (immediate_type == IMT_NONE) { proc_offset = write_instr(proc_code, proc_offset, opcode, width1.value()); } else { proc_offset = write_instr(proc_code, proc_offset, opcode, width1.value(), immediate_type, immediate_value); } } } else { if (immediate_type == IMT_NONE) { proc_offset = write_instr(proc_code, proc_offset, opcode); } else { proc_offset = write_instr(proc_code, proc_offset, opcode, immediate_type, immediate_value); } } return true; } static bool read_meta(ReadInfo & read, LibraryLoading * library, Proc * proc, unsigned proc_offset, uint8_t meta_byte, GCCapability & gc) { BinaryInput & file = read.file; uint32_t data_id; uint32_t line_no; switch (meta_byte) { case PZ_CODE_META_CONTEXT: { // We only need to read the context info when enabled // and during the second pass. if (proc && read.load_debuginfo) { if (!file.read_uint32(&data_id)) return false; String filename = String::from_ptr(library->data(data_id)); if (!file.read_uint32(&line_no)) return false; proc->add_context(gc, proc_offset, filename, line_no); } else { file.seek_cur(8); } break; } case PZ_CODE_META_CONTEXT_SHORT: { if (proc && read.load_debuginfo) { if (!file.read_uint32(&line_no)) return false; proc->add_context(gc, proc_offset, line_no); } else { file.seek_cur(4); } break; } case PZ_CODE_META_CONTEXT_NIL: if (proc && read.load_debuginfo) { proc->no_context(gc, proc_offset); } break; default: fprintf(stderr, "Unknown byte in instruction stream"); abort(); } return true; } static bool read_closures(ReadInfo &read, unsigned num_closures, Imported *imported, LibraryLoading *library) { for (unsigned i = 0; i < num_closures; i++) { uint32_t proc_id; uint32_t data_id; uint8_t * proc_code; void * data; if (!read.file.read_uint32(&proc_id)) return false; proc_code = library->proc(proc_id)->code(); if (!read.file.read_uint32(&data_id)) return false; data = library->data(data_id); library->closure(i)->init(proc_code, data); } return true; } static bool read_exports(ReadInfo &read, unsigned num_exports, LibraryLoading *library, GCTracer &gc) { for (unsigned i = 0; i < num_exports; i++) { Optional mb_name = read.file.read_len_string(gc); if (!mb_name.hasValue()) { return false; } RootString name(gc, mb_name.release()); uint32_t clo_id; if (!read.file.read_uint32(&clo_id)) { return false; } Closure * closure = library->closure(clo_id); if (!closure) { fprintf(stderr, "Closure ID unknown"); return false; } library->add_symbol(name, closure); } return true; } } // namespace pz ================================================ FILE: runtime/pz_read.h ================================================ /* * Plasma bytecode reader * vim: ts=4 sw=4 et * * Copyright (C) Plasma Team * Distributed under the terms of the MIT license, see ../LICENSE.code */ #ifndef PZ_READ_H #define PZ_READ_H namespace pz { /* * Read a bytecode library from the given file. it may reference symbols in * pz. library and names are out-parameters, names is ignored if it's null. */ bool read(PZ & pz, const std::string & bytecode_filename, const Optional & native_filename, Root & library, Vector * names, GCTracer & gc); } // namespace pz #endif /* ! PZ_READ_H */ ================================================ FILE: runtime/pz_string.cpp ================================================ /* * Plasma strings * vim: ts=4 sw=4 et * * Copyright (C) Plasma Team * Distributed under the terms of the MIT license, see ../LICENSE.code */ #include #include "pz_common.h" #include "pz_gc.h" #include "pz_string.h" namespace pz { static void AssertAligned(const void *p) { assert((reinterpret_cast(p) & HIGH_TAG_MASK) == 0); } String::String() : mType(ST_EMPTY) { s.cStr = nullptr; } String::String(const BaseString * base_str) : mType(ST_FLAT) { // Pointers must be aligned AssertAligned(base_str); s.baseStr = base_str; } String::String(const char *c_str) : mType(ST_CONST) { // Pointers must be aligned AssertAligned(c_str); s.cStr = c_str; } void * String::ptr() const { if (mType == ST_EMPTY) { return nullptr; } else { return reinterpret_cast( reinterpret_cast(s.cStr) | (static_cast(mType) << HIGH_TAG_SHIFT)); } } String String::from_ptr(void *ptr) { if (ptr == nullptr) { return String(); } else { StringType tag = static_cast( (reinterpret_cast(ptr) & HIGH_TAG_MASK) >> HIGH_TAG_SHIFT); uintptr_t pointer_no_tag = reinterpret_cast(ptr) & ~HIGH_TAG_MASK; switch (tag) { case ST_FLAT: return String(reinterpret_cast(pointer_no_tag)); case ST_CONST: return String(reinterpret_cast(pointer_no_tag)); default: abort(); } } } void String::print() const { switch (mType) { case ST_CONST: printf("%s", s.cStr); break; case ST_FLAT: s.baseStr->print(); break; case ST_EMPTY: break; } } uint32_t String::length() const { switch (mType) { case ST_CONST: return strlen(s.cStr); case ST_FLAT: return s.baseStr->length(); case ST_EMPTY: return 0; default: abort(); } } bool String::isEmpty() const { switch (mType) { case ST_CONST: return s.cStr[0] == '\0'; case ST_FLAT: return s.baseStr->isEmpty(); case ST_EMPTY: return true; default: abort(); } } bool String::equals(const String &other) const { return equals_pointer(other) || (0 == strcmp(c_str(), other.c_str())); } bool String::equals_pointer(const String &other) const { return this->s.cStr == other.s.cStr; } bool String::startsWith(const String & other, GCCapability &gc0) const { if (other.length() > length()) return false; GCTracer gc(gc0); Root thispos(gc, begin(gc)); Root otherpos(gc, other.begin(gc)); while (!otherpos->at_end()) { assert(!thispos->at_end()); if (thispos->next_char() != otherpos->next_char()) { return false; } thispos = thispos->forward(gc); otherpos = otherpos->forward(gc); } return true; } const char * String::c_str() const { switch (mType) { case ST_CONST: return s.cStr; case ST_FLAT: return s.baseStr->c_str(); case ST_EMPTY: return ""; default: abort(); } } CodePoint32 String::char_at(unsigned i) const { assert(i < length()); // XXX make better. return c_str()[i]; } size_t String::hash() const { const char *c = c_str(); size_t hash = 0; for (unsigned i = 0; i < length(); i++) { hash = (hash >> (sizeof(size_t)*8-1) | hash << 1) ^ std::hash{}(c[i]); } return hash; } String String::append(GCCapability &gc, const String s1, const String s2) { uint32_t len = s1.length() + s2.length(); if (len == 0) { return String(); } else { FlatString *s = FlatString::New(gc, len); strcpy(s->buffer(), s1.c_str()); strcat(s->buffer(), s2.c_str()); return String(s); } } String String::substring(GCCapability &gc, const StringPos * pos1, const StringPos * pos2) { assert(pos1->mPos <= pos1->mStr.length()); assert(pos2->mPos <= pos2->mStr.length()); if (!pos1->mStr.equals_pointer(pos2->mStr)) { fprintf(stderr, "Substring for two different strings\n"); exit(1); } // This uses negative numbers to check when the beginning is after the // end. int len = pos2->mPos - pos1->mPos; if (len <= 0) { return String(); } FlatString *s = FlatString::New(gc, len); strncpy(s->buffer(), &pos1->mStr.c_str()[pos1->mPos], len); return String(s); } String String::dup(GCCapability &gc, const std::string & str) { uint32_t len = str.length(); if (len == 0) { return String(); } else { FlatString *s = FlatString::New(gc, len); strcpy(s->buffer(), str.c_str()); return String(s); } } bool String::operator==(const String other) const { return equals(other); } StringPos* String::begin(GCCapability &gc) const { return new(gc) StringPos(*this, 0); } StringPos* String::end(GCCapability &gc) const { // XXX won't work with other encodings. return new(gc) StringPos(*this, length()); } /* * FlatString *************/ FlatString::FlatString(uint32_t len) : mLen(len) { #ifdef DEBUG // Make debugging slightly more predictable. memset(mBuffer, 'X', len); #endif mBuffer[len] = 0; } FlatString* FlatString::New(GCCapability &gc, uint32_t len) { void *mem = gc.alloc_bytes(sizeof(FlatString) + len + 1); return new(mem) FlatString(len); } StringType FlatString::type() const{ return ST_FLAT; } void FlatString::print() const { printf("%s", mBuffer); } uint32_t FlatString::length() const { return mLen; } bool FlatString::isEmpty() const { return mLen == 0; } uint32_t FlatString::storageSize() const { return sizeof(FlatString) + mLen + 1; } const char * FlatString::c_str() const { return reinterpret_cast(mBuffer); } void FlatString::fixSize(uint32_t len) { assert(len <= mLen); mBuffer[len] = 0; mLen = len; } /* * StringPos ************/ bool StringPos::at_beginning() const { return mPos == 0; } bool StringPos::at_end() const { return mPos == mStr.length(); } StringPos * StringPos::forward(GCCapability &gc) const { if (at_end()) { fprintf(stderr, "StringPos already at end\n"); exit(1); } return new(gc) StringPos(mStr, mPos+1); } StringPos * StringPos::backward(GCCapability &gc) const { if (at_beginning()) { fprintf(stderr, "StringPos already at beginning"); exit(1); } return new(gc) StringPos(mStr, mPos-1); } CodePoint32 StringPos::next_char() const { if (mPos == mStr.length()) { fprintf(stderr, "Access next character at end of string\n"); exit(1); } return mStr.char_at(mPos); } CodePoint32 StringPos::prev_char() const { if (mPos == 0) { fprintf(stderr, "Access previous character at beginning of string\n"); exit(1); } return mStr.char_at(mPos - 1); } } // namespace pz namespace std { size_t hash::operator()(pz::String const& s) const noexcept { return s.hash(); } } ================================================ FILE: runtime/pz_string.h ================================================ /* * Plasma strings * vim: ts=4 sw=4 et * * Copyright (C) Plasma Team * Distributed under the terms of the MIT license, see ../LICENSE.code */ #ifndef PZ_STRING_H #define PZ_STRING_H #include "pz_gc_util.h" #include namespace pz { typedef uint32_t CodePoint32; class BaseString; class StringPos; enum StringType : uint8_t { ST_FLAT = 0, ST_CONST, ST_EMPTY }; /* * Ths string class wraps a reference to the real string. You should pass it * by value rather than pointer or reference. */ class String { private: union { const BaseString *baseStr; const char *cStr; } s; StringType mType; public: String(); explicit String(const BaseString *); explicit String(const char *); // Get a raw pointer (for the bytecode interpreter). void* ptr() const; static String from_ptr(void*); protected: // GC ptr-ptr. Get a pointer to the pointer, for GC rooting. const void ** gc_ptr() { switch (mType) { case ST_EMPTY: case ST_CONST: return nullptr; case ST_FLAT: return reinterpret_cast(&s.baseStr); default: fprintf(stderr, "Invalid string type"); abort(); } }; public: void print() const; bool equals(const String &) const; bool equals_pointer(const String &) const; bool startsWith(const String &, GCCapability &gc) const; // Length in code points uint32_t length() const; bool isEmpty() const; // Length in bytes in RAM, including bookkeeping. uint32_t storageSize() const; const char * c_str() const; // Get the character at this raw position. CodePoint32 char_at(unsigned i) const; size_t hash() const; static String append(GCCapability &gc, const String, const String); static String substring(GCCapability &gc, const StringPos * pos1, const StringPos * pos2); static String dup(GCCapability &gc, const std::string &str); bool operator==(const String string) const; StringPos* begin(GCCapability &gc) const; StringPos* end(GCCapability &gc) const; }; class RootString : public String { private: GCTracer & m_tracer; public: RootString(GCTracer & gc, String && str) : String(str), m_tracer(gc) { m_tracer.add_root(gc_ptr()); } ~RootString() { m_tracer.remove_root(gc_ptr()); } }; class BaseString { public: virtual StringType type() const = 0; virtual void print() const = 0; // Length in code points virtual uint32_t length() const = 0; virtual bool isEmpty() const = 0; // Length in bytes in RAM, including bookkeeping. virtual uint32_t storageSize() const = 0; virtual const char * c_str() const = 0; }; // A flat string has both a null-terminating byte and a length field. class FlatString : public BaseString { private: uint32_t mLen; uint8_t mBuffer[]; protected: FlatString(uint32_t len); public: // We don't use the GCNew class' placement new because we need custom // lengths. static FlatString* New(GCCapability &gc, uint32_t len); StringType type() const override; void print() const override; uint32_t length() const override; bool isEmpty() const override; uint32_t storageSize() const override; const char * c_str() const override; char * buffer() { return reinterpret_cast(mBuffer); } const char * buffer() const { return reinterpret_cast(mBuffer); } void fixSize(uint32_t len); }; class StringPos : public GCNew { const String mStr; unsigned mPos; public: StringPos(const String &str, unsigned pos) : mStr(str), mPos(pos) {} bool at_beginning() const; bool at_end() const; StringPos* forward(GCCapability &gc) const; StringPos* backward(GCCapability &gc) const; CodePoint32 next_char() const; CodePoint32 prev_char() const; friend class String; }; } // namespace pz namespace std { template<> struct hash { size_t operator()(pz::String const& s) const noexcept; }; } #endif // ! PZ_String_H ================================================ FILE: runtime/pz_trace.cpp ================================================ /* * Plasma execution tracing. * vim: ts=4 sw=4 et * * Copyright (C) Plasma Team * Distributed under the terms of the MIT license, see ../LICENSE.code */ #include #include "pz_common.h" #include "pz_code.h" #include "pz_gc.h" #include "pz_trace.h" #include "pz_string.h" #include "pz_util.h" namespace pz { bool trace_enabled = false; /* * THese are used to cache some lookup information to find line numbers * within procs. */ Proc * last_proc = nullptr; unsigned last_lookup = 0; void trace_instr_(unsigned rsp, const char * instr_name) { fprintf(stderr, "%4u: %s\n", rsp, instr_name); } void trace_instr2_(unsigned rsp, const char * instr_name, int num) { fprintf(stderr, "%4u: %s %d\n", rsp, instr_name, num); } void trace_state_(const Heap * heap, void * ip, void * env, unsigned rsp, unsigned esp, uint64_t * stack) { void * code = heap_interior_ptr_to_ptr(heap, ip); assert(ip >= code); std::ptrdiff_t offset = reinterpret_cast(ip) - reinterpret_cast(code); // XXX These should be GC roots. Proc * proc = reinterpret_cast(heap_meta_info(heap, code)); if (proc) { fprintf(stderr, " IP %p: %s+%ld%s", ip, proc->name().c_str(), (long)offset, proc->is_builtin() ? " (builtin)" : ""); } else { fprintf(stderr, " IP %p: +%ld (builtin)", ip, (long)offset); } unsigned line = 0; if (proc && proc->filename().hasValue()) { if (proc != last_proc) { last_lookup = 0; last_proc = proc; } line = proc->line(offset, &last_lookup); if (line) { fprintf(stderr, " from %s:%d", proc->filename().value().c_str(), line); } } fprintf(stderr, "\n"); fprintf(stderr, " ENV %p\n", env); fprintf(stderr, " RSP %4u ESP %4u\n", rsp, esp); fprintf(stderr, " stack: "); int start = esp - 4; start = start >= 1 ? start : 1; for (unsigned i = start; i <= esp; i++) { fprintf(stderr, "0x%." WORDSIZE_HEX_CHARS_STR PRIx64 " ", stack[i]); } fprintf(stderr, "\n\n"); } } // namespace pz ================================================ FILE: runtime/pz_trace.h ================================================ /* * Plasma execution tracing. * vim: ts=4 sw=4 et * * Copyright (C) Plasma Team * Distributed under the terms of the MIT license, see ../LICENSE.code */ #ifndef PZ_TRACE_H #define PZ_TRACE_H #ifdef PZ_DEV namespace pz { extern bool trace_enabled; void trace_instr_(unsigned rsp, const char * instr_name); void trace_instr2_(unsigned rsp, const char * instr_name, int num); void trace_state_(const Heap * heap, void * ip, void * env, unsigned rsp, unsigned esp, uint64_t * stack); } // namespace pz #define pz_trace_instr(rip, name) \ if (pz::trace_enabled) { \ pz::trace_instr_(rip, name); \ } #define pz_trace_instr2(rip, name, num) \ if (pz::trace_enabled) { \ pz::trace_instr2_(rip, name, num); \ } #define pz_trace_state(heap, rip, env, rsp, esp, stack) \ if (pz::trace_enabled) { \ pz::trace_state_(heap, rip, env, rsp, esp, stack); \ } #else /* ! PZ_DEV */ #define pz_trace_instr(rip, name) #define pz_trace_instr2(rip, name, num) #define pz_trace_state(heap, rip, env, rsp, esp, stack) #endif /* ! PZ_DEV */ #endif /* ! PZ_TRACE_H */ ================================================ FILE: runtime/pz_util.h ================================================ /* * PZ Utils. * vim: ts=4 sw=4 et * * Copyright (C) Plasma Team * Distributed under the terms of the MIT license, see ../LICENSE.code */ #ifndef PZ_UTIL_H #define PZ_UTIL_H /* * The machine word size. */ #define WORDSIZE_BYTES sizeof(void *) #if UINTPTR_MAX == 0xFFFFFFFFFFFFFFFF #define WORDSIZE_BITS 64 #elif UINTPTR_MAX == 0xFFFFFFFF #define WORDSIZE_BYTES 32 #else #pragma error "Unknown pointer size" #endif #if WORDSIZE_BITS == 64 #define WORDSIZE_HEX_CHARS_STR "16" #elif WORDSIZE_BITS == 32 #define WORDSIZE_HEX_CHARS_STR "8" #endif template constexpr T RoundUp(T x, T y) { return ((x + y - 1) / y) * y; } template constexpr T RoundDown(T x, T y) { return (x / y) * y; } constexpr size_t AlignUp(size_t x, size_t y) { return RoundUp(x, y); } #endif /* ! PZ_UTIL_H */ ================================================ FILE: runtime/pz_vector.h ================================================ /* * Plasma GC-compatible bounds-checked array * vim: ts=4 sw=4 et * * Copyright (C) Plasma Team * Distributed under the terms of the MIT license, see ../LICENSE.code */ #ifndef PZ_VECTOR_H #define PZ_VECTOR_H #include "string.h" #include "pz_gc_util.h" namespace pz { template class Vector : public GCNew { private: /* * The array data is stored seperately. Array types can be * passed-by-value and easilly embeded within other values. */ size_t m_len; size_t m_capacity; T * m_data; public: Vector(NoGCScope & gc, size_t capacity = 8) : m_len(0) , m_capacity(capacity) { if (m_capacity > 0) { m_data = new (gc) T[m_capacity]; } else { m_data = nullptr; } } size_t size() const { return m_len; } const T & operator[](size_t offset) const { assert(offset < m_len); return m_data[offset]; } T & operator[](size_t offset) { assert(offset < m_len); return m_data[offset]; } const T & front() const { assert(m_len > 0); return m_data[0]; } T & front() { assert(m_len > 0); return m_data[0]; } const T & back() const { assert(m_len > 0); return m_data[m_len - 1]; } T & back() { assert(m_len > 0); return m_data[m_len - 1]; } class Iterator : public std::iterator { private: const Vector *m_vector; size_t m_pos; protected: friend class Vector; Iterator(const Vector *v, size_t pos) : m_vector(v), m_pos(pos) {} public: bool operator!=(const Iterator &r) const { assert(m_vector == r.m_vector); return m_pos != r.m_pos; } Iterator& operator++() { m_pos++; return *this; } const T& operator*() { return (*m_vector)[m_pos]; }; }; Iterator begin() const { return Iterator(this, 0); } Iterator end() const { return Iterator(this, m_len); } bool append(GCCapability & gc_cap, T value) { if (m_len == m_capacity) { if (!grow(gc_cap)) return false; } assert(m_len < m_capacity); m_data[m_len++] = value; return true; } bool grow(GCCapability & gc_cap) { if (m_capacity) { assert(m_data); // TODO: Tune this, right now we double the size of the array. // TODO: Implement realloc in the GC (Bug #208). T * new_data = new (gc_cap) T[m_capacity * 2]; if (!new_data) return false; for (unsigned i = 0; i < m_len; i++) { new_data[i] = m_data[i]; } m_data = new_data; m_capacity *= 2; } else { assert(!m_data); m_data = new (gc_cap) T[8]; m_capacity = 8; } return true; } /* * These are deleted until they're needed (and can be tested) later. */ Vector(const Vector &) = delete; void operator=(const Vector &) = delete; }; } // namespace pz #endif /* ! PZ_VECTOR_H */ ================================================ FILE: scripts/README.md ================================================ # Scripts ## do\_mmc\_make The [do_mmc_make](do_mmc_make) script in this directory can be placed in the path and will run the [.vim_mmc_make](../src/.vim_mmc_make) script from the current directory. Such as the one in the `src` directory. This makes it easy to use `mmc --make` from vim by pressing F9 with the following configuration change. Make this change to the `ftplugin/mercury.vim` file of Mercury's vim plugin. setlocal makeprg=do_mmc_make ## docker The [docker](docker) directory contains a Dockerfile to setup an environment for developing Plasma. You can build the image for yourself or download it from [docker hub](https://hub.docker.com/r/paulbone/plasma-dep) with docker pull paulbone/plasma-dep ================================================ FILE: scripts/do_mmc_make ================================================ #!/bin/sh if [ -f .vim_mmc_make ]; then JOBS=8 exec ./.vim_mmc_make else echo "No .vim_mmc_make file found" exit 1 fi ================================================ FILE: scripts/docker/Dockerfile ================================================ FROM debian:bullseye ## ## The first part of this dockerfile is identical to the Mercury one ## https://github.com/Mercury-Language/packaging/tree/master/docker/min-rotd ## To improve caching ##################################### RUN apt-get update; apt-get upgrade -yq WORKDIR /tmp COPY install.sh . # Install some mercury dependencies, this creates another docker layer # allowing some caching. RUN ./install.sh \ gcc \ libhwloc-dev \ libreadline-dev \ perl COPY paul.gpg /etc/apt/trusted.gpg.d/paul-6507444DBDF4EAD2.gpg COPY mercury.list /etc/apt/sources.list.d/ # Install a minimal set of Mercury grades RUN ./install.sh \ mercury-llc-dev \ mercury-tools=22.01-bullseye1 ############################# ## End of Mercury dockerfile ## ## ## Likewise, this snippet is from the plasma-ci-dep image. ## # Install some Plasma build dependencies. We will test with both gcc and # clang so install both. RUN ./install.sh \ exuberant-ctags \ gcc \ g++ \ clang \ make \ unzip \ ninja-build # Install the extra dependencies / things someone might want for working on # Plasma. RUN ./install.sh \ asciidoc \ ca-certificates \ cdecl \ git \ less \ patchutils \ pinfo \ procps \ screen \ source-highlight \ tig \ vim \ mercury-recommended # Setup git and vim. # TODO: should be able to do this with vim packages and without the pathogen # script. WORKDIR /root COPY gitconfig .gitconfig COPY vimrc .vimrc RUN mkdir .vim .vim/bundle .vim/autoload ADD https://raw.githubusercontent.com/tpope/vim-pathogen/master/autoload/pathogen.vim .vim/autoload/pathogen.vim RUN cp -r /usr/share/doc/mercury-tools/examples/vim .vim/bundle/mercury RUN git clone --depth 1 https://github.com/PlasmaLang/vim.git .vim/bundle/plasma # Some of the Mercury vim files may be compressed RUN find .vim -name \*.gz | xargs gunzip # Get Plasma. RUN git clone https://github.com/PlasmaLang/plasma.git # Update to later git versions. WORKDIR .vim/bundle/plasma RUN git remote update -p && git checkout fa0dcf83c496b34db22e255a2cfec3bd3ee97812 && git checkout master && git merge --ff origin/master WORKDIR /root/plasma RUN git remote update -p && git checkout f25d3d2c0f412b230482b43cf8fafaedaee6b844 && git checkout master && git merge --ff origin/master WORKDIR /root RUN apt-get update; apt-get upgrade -yq # One more tweak to vim. RUN cp plasma/scripts/do_mmc_make /usr/bin RUN echo "setlocal makeprg=do_mmc_make" >> .vim/bundle/mercury/ftplugin/mercury.vim COPY welcome.sh /usr/bin ENTRYPOINT /usr/bin/welcome.sh ================================================ FILE: scripts/docker/README.md ================================================ Build / get a docker image ========================== This directory contains a Dockerfile to setup an environment for developing Plasma. To build the image edit build.sh and then execute it: $ vim build.sh $ ./build.sh Or download it from [docker hub](https://hub.docker.com/r/paulbone/plasma-dep) with $ docker pull paulbone/plasma-dep You can run it (it will open a shell prompt) with: $ docker run -it paulbone/plasma-dep:latest More details ============ The files in this directory do the following: README.md: You're reading it. build.sh: A script to ask docker to build the image. Dockerfile: The Dockerfile (docker's script) to build the image. These files are part of the docker image: gitconfig: A basic ~/.gitconfig install.sh: A script to call apt within docker mercury.list: An apt sources list for Mercury paul.gpg: Paul's GPG key (for signed Mercury packages) vimrc: A suitable .vimrc with this and options in the docker file syntax highlighting will be available for Plasma and Mercury. welcome.sh: A greeting when opening the docker image. ================================================ FILE: scripts/docker/build.sh ================================================ #!/bin/sh set -e # Set this to your dockerhub name. USER=paulbone # The name of the docker image IMAGE=plasma-dep # The version string VERSION=latest docker build -t $USER/$IMAGE:$VERSION . # Comment these out if you don't wish to upload the image. docker push $USER/$IMAGE:$VERSION ================================================ FILE: scripts/docker/gitconfig ================================================ [alias] graph = log --graph --decorate --oneline [merge] log=1000000 conflictstyle = diff3 [fetch] prune=true [color] branch=never ================================================ FILE: scripts/docker/install.sh ================================================ #!/bin/sh set -e apt-get update apt-get install --no-install-recommends -yq $* rm -rf /var/lib/apt/lists/* ================================================ FILE: scripts/docker/mercury.list ================================================ deb http://dl.mercurylang.org/deb/ bullseye main deb-src http://dl.mercurylang.org/deb/ bullseye main ================================================ FILE: scripts/docker/vimrc ================================================ set wrapmargin=1 set showmode set ts=4 sw=4 set textwidth=76 set et set autoindent set smartindent set modeline set t_Co=8 set showmatch set exrc set showcmd filetype plugin on syntax on set background=dark set ignorecase set smartcase set incsearch set ruler set textauto set noerrorbells let g:mercury_no_highlight_tabs=1 let g:mercury_highlight_comment_special=3 let g:mercury_no_highlight_overlong = 1 "set comments=s1:/*,mb:*,ex:*/,://,b:#,:%,:XCOMM,n:>,fb:- highlight PreProc ctermfg=2 highlight SpecialKey ctermfg=2 highlight Underlined ctermfg=2 highlight DiffAdd ctermfg=2 " Save the buffer before suspending vim, switching buffers, running make etc. set autowrite " Trim whitespace from the end of lines. map ;x :g/[ ][ ]*$/s// " compiling " make " next error " previous error noremap :mak noremap :cnext noremap :cprev " Disable annoying help map " Load plugins execute pathogen#infect() ================================================ FILE: scripts/docker/welcome.sh ================================================ #!/bin/sh set -e cat << END Welcome to the Plasma-ready docker image ---------------------------------------- This is a docker image ready for Plasma development or testing. It is based on debian and you may install additional tools with "apt install". There is a plasma/ subdirectory here. Consult the README.md and/or copy template.mk to build.mk to set build parameters. When you're ready type "make" and "make test". Type "git pull" to update to the latest version. Vim is configured with Plasma and Mercury language plugins. See: https://github.com/PlasmaLang/plasma/tree/master/scripts/docker for more info or to contribute inprovements. END exec /bin/bash ================================================ FILE: src/.gitignore ================================================ *.mh *.err Mercury plzasm plzbuild plzc plzdisasm plzgeninit plzlnk tags ================================================ FILE: src/.vim_mmc_make ================================================ #!/bin/sh set -e MCFLAGS=--use-grade-subdirs for prog in plzasm plzbuild plzc plzdisasm plzgeninit plzlnk; do mmc --output-compile-error-lines 1000 \ --max-error-line-width 1000 \ $MCFLAGS -j$JOBS --make $prog done ================================================ FILE: src/Mercury.options ================================================ # CFLAGS for mmc --make to pass to the C compiler. EXTRA_CFLAGS=-std=c99 # Uncomment this to enable extra warnings & warnings-as-errors. # MCFLAGS+=--halt-at-warn \ # --warn-dead-procs \ # --warn-unused-imports \ # --warn-interface-imports-in-parents \ # --warn-insts-with-functors-without-type \ # --warn-inconsistent-pred-order-clauses \ # --warn-inconsistent-pred-order-foreign-procs \ # --warn-non-contiguous-foreign-procs \ # --warn-suspicious-foreign-procs \ # --warn-suspicious-foreign-code # You should not need ot modify these options. EXTRA_CFLAGS+=-I../runtime/ MCFLAGS-lex=--no-halt-at-warn \ --no-warn-unused-imports \ --no-warn-interface-imports-in-parents \ --no-warn-insts-with-functors-without-type \ --no-warn-inconsistent-pred-order-clauses \ --no-warn-inconsistent-pred-order-foreign-procs MCFLAGS-lex.automata=--no-halt-at-warn \ --no-warn-insts-with-functors-without-type MCFLAGS-lex.buf=--no-halt-at-warn \ --no-warn-insts-with-functors-without-type MCFLAGS-lex.convert_NFA_to_DFA=--no-halt-at-warn \ --no-warn-unused-imports MCFLAGS-lex.lexeme=--no-halt-at-warn \ --no-warn-insts-with-functors-without-type MCFLAGS-lex.regexp=--no-halt-at-warn \ --no-warn-unused-imports ================================================ FILE: src/README.md ================================================ # Plasma tools directory The code in this directory builds the plzc and plzasm programs. plzc is the plasma compiler and plzasm will assemble a .pz file from a .pzt (plasma bytecode text) file. The bytecode assembler has three stages, parsing the source to an `asm` structure, assembling this to a `pz` structure, and writing out the `pz` structure. Some files/modules are: * [plzasm.m](plzasm.m) - The plasma bytecode assembler entry point * [pzt\_parse.m](pzt\_parse.m) - The pzt parser * asm - These modules contain structures and code used to represent code during assembly by plzasm The compiler parses the code to an `ast` structure, transforms that to the `core` structure, performs semantic analysis and compilation on the `core` structure before generating code as a `pz` structure and writing out the `pz` structure. This version of the compiler does not perform any optimisations, most optimisations would be done within the `core` phase. * [plzc.m](plzc.m) - The plasma compiler entry point * [parse.m](parse.m) - The plasma parser * [ast.m](ast.m) - The plasma abstract syntax tree * [pre.m](pre.m) - The pre-core representation * [pre.from\_ast.m](pre.from\_ast.m) - The translation between the AST and pre-core representations * [pre.to\_core.m](pre.to\_core.m) - The translation between the pre-core and core representations * [core.m](core.m and sub-modules) - These modules contain the core structure and code that performs semantic analysis. * [core\_to\_pz.m](core\_to\_pz.m and sub-modules) - Code to transform `core` to `pz` The linker links one or more compiled Plasma files (.pzo) into a program. * [plzlnk.m](plzlnk.m) Other tools * [plzdisasm.m](plzdisasm.m) Plasma disassembler. Some files/modules shared between several tools are: * [lex.m](lex.m) - This library is part of the Mercury extras distribution and provides code to build a lexical analyser * [parsing.m](parsing.m) - Code to build table based LL(2) parsers * [pz.m](pz.m and sub-modules) - Code to represent and write out PZ format bytecode ================================================ FILE: src/asm.m ================================================ %-----------------------------------------------------------------------% % vim: ts=4 sw=4 et %-----------------------------------------------------------------------% :- module asm. % % Assemble a PZ bytecode file. % % Copyright (C) Plasma Team % Distributed under the terms of the MIT License see ../LICENSE.code % %-----------------------------------------------------------------------% :- interface. :- import_module asm_ast. :- import_module asm_error. :- import_module pz. :- import_module pz.pz_ds. :- import_module util. :- import_module util.result. %-----------------------------------------------------------------------% :- pred assemble(asm::in, result(pz, asm_error)::out) is det. %-----------------------------------------------------------------------% %-----------------------------------------------------------------------% :- implementation. :- import_module bimap. :- import_module cord. :- import_module digraph. :- import_module int. :- import_module int32. :- import_module list. :- import_module map. :- import_module maybe. :- import_module require. :- import_module set. :- import_module string. :- import_module uint32. :- import_module constant. :- import_module context. :- import_module common_types. :- import_module pz.code. :- import_module q_name. :- import_module util.my_exception. :- import_module util.path. %-----------------------------------------------------------------------% assemble(PZT, MaybePZ) :- some [!PZ, !Errors] ( ( if filename_extension(constant.pz_text_extension, PZT ^ asm_filename, ModuleNameStr) then ModuleName = q_name_single(ModuleNameStr) else ModuleName = q_name_single(PZT ^ asm_filename) ), !:PZ = init_pz([ModuleName], pzft_object), Items = PZT ^ asm_items, % Add a data item to store the source file name. pz_new_data_id(CtxtFileDataId, !PZ), pz_add_data(CtxtFileDataId, pz_encode_string(PZT ^ asm_filename), !PZ), prepare_map(Items, SymbolMap, StructMap, !PZ), !:Errors = init, foldl2(build_items(SymbolMap, StructMap, CtxtFileDataId), Items, !PZ, !Errors), ( is_empty(!.Errors) -> MaybePZ = ok(!.PZ) ; MaybePZ = errors(!.Errors) ) ). :- pred prepare_map(list(asm_item)::in, bimap(q_name, pz_item_id)::out, map(string, pzs_id)::out, pz::in, pz::out) is det. prepare_map(Items, !:SymbolMap, StructMap, !PZ) :- some [!Graph] ( digraph.init(!:Graph), filter_map((pred(Item::in, Data::out) is semidet :- Item = asm_item(Name, Context, asm_data(Type, Value)), Data = asm_item_data(Name, Context, Type, Value) ), Items, DataItems), DataNames = list_to_set(map(func(Data) = Data ^ aid_name, DataItems)), foldl(build_data_graph(DataNames), DataItems, !Graph), !:SymbolMap = bimap.init, ( if return_vertices_in_to_from_order(!.Graph, NamesOrdered) then foldl2((pred(Name::in, S0::in, S::out, PZ0::in, PZ::out) is det :- pz_new_data_id(DID, PZ0, PZ), ID = pzii_data(DID), ( if insert(Name, ID, S0, S1) then S = S1 else compile_error($file, $pred, "Duplicate data name") ) ), NamesOrdered, !SymbolMap, !PZ) else compile_error($file, $pred, "Data contains cycles") ), foldl3(prepare_map_2, Items, !SymbolMap, map.init, StructMap, !PZ) ). :- type asm_item_data ---> asm_item_data( aid_name :: q_name, aid_context :: context, aid_type :: asm_data_type, aid_value :: list(asm_data_value) ). :- pred build_data_graph(set(q_name)::in, asm_item_data::in, digraph(q_name)::in, digraph(q_name)::out) is det. build_data_graph(DataNames, Data, !Graph) :- Name = Data ^ aid_name, add_vertex(Name, NameKey, !Graph), foldl((pred(Item::in, G0::in, G::out) is det :- ( Item = asm_dvalue_num(_), G = G0 ; Item = asm_dvalue_name(Ref), ( if member(Ref, DataNames) then % Only add this edge if the referred-to thing is itself % data. add_vertex(Ref, RefKey, G0, G1), add_edge(NameKey, RefKey, G1, G) else G = G0 ) ) ), Data ^ aid_value, !Graph). :- pred prepare_map_2(asm_item::in, bimap(q_name, pz_item_id)::in, bimap(q_name, pz_item_id)::out, map(string, pzs_id)::in, map(string, pzs_id)::out, pz::in, pz::out) is det. prepare_map_2(asm_item(QName, Context, Type), !SymMap, !StructMap, !PZ) :- ( ( Type = asm_proc(_, _), pz_new_proc_id(PID, !PZ), ID = pzii_proc(PID) ; Type = asm_closure(_, _, _), pz_new_closure_id(CID, !PZ), ID = pzii_closure(CID) ; Type = asm_import(_), pz_new_import(IID, pz_import(QName, pzit_import), !PZ), ID = pzii_import(IID) ), ( if insert(QName, ID, !SymMap) then true else compile_error($file, $pred, Context, "Duplicate name") ) ; Type = asm_struct(Fields), ( if q_name_parts(QName, no, Name) then pz_new_struct_id(SID, nq_name_to_string(Name), !PZ), pz_add_struct(SID, pz_struct(Fields), !PZ), ( if insert(nq_name_to_string(Name), SID, !StructMap) then true else compile_error($file, $pred, Context, "Duplicate struct name") ) else compile_error($file, $pred, Context, "Qualified struct name") ) ; Type = asm_data(_, _) % Already handled above. ). prepare_map_2(asm_entrypoint(_, _), !SymMap, !StructMap, !PZ). :- pred build_items(bimap(q_name, pz_item_id)::in, map(string, pzs_id)::in, pzd_id::in, asm_item::in, pz::in, pz::out, errors(asm_error)::in, errors(asm_error)::out) is det. build_items(SymbolMap, StructMap, CtxtStrData, asm_item(Name, Context, Type), !PZ, !Errors) :- ( ( Type = asm_proc(_, _) ; Type = asm_data(_, _) ; Type = asm_closure(_, _, _) ), bimap.lookup(SymbolMap, Name, ID), ( Type = asm_proc(Signature, Blocks0), PID = item_expect_proc($file, $pred, ID), list.foldl3(build_block_map, Blocks0, 0u32, _, map.init, BlockMap, init, BlockErrors), Info = asm_info(SymbolMap, BlockMap, StructMap, CtxtStrData), ( is_empty(BlockErrors) -> map(build_block(Info), Blocks0, MaybeBlocks0), result_list_to_result(MaybeBlocks0, MaybeBlocks) ; MaybeBlocks = errors(BlockErrors) ), ( MaybeBlocks = ok(Blocks), pz_add_proc(PID, pz_proc(Name, Signature, yes(Blocks)), !PZ) ; MaybeBlocks = errors(Errors), add_errors(Errors, !Errors) ) ; Type = asm_data(ASMDType, ASMValues), DID = item_expect_data($file, $pred, ID), DType = build_data_type(StructMap, ASMDType, ASMValues), ( DType = type_struct(PZSId), pz_lookup_struct(!.PZ, PZSId) = pz_struct(Widths), ( if length(Widths) = length(ASMValues) `with_type` int then true else compile_error($file, $pred, Context, "Data length doesn't match struct length") ) ; DType = type_array(_, _) ; DType = type_string(_) ), Values = map(build_data_value(SymbolMap), ASMValues), pz_add_data(DID, pz_data(DType, Values), !PZ) ; Type = asm_closure(ProcName, DataName, Sharing), CID = item_expect_closure($file, $pred, ID), Closure = build_closure(SymbolMap, ProcName, DataName), pz_add_closure(CID, Closure, !PZ), ( Sharing = s_public, q_name_parts(Name, MaybeModule, _), ( if ( MaybeModule = yes(Module), member(Module, pz_get_module_names(!.PZ)) ; MaybeModule = no ) then pz_export_closure(CID, Name, !PZ) else my_exception.sorry($file, $pred, "Module can't yet export other modules' symbols") ) ; Sharing = s_private ) ) ; Type = asm_struct(_) ; Type = asm_import(_) ). build_items(Map, _StructMap, _, asm_entrypoint(_, Name), !PZ, !Errors) :- lookup(Map, Name, ID), CID = item_expect_closure($file, $pred, ID), pz_add_entry_candidate(CID, pz_es_plain, !PZ). :- pred build_block_map(pzt_block::in, pzb_id::in, pzb_id::out, map(string, pzb_id)::in, map(string, pzb_id)::out, errors(asm_error)::in, errors(asm_error)::out) is det. build_block_map(pzt_block(Name, _, Context), !Num, !Map, !Errors) :- ( map.insert(Name, !.Num, !Map) -> true ; add_error(Context, e_name_already_defined(Name), !Errors) ), !:Num = !.Num + 1u32. :- type asm_info ---> asm_info( ai_symbols :: bimap(q_name, pz_item_id), ai_blocks :: map(string, pzb_id), ai_structs :: map(string, pzs_id), % The string data for the filename part of context % information. ai_context_string :: pzd_id ). :- pred build_block(asm_info::in, pzt_block::in, result(pz_block, asm_error)::out) is det. build_block(Info, pzt_block(_, Instrs0, _), MaybeBlock) :- map(build_instruction(Info), Instrs0, MaybeInstrs0), result_list_to_result(MaybeInstrs0, MaybeInstrs1), MaybeInstrs = result_map(condense, MaybeInstrs1), MaybeBlock = result_map((func(X) = pz_block(X)), MaybeInstrs). :- pred build_instruction(asm_info::in, pzt_instruction::in, result(list(pz_instr_obj), asm_error)::out) is det. build_instruction(Info, pzt_instruction(Instr, Widths0, Context), MaybeInstrs) :- default_widths(Widths0, Width1, Width2), build_instruction(Info, Context, Instr, Width1, Width2, MaybeInstr), ( if is_nil_context(Context) then PZContext = pz_nil_context else PZContext = pz_context(Context, Info ^ ai_context_string) ), MaybeInstrs = result_map( func(X) = [pzio_context(PZContext), pzio_instr(X)], MaybeInstr). :- pred default_widths(pzt_instruction_widths::in, pz_width::out, pz_width::out) is det. default_widths(no, pzw_fast, pzw_fast). default_widths(one_width(Width), Width, pzw_fast). default_widths(two_widths(Width1, Width2), Width1, Width2). :- pred build_instruction(asm_info::in, context::in, pzt_instruction_code::in, pz_width::in, pz_width::in, result(pz_instr, asm_error)::out) is det. build_instruction(Info, Context, PInstr, Width1, Width2, MaybeInstr) :- ( PInstr = pzti_load_immediate(N), % TODO: Encode the immediate value with a more suitable width. MaybeInstr = ok(pzi_load_immediate(Width1, im_i32(det_from_int(N)))) ; PInstr = pzti_word(Name), ( if builtin_instr(Name, Width1, Width2, Instr) then MaybeInstr = ok(Instr) else MaybeInstr = return_error(Context, e_no_such_instruction(Name)) ) ; PInstr = pzti_jmp(Name), ( search(Info ^ ai_blocks, Name, Num) -> MaybeInstr = ok(pzi_jmp(Num)) ; MaybeInstr = return_error(Context, e_block_not_found(Name)) ) ; PInstr = pzti_cjmp(Name), ( search(Info ^ ai_blocks, Name, Num) -> MaybeInstr = ok(pzi_cjmp(Num, Width1)) ; MaybeInstr = return_error(Context, e_block_not_found(Name)) ) ; PInstr = pzti_call(QName), ( if search(Info ^ ai_symbols, QName, Entry), ( Entry = pzii_closure(CID), Callee = pzc_closure(CID) ; Entry = pzii_proc(PID), Callee = pzc_proc_opt(PID) ; Entry = pzii_import(ImportId), Callee = pzc_import(ImportId) ) then MaybeInstr = ok(pzi_call(Callee)) else MaybeInstr = return_error(Context, e_symbol_not_found(QName)) ) ; PInstr = pzti_tcall(QName), ( if search(Info ^ ai_symbols, QName, Entry), ( Entry = pzii_proc(PID), Callee = pzc_proc_opt(PID) ; Entry = pzii_closure(CID), Callee = pzc_closure(CID) ) then MaybeInstr = ok(pzi_tcall(Callee)) else MaybeInstr = return_error(Context, e_symbol_not_found(QName)) ) ; ( PInstr = pzti_roll(Depth) ; PInstr = pzti_pick(Depth) ), ( Depth =< 255 -> ( PInstr = pzti_roll(_), Instr = pzi_roll(Depth) ; PInstr = pzti_pick(_), Instr = pzi_pick(Depth) ), MaybeInstr = ok(Instr) ; MaybeInstr = return_error(Context, e_stack_depth) ) ; ( PInstr = pzti_alloc(Name) ; PInstr = pzti_load(Name, _) ; PInstr = pzti_store(Name, _) ), ( if search(Info ^ ai_structs, Name, StructId) then ( PInstr = pzti_alloc(_), MaybeInstr = ok(pzi_alloc(StructId)) ; PInstr = pzti_load(_, Field), % TODO: Use the width from the structure and don't allow a % custom one. MaybeInstr = ok(pzi_load(StructId, Field, Width1)) ; PInstr = pzti_store(_, Field), MaybeInstr = ok(pzi_store(StructId, Field, Width1)) ) else MaybeInstr = return_error(Context, e_struct_not_found(Name)) ) ; PInstr = pzti_make_closure(QName), ( if search(Info ^ ai_symbols, QName, Entry), Entry = pzii_proc(PID) then MaybeInstr = ok(pzi_make_closure(PID)) else MaybeInstr = return_error(Context, e_symbol_not_found(QName)) ) ). % Identifiers that are builtin instructions. % :- pred builtin_instr(string::in, pz_width::in, pz_width::in, pz_instr::out) is semidet. builtin_instr("ze", W1, W2, pzi_ze(W1, W2)). builtin_instr("se", W1, W2, pzi_se(W1, W2)). builtin_instr("trunc", W1, W2, pzi_trunc(W1, W2)). builtin_instr("add", W1, _, pzi_add(W1)). builtin_instr("sub", W1, _, pzi_sub(W1)). builtin_instr("mul", W1, _, pzi_mul(W1)). builtin_instr("div", W1, _, pzi_div(W1)). builtin_instr("and", W1, _, pzi_and(W1)). builtin_instr("or", W1, _, pzi_or(W1)). builtin_instr("xor", W1, _, pzi_xor(W1)). builtin_instr("dup", _, _, pzi_dup). builtin_instr("drop", _, _, pzi_drop). builtin_instr("swap", _, _, pzi_swap). builtin_instr("lt_u", W1, _, pzi_lt_u(W1)). builtin_instr("lt_s", W1, _, pzi_lt_s(W1)). builtin_instr("gt_u", W1, _, pzi_gt_u(W1)). builtin_instr("gt_s", W1, _, pzi_gt_s(W1)). builtin_instr("eq", W1, _, pzi_eq(W1)). builtin_instr("not", W1, _, pzi_not(W1)). builtin_instr("ret", _, _, pzi_ret). builtin_instr("call_ind", _, _, pzi_call_ind). builtin_instr("tcall_ind", _, _, pzi_tcall_ind). builtin_instr("get_env", _, _, pzi_get_env). %-----------------------------------------------------------------------% :- func build_data_type(map(string, pzs_id), asm_data_type, list(T)) = pz_data_type. build_data_type(_, asm_dtype_array(Width), Values) = type_array(Width, length(Values)). build_data_type(Map, asm_dtype_struct(Name), _) = type_struct(ID) :- ( if map.search(Map, Name, IDPrime) then ID = IDPrime else compile_error($file, $pred, format("Unknown data type: '%s'", [s(Name)])) ). build_data_type(_, asm_dtype_string, Values) = type_string(length(Values)). :- func build_data_value(bimap(q_name, pz_item_id), asm_data_value) = pz_data_value. build_data_value(_, asm_dvalue_num(Num)) = pzv_num(Num). build_data_value(Map, asm_dvalue_name(Name)) = Value :- ( if search(Map, Name, ID) then ( ID = pzii_proc(_), compile_error($file, $pred, "Can't store proc references in data yet") ; ID = pzii_data(DID), Value = pzv_data(DID) ; ID = pzii_closure(CID), Value = pzv_closure(CID) ; ID = pzii_import(IID), Value = pzv_import(IID) ) else compile_error($file, $pred, format("Unknown data name: '%s'", [s(q_name_to_string(Name))])) ). :- func build_closure(bimap(q_name, pz_item_id), string, string) = pz_closure. build_closure(Map, ProcName, DataName) = Closure :- ( if search(Map, q_name_single(ProcName), ProcEntry), ProcEntry = pzii_proc(ProcPrime) then Proc = ProcPrime else compile_error($file, $pred, format("Unknown procedure name: '%s'", [s(ProcName)])) ), ( if search(Map, q_name_single(DataName), DataEntry), DataEntry = pzii_data(DataPrime) then Data = DataPrime else compile_error($file, $pred, format("Unknown data name: '%s'", [s(DataName)])) ), Closure = pz_closure(Proc, Data). %-----------------------------------------------------------------------% :- type pz_item_id ---> pzii_proc(pzp_id) ; pzii_data(pzd_id) ; pzii_closure(pzc_id) ; pzii_import(pzi_id). :- func item_expect_proc(string, string, pz_item_id) = pzp_id. item_expect_proc(File, Pred, ID) = ( if ID = pzii_proc(Proc) then Proc else unexpected(File, Pred, "Expected proc") ). :- func item_expect_data(string, string, pz_item_id) = pzd_id. item_expect_data(File, Pred, ID) = ( if ID = pzii_data(Data) then Data else unexpected(File, Pred, "Expected data") ). :- func item_expect_closure(string, string, pz_item_id) = pzc_id. item_expect_closure(File, Pred, ID) = ( if ID = pzii_closure(Closure) then Closure else unexpected(File, Pred, "Expected closure") ). %-----------------------------------------------------------------------% %-----------------------------------------------------------------------% ================================================ FILE: src/asm_ast.m ================================================ %-----------------------------------------------------------------------% % vim: ts=4 sw=4 et %-----------------------------------------------------------------------% :- module asm_ast. % % AST for PZ Textual representation. % % Copyright (C) Plasma Team % Distributed under the terms of the MIT License see ../LICENSE.code % %-----------------------------------------------------------------------% :- interface. :- import_module list. :- import_module common_types. :- import_module context. :- import_module pz. :- import_module pz.code. :- import_module q_name. %-----------------------------------------------------------------------% :- type asm ---> asm( asm_module :: q_name, asm_filename :: string, asm_items :: asm_items ). :- type asm_items == list(asm_item). % Everything is defined at the same "global entry" level in the same % namespace: a procedure and some static data cannot have the same name. % When that name is used we can decide what to do depending on the entry % type. % % Visibility rules will be added later. % :- type asm_item ---> asm_item( asmi_name :: q_name, asmi_context :: context, asmi_type :: entry_type ) ; asm_entrypoint( asme_context :: context, asme_name :: q_name ). % There are currently two entry types. % :- type entry_type % A procedure ---> asm_proc( asmp_sig :: pz_signature, asmp_blocks :: list(pzt_block) ) % A procedure import ; asm_import( asmpd_sig :: pz_signature ) % A structure ; asm_struct( asms_fields :: list(pz_width) ) % Global data ; asm_data( asmd_type :: asm_data_type, asmd_value :: list(asm_data_value) ) ; asm_closure( asmc_proc :: string, asmc_data :: string, asmc_sharing :: sharing ). :- type asm_data_type ---> asm_dtype_array(pz_width) % Note that this is a string and it is not possible to refer to % structs in other modules. ; asm_dtype_struct(string) ; asm_dtype_string. :- type asm_data_value ---> asm_dvalue_num(int) ; asm_dvalue_name(q_name). %-----------------------------------------------------------------------% % % Procedures % :- type pzt_block ---> pzt_block( pztb_name :: string, pztb_instrs :: list(pzt_instruction), pztb_context :: context ). :- type pzt_instruction ---> pzt_instruction( pzti_instr :: pzt_instruction_code, pzti_widths :: pzt_instruction_widths, pzti_context :: context ). % Instructions such as "add" although not really implemented as calls in % the runtime, look like calls in this structure. They use pzti_word. % Instructions that require special handling by the parser are handled % specifically. % :- type pzt_instruction_code ---> pzti_word(string) % Call instructions are handled specifically because it'll be % easier when we introduce tail calls. ; pzti_call(q_name) ; pzti_tcall(q_name) % These instructions are handled specifically because the have % immediate values. ; pzti_load_immediate(int) ; pzti_jmp(string) ; pzti_cjmp(string) ; pzti_roll(int) ; pzti_pick(int) ; pzti_alloc(string) ; pzti_make_closure(q_name) ; pzti_load(string, field_num) ; pzti_store(string, field_num). :- type pzt_instruction_widths ---> no ; one_width(pz_width) ; two_widths(pz_width, pz_width). %-----------------------------------------------------------------------% %-----------------------------------------------------------------------% :- implementation. %-----------------------------------------------------------------------% %-----------------------------------------------------------------------% ================================================ FILE: src/asm_error.m ================================================ %-----------------------------------------------------------------------% % vim: ts=4 sw=4 et %-----------------------------------------------------------------------% :- module asm_error. % % Copyright (C) Plasma Team % Distributed under the terms of the MIT License see ../LICENSE.code % % Error type for the PZ assembler. % %-----------------------------------------------------------------------% :- interface. :- import_module parse_util. :- import_module q_name. :- import_module util. :- import_module util.result. %-----------------------------------------------------------------------% :- type asm_error ---> e_read_src_error(read_src_error) ; e_name_already_defined(string) ; e_no_such_instruction(string) ; e_symbol_not_found(q_name) ; e_block_not_found(string) ; e_struct_not_found(string) ; e_import_not_found(q_name) ; e_stack_depth. :- instance error(asm_error). %-----------------------------------------------------------------------% %-----------------------------------------------------------------------% :- implementation. :- import_module list. :- import_module string. :- import_module util.pretty. %-----------------------------------------------------------------------% :- instance error(asm_error) where [ pred(pretty/4) is asme_pretty, func(error_or_warning/1) is asme_error_or_warning ]. :- pred asme_pretty(string::in, asm_error::in, list(pretty)::out, list(pretty)::out) is det. asme_pretty(SrcPath, Error, Para, Extra) :- ( Error = e_read_src_error(ReadSrcError), pretty(SrcPath, ReadSrcError, Para, Extra) ; ( Error = e_name_already_defined(Name), Para = [p_quote("\"", p_str(Name))] ++ p_spc_nl ++ p_words("is already defined") ; Error = e_no_such_instruction(Name), Para = [p_quote("\"", p_str(Name))] ++ p_spc_nl ++ p_words("is not a PZ instruction") ; Error = e_symbol_not_found(Symbol), Para = p_words("The symbol") ++ p_spc_nl ++ [p_quote("\"", q_name_pretty(Symbol))] ++ p_spc_nl ++ p_words("is undefined") ; Error = e_block_not_found(Name), Para = p_words("The block") ++ p_spc_nl ++ [p_quote("\"", p_str(Name))] ++ p_spc_nl ++ p_words("is undefined") ; Error = e_struct_not_found(Name), Para = p_words("The structure") ++ p_spc_nl ++ [p_quote("\"", p_str(Name))] ++ p_spc_nl ++ p_words("is undefined") ; Error = e_stack_depth, Para = p_words("Stack operations have a maximum depth of 255") ; Error = e_import_not_found(Symbol), Para = p_words("The symbol") ++ p_spc_nl ++ [p_quote("\"", q_name_pretty(Symbol))] ++ p_spc_nl ++ p_words("cannot be found or is not an imported procedure") ), Extra = [] ). :- func asme_error_or_warning(asm_error) = error_or_warning. asme_error_or_warning(_) = error. %-----------------------------------------------------------------------% %-----------------------------------------------------------------------% ================================================ FILE: src/ast.m ================================================ %-----------------------------------------------------------------------% % Plasma AST % vim: ts=4 sw=4 et % % Copyright (C) Plasma Team % Distributed under the terms of the MIT License see ../LICENSE.code % % This module represents the AST for plasma programs. % %-----------------------------------------------------------------------% :- module ast. %-----------------------------------------------------------------------% :- interface. :- import_module list. :- import_module maybe. :- import_module common_types. :- import_module context. :- import_module q_name. :- import_module varmap. :- type ast == ast(ast_entry). :- type ast(E) ---> ast( a_module_name :: q_name, % Context of module declaration. a_context :: context, a_entries :: list(E) ). % AST for include files. :- type ast_interface == ast(ast_interface_entry). % AST for typeres files. :- type ast_typeres == ast(ast_typeres_entry). :- type ast_entry ---> ast_import(ast_import) ; ast_type(nq_name, ast_type(nq_name)) ; ast_resource(nq_name, ast_resource) ; ast_function(nq_name, ast_function) ; ast_pragma(ast_pragma). :- type ast_interface_entry ---> asti_resource( q_name, % Opaque resources won't have a definition. maybe(ast_resource) ) ; asti_type(q_name, ast_type(q_name)) ; asti_function(q_name, ast_function_decl). :- type ast_typeres_entry ---> asti_resource_abs(q_name) ; asti_type_abs(q_name, arity). :- type ast_import ---> ast_import( ai_name :: q_name, ai_as :: maybe(string), ai_context :: context ). :- type ast_type(Name) ---> ast_type( at_params :: list(string), at_costructors :: list(at_constructor(Name)), at_export :: sharing_opaque, at_context :: context ) % An abstractly-imported type. % This module has no knowledge of the constructors and % these are always st_private. ; ast_type_abstract( ata_arity :: arity, ata_context :: context ). :- type ast_resource ---> ast_resource( ar_from :: q_name, ar_sharing :: sharing_opaque, ar_context :: context ). :- type ast_function_decl ---> ast_function_decl( afd_params :: list(ast_param), afd_return :: list(ast_type_expr), afd_uses :: list(ast_uses), afd_context :: context ). :- type ast_function ---> ast_function( af_decl :: ast_function_decl, af_body :: ast_body, af_export :: sharing, af_is_entrypoint :: is_entrypoint ). :- type ast_body ---> ast_body_block( list(ast_block_thing) ) ; ast_body_foreign( abf_foreign_sym :: string ). :- type ast_block_thing(Info) ---> astbt_statement(ast_statement(Info)) ; astbt_function(nq_name, ast_nested_function). :- type ast_block_thing == ast_block_thing(context). :- type ast_nested_function ---> ast_nested_function( anf_decl :: ast_function_decl, anf_body :: list(ast_block_thing) ). % % Modules, imports and exports. % :- type export_some_or_all ---> export_some(list(string)) ; export_all. % % Types % :- type at_constructor(Name) ---> at_constructor( atc_name :: Name, atc_args :: list(at_field), atc_context :: context ). :- type at_field ---> at_field( atf_name :: string, atf_type :: ast_type_expr, atf_context :: context ). :- type ast_type_expr ---> ast_type( ate_name :: q_name, ate_args :: list(ast_type_expr), ate_context :: context ) ; ast_type_func( atf_args :: list(ast_type_expr), atf_returns :: list(ast_type_expr), atf_uses :: list(ast_uses), atf_context_ :: context ) ; ast_type_var( atv_name :: string, atv_context :: context ). % % Code signatures % :- type ast_param ---> ast_param( ap_name :: var_or_wildcard(string), ap_type :: ast_type_expr ). :- type ast_uses ---> ast_uses( au_uses_type :: uses_type, au_name :: q_name ). :- type uses_type ---> ut_uses ; ut_observes. % % Code % :- type ast_statement(Info) ---> ast_statement( ast_stmt_type :: ast_stmt_type(Info), ast_stmt_info :: Info ). :- type ast_statement == ast_statement(context). :- type ast_stmt_type(Info) % A statement that looks like a call must be a call, it cannot % be a construction as that would have no effect. ---> s_call(ast_call_like) ; s_assign_statement( as_ast_vars :: list(ast_pattern), as_expr :: list(ast_expression) ) ; s_array_set_statement( sas_array :: string, sas_subscript :: ast_expression, sas_rhs :: ast_expression ) ; s_return_statement(list(ast_expression)) ; s_var_statement( vs_vars :: string ) ; s_match_statement( sms_expr :: ast_expression, sms_cases :: list(ast_match_case(Info)) ) ; s_ite( psi_cond :: ast_expression, psi_then :: list(ast_block_thing(Info)), psi_else :: list(ast_block_thing(Info)) ). :- type ast_match_case(Info) ---> ast_match_case( c_pattern :: ast_pattern, c_stmts :: list(ast_block_thing(Info)) ). :- type ast_match_case == ast_match_case(context). :- type ast_expression ---> e_call_like( ec_call_like :: ast_call_like ) ; e_u_op( euo_op :: ast_uop, euo_expr :: ast_expression ) ; e_b_op( ebo_expr_left :: ast_expression, ebo_op :: ast_bop, ebo_expr_right :: ast_expression ) ; e_match( em_expr :: ast_expression, em_cases :: list(ast_expr_match_case) ) ; e_if( eif_cond :: ast_expression, eif_then :: list(ast_expression), eif_else :: list(ast_expression) ) ; e_symbol( es_name :: q_name ) ; e_const( ec_value :: ast_const ) ; e_array( ea_values :: list(ast_expression) ). :- type ast_uop ---> u_minus ; u_not. :- type ast_bop ---> b_add ; b_sub ; b_mul ; b_div ; b_mod ; b_lt ; b_gt ; b_lteq ; b_gteq ; b_eq ; b_neq ; b_logical_and ; b_logical_or ; b_concat ; b_list_cons ; b_array_subscript. :- type ast_expr_match_case ---> ast_emc(ast_pattern, list(ast_expression)). :- type ast_const ---> c_number(int) ; c_string(string) ; c_list_nil. % A call or call-like thing (such as a construction). % :- type ast_call_like ---> ast_call_like( ec_callee :: ast_expression, ec_args :: list(ast_expression) ) ; ast_bang_call( ebc_callee :: ast_expression, ebc_args :: list(ast_expression) ). :- type ast_pattern ---> p_constr(q_name, list(ast_pattern)) ; p_number(int) ; p_wildcard ; p_var(string) % A declaration of a new variable ; p_symbol(q_name) % The binding of a new variable or a % constructor with zero args. ; p_list_nil ; p_list_cons(ast_pattern, ast_pattern). :- type ast_pragma ---> ast_pragma( astp_name :: string, astp_args :: list(ast_pragma_arg), astp_context :: context ). :- type ast_pragma_arg ---> ast_pragma_arg(string). %-----------------------------------------------------------------------% :- func type_arity(ast_type(T)) = arity. %-----------------------------------------------------------------------% %-----------------------------------------------------------------------% :- implementation. %-----------------------------------------------------------------------% type_arity(ast_type(Params, _, _, _)) = arity(length(Params)). type_arity(ast_type_abstract(Arity, _)) = Arity. %-----------------------------------------------------------------------% %-----------------------------------------------------------------------% ================================================ FILE: src/build.m ================================================ %-----------------------------------------------------------------------% % Plasma builder % vim: ts=4 sw=4 et % % Copyright (C) Plasma Team % Distributed under the terms of the MIT License see ../LICENSE.code % % This program starts the build process for Plasma projects % %-----------------------------------------------------------------------% :- module build. %-----------------------------------------------------------------------% :- interface. :- import_module io. :- import_module list. :- import_module string. :- import_module q_name. :- import_module util. :- import_module util.result. :- type plzbuild_options ---> plzbuild_options( pzb_targets :: list(nq_name), pzb_verbose :: verbose, pzb_rebuild :: rebuild, pzb_build_file :: string, pzb_build_dir :: string, pzb_report_timing :: report_timing, % Path to the plasma tools pzb_tools_path :: string, % Path to the source code pzb_source_path :: string ). :- type verbose ---> verbose ; terse. :- type rebuild ---> need_rebuild ; dont_rebuild. :- type report_timing ---> report_timing ; dont_report_timing. % build(Target, Verbose, Rebuild, !IO) % :- pred build(plzbuild_options::in, errors(string)::out, io::di, io::uo) is det. %-----------------------------------------------------------------------% %-----------------------------------------------------------------------% :- implementation. :- import_module assoc_list. :- import_module bool. :- import_module cord. :- import_module float. :- import_module map. :- import_module maybe. :- import_module pair. :- import_module require. :- import_module set. :- import_module time. :- import_module toml. :- import_module constant. :- import_module context. :- import_module file_utils. :- import_module util.my_exception. :- import_module util.my_io. :- import_module util.mercury. :- import_module util.path. %-----------------------------------------------------------------------% build(Options, Result, !IO) :- BuildDir = Options ^ pzb_build_dir, % This code would make an interesting concurrency example. There's: % + Several calls to fsstat() and readdir() that can occur independent % of anything else. % + Reading the project file % + 2 independent computations (each is dependent on the project file's % contents), but may be skipped if files are up to date. % + mkdir and writing 3 files that depend on various other steps. % But ideally they're not broken down that finely as is common with % Promises, instead some of them may be threads because their control % flow makes sense that way. some [!Errors] ( !:Errors = init, file_modification_time(Options ^ pzb_tools_path ++ "/plzbuild", PlzBuildMTime, !IO), read_project(Options ^ pzb_build_file, ProjRes, ProjFileMTime, !IO), ( ProjRes = ok(_) ; ProjRes = errors(ReadProjErrors), add_errors(ReadProjErrors, !Errors) ), ( ProjRes = ok(Proj), build_dependency_info(Proj, DepInfoRes, init, _, !IO), ( DepInfoRes = ok(DepInfo), setup_build_dir(Options, PlzBuildMTime, SetupDirRes, !IO), ( SetupDirRes = ok ; SetupDirRes = error(SetupDirError), add_error(context(Options ^ pzb_build_dir), SetupDirError, !Errors) ), % For now we have no detection of when the vars file % changes, we updated it every time. write_vars_file(Options, WriteVarsRes, !IO), ( WriteVarsRes = ok ; WriteVarsRes = error(WriteVarsError), add_error( context(BuildDir ++ "/" ++ ninja_vars_file), WriteVarsError, !Errors) ), ProjMTime = latest(ProjFileMTime, PlzBuildMTime), maybe_write_dependency_file(Options, ProjMTime, DepInfo, WriteDepsRes, !IO), ( WriteDepsRes = ok ; WriteDepsRes = error(WriteNinjaBuildError), add_error(context(BuildDir ++ "/" ++ ninja_build_file), WriteNinjaBuildError, !Errors) ), ImportWhitelist = compute_import_whitelist(Proj), maybe_write_import_whitelist(Options, ProjMTime, ImportWhitelist, WhitelistRes, !IO), ( WhitelistRes = ok ; WhitelistRes = error(WriteWhitelistError), add_error(nil_context, WriteWhitelistError, !Errors) ), ( if is_empty(!.Errors) then invoke_ninja(Options, Proj, Result0, !IO), ( Result0 = ok ; Result0 = error(Error), add_error(nil_context, Error, !Errors) ) else true ) ; DepInfoRes = errors(DepInfoErrors), add_errors(DepInfoErrors, !Errors) ) ; ProjRes = errors(_) ), Result = !.Errors ). %-----------------------------------------------------------------------% :- type target ---> target( % The base name for the file of the compiled code t_name :: nq_name, % The modules that make up the program t_modules :: list(q_name), t_modules_context :: context, t_pcflags :: maybe(string), t_c_sources :: list(string), t_c_sources_context :: context ). :- pred read_project(string::in, result(list(target), string)::out, time_t::out, io::di, io::uo) is det. read_project(BuildFile, Result, MTime, !IO) :- file_modification_time(BuildFile, MTime, !IO), io.open_input(BuildFile, OpenRes, !IO), ( OpenRes = ok(File), parse_toml(File, BuildFile, TOMLRes, !IO), close_input(File, !IO), ( TOMLRes = ok(TOML), Result0 = result_list_to_result(map(make_target(TOML), keys(TOML))), ( Result0 = ok(MaybeTargets), Result = ok(filter_map(func(yes(X)) = X is semidet, MaybeTargets)) ; Result0 = errors(Errors), Result = errors(Errors) ) ; TOMLRes = errors(Errors), Result = errors(Errors) ) ; OpenRes = error(Error), Result = return_error(context(BuildFile), error_message(Error)) ). :- func make_target(toml, string) = result(maybe(target), string). make_target(TOML, TargetStr) = Result :- lookup(TOML, TargetStr, TargetVal - TargetContext), ( if TargetVal = tv_table(Target), search(Target, "type", tv_string("program") - _) then TargetResult = nq_name_from_string(TargetStr), ( TargetResult = ok(TargetName), ModulesResult = search_toml_q_names( not_found_error(TargetContext, "modules"), Target, "modules"), CSourcesResult = search_toml_filenames( toml_search_default([], TargetContext), Target, "c_sources"), CompilerOptsResult = search_toml_maybe_string(Target, "compiler_opts"), ( ModulesResult = ok(Modules - ModulesContext), CSourcesResult = ok(CSources - CSourcesContext), CompilerOptsResult = ok(CompilerOpts - _), ( if find_duplicates(Modules, DupModules), not is_empty(DupModules) then DupModulesStrings = map(func(M) = "'" ++ q_name_to_string(M) ++ "'", to_sorted_list(DupModules)), Result = return_error(TargetContext, format( "The following modules were listed more than once: %s", [s(string_join(", ", DupModulesStrings))])) else Result = ok(yes(target(TargetName, Modules, ModulesContext, CompilerOpts, CSources, CSourcesContext))) ) ; ModulesResult = ok(_), CSourcesResult = ok(_), CompilerOptsResult = errors(Errors), Result = errors(Errors) ; ModulesResult = ok(_), CSourcesResult = errors(Errors), Result = errors(Errors) ; ModulesResult = errors(Errors), Result = errors(Errors) ) ; TargetResult = error(_), Result = return_error(TargetContext, format("Invalid name '%s'", [s(TargetStr)])) ) else Result = ok(no) ). %-----------------------------------------------------------------------% :- type search_result(T) == result(pair(T, context), string). % search_toml_q_names(NotFoundResult, WrapError, Toml, Key) = Result % % Search the toml for the given key, if not found return an error at % Context, if found try to parse it as a list of q_names. WrapError % lets the caller explain the context of the error. % :- func search_toml_q_names(search_result(list(q_name)), toml, toml_key) = search_result(list(q_name)). search_toml_q_names(NotFoundResult, TOML, Key) = search_toml_array(NotFoundResult, q_name_from_dotted_string, TOML, Key). % search_toml_q_names(NotFoundResult, WrapError, Toml, Key) = Result % :- func search_toml_filenames(search_result(list(string)), toml, toml_key) = search_result(list(string)). search_toml_filenames(NotFoundResult, TOML, Key) = search_toml_array(NotFoundResult, func(X) = ok(X), TOML, Key). :- func search_toml_array(search_result(list(T)), func(string) = maybe_error(T), toml, toml_key) = search_result(list(T)). search_toml_array(NotFoundResult, MakeResult, TOML, Key) = Result :- ( if search(TOML, Key, Value - Context) then ( if Value = tv_array(Values) then Result0 = result_list_to_result(map( (func(TV) = R :- ( if TV = tv_string(S) then R0 = MakeResult(S), ( R0 = ok(N), R = ok(N) ; R0 = error(Why), R = return_error(Context, field_error(Key, format("'%s' %s", [s(S), s(Why)]))) ) else R = return_error(Context, "Name in array is a string") ) ), Values)), ( Result0 = ok(List), Result = ok(List - Context) ; Result0 = errors(Errors), Result = errors(Errors) ) else Result = return_error(Context, field_error(Key, "Value is not an array")) ) else Result = NotFoundResult ). :- func search_toml_maybe_string(toml, toml_key) = search_result(maybe(string)). search_toml_maybe_string(TOML, Key) = Result :- ( if search(TOML, Key, Value - Context) then ( if Value = tv_string(String) then Result = ok(yes(String) - Context) else Result = return_error(Context, field_error(Key, "Value is not a string")) ) else Result = ok(no - nil_context) ). :- func field_error(string, string) = string. field_error(Field, Msg) = format("Invalid %s field: %s", [s(Field), s(Msg)]). :- func not_found_error(context, toml_key) = search_result(T). not_found_error(Context, Key) = return_error(Context, format("Key not found '%s'", [s(Key)])). :- func toml_search_default(T, context) = search_result(T). toml_search_default(X, C) = ok(X - C). %-----------------------------------------------------------------------% :- type dep_info == list(dep_target). :- type dep_target ---> dt_program( dtp_name :: nq_name, dtp_output :: string, dtp_inputs :: list(string) ) ; dt_object( dto_name :: q_name, dto_output :: string, dto_input :: string, dto_depfile :: string, dto_flags :: string ) ; dt_interface( dti_name :: q_name, dti_output :: string, dti_input :: string, dti_depfile :: string ) ; dt_typeres( dttr_name :: q_name, dttr_output :: string, dttr_input :: string ) ; dt_scan( dts_name :: q_name, dts_dep_file :: string, dts_source :: string, dts_interface :: string, dts_bytecode :: string ) ; dt_foreign_hooks( dtcg_name :: q_name, dtcg_output_code :: string, dtcg_output_header :: string, dtcg_input :: string ) % Generate an init file for the FFI from the info files. ; dt_gen_init( dtgi_name :: nq_name, dtgi_output :: string, dtgi_modules :: list(q_name) ) ; dt_c_link( dtcl_name :: nq_name, dtcl_output :: string, dtcl_input :: list(string) ) ; dt_c_compile( dtcc_output :: string, dtcc_input :: string, dtcc_headers :: list(string), dtcc_generated :: generated ). :- type generated ---> was_generated ; hand_written. :- pred build_dependency_info(list(target)::in, result(dep_info, string)::out, dir_info::in, dir_info::out, io::di, io::uo) is det. build_dependency_info(Targets, MaybeDeps, !DirInfo, !IO) :- MaybeModules0 = make_module_info(Targets), ( MaybeModules0 = ok(Modules0), % The term Target is overloaded here, it means both the whole things % that plzbuild is trying to build, but also the steps that ninja does % to build them. map_foldl2(find_module_file, Modules0, MaybeModules1, !DirInfo, !IO), MaybeModules = result_list_to_result(MaybeModules1), find_foreign_sources(Targets, MaybeForeignSources, !DirInfo, !IO), ( MaybeModules = ok(Modules), MaybeForeignSources = ok(ForeignSources0), ForeignSources = sort_and_remove_dups(ForeignSources0), ModuleTargets = map(make_module_targets, Modules), ProgramTargets = map(make_program_target, Targets), ForeignLinkTargetsRes = result_list_to_result( map(make_foreign_link_targets, Targets)), ( ForeignLinkTargetsRes = ok(ForeignLinkTargets0), ForeignCompileTargets = map(make_foreign_target, ForeignSources), ForeignLinkTargets = condense(ForeignLinkTargets0), MaybeDeps = ok(condense(ModuleTargets) ++ ForeignCompileTargets ++ ForeignLinkTargets ++ ProgramTargets) ; ForeignLinkTargetsRes = errors(Errors), MaybeDeps = errors(Errors) ) ; MaybeModules = ok(_), MaybeForeignSources = errors(Errors), MaybeDeps = errors(Errors) ; MaybeModules = errors(Errors), MaybeForeignSources = ok(_), MaybeDeps = errors(Errors) ; MaybeModules = errors(ErrorsA), MaybeForeignSources = errors(ErrorsB), MaybeDeps = errors(ErrorsA ++ ErrorsB) ) ; MaybeModules0 = errors(Errors), MaybeDeps = errors(Errors) ). :- type module_info ---> module_info( mi_name :: q_name, mi_context :: context, mi_file :: string, mi_pcflags :: string ). :- func make_module_info(list(target)) = result(list(module_info), string). make_module_info(Targets) = Modules :- Modules0 = condense(map(target_get_modules, Targets)), foldl_result(resolve_duplicate_modules, Modules0, init, MaybeModules1), ( MaybeModules1 = ok(Modules1), Modules = ok(map.values(Modules1)) ; MaybeModules1 = errors(Error), Modules = errors(Error) ). :- func target_get_modules(target) = list(module_info). target_get_modules(Target) = Modules :- Context = Target ^ t_modules_context, PCFlags = maybe_default("", Target ^ t_pcflags), Modules = map(func(N) = module_info(N, Context, "", PCFlags), Target ^ t_modules). :- pred resolve_duplicate_modules(module_info::in, map(q_name, module_info)::in, result(map(q_name, module_info), string)::out) is det. resolve_duplicate_modules(Module, !Map) :- Name = Module ^ mi_name, map_set_or_update_result(func(M) = module_merge(M, Module), Name, Module, !Map). :- func module_merge(module_info, module_info) = result(module_info, string). module_merge(Ma, Mb) = ( if Ma ^ mi_pcflags = Mb ^ mi_pcflags then ok(module_info(Ma ^ mi_name, context_earliest(Ma ^ mi_context, Mb ^ mi_context), Ma ^ mi_file, Ma ^ mi_pcflags)) else return_error(context_earliest(Ma ^ mi_context, Mb ^ mi_context), "Flags set for the same module in different programs do not match") ). :- pred find_module_file(module_info::in, result(module_info, string)::out, dir_info::in, dir_info::out, io::di, io::uo) is det. find_module_file(Module, ModuleResult, !DirInfo, !IO) :- find_module_file(".", source_extension, Module ^ mi_name, FileRes, !DirInfo, !IO), ( FileRes = yes(File), ModuleResult = ok(Module ^ mi_file := File) ; FileRes = no, ModuleResult = return_error(Module ^ mi_context, format("Can't find source for %s module", [s(q_name_to_string(Module ^ mi_name))])) ; FileRes = error(Path, Message), ModuleResult = return_error(context(Path), Message) ). :- pred find_foreign_sources(list(target)::in, result(list(string), string)::out, dir_info::in, dir_info::out, io::di, io::uo) is det. find_foreign_sources(Targets, Result, !DirInfo, !IO) :- SourcesList = condense(map((func(T) = T ^ t_c_sources), Targets)), % We don't do any filesystem checking, but might in the future. Result = ok(SourcesList). :- func make_program_target(target) = dep_target. make_program_target(Target) = DepTarget :- FileName = nq_name_to_string(Target ^ t_name) ++ library_extension, ObjectNames = map(func(M) = canonical_base_name(M) ++ output_extension, Target ^ t_modules), DepTarget = dt_program(Target ^ t_name, FileName, ObjectNames). :- func make_module_targets(module_info) = list(dep_target). make_module_targets(ModuleInfo) = Targets :- module_info(ModuleName, _, SourceName, PCFlags) = ModuleInfo, BaseName = canonical_base_name(ModuleName), TyperesName = BaseName ++ typeres_extension, InterfaceName = BaseName ++ interface_extension, ObjectName = BaseName ++ output_extension, DepFile = BaseName ++ depends_extension, Targets = [ dt_scan(ModuleName, DepFile, SourceName, InterfaceName, ObjectName), dt_interface(ModuleName, InterfaceName, SourceName, DepFile), dt_object(ModuleName, ObjectName, SourceName, DepFile, PCFlags), dt_typeres(ModuleName, TyperesName, SourceName), dt_foreign_hooks(ModuleName, module_to_foreign_hooks_code(ModuleName), module_to_foreign_hooks_header(ModuleName), SourceName), dt_c_compile( module_to_foreign_object(ModuleName), module_to_foreign_hooks_code(ModuleName), [module_to_foreign_hooks_header(ModuleName)], was_generated) ]. :- func make_foreign_link_targets(target) = result(list(dep_target), string). make_foreign_link_targets(Target) = DepsResult :- ForeignSources = Target ^ t_c_sources, Modules = Target ^ t_modules, ( ForeignSources = [], DepsResult = ok([]) ; ForeignSources = [_ | _], Output = make_c_library_name(Target), map((pred(In::in, Out::out) is det :- ( if file_change_extension(cpp_extension, native_object_extension, In, Out0) then Out = ok(Out0) else Out = error(In) ) ), ForeignSources, ForeignObjectsResults), ForeignObjectsResult = maybe_error_list(ForeignObjectsResults), ( ForeignObjectsResult = ok(ForeignObjects), ModuleForeignObjects = map(module_to_foreign_object, Modules), InitBaseName = nq_name_to_string(Target ^ t_name) ++ "_init", InitSourceName = InitBaseName ++ cpp_extension, InitObjectName = InitBaseName ++ native_object_extension, InitTargetSource = dt_gen_init(Target ^ t_name, InitSourceName, Modules), InitTargetObject = dt_c_compile(InitObjectName, InitSourceName, map(module_to_foreign_hooks_header, Modules), was_generated), LinkTarget = dt_c_link(Target ^ t_name, Output, ForeignObjects ++ ModuleForeignObjects ++ [InitObjectName]), DepsResult = ok([InitTargetSource, InitTargetObject, LinkTarget]) ; ForeignObjectsResult = error(Errors), DepsResult = return_error( Target ^ t_c_sources_context, format("Unrecognised extensions on these files: %s", [s(join_list(", ", Errors))])) ) ). :- func make_c_library_name(target) = string. make_c_library_name(Target) = nq_name_to_string(Target ^ t_name) ++ native_dylib_extension. :- func make_foreign_target(string) = dep_target. make_foreign_target(CFileName) = Target :- ( if file_change_extension(cpp_extension, native_object_extension, CFileName, ObjectName) then Target = dt_c_compile(ObjectName, CFileName, [], hand_written) else compile_error($file, $pred, "Unrecognised source file extension") ). :- func module_to_foreign_hooks_code(q_name) = string. module_to_foreign_hooks_code(Module) = module_to_foreign_hooks_base(Module) ++ cpp_extension. :- func module_to_foreign_hooks_header(q_name) = string. module_to_foreign_hooks_header(Module) = module_to_foreign_hooks_base(Module) ++ c_header_extension. :- func module_to_foreign_hooks_base(q_name) = string. module_to_foreign_hooks_base(Module) = canonical_base_name(Module) ++ "_f". :- func module_to_foreign_object(q_name) = string. module_to_foreign_object(Module) = canonical_base_name(Module) ++ "_f" ++ native_object_extension. %-----------------------------------------------------------------------% % Write the dependency file if it the build file is newer. % :- pred maybe_write_dependency_file(plzbuild_options::in, time_t::in, dep_info::in, maybe_error::out, io::di, io::uo) is det. maybe_write_dependency_file(Options, ProjMTime, DepInfo, Result, !IO) :- update_if_stale(Options ^ pzb_verbose, ProjMTime, Options ^ pzb_build_dir ++ "/" ++ ninja_build_file, write_dependency_file(Options, DepInfo), Result, !IO). :- pred write_dependency_file(plzbuild_options::in, dep_info::in, maybe_error::out, io::di, io::uo) is det. write_dependency_file(Options, DepInfo, Result, !IO) :- write_file(Options ^ pzb_verbose, Options ^ pzb_build_dir ++ "/" ++ ninja_build_file, do_write_dependency_file(DepInfo), Result, !IO). :- pred do_write_dependency_file(dep_info::in, output_stream::in, io::di, io::uo) is det. do_write_dependency_file(DepInfo, BuildFile, !IO) :- write_string(BuildFile, "# Auto-generated by plzbuild\n", !IO), format(BuildFile, "include %s\n", [s(ninja_rules_file)], !IO), format(BuildFile, "include %s\n\n", [s(ninja_vars_file)], !IO), foldl(write_target(BuildFile), DepInfo, !IO). :- pred write_statement(output_stream::in, string::in, string::in, string::in, list(string)::in, list(string)::in, maybe(string)::in, list(string)::in, maybe(string)::in, list(pair(string, string))::in, io::di, io::uo) is det. write_statement(File, Command, Name, Output, ImplicitOutputs, Inputs, MaybeBinary, ImplicitDeps, MaybeDynDep, Vars, !IO) :- ( ImplicitOutputs = [], ImplicitOutput = "" ; ImplicitOutputs = [_ | _], ImplicitOutput = " | " ++ string_join(" ", ImplicitOutputs) ), InputsStr = string_join(" ", Inputs), ( MaybeBinary = yes(Binary), BinaryInput = ["$path/" ++ Binary] ; MaybeBinary = no, BinaryInput = [] ), ExtraDeps = BinaryInput ++ ImplicitDeps, ( ExtraDeps = [_ | _], ExtraDepsStr = " | " ++ string_join(" ", ExtraDeps) ; ExtraDeps = [], ExtraDepsStr = "" ), ( MaybeDynDep = yes(DynDep), DynDepStr = " || " ++ DynDep ; MaybeDynDep = no, DynDepStr = "" ), write_string(File, "build " ++ Output ++ ImplicitOutput ++ " : " ++ Command ++ " " ++ InputsStr ++ ExtraDepsStr ++ DynDepStr ++ "\n", !IO), write_var(File, "name" - Name, !IO), ( MaybeDynDep = yes(DynDep_), write_var(File, "dyndep" - DynDep_, !IO) ; MaybeDynDep = no ), foldl(write_var(File), Vars, !IO), nl(File, !IO). :- pred write_var(output_stream::in, pair(string, string)::in, io::di, io::uo) is det. write_var(File, Var - Val, !IO) :- format(File, " %s = %s\n", [s(Var), s(Val)], !IO). :- pred write_build_statement(output_stream::in, string::in, string::in, string::in, string::in, string::in, maybe(string)::in, io::di, io::uo) is det. write_build_statement(File, Command, Name, Output, Path, Input, MaybeBinary, !IO) :- write_statement(File, Command, Name, Output, [], [Path ++ Input], MaybeBinary, [], no, [], !IO). :- pred write_c_compile_statement(output_stream::in, string::in, string::in, string::in, string::in, list(string)::in, io::di, io::uo) is det. write_c_compile_statement(File, Name, Output, Path, Input, Headers, !IO) :- write_statement(File, "c_compile", Name, Output, [], [Path ++ Input], no, Headers, no, [], !IO). :- pred write_plzc_statement(output_stream::in, string::in, q_name::in, string::in, string::in, string::in, list(pair(string, string))::in, io::di, io::uo) is det. write_plzc_statement(File, Command, Name, Output, Input, DepFile, Vars, !IO) :- write_statement(File, Command, q_name_to_string(Name), Output, [], ["../" ++ Input], yes("plzc"), [], yes(DepFile), Vars, !IO). :- pred write_link_statement(output_stream::in, string::in, nq_name::in, string::in, list(string)::in, maybe(string)::in, io::di, io::uo) is det. write_link_statement(File, Command, Name, Output, Objects, MaybeBinary, !IO) :- write_statement(File, Command, nq_name_to_string(Name), "../" ++ Output, [], Objects, MaybeBinary, [], no, [], !IO). :- pred write_target(output_stream::in, dep_target::in, io::di, io::uo) is det. write_target(File, dt_program(ProgName, ProgFile, Objects), !IO) :- write_link_statement(File, "plzlink", ProgName, ProgFile, Objects, yes("plzlnk"), !IO). write_target(File, dt_object(ModuleName, ObjectFile, SourceFile, DepFile, Flags), !IO) :- % If we can detect import errors when building dependencies we can % remove it from this step and avoid some extra rebuilds. ImportWhitelistVar = "import_whitelist" - import_whitelist_file_no_directroy, PCFlagsVar = "pcflags_file" - Flags, write_plzc_statement(File, "plzc", ModuleName, ObjectFile, SourceFile, DepFile, [ImportWhitelistVar, PCFlagsVar], !IO). write_target(File, dt_interface(ModuleName, InterfaceFile, SourceFile, DepFile), !IO) :- write_plzc_statement(File, "plzi", ModuleName, InterfaceFile, SourceFile, DepFile, [], !IO). write_target(File, dt_typeres(ModuleName, TyperesFile, SourceFile), !IO) :- write_build_statement(File, "plztyperes", q_name_to_string(ModuleName), TyperesFile, "../", SourceFile, yes("plzc"), !IO). write_target(File, dt_scan(ModuleName, DepFile, SourceFile, InterfaceFile, BytecodeFile), !IO) :- Inputs = ["../" ++ SourceFile], write_statement(File, "plzscan", q_name_to_string(ModuleName), DepFile, [], Inputs, yes("plzc"), [], no, ["target" - BytecodeFile, "interface" - InterfaceFile], !IO). write_target(File, dt_foreign_hooks(ModuleName, OutCode, OutHeader, Source), !IO) :- write_statement(File, "plzgf", q_name_to_string(ModuleName), OutCode, [OutHeader], ["../" ++ Source], no, [], no, ["header" - OutHeader], !IO). write_target(File, dt_gen_init(ModuleName, Output, Inputs), !IO) :- InputsString = string_join(" ", map(q_name_to_string, Inputs)), write_statement(File, "gen_init", nq_name_to_string(ModuleName), Output, [], [], yes("plzgeninit"), [], no, ["modules" - InputsString], !IO). write_target(File, dt_c_link(ModuleName, Output, Inputs), !IO) :- write_link_statement(File, "c_link", ModuleName, Output, Inputs, no, !IO). write_target(File, dt_c_compile(Object, Source, Headers, SrcWasGenerated), !IO) :- ( SrcWasGenerated = was_generated, Path = "" ; SrcWasGenerated = hand_written, Path = "../" ), write_c_compile_statement(File, Source, Object, Path, Source, Headers, !IO). %-----------------------------------------------------------------------% :- pred write_vars_file(plzbuild_options::in, maybe_error::out, io::di, io::uo) is det. write_vars_file(Options, Result, !IO) :- write_file(Options ^ pzb_verbose, Options ^ pzb_build_dir ++ "/" ++ ninja_vars_file, do_write_vars_file(Options), Result, !IO). :- pred do_write_vars_file(plzbuild_options::in, output_stream::in, io::di, io::uo) is det. do_write_vars_file(Options, File, !IO) :- Path0 = Options ^ pzb_tools_path, ( if is_relative(Path0) then Path = "../" ++ Path0 else Path = Path0 ), ReportTiming = Options ^ pzb_report_timing, ( ReportTiming = report_timing, PCFlags = "--report-timing" ; ReportTiming = dont_report_timing, PCFlags = "" ), % All options are the same for now. PLFlags = PCFlags, write_string(File, "# Auto-generated by plzbuild\n", !IO), format(File, "path = %s\n", [s(Path)], !IO), format(File, "source_path = %s\n\n", [s(Options ^ pzb_source_path)], !IO), format(File, "pcflags_global = %s\n", [s(PCFlags)], !IO), format(File, "plflags_global = %s\n", [s(PLFlags)], !IO), format(File, "cxx = c++ -fpic\n", [], !IO), format(File, "cc = cc -fpic -shared\n", [], !IO). %-----------------------------------------------------------------------% % % Use a whitelist to inform the compiler which modules may import which % other modules based on the module lists in the project file. % % Rather than actually compute the whitelist and store it, which could % be large, store the information used to compute it. The set of sets % of modules that may import each-other. % :- type whitelist == set(set(q_name)). :- func compute_import_whitelist(list(target)) = whitelist. compute_import_whitelist(Proj) = list_to_set(map(func(T) = list_to_set(T ^ t_modules), Proj)). :- pred maybe_write_import_whitelist(plzbuild_options::in, time_t::in, whitelist::in, maybe_error::out, io::di, io::uo) is det. maybe_write_import_whitelist(Options, ProjMTime, DepInfo, Result, !IO) :- update_if_stale(Options ^ pzb_verbose, ProjMTime, Options ^ pzb_build_dir ++ "/" ++ import_whitelist_file_no_directroy, write_import_whitelist(Options, DepInfo), Result, !IO). :- pred write_import_whitelist(plzbuild_options::in, whitelist::in, maybe_error::out, io::di, io::uo) is det. write_import_whitelist(Options, Whitelist, Result, !IO) :- write_file(Options ^ pzb_verbose, Options ^ pzb_build_dir ++ "/" ++ import_whitelist_file_no_directroy, do_write_import_whitelist(Whitelist), Result, !IO). :- pred do_write_import_whitelist(whitelist::in, text_output_stream::in, io::di, io::uo) is det. do_write_import_whitelist(Whitelist, File, !IO) :- write(File, map(to_sorted_list, to_sorted_list(Whitelist)) `with_type` list(list(q_name)), !IO), write_string(File, ".\n", !IO). %-----------------------------------------------------------------------% :- pred ensure_ninja_rules_file(plzbuild_options::in, time_t::in, maybe_error::out, io::di, io::uo) is det. ensure_ninja_rules_file(Options, MTime, Result, !IO) :- Rebuild = Options ^ pzb_rebuild, ( Rebuild = need_rebuild, write_ninja_rules_file(Options, Result, !IO) ; Rebuild = dont_rebuild, update_if_stale(Options ^ pzb_verbose, MTime, Options ^ pzb_build_dir ++ "/" ++ ninja_rules_file, write_ninja_rules_file(Options), Result, !IO) ). :- pred write_ninja_rules_file(plzbuild_options::in, maybe_error::out, io::di, io::uo) is det. write_ninja_rules_file(Options, Result, !IO) :- write_file(Options ^ pzb_verbose, Options ^ pzb_build_dir ++ "/" ++ ninja_rules_file, (pred(File::in, IO0::di, IO::uo) is det :- write_string(File, rules_contents, IO0, IO) ), Result, !IO). :- func rules_contents = string. rules_contents = "# Auto-generated by plzbuild ninja_required_version = 1.10 rule plztyperes command = $path/plzc $pcflags_global $pcflags_file $ --mode make-typeres-exports $ --module-name-check $name $ --source-path $source_path $ $in -o $out description = Calculating type & resource exports for $name rule plzi command = $path/plzc $pcflags_global $pcflags_file $ --mode make-interface $ --module-name-check $name $ --source-path $source_path $ $in -o $out description = Making interface for $name rule plzscan command = $path/plzc $pcflags_global $pcflags_file $ --mode scan $ --target-bytecode $target --target-interface $interface $ --module-name-check $name $ --source-path $source_path $ $in -o $out description = Scanning $name for dependencies rule plzc command = $path/plzc $pcflags_global $pcflags_file $ --mode compile $ --import-whitelist $import_whitelist $ --module-name-check $name $ --source-path $source_path $ $in -o $out description = Compiling $name rule plzgf command = $path/plzc $pcflags_global $pcflags_file $ --mode generate-foreign $ --module-name-check $name $ --source-path $source_path $ --output-header $header $ $in -o $out description = Generating foreign hooks for $name rule gen_init command = $path/plzgeninit $ $modules -o $out description = Generating foreign initialisation code for $name rule plzlink command = $path/plzlnk $plflags_global -n $name -o $out $in description = Linking $name rule c_link command = $cc -o $out $in description = Linking foreign code for $name rule c_compile command = $cxx -o $out -c $in description = Compiling $name ". %-----------------------------------------------------------------------% :- pred invoke_ninja(plzbuild_options::in, list(target)::in, maybe_error::out, io::di, io::uo) is det. invoke_ninja(Options, Proj, Result, !IO) :- Verbose = Options ^ pzb_verbose, Targets0 = Options ^ pzb_targets, ( Targets0 = [_ | _], TargetSet = list_to_set(Targets0), Targets = filter(pred(T::in) is semidet :- member(T ^ t_name, TargetSet), Proj) ; Targets0 = [], Targets = Proj ), NinjaTargets = map( (func(T) = [PZTarget] ++ CTarget :- Name = T ^ t_name, PZTarget = ninja_target_path(Name, library_extension), CSources = T ^ t_c_sources, ( CSources = [], CTarget = [] ; CSources = [_ | _], % Need to build the foreign code CTarget = [ninja_target_path(Name, native_dylib_extension)] ) ), Targets), NinjaTargetsStr = string_join(" ", condense(NinjaTargets)), invoke_command(Verbose, format("ninja %s -C %s %s", [s(verbose_opt_str(Verbose)), s(Options ^ pzb_build_dir), s(NinjaTargetsStr)]), Result, !IO). :- func ninja_target_path(nq_name, string) = string. ninja_target_path(Name, Extension) = "../" ++ nq_name_to_string(Name) ++ Extension. :- pred clean(plzbuild_options::in, io::di, io::uo) is det. clean(Options, !IO) :- Verbose = Options ^ pzb_verbose, BuildDir = Options ^ pzb_build_dir, ( Verbose = verbose, format("Removing build directory %s\n", [s(BuildDir)], !IO) ; Verbose = terse ), remove_file_recursively(BuildDir, Result, !IO), ( Result = ok ; Result = error(Error), format("%s: %s", [s(BuildDir), s(error_message(Error))], !IO) ). :- func verbose_opt_str(verbose) = string. verbose_opt_str(terse) = "". verbose_opt_str(verbose) = "-v". :- pred invoke_command(verbose::in, string::in, maybe_error::out, io::di, io::uo) is det. invoke_command(Verbose, Command, Result, !IO) :- ( Verbose = verbose, format(stderr_stream, "Invoking: %s\n", [s(Command)], !IO), write_string(stderr_stream, "-----\n", !IO) ; Verbose = terse ), call_system(Command, SysResult, !IO), ( Verbose = verbose, write_string(stderr_stream, "-----\n", !IO) ; Verbose = terse ), ( SysResult = ok(Status), ( if Status = 0 then Result = ok else Result = error(format("Sub-command '%s' exited with exit-status %d", [s(Command), i(Status)])) ) ; SysResult = error(Error), Result = error(format("Could not execute sub-command '%s': %s", [s(Command), s(error_message(Error))])) ). %-----------------------------------------------------------------------% :- pred setup_build_dir(plzbuild_options::in, time_t::in, maybe_error::out, io::di, io::uo) is det. setup_build_dir(Options, MTime, Result, !IO) :- ensure_directory(Options, Result0, FreshBuildDir, !IO), ( Result0 = ok, ( FreshBuildDir = fresh, % We know that we ust mkdir'd the build directory, so we can % skip a stat() call. write_ninja_rules_file(Options, Result, !IO) ; FreshBuildDir = stale, ensure_ninja_rules_file(Options, MTime, Result, !IO) ) ; Result0 = error(_), Result = Result0 ). :- type fresh ---> fresh ; stale. :- pred ensure_directory(plzbuild_options::in, maybe_error::out, fresh::out, io::di, io::uo) is det. ensure_directory(Options, Result, Fresh, !IO) :- Rebuild = Options ^ pzb_rebuild, BuildDir = Options ^ pzb_build_dir, file_type(yes, BuildDir, StatResult, !IO), ( StatResult = ok(Stat), ( Stat = directory, ( Rebuild = need_rebuild, clean(Options, !IO), mkdir_build_directory(Options, Result, !IO), Fresh = fresh ; Rebuild = dont_rebuild, Result = ok, Fresh = stale ) ; ( Stat = regular_file ; Stat = symbolic_link ; Stat = named_pipe ; Stat = socket ; Stat = character_device ; Stat = block_device ; Stat = message_queue ; Stat = semaphore ; Stat = shared_memory ; Stat = unknown ), ( Rebuild = need_rebuild, clean(Options, !IO), mkdir_build_directory(Options, Result, !IO), Fresh = fresh ; Rebuild = dont_rebuild, Result = error(format( "Cannot create build directory, " ++ "'%s' already exists as non-directory", [s(BuildDir)])), Fresh = stale ) ) ; StatResult = error(_), mkdir_build_directory(Options, Result, !IO), Fresh = fresh ). :- pred mkdir_build_directory(plzbuild_options::in, maybe_error::out, io::di, io::uo) is det. mkdir_build_directory(Options, Result, !IO) :- Verbose = Options ^ pzb_verbose, BuildDir = Options ^ pzb_build_dir, ( Verbose = verbose, format(stderr_stream, "mkdir %s\n", [s(BuildDir)], !IO) ; Verbose = terse ), mkdir(BuildDir, MkdirResult, Error, !IO), ( MkdirResult = yes, Result = ok ; MkdirResult = no, Result = error( format("Cannot create build directory '%s': %s", [s(BuildDir), s(Error)])) ). :- pragma foreign_decl("C", local, " #include "). :- pred mkdir(string::in, bool::out, string::out, io::di, io::uo) is det. :- pragma foreign_proc("C", mkdir(Name::in, Result::out, Error::out, _IO0::di, _IO::uo), [promise_pure, will_not_call_mercury, will_not_throw_exception], " int ret = mkdir(Name, 0755); if (ret == 0) { Result = MR_YES; // Error really is const Error = (char *)""""; } else { Result = MR_NO; char *error_msg = MR_GC_NEW_ARRAY(char, 128); ret = strerror_r(errno, error_msg, 128); if (ret == 0) { Error = error_msg; } else { Error = (char *)""Buffer too small for error message""; } } "). %-----------------------------------------------------------------------% :- pred update_if_stale(verbose, time_t, string, pred(maybe_error, io, io), maybe_error, io, io). :- mode update_if_stale(in, in, in, pred(out, di, uo) is det, out, di, uo). update_if_stale(Verbose, ProjMTime, File, Update, Result, !IO) :- io.file_modification_time(File, MTimeResult, !IO), ( MTimeResult = ok(MTime), ( if difftime(ProjMTime, MTime) > 0.0 then % Project file is newer. Update(Result, !IO) else ( Verbose = verbose, format(stderr_stream, "Not writing %s, it is already current\n", [s(File)], !IO) ; Verbose = terse ), Result = ok ) ; MTimeResult = error(_), % Always write the file. Update(Result, !IO) ). :- func latest(time_t, time_t) = time_t. latest(A, B) = ( if difftime(A, B) > 0.0 then A else B ). % Get a file modification time or now if unknown. % :- pred file_modification_time(string::in, time_t::out, io::di, io::uo) is det. file_modification_time(File, MTime, !IO) :- io.file_modification_time(File, TimeRes, !IO), ( TimeRes = ok(MTime) ; TimeRes = error(_), % Assume the file was modified now, causing other files to be % updated. time(MTime, !IO) ). :- pred write_file(verbose, string, pred(text_output_stream, io, io), maybe_error, io, io). :- mode write_file(in, in, pred(in, di, uo) is det, out, di, uo) is det. write_file(Verbose, Filename, Writer, Result, !IO) :- ( Verbose = verbose, format(stderr_stream, "Writing %s\n", [s(Filename)], !IO) ; Verbose = terse ), io.open_output(Filename, FileResult, !IO), ( FileResult = ok(File), Writer(File, !IO), close_output(File, !IO), Result = ok ; FileResult = error(Error), Result = error( format("Cannot write '%s': %s", [s(Filename), s(error_message(Error))])) ). %-----------------------------------------------------------------------% %-----------------------------------------------------------------------% ================================================ FILE: src/builtins.m ================================================ %-----------------------------------------------------------------------% % vim: ts=4 sw=4 et %-----------------------------------------------------------------------% :- module builtins. % % Copyright (C) Plasma Team % Distributed under the terms of the MIT License see ../LICENSE.code % % Plasma builtins. % % Builtins belong in the builtin module which is implicitly imported, both % with and without the "builtin" qualifier during compilation of any module. % Builtins may include functions, types and their constructors, interfaces % and interface implementations. % % There are two main types of builtin function, with sub-types: % % + Non-foreign % + Foreign % % Non-foreign % =========== % % Non-foreign builtins are completely handled by the compiler, by the time % the runtime is involved they look like regular Plasma code. % % Core builtins (bit_core) % ------------------------ % % Any procedure that could be written in Plasma, but it instead provided by % the compiler and compiled (from Core representation, hence the name) with % the program. bool_to_string is an example, these builtins have their core % definitions in this module. % % PZ inline builtins (bit_inline_pz) % ---------------------------------- % % This covers arithmetic operators and other small "functions" that are % equivalent to one or maybe 2-3 PZ instructions. core_to_pz will convert % calls to these functions into their native PZ bytecodes. It also % generates function bodies for these so higher-order references can call to % them. % % Foreign % ======= % % The compiler passes calls to foreign builtins through to the runtime where % they look like references to the imported Builtin module. pz_builtin.cpp % decides how each foreign builtin is implemented. So these are all bit_rts % builtins. % % Runtime inline % -------------- % % These builtins are stored as a sequence of PZ instructions within the % runtime, they're executed just like normal procedures, their definitions % are simply provided by the runtime rather than a .pz file. % % PZ builtins % ----------- % % Just like runtime inline builtins, these are a series of PZ instructions. % The difference is they arn't callable by the programmer, usually being % responsible for data tagging. % % Foreign builtins % ---------------- % % These mostly cover operating system services. They are implemented in % pz_run_*.c and are transformed when the program is read into an opcode % that will cause the C procedure built into the RTS to be executed. The % specifics depend on which pz_run_*.c file is used. % % They are very similar to foreign code generally, but marked as an import % rather than foreign in the PZ bytecode files since they have a different % module name. % %-----------------------------------------------------------------------% :- interface. :- import_module map. :- import_module common_types. :- import_module core. :- import_module core.types. :- import_module pre. :- import_module pre.env. :- import_module pz. :- import_module pz.pz_ds. :- import_module q_name. :- type builtin_item ---> bi_func(func_id) ; bi_ctor(ctor_id) ; bi_resource(resource_id) ; bi_type(type_id, arity) ; bi_type_builtin(builtin_type). :- type builtin_map ---> builtin_map( % Items that should be avaiable without any module qualification. bm_root_map :: map(nq_name, builtin_item), % Items that should be available under the builtin_module_name % module. bm_builtin_map :: map(nq_name, builtin_item) ). % setup_builtins(Map, Operators, !Core) % :- pred setup_builtins(builtin_map::out, operators::out, core::in, core::out) is det. :- func builtin_module_name = q_name. %-----------------------------------------------------------------------% % % PZ Builtins % :- type pz_builtin_ids ---> pz_builtin_ids( pbi_make_tag :: pzi_id, pbi_shift_make_tag :: pzi_id, pbi_break_tag :: pzi_id, pbi_break_shift_tag :: pzi_id, pbi_unshift_value :: pzi_id, % A struct containing only a secondary tag. % TODO: actually make this imported so that the runtime % structures can be shared easily. pbi_stag_struct :: pzs_id ). % Setup procedures that are PZ builtins but not Plasma builtins. For % example things like tagged pointer manipulation. % :- pred setup_pz_builtin_procs(pz_builtin_ids::out, pz::in, pz::out) is det. %-----------------------------------------------------------------------% %-----------------------------------------------------------------------% :- implementation. :- import_module list. :- import_module pair. :- import_module require. :- import_module set. :- import_module context. :- import_module core.code. :- import_module core.function. :- import_module core.resource. :- import_module core_to_pz. :- import_module pz.code. :- import_module varmap. %-----------------------------------------------------------------------% setup_builtins(!:Map, Operators, !Core) :- !:Map = builtin_map(init, init), setup_core_types(MaybeType, !Map, !Core), setup_bool_builtins(BoolType, BoolTrue, BoolFalse, BoolAnd, BoolOr, BoolNot, !Map, !Core), setup_int_builtins(BoolType, IntAdd, IntSub, IntMul, IntDiv, IntMod, IntGt, IntLt, IntGtEq, IntLtEq, IntEq, IntNEq, IntMinus, !Map, !Core), setup_list_builtins(ListType, ListNil, ListCons, !Map, !Core), setup_string_builtins(BoolType, MaybeType, StringConcat, !Map, !Core), setup_misc_builtins(BoolType, BoolTrue, BoolFalse, !Map, !Core), Operators = operators( IntAdd, IntSub, IntMul, IntDiv, IntMod, IntGt, IntLt, IntGtEq, IntLtEq, IntEq, IntNEq, IntMinus, BoolTrue, BoolFalse, BoolAnd, BoolOr, BoolNot, ListType, ListNil, ListCons, StringConcat), foldl(make_body_for_inline, core_all_functions(!.Core), !Core). :- pred setup_core_types(type_id::out, builtin_map::in, builtin_map::out, core::in, core::out) is det. setup_core_types(MaybeType, !Map, !Core) :- foldl((pred(Type::in, M0::in, M::out) is det :- builtin_type_name(Type, Name), root_name(Name, bi_type_builtin(Type), M0, M) ), [int, codepoint, string, string_pos], !Map), core_allocate_type_id(MaybeType, !Core), MaybeParamName = "v", NoneName = nq_name_det("None"), NoneQName = q_name_append(builtin_module_name, NoneName), core_allocate_ctor_id(NoneId, !Core), core_set_constructor(NoneId, NoneQName, MaybeType, constructor(NoneQName, [MaybeParamName], []), !Core), root_name(NoneName, bi_ctor(NoneId), !Map), SomeName = nq_name_det("Some"), SomeQName = q_name_append(builtin_module_name, SomeName), core_allocate_ctor_id(SomeId, !Core), core_set_constructor(SomeId, SomeQName, MaybeType, constructor(SomeQName, [MaybeParamName], [ type_field(q_name_append_str(builtin_module_name, "value"), type_variable(MaybeParamName))]), !Core), root_name(SomeName, bi_ctor(SomeId), !Map), MaybeName = nq_name_det("Maybe"), core_set_type(MaybeType, type_init(q_name_append(builtin_module_name, MaybeName), [MaybeParamName], [NoneId, SomeId], so_private, i_imported, builtin_context), !Core), root_name(MaybeName, bi_type(MaybeType, arity(1)), !Map). % If a function is implemented by inlining PZ instructions during % codegen, then give it a definition that does the same so it can be % used as a higher order value. % :- pred make_body_for_inline(pair(func_id, function)::in, core::in, core::out) is det. make_body_for_inline(FuncId - Function0, !Core) :- ( if func_builtin_inline_pz(Function0, _) then func_get_type_signature(Function0, ParamTypes, ReturnTypes, Arity), func_get_resource_signature(Function0, Uses, Observes), some [!Varmap, !Typemap, !CodeInfo] ( !:Varmap = varmap.init, !:Typemap = init, map_foldl2(add_var_with_type, ParamTypes, Params, !Varmap, !Typemap), % The whacky thing here is that to implement a function whose % contents get replaced by a list of PZ instructions, we implement % it as a call to itself, because that direct call will be replaced % with the PZ instructions during codegen. Callee = c_plain(FuncId), Resources = resources(Uses, Observes), !:CodeInfo = code_info_init(o_builtin), code_info_set_arity(Arity, !CodeInfo), code_info_set_types(ReturnTypes, !CodeInfo), % XXX: If we add extra parts to code_info in the future then % this may be incomplete. We need a typesafe way to make a % complete one or we should run this code through the % typechecker etc. Expr = expr(e_call(Callee, Params, Resources), !.CodeInfo), func_set_body(!.Varmap, Params, [], Expr, !.Typemap, Function0, Function), core_set_function(FuncId, Function, !Core) ) else true ). :- pred add_var_with_type(type_::in, var::out, varmap::in, varmap::out, map(var, type_)::in, map(var, type_)::out) is det. add_var_with_type(Type, Var, !Varmap, !Typemap) :- add_anon_var(Var, !Varmap), det_insert(Var, Type, !Typemap). %-----------------------------------------------------------------------% :- pred setup_bool_builtins(type_id::out, ctor_id::out, ctor_id::out, func_id::out, func_id::out, func_id::out, builtin_map::in, builtin_map::out, core::in, core::out) is det. setup_bool_builtins(BoolId, TrueId, FalseId, AndId, OrId, NotId, !Map, !Core) :- core_allocate_type_id(BoolId, !Core), FalseName = nq_name_det("False"), FalseQName = q_name_append(builtin_module_name, FalseName), core_allocate_ctor_id(FalseId, !Core), core_set_constructor(FalseId, FalseQName, BoolId, constructor(FalseQName, [], []), !Core), root_name(FalseName, bi_ctor(FalseId), !Map), TrueName = nq_name_det("True"), TrueQName = q_name_append(builtin_module_name, TrueName), core_allocate_ctor_id(TrueId, !Core), core_set_constructor(TrueId, TrueQName, BoolId, constructor(TrueQName, [], []), !Core), root_name(TrueName, bi_ctor(TrueId), !Map), % NOTE: False is first so that it is allocated 0 for its tag, and true % will be allocated 1 for its tag, this will make interoperability % easier. BoolName = nq_name_det("Bool"), core_set_type(BoolId, type_init(q_name_append(builtin_module_name, BoolName), [], [FalseId, TrueId], so_private, i_imported, builtin_context), !Core), root_name(BoolName, bi_type(BoolId, arity(0)), !Map), BoolWidth = bool_width, BoolNotName = nq_name_det("bool_not"), register_builtin_func_builtin(BoolNotName, func_init_builtin_inline_pz( q_name_append(builtin_module_name, BoolNotName), [type_ref(BoolId, [])], [type_ref(BoolId, [])], init, init, [pzi_not(BoolWidth)]), NotId, !Map, !Core), register_bool_biop(BoolId, "bool_and", [pzi_and(BoolWidth)], AndId, !Map, !Core), register_bool_biop(BoolId, "bool_or", [pzi_or(BoolWidth)], OrId, !Map, !Core). :- pred register_bool_biop(type_id::in, string::in, list(pz_instr)::in, func_id::out, builtin_map::in, builtin_map::out, core::in, core::out) is det. register_bool_biop(BoolType, NameStr, Defn, FuncId, !Map, !Core) :- Name = nq_name_det(NameStr), FName = q_name_append(builtin_module_name, Name), register_builtin_func_builtin(Name, func_init_builtin_inline_pz(FName, [type_ref(BoolType, []), type_ref(BoolType, [])], [type_ref(BoolType, [])], init, init, Defn), FuncId, !Map, !Core). %-----------------------------------------------------------------------% :- pred setup_int_builtins(type_id::in, func_id::out, func_id::out, func_id::out, func_id::out, func_id::out, func_id::out, func_id::out, func_id::out, func_id::out, func_id::out, func_id::out, func_id::out, builtin_map::in, builtin_map::out, core::in, core::out) is det. setup_int_builtins(BoolType, AddId, SubId, MulId, DivId, ModId, GtId, LtId, GtEqId, LtEqId, EqId, NEqId, MinusId, !Map, !Core) :- register_int_fn2("int_add", [pzi_add(pzw_fast)], AddId, !Map, !Core), register_int_fn2("int_sub", [pzi_sub(pzw_fast)], SubId, !Map, !Core), register_int_fn2("int_mul", [pzi_mul(pzw_fast)], MulId, !Map, !Core), % Mod and div can maybe be combined into one operator, and optimised at % PZ load time. register_int_fn2("int_div", [pzi_div(pzw_fast)], DivId, !Map, !Core), register_int_fn2("int_mod", [pzi_mod(pzw_fast)], ModId, !Map, !Core), % TODO: remove the extend operation once we fix how booleans are % stored. BoolWidth = bool_width, require(unify(BoolWidth, pzw_ptr), "Fix this code once we fix bool storage"), register_int_comp(BoolType, "int_gt", [ pzi_gt_s(pzw_fast), pzi_ze(pzw_fast, pzw_ptr)], GtId, !Map, !Core), register_int_comp(BoolType, "int_lt", [ pzi_lt_s(pzw_fast), pzi_ze(pzw_fast, pzw_ptr)], LtId, !Map, !Core), register_int_comp(BoolType, "int_gteq", [ pzi_lt_s(pzw_fast), pzi_not(pzw_fast), pzi_ze(pzw_fast, pzw_ptr)], GtEqId, !Map, !Core), register_int_comp(BoolType, "int_lteq", [ pzi_gt_s(pzw_fast), pzi_not(pzw_fast), pzi_ze(pzw_fast, pzw_ptr)], LtEqId, !Map, !Core), register_int_comp(BoolType, "int_eq", [ pzi_eq(pzw_fast), pzi_ze(pzw_fast, pzw_ptr)], EqId, !Map, !Core), register_int_comp(BoolType, "int_neq", [ pzi_eq(pzw_fast), pzi_not(pzw_fast), pzi_ze(pzw_fast, pzw_ptr)], NEqId, !Map, !Core), register_int_fn1("int_minus", [pzi_load_immediate(pzw_fast, im_i32(0i32)), pzi_roll(2), pzi_sub(pzw_fast)], MinusId, !Map, !Core), % Register the builtin bitwise functions.. % TODO: make the number of bits to shift a single byte. register_int_fn2("int_lshift", [pzi_trunc(pzw_fast, pzw_8), pzi_lshift(pzw_fast)], _, !Map, !Core), register_int_fn2("int_rshift", [pzi_trunc(pzw_fast, pzw_8), pzi_rshift(pzw_fast)], _, !Map, !Core), register_int_fn2("int_and", [pzi_and(pzw_fast)], _, !Map, !Core), register_int_fn2("int_or", [pzi_or(pzw_fast)], _, !Map, !Core), register_int_fn2("int_xor", [pzi_xor(pzw_fast)], _, !Map, !Core), register_int_fn1("int_comp", [pzi_load_immediate(pzw_32, im_i32(-1i32)), pzi_se(pzw_32, pzw_fast), pzi_xor(pzw_fast)], _, !Map, !Core). :- pred register_int_fn1(string::in, list(pz_instr)::in, func_id::out, builtin_map::in, builtin_map::out, core::in, core::out) is det. register_int_fn1(NameStr, Defn, FuncId, !Map, !Core) :- Name = nq_name_det(NameStr), FName = q_name_append(builtin_module_name, Name), register_builtin_func_builtin(Name, func_init_builtin_inline_pz(FName, [builtin_type(int)], [builtin_type(int)], init, init, Defn), FuncId, !Map, !Core). :- pred register_int_fn2(string::in, list(pz_instr)::in, func_id::out, builtin_map::in, builtin_map::out, core::in, core::out) is det. register_int_fn2(NameStr, Defn, FuncId, !Map, !Core) :- Name = nq_name_det(NameStr), FName = q_name_append(builtin_module_name, Name), register_builtin_func_builtin(Name, func_init_builtin_inline_pz(FName, [builtin_type(int), builtin_type(int)], [builtin_type(int)], init, init, Defn), FuncId, !Map, !Core). :- pred register_int_comp(type_id::in, string::in, list(pz_instr)::in, func_id::out, builtin_map::in, builtin_map::out, core::in, core::out) is det. register_int_comp(BoolType, NameStr, Defn, FuncId, !Map, !Core) :- Name = nq_name_det(NameStr), FName = q_name_append(builtin_module_name, Name), register_builtin_func_builtin(Name, func_init_builtin_inline_pz(FName, [builtin_type(int), builtin_type(int)], [type_ref(BoolType, [])], init, init, Defn), FuncId, !Map, !Core). :- pred setup_list_builtins(type_id::out, ctor_id::out, ctor_id::out, builtin_map::in, builtin_map::out, core::in, core::out) is det. setup_list_builtins(ListId, NilId, ConsId, !Map, !Core) :- core_allocate_type_id(ListId, !Core), T = "T", NilName = nq_name_det("list_nil"), NilQName = q_name_append(builtin_module_name, NilName), core_allocate_ctor_id(NilId, !Core), core_set_constructor(NilId, NilQName, ListId, constructor(NilQName, [T], []), !Core), builtin_name(NilName, bi_ctor(NilId), !Map), Head = q_name_append_str(builtin_module_name, "head"), Tail = q_name_append_str(builtin_module_name, "tail"), ConsName = nq_name_det("list_cons"), ConsQName = q_name_append(builtin_module_name, ConsName), core_allocate_ctor_id(ConsId, !Core), core_set_constructor(ConsId, ConsQName, ListId, constructor(ConsQName, [T], [type_field(Head, type_variable(T)), type_field(Tail, type_ref(ListId, [type_variable(T)]))]), !Core), builtin_name(ConsName, bi_ctor(ConsId), !Map), core_set_type(ListId, type_init(q_name_append_str(builtin_module_name, "List"), [T], [NilId, ConsId], so_private, i_imported, builtin_context), !Core), root_name(nq_name_det("List"), bi_type(ListId, arity(1)), !Map). %-----------------------------------------------------------------------% :- pred setup_misc_builtins(type_id::in, ctor_id::in, ctor_id::in, builtin_map::in, builtin_map::out, core::in, core::out) is det. setup_misc_builtins(BoolType, BoolTrue, BoolFalse, !Map, !Core) :- register_builtin_resource(nq_name_det("IO"), r_io, RIO, !Map, !Core), PrintName = q_name_append_str(builtin_module_name, "print"), register_builtin_func_root(nq_name_det("print"), func_init_builtin_rts(PrintName, [builtin_type(string)], [], list_to_set([RIO]), init), _, !Map, !Core), core_allocate_type_id(IOResultType, !Core), % There's currently no error constructor. but there should be, currently % the runtime just aborts. OkParamName = "v", OkName = nq_name_det("Ok"), OkQName = q_name_append(builtin_module_name, OkName), core_allocate_ctor_id(OkId, !Core), core_set_constructor(OkId, OkQName, IOResultType, constructor(OkQName, [OkParamName], [ type_field(q_name_append_str(builtin_module_name, "value"), type_variable(OkParamName))]), !Core), root_name(OkName, bi_ctor(OkId), !Map), EOFName = nq_name_det("EOF"), EOFQName = q_name_append(builtin_module_name, EOFName), core_allocate_ctor_id(EOFId, !Core), core_set_constructor(EOFId, EOFQName, IOResultType, constructor(EOFQName, [OkParamName], []), !Core), root_name(EOFName, bi_ctor(EOFId), !Map), IOResultName = nq_name_det("IOResult"), core_set_type(IOResultType, type_init(q_name_append(builtin_module_name, IOResultName), [OkParamName], [OkId, EOFId], so_private, i_imported, builtin_context), !Core), root_name(IOResultName, bi_type(IOResultType, arity(1)), !Map), ReadlnName = q_name_append_str(builtin_module_name, "readline"), register_builtin_func_root(nq_name_det("readline"), func_init_builtin_rts(ReadlnName, [], [type_ref(IOResultType, [builtin_type(string)])], list_to_set([RIO]), init), _, !Map, !Core), IntToStringName = q_name_append_str(builtin_module_name, "int_to_string"), register_builtin_func_root(nq_name_det("int_to_string"), func_init_builtin_rts(IntToStringName, [builtin_type(int)], [builtin_type(string)], init, init), _, !Map, !Core), BoolToStringName = q_name_append_str(builtin_module_name, "bool_to_string"), BoolToString0 = func_init_builtin_core(BoolToStringName, [type_ref(BoolType, [])], [builtin_type(string)], init, init), define_bool_to_string(BoolTrue, BoolFalse, BoolToString0, BoolToString), register_builtin_func_root(nq_name_det("bool_to_string"), BoolToString, _, !Map, !Core), SetParameterName = q_name_append_str(builtin_module_name, "set_parameter"), register_builtin_func_builtin(nq_name_det("set_parameter"), func_init_builtin_rts(SetParameterName, [builtin_type(string), builtin_type(int)], [type_ref(BoolType, [])], list_to_set([RIO]), init), _, !Map, !Core), GetParameterName = q_name_append_str(builtin_module_name, "get_parameter"), register_builtin_func_builtin(nq_name_det("get_parameter"), func_init_builtin_rts(GetParameterName, [builtin_type(string)], [type_ref(BoolType, []), builtin_type(int)], init, list_to_set([RIO])), _, !Map, !Core), EnvironmentName = nq_name_det("Environment"), EnvironmentQName = q_name_append(builtin_module_name, EnvironmentName), register_builtin_resource(EnvironmentName, r_other(EnvironmentQName, RIO, so_private, i_imported, builtin_context), REnv, !Map, !Core), SetenvName = q_name_append_str(builtin_module_name, "setenv"), register_builtin_func_root(nq_name_det("setenv"), func_init_builtin_rts(SetenvName, [builtin_type(string), builtin_type(string)], [type_ref(BoolType, [])], list_to_set([REnv]), init), _, !Map, !Core), TimeName = nq_name_det("Time"), TimeQName = q_name_append(builtin_module_name, TimeName), register_builtin_resource(TimeName, r_other(TimeQName, RIO, so_private, i_imported, builtin_context), RTime, !Map, !Core), GettimeofdayName = q_name_append_str(builtin_module_name, "gettimeofday"), register_builtin_func_builtin(nq_name_det("gettimeofday"), func_init_builtin_rts(GettimeofdayName, [], [type_ref(BoolType, []), builtin_type(int), builtin_type(int)], init, list_to_set([RTime])), _, !Map, !Core), DieName = nq_name_det("die"), DieQName = q_name_append(builtin_module_name, DieName), register_builtin_func_builtin(DieName, func_init_builtin_rts(DieQName, [builtin_type(string)], [], init, init), _, !Map, !Core). %-----------------------------------------------------------------------% :- pred setup_string_builtins(type_id::in, type_id::in, func_id::out, builtin_map::in, builtin_map::out, core::in, core::out) is det. setup_string_builtins(BoolType, MaybeType, StringConcat, !Map, !Core) :- core_allocate_type_id(CodepointCategoryId, !Core), % TODO: Implement more character classes. WhitespaceName = nq_name_det("Whitespace"), WhitespaceQName = q_name_append(builtin_module_name, WhitespaceName), core_allocate_ctor_id(WhitespaceId, !Core), core_set_constructor(WhitespaceId, WhitespaceQName, CodepointCategoryId, constructor(WhitespaceQName, [], []), !Core), root_name(WhitespaceName, bi_ctor(WhitespaceId), !Map), OtherName = nq_name_det("Other"), OtherQName = q_name_append(builtin_module_name, OtherName), core_allocate_ctor_id(OtherId, !Core), core_set_constructor(OtherId, OtherQName, CodepointCategoryId, constructor(OtherQName, [], []), !Core), root_name(OtherName, bi_ctor(OtherId), !Map), CodepointCategoryTypeName = nq_name_det("CodepointCategory"), core_set_type(CodepointCategoryId, type_init(q_name_append(builtin_module_name, CodepointCategoryTypeName), [], [WhitespaceId, OtherId], so_private, i_imported, builtin_context), !Core), root_name(CodepointCategoryTypeName, bi_type(CodepointCategoryId, arity(0)), !Map), CodepointCategoryName = nq_name_det("codepoint_category"), register_builtin_func_root(CodepointCategoryName, func_init_builtin_rts( q_name_append(builtin_module_name, CodepointCategoryName), [builtin_type(codepoint)], [type_ref(CodepointCategoryId, [])], init, init), _, !Map, !Core), CPToStringName = nq_name_det("codepoint_to_string"), register_builtin_func_root(CPToStringName, func_init_builtin_rts( q_name_append(builtin_module_name, CPToStringName), [builtin_type(codepoint)], [builtin_type(string)], init, init), _, !Map, !Core), CPToNumName = nq_name_det("codepoint_to_number"), register_builtin_func_root(CPToNumName, func_init_builtin_inline_pz( q_name_append(builtin_module_name, CPToNumName), [builtin_type(codepoint)], [builtin_type(int)], init, init, [pzi_ze(pzw_32, pzw_fast)]), _, !Map, !Core), IntToCPName = nq_name_det("int_to_codepoint"), register_builtin_func_builtin(IntToCPName, func_init_builtin_inline_pz( q_name_append(builtin_module_name, IntToCPName), [builtin_type(int)], [builtin_type(codepoint)], init, init, [pzi_trunc(pzw_fast, pzw_32)]), _, !Map, !Core), StringConcatName = nq_name_det("string_concat"), register_builtin_func_builtin(StringConcatName, func_init_builtin_rts( q_name_append(builtin_module_name, StringConcatName), [builtin_type(string), builtin_type(string)], [builtin_type(string)], init, init), StringConcat, !Map, !Core), StrposForwadName = nq_name_det("strpos_forward"), register_builtin_func_root(StrposForwadName, func_init_builtin_rts( q_name_append(builtin_module_name, StrposForwadName), [builtin_type(string_pos)], [builtin_type(string_pos)], init, init), _, !Map, !Core), StrposBackwardName = nq_name_det("strpos_backward"), register_builtin_func_root(StrposBackwardName, func_init_builtin_rts( q_name_append(builtin_module_name, StrposBackwardName), [builtin_type(string_pos)], [builtin_type(string_pos)], init, init), _, !Map, !Core), StrposNextName = nq_name_det("strpos_next"), register_builtin_func_root(StrposNextName, func_init_builtin_rts( q_name_append(builtin_module_name, StrposNextName), [builtin_type(string_pos)], [type_ref(MaybeType, [builtin_type(codepoint)])], init, init), _, !Map, !Core), StrposPrevName = nq_name_det("strpos_prev"), register_builtin_func_root(StrposPrevName, func_init_builtin_rts( q_name_append(builtin_module_name, StrposPrevName), [builtin_type(string_pos)], [type_ref(MaybeType, [builtin_type(codepoint)])], init, init), _, !Map, !Core), StringBeginName = nq_name_det("string_begin"), register_builtin_func_root(StringBeginName, func_init_builtin_rts( q_name_append(builtin_module_name, StringBeginName), [builtin_type(string)], [builtin_type(string_pos)], init, init), _, !Map, !Core), StringEndName = nq_name_det("string_end"), register_builtin_func_root(StringEndName, func_init_builtin_rts( q_name_append(builtin_module_name, StringEndName), [builtin_type(string)], [builtin_type(string_pos)], init, init), _, !Map, !Core), StringSubstringName = nq_name_det("string_substring"), register_builtin_func_root(StringSubstringName, func_init_builtin_rts( q_name_append(builtin_module_name, StringSubstringName), [builtin_type(string_pos), builtin_type(string_pos)], [builtin_type(string)], init, init), _, !Map, !Core), StringEqualsName = nq_name_det("string_equals"), register_builtin_func_root(StringEqualsName, func_init_builtin_rts( q_name_append(builtin_module_name, StringEqualsName), [builtin_type(string), builtin_type(string)], [type_ref(BoolType, [])], init, init), _, !Map, !Core). %-----------------------------------------------------------------------% % Register the builtin function with it's name in the root namespace. % :- pred register_builtin_func_root(nq_name::in, function::in, func_id::out, builtin_map::in, builtin_map::out, core::in, core::out) is det. register_builtin_func_root(Name, Func, FuncId, !Map, !Core) :- register_builtin_func(Func, FuncId, !Core), root_name(Name, bi_func(FuncId), !Map). % Register the builtin function with it's name in the Builtin module % namespace. % :- pred register_builtin_func_builtin(nq_name::in, function::in, func_id::out, builtin_map::in, builtin_map::out, core::in, core::out) is det. register_builtin_func_builtin(Name, Func, FuncId, !Map, !Core) :- register_builtin_func(Func, FuncId, !Core), builtin_name(Name, bi_func(FuncId), !Map). :- pred register_builtin_func(function::in, func_id::out, core::in, core::out) is det. register_builtin_func(Func, FuncId, !Core) :- core_allocate_function(FuncId, !Core), core_set_function(FuncId, Func, !Core). :- pred register_builtin_resource(nq_name::in, resource::in, resource_id::out, builtin_map::in, builtin_map::out, core::in, core::out) is det. register_builtin_resource(Name, Res, ResId, !Map, !Core) :- core_allocate_resource_id(ResId, !Core), core_set_resource(ResId, Res, !Core), root_name(Name, bi_resource(ResId), !Map). %-----------------------------------------------------------------------% :- pred define_bool_to_string(ctor_id::in, ctor_id::in, function::in, function::out) is det. define_bool_to_string(TrueId, FalseId, !Func) :- some [!Varmap] ( !:Varmap = init, CI = code_info_init(o_builtin), varmap.add_anon_var(In, !Varmap), TrueCase = e_case(p_ctor(make_singleton_set(TrueId), []), expr(e_constant(c_string("True")), CI)), FalseCase = e_case(p_ctor(make_singleton_set(FalseId), []), expr(e_constant(c_string("False")), CI)), Expr = expr(e_match(In, [TrueCase, FalseCase]), CI), func_set_body(!.Varmap, [In], [], Expr, !Func) ). %-----------------------------------------------------------------------% :- pred root_name(nq_name::in, builtin_item::in, builtin_map::in, builtin_map::out) is det. root_name(Name, Item, !Map) :- det_insert(Name, Item, !.Map ^ bm_root_map, Map), !Map ^ bm_root_map := Map. :- pred builtin_name(nq_name::in, builtin_item::in, builtin_map::in, builtin_map::out) is det. builtin_name(Name, Item, !Map) :- det_insert(Name, Item, !.Map ^ bm_builtin_map, Map), !Map ^ bm_builtin_map := Map. %-----------------------------------------------------------------------% builtin_module_name = q_name_single("Builtin"). %-----------------------------------------------------------------------% setup_pz_builtin_procs(BuiltinProcs, !PZ) :- % pz_signature([pzw_ptr, pzw_ptr], [pzw_ptr]) pz_new_import(MakeTag, pz_import(make_tag_qname, pzit_import), !PZ), % pz_signature([pzw_ptr, pzw_ptr], [pzw_ptr]) pz_new_import(ShiftMakeTag, pz_import(shift_make_tag_qname, pzit_import), !PZ), % pz_signature([pzw_ptr], [pzw_ptr, pzw_ptr]) pz_new_import(BreakTag, pz_import(break_tag_qname, pzit_import), !PZ), % pz_signature([pzw_ptr], [pzw_ptr, pzw_ptr]) pz_new_import(BreakShiftTag, pz_import(break_shift_tag_qname, pzit_import), !PZ), % pz_signature([pzw_ptr], [pzw_ptr]) pz_new_import(UnshiftValue, pz_import(unshift_value_qname, pzit_import), !PZ), STagStruct = pz_struct([pzw_fast]), pz_new_struct_id(STagStructId, "Secondary tag struct", !PZ), pz_add_struct(STagStructId, STagStruct, !PZ), BuiltinProcs = pz_builtin_ids(MakeTag, ShiftMakeTag, BreakTag, BreakShiftTag, UnshiftValue, STagStructId). %-----------------------------------------------------------------------% :- func make_tag_qname = q_name. make_tag_qname = q_name_append_str(builtin_module_name, "make_tag"). :- func shift_make_tag_qname = q_name. shift_make_tag_qname = q_name_append_str(builtin_module_name, "shift_make_tag"). :- func break_tag_qname = q_name. break_tag_qname = q_name_append_str(builtin_module_name, "break_tag"). :- func break_shift_tag_qname = q_name. break_shift_tag_qname = q_name_append_str(builtin_module_name, "break_shift_tag"). :- func unshift_value_qname = q_name. unshift_value_qname = q_name_append_str(builtin_module_name, "unshift_value"). %-----------------------------------------------------------------------% %-----------------------------------------------------------------------% ================================================ FILE: src/common_types.m ================================================ %-----------------------------------------------------------------------% % vim: ts=4 sw=4 et %-----------------------------------------------------------------------% :- module common_types. % % Copyright (C) Plasma Team % Distributed under the terms of the MIT License see ../LICENSE.code % % This module defines types useful to multiple Plasma tools. % %-----------------------------------------------------------------------% :- interface. :- import_module set. :- import_module util. :- import_module util.pretty. % Is a declaration visible outside of its defining module. % :- type sharing ---> s_public ; s_private. % Types and resources have a 3rd option, to export the name but not its % details. % :- type sharing_opaque ---> so_private ; so_public ; so_public_opaque. % Is an exported function an entrypoint. % :- type is_entrypoint ---> is_entrypoint ; not_entrypoint. % Has a declaration been imported from another module? % :- type imported ---> i_local ; i_imported. % The arity of an expression is the number of results it returns. % :- type arity ---> arity(a_num :: int). % The number of a particular field within a structure. This is 1-based, % that is the first field is field_num_(1). % :- type field_num ---> field_num(field_num_int :: int). :- func field_num_first = field_num. :- func field_num_next(field_num) = field_num. %-----------------------------------------------------------------------% % A constant in an expression. % :- type const_type ---> c_string(string) ; c_number(int) ; c_func(func_id) ; c_ctor(set(ctor_id)). :- type id_printer(ID) == (func(ID) = pretty). :- func const_pretty(id_printer(func_id), id_printer(set(ctor_id)), const_type) = pretty. %-----------------------------------------------------------------------% :- type func_id ---> func_id(int). %-----------------------------------------------------------------------% :- type type_id ---> type_id(int). %-----------------------------------------------------------------------% :- type resource_id ---> resource_id(int). :- type maybe_resources ---> resources( r_uses :: set(resource_id), r_observes :: set(resource_id) ) ; unknown_resources. %-----------------------------------------------------------------------% :- type ctor_id ---> ctor_id(int). %-----------------------------------------------------------------------% %-----------------------------------------------------------------------% :- implementation. :- import_module int. :- import_module string. :- import_module util.my_string. %-----------------------------------------------------------------------% field_num_first = field_num(1). field_num_next(field_num(Num)) = field_num(Num + 1). %-----------------------------------------------------------------------% const_pretty(_, _, c_number(Int)) = p_str(string(Int)). const_pretty(_, _, c_string(String)) = p_str(escape_string(String)). const_pretty(FuncPretty, _, c_func(FuncId)) = FuncPretty(FuncId). const_pretty(_, CtorPretty, c_ctor(CtorId)) = CtorPretty(CtorId). %-----------------------------------------------------------------------% %-----------------------------------------------------------------------% ================================================ FILE: src/compile.m ================================================ %-----------------------------------------------------------------------% % Plasma compilation process % vim: ts=4 sw=4 et % % Copyright (C) Plasma Team % Distributed under the terms of the MIT License see ../LICENSE.code % % This module drives the compilation process. It sits between plzc.m which % interprets command line options to start the process and the other modules % to actually do the compilation. % %-----------------------------------------------------------------------% :- module compile. %-----------------------------------------------------------------------% :- interface. :- import_module io. :- import_module list. :- import_module ast. :- import_module common_types. :- import_module compile_error. :- import_module context. :- import_module core. :- import_module options. :- import_module pz. :- import_module pz.pz_ds. :- import_module q_name. :- import_module util. :- import_module util.result. %-----------------------------------------------------------------------% :- pred check_module_name(general_options::in, context::in, q_name::in, errors(compile_error)::in, errors(compile_error)::out) is det. :- pred process_declarations(general_options::in, ast::in, result_partial(core, compile_error)::out, io::di, io::uo) is det. :- pred compile(general_options::in, compile_options::in, ast::in, result_partial(pz, compile_error)::out, io::di, io::uo) is det. :- type typeres_exports ---> typeres_exports( te_resources :: list(q_name), te_types :: list({q_name, arity}) ). :- func find_typeres_exports(general_options, ast) = result_partial(typeres_exports, compile_error). %-----------------------------------------------------------------------% % Exported so plzc can filter entries to process imports. % :- pred filter_entries(list(ast_entry)::in, list(ast_import)::out, list(nq_named(ast_resource))::out, list(nq_named(ast_type(nq_name)))::out, list(nq_named(ast_function))::out, list(ast_pragma)::out) is det. %-----------------------------------------------------------------------% %-----------------------------------------------------------------------% :- implementation. :- import_module cord. :- import_module map. :- import_module maybe. :- import_module string. :- import_module builtins. :- import_module constant. :- import_module core.arity_chk. :- import_module core.branch_chk. :- import_module core.pretty. :- import_module core.res_chk. :- import_module core.simplify. :- import_module core.type_chk. :- import_module core_to_pz. :- import_module core_to_pz.data. :- import_module dump_stage. :- import_module file_utils. :- import_module pre. :- import_module pre.ast_to_core. :- import_module pre.env. :- import_module pre.import. :- import_module pz.pretty. :- import_module util.my_exception. :- import_module util.log. :- import_module util.path. %-----------------------------------------------------------------------% check_module_name(GOptions, Context, ModuleName, !Errors) :- MbModuleNameCheck = GOptions ^ go_module_name_check, ( MbModuleNameCheck = no ; MbModuleNameCheck = yes(ModuleNameCheck), ( if q_name_to_string(ModuleName) = ModuleNameCheck then true else add_error(Context, ce_module_name_not_match_build(ModuleName, ModuleNameCheck), !Errors) ) ), % The module name and file name are both converted to an internal % representation and then compared lexicographically. If that matches % then they match. This allows the file name to vary with case and % punctuation differences. ModuleNameStripped = strip_file_name_punctuation( q_name_to_string(ModuleName)), InputFileName = GOptions ^ go_input_file, file_part(InputFileName, InputFileNameNoPath), ( if filename_extension(source_extension, InputFileNameNoPath, InputFileNameBase), strip_file_name_punctuation(InputFileNameBase) = ModuleNameStripped then true else add_error(Context, ce_source_file_name_not_match_module(ModuleName, filename(InputFileName)), !Errors) ), OutputFileName = GOptions ^ go_output_file, ( if ( Extension = output_extension ; Extension = interface_extension ; Extension = typeres_extension ; Extension = depends_extension ), filename_extension(Extension, OutputFileName, OutputFileNameBase), strip_file_name_punctuation(OutputFileNameBase) = ModuleNameStripped then true else add_error(Context, ce_object_file_name_not_match_module(ModuleName, filename(OutputFileName)), !Errors) ). %-----------------------------------------------------------------------% process_declarations(GeneralOpts, ast(ModuleName, Context, Entries), Result, !IO) :- Verbose = GeneralOpts ^ go_verbose, some [!Env, !ImportEnv, !Core, !Errors] ( !:Errors = init, check_module_name(GeneralOpts, Context, ModuleName, !Errors), filter_entries(Entries, Imports, Resources0, Types0, Funcs, _), setup_env_and_core(ModuleName, !:ImportEnv, !:Env, !:Core), map_foldl3(gather_resource(ModuleName), Resources0, Resources, !ImportEnv, !Env, !Core), map_foldl3(gather_type(ModuleName), Types0, Types, !ImportEnv, !Env, !Core), ast_to_core_imports(Verbose, ModuleName, typeres_import, !.ImportEnv, GeneralOpts ^ go_import_whitelist_file, Imports, !Env, !Core, !Errors, !IO), ast_to_core_declarations(GeneralOpts, Resources, Types, Funcs, !.Env, _, !Core, !Errors, !IO), ( if not has_fatal_errors(!.Errors) then Result = ok(!.Core, !.Errors) else Result = errors(!.Errors) ) ). %-----------------------------------------------------------------------% compile(GeneralOpts, CompileOpts, ast(ModuleName, Context, Entries), Result, !IO) :- Verbose = GeneralOpts ^ go_verbose, some [!Env, !ImportEnv, !Core, !Errors] ( !:Errors = init, check_module_name(GeneralOpts, Context, ModuleName, !Errors), filter_entries(Entries, Imports, Resources0, Types0, Funcs, Pragmas), foldl(check_pragma, Pragmas, !Errors), setup_env_and_core(ModuleName, !:ImportEnv, !:Env, !:Core), map_foldl3(gather_resource(ModuleName), Resources0, Resources, !ImportEnv, !Env, !Core), map_foldl3(gather_type(ModuleName), Types0, Types, !ImportEnv, !Env, !Core), ast_to_core_imports(Verbose, ModuleName, interface_import, !.ImportEnv, GeneralOpts ^ go_import_whitelist_file, Imports, !Env, !Core, !Errors, !IO), ast_to_core_declarations(GeneralOpts, Resources, Types, Funcs, !Env, !Core, !Errors, !IO), ( if not has_fatal_errors(!.Errors) then verbose_output(Verbose, "pre_to_core: Processing function bodies\n", !IO), ast_to_core_funcs(GeneralOpts, ModuleName, Funcs, !.Env, !Core, !Errors, !IO), ( if not has_fatal_errors(!.Errors) then maybe_dump_core_stage(GeneralOpts, "core0_initial", !.Core, !IO), semantic_checks(GeneralOpts, CompileOpts, !.Core, CoreResult, !IO), ( CoreResult = ok(!:Core), core_to_pz(GeneralOpts ^ go_verbose, CompileOpts, !.Core, PZ, TypeTagMap, ConstructorTagMap, !IO), maybe_dump_stage(GeneralOpts, module_name(!.Core), "pz0_final", pz_pretty, PZ, !IO), maybe_dump_stage(GeneralOpts, module_name(!.Core), "data_rep", data_rep_pretty, {!.Core, TypeTagMap, ConstructorTagMap}, !IO), Result = ok(PZ, !.Errors) ; CoreResult = errors(SemErrors), Result = errors(!.Errors ++ SemErrors) ) else Result = errors(!.Errors) ) else Result = errors(!.Errors) ) ). %-----------------------------------------------------------------------% :- pred check_pragma(ast_pragma::in, errors(compile_error)::in, errors(compile_error)::out) is det. check_pragma(ast_pragma(Name, Args, Context), !Errors) :- ( if Name = "foreign_include" then % This is already checked in foreign.m but that only runs if we're % actually generating foreign code. Check it again here. ( if Args = [_] then true else add_error(Context, ce_pragma_bad_argument, !Errors) ) else add_error(Context, ce_pragma_unknown(Name), !Errors) ). %-----------------------------------------------------------------------% :- pred setup_env_and_core(q_name::in, env::out, env::out, core::out) is det. setup_env_and_core(ModuleName, ImportEnv, Env, !:Core) :- !:Core = core.init(ModuleName), setup_builtins(BuiltinMap, Operators, !Core), InitEnv0 = env.init(Operators), % Setup those builtins that are always module qualified: map.foldl(env_add_builtin(func(Name) = q_name_append(builtin_module_name, Name) ), BuiltinMap ^ bm_builtin_map, InitEnv0, InitEnv), % Setup those that are sometimes qulaified, We split the Environment in % two to create an environment were they are (ImportEnv) and one where % they arn't (Env). map.foldl(env_add_builtin(q_name), BuiltinMap ^ bm_root_map, InitEnv, Env), map.foldl(env_add_builtin(func(Name) = q_name_append(builtin_module_name, Name) ), BuiltinMap ^ bm_root_map, InitEnv, ImportEnv). :- pred env_add_builtin((func(T) = q_name)::in, T::in, builtin_item::in, env::in, env::out) is det. % Resources and types arn't copied into the new namespace with % env_import_star. But that's okay because that actually needs % replacing in the future so will fix this then (TODO). % env_add_builtin(MakeName, Name, bi_func(FuncId), !Env) :- env_add_func_det(MakeName(Name), FuncId, !Env). env_add_builtin(MakeName, Name, bi_ctor(CtorId), !Env) :- env_add_constructor(MakeName(Name), CtorId, !Env). env_add_builtin(MakeName, Name, bi_resource(ResId), !Env) :- env_add_resource_det(MakeName(Name), ResId, !Env). env_add_builtin(MakeName, Name, bi_type(TypeId, Arity), !Env) :- env_add_type_det(MakeName(Name), Arity, TypeId, !Env). env_add_builtin(MakeName, Name, bi_type_builtin(Builtin), !Env) :- env_add_builtin_type_det(MakeName(Name), Builtin, !Env). %-----------------------------------------------------------------------% :- pred gather_resource(q_name::in, nq_named(ast_resource)::in, a2c_resource::out, env::in, env::out, env::in, env::out, core::in, core::out) is det. gather_resource(ModuleName, nq_named(Name, Res), a2c_resource(Name, ResId, Res), !ImportEnv, !Env, !Core) :- core_allocate_resource_id(ResId, !Core), ( if env_add_resource(q_name(Name), ResId, !Env), Sharing = Res ^ ar_sharing, ( ( Sharing = so_public ; Sharing = so_public_opaque ), env_add_resource(q_name_append(ModuleName, Name), ResId, !ImportEnv) ; Sharing = so_private ) then true else compile_error($file, $pred, "Resource already defined") ). :- pred gather_type(q_name::in, nq_named(ast_type(nq_name))::in, a2c_type::out, env::in, env::out, env::in, env::out, core::in, core::out) is det. gather_type(ModuleName, nq_named(Name, Type), a2c_type(Name, TypeId, Type), !ImportEnv, !Env, !Core) :- core_allocate_type_id(TypeId, !Core), Arity = type_arity(Type), ( if env_add_type(q_name(Name), Arity, TypeId, !Env), Sharing = Type ^ at_export, ( ( Sharing = so_public ; Sharing = so_public_opaque ), env_add_type(q_name_append(ModuleName, Name), Arity, TypeId, !ImportEnv) ; Sharing = so_private ) then true else compile_error($file, $pred, "Type already defined") ). %-----------------------------------------------------------------------% find_typeres_exports(GeneralOpts, ast(ModuleName, Context, Entries)) = Result :- some [!Errors] ( !:Errors = init, check_module_name(GeneralOpts, Context, ModuleName, !Errors), filter_entries(Entries, _, Resources0, Types0, _, _), filter_map((pred(NamedRes::in, Name::out) is semidet :- NamedRes = nq_named(NQName, ast_resource(_, Sharing, _)), ( Sharing = so_public ; Sharing = so_public_opaque ), Name = q_name_append(ModuleName, NQName) ), Resources0, Resources), filter_map((pred(NamedRes::in, {Name, Arity}::out) is semidet :- NamedRes = nq_named(NQName, ast_type(Params, _, Sharing, _)), ( Sharing = so_public ; Sharing = so_public_opaque ), Name = q_name_append(ModuleName, NQName), Arity = arity(length(Params)) ), Types0, Types), ( if not has_fatal_errors(!.Errors) then Result = ok(typeres_exports(Resources, Types), !.Errors) else Result = errors(!.Errors) ) ). %-----------------------------------------------------------------------% filter_entries([], [], [], [], [], []). filter_entries([E | Es], !:Is, !:Rs, !:Ts, !:Fs, !:Ps) :- filter_entries(Es, !:Is, !:Rs, !:Ts, !:Fs, !:Ps), ( E = ast_import(I), !:Is = [I | !.Is] ; E = ast_resource(N, R), !:Rs = [nq_named(N, R) | !.Rs] ; E = ast_type(N, T), !:Ts = [nq_named(N, T) | !.Ts] ; E = ast_function(N, F), !:Fs = [nq_named(N, F) | !.Fs] ; E = ast_pragma(P), !:Ps = [P | !.Ps] ). %-----------------------------------------------------------------------% :- pred semantic_checks(general_options::in, compile_options::in, core::in, result(core, compile_error)::out, io::di, io::uo) is det. semantic_checks(GeneralOpts, CompileOpts, !.Core, Result, !IO) :- some [!Errors] ( !:Errors = init, Verbose = GeneralOpts ^ go_verbose, verbose_output(Verbose, "Core: arity checking\n", !IO), arity_check(Verbose, ArityErrors, !Core, !IO), maybe_dump_core_stage(GeneralOpts, "core1_arity", !.Core, !IO), add_errors(ArityErrors, !Errors), Simplify = CompileOpts ^ co_do_simplify, ( Simplify = do_simplify_pass, verbose_output(Verbose, "Core: simplify pass\n", !IO), simplify(Verbose, SimplifyErrors, !Core, !IO), maybe_dump_core_stage(GeneralOpts, "core2_simplify", !.Core, !IO), add_errors(SimplifyErrors, !Errors) ; Simplify = skip_simplify_pass ), ( if not has_fatal_errors(!.Errors) then verbose_output(Verbose, "Core: type checking\n", !IO), type_check(Verbose, TypecheckErrors, !Core, !IO), maybe_dump_core_stage(GeneralOpts, "core3_typecheck", !.Core, !IO), add_errors(TypecheckErrors, !Errors), verbose_output(Verbose, "Core: branch checking\n", !IO), branch_check(Verbose, BranchcheckErrors, !Core, !IO), maybe_dump_core_stage(GeneralOpts, "core4_branch", !.Core, !IO), add_errors(BranchcheckErrors, !Errors), verbose_output(Verbose, "Core: resource checking\n", !IO), res_check(Verbose, RescheckErrors, !Core, !IO), maybe_dump_core_stage(GeneralOpts, "core5_res", !.Core, !IO), add_errors(RescheckErrors, !Errors), ( if not has_fatal_errors(!.Errors) then Result = ok(!.Core) else Result = errors(!.Errors) ) else Result = errors(!.Errors) ) ). %-----------------------------------------------------------------------% :- pred maybe_dump_core_stage(general_options::in, string::in, core::in, io::di, io::uo) is det. maybe_dump_core_stage(Opts, Stage, Core, !IO) :- maybe_dump_stage(Opts, module_name(Core), Stage, core_pretty, Core, !IO). %-----------------------------------------------------------------------% %-----------------------------------------------------------------------% ================================================ FILE: src/compile_error.m ================================================ %-----------------------------------------------------------------------% % vim: ts=4 sw=4 et %-----------------------------------------------------------------------% :- module compile_error. % % Copyright (C) Plasma Team % Distributed under the terms of the MIT License see ../LICENSE.code % % This module defines possible Plasma compilation errors. % %-----------------------------------------------------------------------% :- interface. :- import_module list. :- import_module maybe. :- import_module common_types. :- import_module core. :- import_module core.resource. :- import_module parse_util. :- import_module q_name. :- import_module util. :- import_module util.pretty. :- import_module util.result. %-----------------------------------------------------------------------% :- type filename ---> filename(string). :- type compile_error % Errors for reading source code or the organisation of code (module and % file names don't match, etc). % This creates a dependency on the parser, I'm uneasy about % this. ---> ce_read_source_error(read_src_error) ; ce_module_name_not_match_build(q_name, string) ; ce_source_file_name_not_match_module(q_name, filename) ; ce_object_file_name_not_match_module(q_name, filename) ; ce_module_not_found(q_name) ; ce_module_unavailable(q_name, q_name) ; ce_interface_contains_wrong_module(filename, q_name, q_name) ; ce_import_would_clobber(q_name, maybe(q_name)) ; ce_import_duplicate(q_name) % Generic errors with the binding of symbols. ; ce_function_already_defined(string) ; ce_entry_function_wrong_signature % Type related errors ; ce_type_already_defined(q_name) ; ce_type_duplicate_constructor(q_name) ; ce_type_not_known(q_name) ; ce_type_not_public_in_type(nq_name, nq_name) ; ce_type_not_public_in_func(nq_name, nq_name) ; ce_type_var_unknown(string) ; ce_type_has_incorrect_num_of_args(q_name, int, int) ; ce_builtin_type_with_args(q_name) ; ce_type_var_with_args(string) ; ce_type_error(type_error) ; ce_type_floundering(list(pretty), list(pretty)) % Pattern matching ; ce_match_has_no_cases ; ce_match_does_not_cover_all_cases ; ce_match_unreached_cases ; ce_match_duplicate_case ; ce_match_on_function_type ; ce_case_does_not_define_all_variables(list(string)) % Arity related. ; ce_arity_mismatch_func(arity, arity) ; ce_arity_mismatch_expr(arity, arity) ; ce_arity_mismatch_tuple ; ce_arity_mismatch_match(list(maybe(arity))) ; ce_parameter_number(int, int) ; ce_no_return_statement(arity) % Resource system ; ce_uses_observes_not_distinct(list(resource)) ; ce_resource_unavailable_call ; ce_resource_unavailable_arg ; ce_resource_unavailable_output ; ce_resource_unknown(q_name) ; ce_resource_not_public_in_resource(nq_name, nq_name) ; ce_resource_not_public_in_type(nq_name, nq_name) ; ce_resource_not_public_in_function(nq_name, nq_name) ; ce_too_many_bangs_in_statement ; ce_no_bang ; ce_unnecessary_bang % Pragma related. ; ce_pragma_unknown(string) ; ce_pragma_bad_argument. :- type type_error ---> type_unification_failed(pretty, pretty, maybe(type_error)) ; type_unification_occurs(pretty, pretty). :- instance error(compile_error). %-----------------------------------------------------------------------% %-----------------------------------------------------------------------% :- implementation. :- import_module cord. :- import_module string. %-----------------------------------------------------------------------% :- instance error(compile_error) where [ func(error_or_warning/1) is ce_error_or_warning, pred(pretty/4) is ce_to_pretty ]. :- func ce_error_or_warning(compile_error) = error_or_warning. ce_error_or_warning(Error) = ( if Error = ce_unnecessary_bang ; Error = ce_import_duplicate(_) ; Error = ce_pragma_unknown(_) then warning else error ). :- pred ce_to_pretty(string::in, compile_error::in, list(pretty)::out, list(pretty)::out) is det. ce_to_pretty(SrcPath, ce_read_source_error(E), Para, Extra) :- pretty(SrcPath, E, Para, Extra). ce_to_pretty(_, ce_module_name_not_match_build(Module, ModuleInBuild), Para, []) :- Para = p_words("The module name from the source file") ++ p_spc_nl ++ [p_quote("'", q_name_pretty(Module))] ++ p_spc_nl ++ p_words("does not match the module name from the BUILD.plz file") ++ p_spc_nl ++ [p_quote("'", p_str(ModuleInBuild))]. ce_to_pretty(SrcPath, ce_source_file_name_not_match_module(Expect, Got), Para, []) :- Para = p_words("The source filename") ++ p_spc_nl ++ p_file(SrcPath, Got) ++ p_spc_nl ++ p_words("does not match the module name") ++ p_spc_nl ++ [p_quote("'", q_name_pretty(Expect))]. ce_to_pretty(SrcPath, ce_object_file_name_not_match_module(Expect, Got), Para, []) :- Para = p_words("The output filename") ++ p_spc_nl ++ p_file(SrcPath, Got) ++ p_spc_nl ++ p_words("does not match the module name") ++ p_spc_nl ++ [p_quote("'", q_name_pretty(Expect))]. ce_to_pretty(_, ce_module_not_found(Name), Para, []) :- Para = p_words("The interface file for the imported module") ++ p_spc_nl ++ [p_str("("), q_name_pretty(Name), p_str(")")] ++ p_spc_nl ++ p_words("cannot be found. Was the module listed in BUILD.plz?"). ce_to_pretty(_, ce_module_unavailable(Importee, Importer), Para, []) :- Para = p_words("The module") ++ p_spc_nl ++ [q_name_pretty(Importee)] ++ p_spc_nl ++ p_words("can't be included because it is not listed in all the " ++ "build file's module lists that include module") ++ p_spc_nl ++ [q_name_pretty(Importer)]. ce_to_pretty(SrcPath, ce_interface_contains_wrong_module(File, Expect, Got), Para, []) :- Para = p_words("The interface file") ++ p_spc_nl ++ p_file(SrcPath, File) ++ p_spc_nl ++ p_words("describes the wrong module, got:") ++ p_spc_nl ++ [p_quote("'", q_name_pretty(Got))] ++ p_spc_nl ++ [p_str("expected:")] ++ p_spc_nl ++ [p_quote("'", q_name_pretty(Expect))]. ce_to_pretty(_, ce_import_would_clobber(ModuleName, MaybeAsName), Para, []) :- ParaA = p_words("The import of") ++ p_spc_nl ++ [p_quote("'", q_name_pretty(ModuleName))] ++ p_spc_nl, ( MaybeAsName = no, ParaB = p_words("clobbers a previous import to that name") ; MaybeAsName = yes(AsName), ParaB = [p_str("clobbers")] ++ p_spc_nl ++ [p_quote("'", q_name_pretty(AsName))] ++ p_spc_nl ++ p_words("which is used by a previous import") ), Para = ParaA ++ ParaB. ce_to_pretty(_, ce_import_duplicate(ModuleName), Para, []) :- Para = p_words("The import of") ++ p_spc_nl ++ [p_quote("'", q_name_pretty(ModuleName))] ++ p_spc_nl ++ p_words("is redundant, this module is already imported"). ce_to_pretty(_, ce_function_already_defined(Name), Para, []) :- Para = p_words("Function already defined:") ++ p_spc_nl ++ [p_str(Name)]. ce_to_pretty(_, ce_entry_function_wrong_signature, Para, []) :- Para = p_words("A function that is marked as an entrypoint does not " ++ "have the correct signature for an entrypoint."). ce_to_pretty(_, ce_type_already_defined(Name), Para, []) :- Para = p_words("Type already defined: ") ++ p_spc_nl ++ [q_name_pretty(Name)]. ce_to_pretty(_, ce_type_duplicate_constructor(Name), Para, []) :- Para = p_words("This type already has a constructor named") ++ p_spc_nl ++ [p_quote("'", q_name_pretty(Name))]. ce_to_pretty(_, ce_type_not_known(Name), Para, []) :- Para = p_words("Unknown type:") ++ p_spc_nl ++ [q_name_pretty(Name)]. ce_to_pretty(_, ce_type_not_public_in_type(Referer, Referee), Para, []) :- Para = p_words("The type") ++ p_spc_nl ++ [nq_name_pretty(Referer)] ++ p_spc_nl ++ p_words("is exported, but it refers to another type") ++ p_spc_nl ++ [nq_name_pretty(Referee)] ++ p_spc_nl ++ p_words("which is not."). ce_to_pretty(_, ce_type_not_public_in_func(Func, Type), Para, []) :- Para = p_words("The function") ++ p_spc_nl ++ [nq_name_pretty(Func)] ++ p_spc_nl ++ p_words("is exported, but it refers to the type") ++ p_spc_nl ++ [nq_name_pretty(Type)] ++ p_spc_nl ++ p_words("which is not."). ce_to_pretty(_, ce_type_var_unknown(Name), Para, []) :- Para = p_words("Type variable") ++ p_spc_nl ++ [p_quote("'", p_str(Name))] ++ p_spc_nl ++ p_words("does not appear on left of '=' in type definition"). ce_to_pretty(_, ce_type_has_incorrect_num_of_args(Name, Want, Got), Para, []) :- Para = p_words("Wrong number of type args for ") ++ p_spc_nl ++ [p_quote("'", q_name_pretty(Name)), p_str(",")] ++ p_spc_nl ++ [p_str("expected: "), p_str(string(Want)), p_str(",")] ++ p_spc_nl ++ [p_str("got: "), p_str(string(Got))]. ce_to_pretty(_, ce_builtin_type_with_args(Name), Para, []) :- Para = p_words("Builtin type") ++ p_spc_nl ++ [p_quote("'", q_name_pretty(Name))] ++ p_spc_nl ++ p_words("does not take arguments"). ce_to_pretty(_, ce_type_var_with_args(Name), Para, []) :- Para = p_words("Type variables (like") ++ p_spc_nl ++ [p_quote("'", p_str(Name))] ++ p_spc_nl ++ p_words("cannot take arguments"). ce_to_pretty(_, ce_type_error(TypeError), Para, []) :- Para = type_error_pretty(TypeError). ce_to_pretty(_, ce_type_floundering(Vars, Clauses), Para, Extra) :- Para = p_words("Ambigious types"), Extra = [ p_expr([p_str("The unbound solver variables are: "), p_nl_hard, p_list(pretty_seperated([p_nl_hard], Vars))]), p_nl_double, p_expr([p_str("The unresolved solver clauses are: "), p_nl_hard, p_list(pretty_seperated([p_nl_double], Clauses))])]. ce_to_pretty(_, ce_match_has_no_cases, p_words("Match expression has no cases"), []). ce_to_pretty(_, ce_match_does_not_cover_all_cases, p_words("Match does not cover all cases"), []). ce_to_pretty(_, ce_match_unreached_cases, p_words("This case will never be tested because earlier cases cover " ++ "all values"), []). ce_to_pretty(_, ce_match_duplicate_case, p_words("This case occurs multiple times in this match"), []). ce_to_pretty(_, ce_match_on_function_type, p_words("Attempt to pattern match on a function"), []). ce_to_pretty(_, ce_case_does_not_define_all_variables(Vars), p_words("This branch did not initialise variables initialised on other branches, they are:") ++ [p_nl_soft, p_str(" "), p_list(pretty_seperated([p_str(", "), p_nl_soft], map(p_str, Vars)))], []). ce_to_pretty(_, Error, Pretty, []) :- % These to errors are broken and can't be properly distinguished. ( Error = ce_arity_mismatch_func(Got, Expect) ; Error = ce_arity_mismatch_expr(Got, Expect) ), Pretty = p_words(format( "Arity error got %d values, but %d values were expected", [i(Got ^ a_num), i(Expect ^ a_num)])). %ce_to_pretty(ce_arity_mismatch_func(Decl, Infer)) = % format("Function has %d declared results but returns %d results", % [i(Decl ^ a_num), i(Infer ^ a_num)]). %ce_to_pretty(ce_arity_mismatch_expr(Got, Expect)) = % format("Expression returns %d values, but %d values were expected", % [i(Got ^ a_num), i(Expect ^ a_num)]). ce_to_pretty(_, ce_arity_mismatch_tuple, p_words("Arity mismatch in tuple, could be called by arguments to call"), []). ce_to_pretty(_, ce_arity_mismatch_match(Arities), Para, []) :- Para = p_words("Match expression has cases with different arrites, " ++ " they are:") ++ p_spc_nl ++ [p_expr(pretty_comma_seperated( map((func(MA) = S :- ( MA = yes(A), S = p_str(string(A ^ a_num)) ; MA = no, S = p_str("_") ) ), Arities) ))]. ce_to_pretty(_, ce_parameter_number(Exp, Got), Para, []) :- Para = p_words(format("Wrong number of parameters in function call, " ++ "expected %d got %d", [i(Exp), i(Got)])). ce_to_pretty(_, ce_no_return_statement(Arity), Para, []) :- Para = p_words(format( "Function returns %d results but this path has no return statement", [i(Arity ^ a_num)])). ce_to_pretty(_, ce_uses_observes_not_distinct(Resources), Para, []) :- Para = p_words("A resource cannot appear in both the uses and observes " ++ "lists, found resources:") ++ p_spc_nl ++ pretty_comma_seperated(map(func(R) = p_str(resource_to_string(R)), Resources)). ce_to_pretty(_, ce_resource_unavailable_call, p_words("One or more resources needed for this call is unavailable " ++ "in this function"), []). ce_to_pretty(_, ce_resource_unavailable_arg, p_words("One or more resources needed for an argument to a call " ++ "is not provided in by the passed-in value"), []). ce_to_pretty(_, ce_resource_unavailable_output, p_words("The function returns a higher order value that uses or " ++ "observes one or more resources, however the resources arn't " ++ "declared in the function's return type"), []). ce_to_pretty(_, ce_resource_unknown(Res), p_words("Unknown resource") ++ p_spc_nl ++ [p_quote("'", q_name_pretty(Res))], []). ce_to_pretty(_, ce_resource_not_public_in_resource(Res, From), Para, []) :- Para = p_words("The resource") ++ p_spc_nl ++ [nq_name_pretty(Res)] ++ p_spc_nl ++ p_words("is exported, but it depends on") ++ p_spc_nl ++ [nq_name_pretty(From)] ++ p_spc_nl ++ p_words("which is not"). ce_to_pretty(_, ce_resource_not_public_in_type(Type, Res), Para, []) :- Para = p_words("The type") ++ p_spc_nl ++ [nq_name_pretty(Type)] ++ p_spc_nl ++ p_words("is exported, but it refers to the resource") ++ p_spc_nl ++ [nq_name_pretty(Res)] ++ p_spc_nl ++ p_words("which is not exported"). ce_to_pretty(_, ce_resource_not_public_in_function(Func, Res), Para, []) :- Para = p_words("The function") ++ p_spc_nl ++ [nq_name_pretty(Func)] ++ p_spc_nl ++ p_words("is exported, but it refers to the resource") ++ p_spc_nl ++ [nq_name_pretty(Res)] ++ p_spc_nl ++ p_words("which is not exported"). ce_to_pretty(_, ce_too_many_bangs_in_statement, p_words("Statement has more than one ! call"), []). ce_to_pretty(_, ce_no_bang, p_words("Call uses or observes a resource but has no !"), []). ce_to_pretty(_, ce_unnecessary_bang, p_words("Call has a ! but does not need it"), []). ce_to_pretty(_, ce_pragma_unknown(Pragma), Para, []) :- Para = p_words("Pragma") ++ p_spc_nl ++ [p_quote("'", p_str(Pragma))] ++ p_spc_nl ++ p_words("is unrecognised and will be ignored"). ce_to_pretty(_, ce_pragma_bad_argument, Para, []) :- Para = p_words("Unrecognised argument for this pragma"). :- func type_error_pretty(type_error) = list(pretty). type_error_pretty(type_unification_failed(Type1, Type2, MaybeWhy)) = Error :- Error = [p_quote("\"", Type1)] ++ p_spc_nl ++ [p_str("and")] ++ p_spc_nl ++ [p_quote("\"", Type2)] ++ p_spc_nl ++ p_words("are not the same") ++ WhyError, ( MaybeWhy = yes(Why), WhyError = p_words(", because") ++ [p_nl_hard] ++ type_error_pretty(Why) ; MaybeWhy = no, WhyError = [] ). type_error_pretty(type_unification_occurs(Var, Type)) = [p_str("Type error: "), p_str("The type "), p_quote("\"", Var)] ++ p_spc_nl ++ p_words("cannot be bound to") ++ p_spc_nl ++ [p_quote("\"", Type)] ++ p_spc_nl ++ p_words("because it can't contain itself."). :- func p_file(string, filename) = list(pretty). p_file(SourcePath, filename(File0)) = [p_quote("'", p_str(File))] :- ( if append(SourcePath, File1, File0) then File = File1 else File = File0 ). %-----------------------------------------------------------------------% ================================================ FILE: src/constant.m ================================================ %-----------------------------------------------------------------------% % Plasma constants % vim: ts=4 sw=4 et % % Copyright (C) Plasma Team % Distributed under the terms of the MIT License see ../LICENSE.code % % This module provides constants used in the compiler and other tools. % %-----------------------------------------------------------------------% :- module constant. %-----------------------------------------------------------------------% :- interface. :- import_module io. :- func source_extension = string. :- func typeres_extension = string. :- func interface_extension = string. :- func depends_extension = string. :- func pz_text_extension = string. :- func output_extension = string. :- func library_extension = string. :- func native_object_extension = string. :- func native_dylib_extension = string. :- func cpp_extension = string. :- func c_header_extension = string. :- func build_file = string. :- func build_directory = string. :- func ninja_rules_file = string. :- func ninja_vars_file = string. :- func ninja_build_file = string. :- func import_whitelist_file_no_directroy = string. %-----------------------------------------------------------------------% :- func version_string = string. % Print the version message. % :- pred version(string::in, io::di, io::uo) is det. %-----------------------------------------------------------------------% %-----------------------------------------------------------------------% :- implementation. :- import_module list. :- import_module string. %-----------------------------------------------------------------------% source_extension = ".p". typeres_extension = ".typeres". interface_extension = ".pi". depends_extension = ".dep". pz_text_extension = ".pzt". output_extension = ".pzo". library_extension = ".pz". native_object_extension = ".o". native_dylib_extension = ".so". cpp_extension = ".cpp". c_header_extension = ".h". build_file = "BUILD.plz". build_directory = "_build". ninja_rules_file = "rules.ninja". ninja_vars_file = "vars.ninja". ninja_build_file = "build.ninja". % Ninja requires it uses this name. import_whitelist_file_no_directroy = "include_whitelist.txt". %-----------------------------------------------------------------------% :- pragma foreign_decl("C", include_file("../runtime/pz_config.h")). :- pragma foreign_proc("C", version_string = (Version::out), [promise_pure, thread_safe, will_not_call_mercury, will_not_throw_exception], " Version = GC_STRDUP(PLASMA_VERSION_STRING); "). version(Name, !IO) :- io.format("%s, %s\n", [s(Name), s(version_string)], !IO), io.write_string("https://plasmalang.org\n", !IO), io.write_string("Copyright (C) 2015-2025 The Plasma Team\n", !IO), io.write_string("Distributed under the MIT License\n", !IO). %-----------------------------------------------------------------------% %-----------------------------------------------------------------------% ================================================ FILE: src/context.m ================================================ %-----------------------------------------------------------------------% % vim: ts=4 sw=4 et %-----------------------------------------------------------------------% :- module context. % % A location in a source file % % Copyright (C) Plasma Team % Distributed under the terms of the MIT License see ../LICENSE.code % %-----------------------------------------------------------------------% :- interface. :- import_module string. %-----------------------------------------------------------------------% :- type context ---> context( c_file :: string, c_line :: int, c_col :: int ). :- func context(string) = context. :- func context(string, int) = context. %-----------------------------------------------------------------------% :- func nil_context = context. :- pred is_nil_context(context::in) is semidet. :- func builtin_context = context. :- func command_line_context = context. :- func context_string(context) = string. % context_string(SourcePath, Context) = Pretty. % % Print the context but with the initial SourcePath removed. % :- func context_string(string, context) = string. %-----------------------------------------------------------------------% :- func context_earliest(context, context) = context. %-----------------------------------------------------------------------% %-----------------------------------------------------------------------% :- implementation. :- import_module list. %-----------------------------------------------------------------------% context(Name) = context(Name, 0, 0). context(Name, Line) = context(Name, Line, 0). %-----------------------------------------------------------------------% nil_context = context(""). is_nil_context(context("", _, _)). builtin_context = context("builtin"). command_line_context = context("Command line"). %-----------------------------------------------------------------------% context_string(Context) = context_string("", Context). % We do not print the character information, I'm pretty sure that they're % inaccurate because whitespace is not included in their calculation (see % the tokenize and tokenize_line predicates). But we still store them to % make comparing contexts feasible. context_string(SourcePath, context(File0, Line, _)) = Pretty :- ( if append(SourcePath, File1, File0) then File = File1 else File = File0 ), ( if Line = 0 then Pretty = File else Pretty = format("%s:%d", [s(File), i(Line)]) ). %-----------------------------------------------------------------------% context_earliest(C1, C2) = ( if compare((<), C1, C2) then C1 else C2 ). %-----------------------------------------------------------------------% %-----------------------------------------------------------------------% ================================================ FILE: src/core.arity_chk.m ================================================ %-----------------------------------------------------------------------% % Plasma arity checking % vim: ts=4 sw=4 et % % Copyright (C) Plasma Team % Distributed under the terms of the MIT see ../LICENSE.code % % Annotate each expression with its arity (the number of things it returns). % %-----------------------------------------------------------------------% :- module core.arity_chk. %-----------------------------------------------------------------------% :- interface. :- import_module io. :- import_module util.log. :- import_module util.result. :- import_module compile_error. %-----------------------------------------------------------------------% :- pred arity_check(log_config::in, errors(compile_error)::out, core::in, core::out, io::di, io::uo) is det. %-----------------------------------------------------------------------% %-----------------------------------------------------------------------% :- implementation. :- import_module cord. :- import_module require. :- import_module core.util. %-----------------------------------------------------------------------% arity_check(Verbose, Errors, !Core, !IO) :- process_noerror_funcs(Verbose, compute_arity_func, Errors, !Core, !IO). :- pred compute_arity_func(core::in, Unused::in, function::in, result_partial(function, compile_error)::out) is det. compute_arity_func(Core, _, Func0, Result) :- func_get_type_signature(Func0, _, _, DeclaredArity), ( if func_get_body(Func0, Varmap, Args, Captured, Expr0) then compute_arity_expr(Core, Expr0, Expr1, ArityResult), ( ArityResult = ok(yes(Arity)), Origin = code_info_origin(Expr1 ^ e_info), ( if Arity = DeclaredArity then func_set_body(Varmap, Args, Captured, Expr1, Func0, Func), Result = ok(Func, init) else if Origin = o_user_return(_) then Result = errors(error(func_get_context(Func0), ce_arity_mismatch_func(DeclaredArity, Arity))) else Result = errors(error(code_info_context(Expr1 ^ e_info), ce_arity_mismatch_expr(Arity, DeclaredArity))) ) ; ArityResult = ok(no), push_arity_into_expr(DeclaredArity, Expr1, Expr), func_set_body(Varmap, Args, Captured, Expr, Func0, Func), Result = ok(Func, init) ; ArityResult = errors(Errors), Result = errors(Errors) ) else unexpected($file, $pred, "Imported function") ). :- pred compute_arity_expr(core::in, expr::in, expr::out, result(maybe(arity), compile_error)::out) is det. compute_arity_expr(Core, expr(ExprType0, CodeInfo0), expr(ExprType, CodeInfo), Result) :- ( ExprType0 = e_tuple(Exprs0), ( if Exprs0 = [Expr0] then % Arity checking is easier without singleton tuples, simplify them % now (the real simplification pass happens after arity % checking). compute_arity_expr(Core, Expr0, expr(ExprType, CodeInfo), Result) else compute_arity_expr_tuple(Core, Exprs0, Exprs, CodeInfo0, CodeInfo, Result), ExprType = e_tuple(Exprs) ) ; ExprType0 = e_lets(Lets0, Expr0), compute_arity_expr_lets(Core, Lets0, Lets, Expr0, Expr, CodeInfo0, CodeInfo, Result), ExprType = e_lets(Lets, Expr) ; ExprType0 = e_call(Callee, Args, MaybeResources), ExprType = e_call(Callee, Args, MaybeResources), compute_arity_expr_call(Core, Callee, Args, CodeInfo0, CodeInfo, Result) ; ExprType0 = e_match(Var, Cases0), compute_arity_expr_match(Core, Cases0, Cases, CodeInfo0, CodeInfo, Result), ExprType = e_match(Var, Cases) ; ( ExprType0 = e_var(_) ; ExprType0 = e_constant(_) ; ExprType0 = e_construction(_, _) ; ExprType0 = e_closure(_, _) ), Arity = arity(1), code_info_set_arity(Arity, CodeInfo0, CodeInfo), ExprType = ExprType0, Result = ok(yes(Arity)) ). :- pred compute_arity_expr_tuple(core::in, list(expr)::in, list(expr)::out, code_info::in, code_info::out, result(maybe(arity), compile_error)::out) is det. compute_arity_expr_tuple(Core, !Exprs, !CodeInfo, Result) :- map2(compute_arity_expr_in_tuple(Core), !Exprs, TupleErrorss), Arity = arity(length(!.Exprs)), code_info_set_arity(Arity, !CodeInfo), TupleErrors = cord_list_to_cord(TupleErrorss), ( if is_empty(TupleErrors) then Result = ok(yes(Arity)) else Result = errors(TupleErrors) ). :- pred compute_arity_expr_in_tuple(core::in, expr::in, expr::out, errors(compile_error)::out) is det. compute_arity_expr_in_tuple(Core, !Expr, Errors) :- compute_arity_expr(Core, !Expr, Result), ( Result = errors(Errors) ; Result = ok(MaybeArity), ( MaybeArity = yes(Arity), ( if Arity = arity(1) then Errors = init else Errors = error(code_info_context(!.Expr ^ e_info), ce_arity_mismatch_tuple) ) ; MaybeArity = no, push_arity_into_expr(arity(1), !Expr), Errors = init ) ). :- pred compute_arity_expr_lets(core::in, list(expr_let)::in, list(expr_let)::out, expr::in, expr::out, code_info::in, code_info::out, result(maybe(arity), compile_error)::out) is det. compute_arity_expr_lets(Core, Lets0, Lets, Expr0, Expr, !CodeInfo, Result) :- map2(compute_arity_expr_let(Core), Lets0, Lets, LetsErrors0), LetsErrors = cord_list_to_cord(LetsErrors0), compute_arity_expr(Core, Expr0, Expr, Result0), ( Result0 = ok(MaybeArity), ( if is_empty(LetsErrors) then ( MaybeArity = yes(Arity), code_info_set_arity(Arity, !CodeInfo) ; MaybeArity = no ), Result = Result0 else Result = errors(LetsErrors) ) ; Result0 = errors(Errors), Result = errors(LetsErrors ++ Errors) ). :- pred compute_arity_expr_let(core::in, expr_let::in, expr_let::out, errors(compile_error)::out) is det. compute_arity_expr_let(Core, e_let(Vars, Expr0), e_let(Vars, Expr), Result) :- compute_arity_expr(Core, Expr0, Expr1, LetRes), VarsArity = arity(length(Vars)), ( LetRes = ok(MaybeLetArity), ( MaybeLetArity = yes(LetArity), Expr = Expr1, ( if VarsArity = LetArity then Result = init else Result = error( code_info_context(Expr ^ e_info), ce_arity_mismatch_expr(LetArity, VarsArity)) ) ; MaybeLetArity = no, push_arity_into_expr(VarsArity, Expr1, Expr), Result = init ) ; LetRes = errors(Errors), Expr = Expr1, Result = Errors ). :- pred compute_arity_expr_call(core::in, callee::in, list(T)::in, code_info::in, code_info::out, result(maybe(arity), compile_error)::out) is det. compute_arity_expr_call(Core, Callee, Args, !CodeInfo, Result) :- ( Callee = c_plain(FuncId), core_get_function_det(Core, FuncId, CalleeFn), func_get_type_signature(CalleeFn, Inputs, _, Arity), length(Inputs, InputsLen), length(Args, ArgsLen), ( if InputsLen = ArgsLen then InputErrors = init else InputErrors = error(code_info_context(!.CodeInfo), ce_parameter_number(length(Inputs), length(Args))) ), code_info_set_arity(Arity, !CodeInfo), ( if is_empty(InputErrors) then Result = ok(yes(Arity)) else Result = errors(InputErrors) ) ; Callee = c_ho(_), Result = ok(no) ). :- pred compute_arity_expr_match(core::in, list(expr_case)::in, list(expr_case)::out, code_info::in, code_info::out, result(maybe(arity), compile_error)::out) is det. compute_arity_expr_match(Core, !Cases, !CodeInfo, Result) :- Context = code_info_context(!.CodeInfo), map2(compute_arity_case(Core), !Cases, CaseResults), Result0 = result_list_to_result(CaseResults), ( Result0 = ok(CaseArities), filter_map((pred(yes(A)::in, A::out) is semidet), CaseArities, KnownCaseArities), ( KnownCaseArities = [], Result = ok(no) ; KnownCaseArities = [Arity | _], ( if all_same(KnownCaseArities) then code_info_set_arity(Arity, !CodeInfo), map(update_arity_case(Arity), !Cases), Result = ok(yes(Arity)) else Result = return_error(Context, ce_arity_mismatch_match(CaseArities)) ) ) ; Result0 = errors(Errors), Result = errors(Errors) ). :- pred compute_arity_case(core::in, expr_case::in, expr_case::out, result(maybe(arity), compile_error)::out) is det. compute_arity_case(Core, e_case(Pat, Expr0), e_case(Pat, Expr), Result) :- compute_arity_expr(Core, Expr0, Expr, Result). :- pred update_arity_case(arity::in, expr_case::in, expr_case::out) is det. update_arity_case(Arity, e_case(Pat, Expr0), e_case(Pat, Expr)) :- CodeInfo0 = Expr0 ^ e_info, ( if code_info_arity(CodeInfo0, _Arity0) then Expr = Expr0 else push_arity_into_expr(Arity, Expr0, Expr) ). :- pred push_arity_into_expr(arity::in, expr::in, expr::out) is det. push_arity_into_expr(Arity, !Expr) :- some [!CodeInfo] ( !:CodeInfo = !.Expr ^ e_info, ( if not code_info_arity(!.CodeInfo, _) then code_info_set_arity(Arity, !CodeInfo), !Expr ^ e_info := !.CodeInfo, some [!EType] ( !:EType = !.Expr ^ e_type, ( !.EType = e_lets(Lets, Expr0), push_arity_into_expr(Arity, Expr0, Expr), !:EType = e_lets(Lets, Expr) ; !.EType = e_call(_, _, _) ; !.EType = e_match(Var, Cases0), Cases = map((func(e_case(Pat, E0)) = e_case(Pat, E) :- push_arity_into_expr(Arity, E0, E) ), Cases0), !:EType = e_match(Var, Cases) ; ( !.EType = e_tuple(_) ; !.EType = e_var(_) ; !.EType = e_constant(_) ; !.EType = e_construction(_, _) ; !.EType = e_closure(_, _) ), unexpected($file, $pred, "This expression should already have an arity") ), !Expr ^ e_type := !.EType ) else true ) ). %-----------------------------------------------------------------------% %-----------------------------------------------------------------------% ================================================ FILE: src/core.branch_chk.m ================================================ %-----------------------------------------------------------------------% % vim: ts=4 sw=4 et %-----------------------------------------------------------------------% :- module core.branch_chk. % % Copyright (C) Plasma Team % Distributed under the terms of the MIT see ../LICENSE.code % % Plasma branch checking. % %-----------------------------------------------------------------------% :- interface. :- import_module io. :- import_module compile_error. :- import_module util.log. :- import_module util.result. :- pred branch_check(log_config::in, errors(compile_error)::out, core::in, core::out, io::di, io::uo) is det. %-----------------------------------------------------------------------% %-----------------------------------------------------------------------% :- implementation. :- import_module cord. :- import_module require. :- import_module context. :- import_module core.util. :- import_module util.mercury. %-----------------------------------------------------------------------% branch_check(Verbose, Errors, !Core, !IO) :- process_noerror_funcs(Verbose, branchcheck_func, Errors, !Core, !IO). :- pred branchcheck_func(core::in, func_id::in, function::in, result_partial(function, compile_error)::out) is det. branchcheck_func(Core, _FuncId, Func, Result) :- ( if func_get_body(Func, _, _, _, Expr), func_get_vartypes(Func, Vartypes) then Errors = branchcheck_expr(Core, Vartypes, Expr), ( if not has_fatal_errors(Errors) then Result = ok(Func, Errors) else Result = errors(Errors) ) else unexpected($file, $pred, "Function body or types not present") ). :- func branchcheck_expr(core, map(var, type_), expr) = errors(compile_error). branchcheck_expr(Core, Vartypes, expr(ExprType, CodeInfo)) = Errors :- ( ExprType = e_tuple(Exprs), Errors = cord_list_to_cord(map(branchcheck_expr(Core, Vartypes), Exprs)) ; ExprType = e_lets(Lets, Expr), Errors = cord_list_to_cord(map(branchcheck_let(Core, Vartypes), Lets)) ++ branchcheck_expr(Core, Vartypes, Expr) ; ( ExprType = e_call(_, _, _) ; ExprType = e_var(_) ; ExprType = e_constant(_) ; ExprType = e_construction(_, _) ; ExprType = e_closure(_, _) ), Errors = init ; ExprType = e_match(Var, Cases), map.lookup(Vartypes, Var, Type), Context = code_info_context(CodeInfo), Errors = branchcheck_match(Core, Context, Type, Cases) ). :- func branchcheck_let(core, map(var, type_), expr_let) = errors(compile_error). branchcheck_let(Core, Vartypes, e_let(_, Expr)) = branchcheck_expr(Core, Vartypes, Expr). :- func branchcheck_match(core, context, type_, list(expr_case)) = errors(compile_error). branchcheck_match(Core, Context, Type, Cases) = Errors :- ( Type = builtin_type(Builtin), % Int and string have an infinite number of values. Their pattern % matches must contain at least one wildcard. ( ( Builtin = int ; Builtin = string ; Builtin = codepoint ) ; Builtin = string_pos, unexpected($file, $pred, "Match on opaque builtin") ), Errors = branchcheck_inf(Context, Cases, set.init) ; Type = type_ref(TypeId, _), MaybeCtors = utype_get_ctors(core_get_type(Core, TypeId)), ( MaybeCtors = yes(CtorsList), Ctors = list_to_set(CtorsList) ; MaybeCtors = no, unexpected($file, $pred, "Pattern match on abstract type") ), Errors = branchcheck_type(Context, Ctors, Cases) ; Type = type_variable(_), unexpected($file, $pred, "Type variable in match") ; Type = func_type(_, _, _, _), Errors = error(Context, ce_match_on_function_type) ). :- func branchcheck_inf(context, list(expr_case), set(int)) = errors(compile_error). branchcheck_inf(Context, [], _) = error(Context, ce_match_does_not_cover_all_cases). branchcheck_inf(Context, [e_case(Pat, Expr) | Cases], SeenSet0) = Errors :- ( Pat = p_num(Num), ( if insert_new(Num, SeenSet0, SeenSet) then Errors = branchcheck_inf(Context, Cases, SeenSet) else Errors = error(code_info_context(Expr ^ e_info), ce_match_duplicate_case) ++ branchcheck_inf(Context, Cases, SeenSet0) ) ; ( Pat = p_variable(_) ; Pat = p_wildcard ), Errors = branchcheck_tail(Cases) ; Pat = p_ctor(_, _), unexpected($file, $pred, "Constructor seen on builtin type match") ). :- func branchcheck_type(context, set(ctor_id), list(expr_case)) = errors(compile_error). branchcheck_type(Context, TypeCtors, []) = ( if is_empty(TypeCtors) then init else error(Context, ce_match_does_not_cover_all_cases) ). branchcheck_type(Context, TypeCtors, [e_case(Pat, Expr) | Cases]) = Errors :- ( if is_empty(TypeCtors) then Errors = error(code_info_context(Expr ^ e_info), ce_match_unreached_cases) else ( Pat = p_num(_), unexpected($file, $pred, "Number seen on user type match") ; ( Pat = p_variable(_) ; Pat = p_wildcard ), Errors = branchcheck_tail(Cases) ; Pat = p_ctor(Ctors, _), % There should be only one constructor here because typechecking % would have made it unambigious. Ctor = one_item_in_set(Ctors), ( if remove(Ctor, TypeCtors, RestCtors) then Errors = branchcheck_type(Context, RestCtors, Cases) else % The only way remove can fail when the program is type % correct is if there is a duplicate case. Errors = error(code_info_context(Expr ^ e_info), ce_match_duplicate_case) ++ branchcheck_type(Context, TypeCtors, Cases) ) ) ). :- func branchcheck_tail(list(expr_case)) = errors(compile_error). branchcheck_tail([]) = init. branchcheck_tail([e_case(_, expr(_, CodeInfo)) | _]) = error(code_info_context(CodeInfo), ce_match_unreached_cases). %-----------------------------------------------------------------------% %-----------------------------------------------------------------------% ================================================ FILE: src/core.code.m ================================================ %-----------------------------------------------------------------------% % Plasma code representation % vim: ts=4 sw=4 et % % Copyright (C) Plasma Team % Distributed under the terms of the MIT License see ../LICENSE.code % %-----------------------------------------------------------------------% :- module core.code. %-----------------------------------------------------------------------% :- interface. :- import_module context. :- import_module common_types. %-----------------------------------------------------------------------% :- type expr ---> expr( e_type :: expr_type, e_info :: code_info ). :- type expr_type ---> e_tuple(list(expr)) ; e_lets(list(expr_let), expr) ; e_call(callee, list(var), maybe_resources) ; e_var(var) ; e_constant(const_type) % A constructon of one of the possible constructors. After % successful type checking this set contains exactly one item. ; e_construction(set(ctor_id), list(var)) ; e_closure(func_id, list(var)) ; e_match(var, list(expr_case)). % All expressions must be matched with a variable or otherwise the root of a % function. The typechecker uses this property to attach types to each % variable and therefore all expressions will have types. Therefore we % cannot allow an expression to bind no variables (except the empty tuple % expression which has no type). Similarly we cannot cast arity. Instead % some variables are bound but never used. :- type expr_let ---> e_let(list(var), expr). :- type expr_case ---> e_case(expr_pattern, expr). :- type expr_pattern ---> p_num(int) ; p_variable(var) ; p_wildcard ; p_ctor(set(ctor_id), list(var)). :- type callee ---> c_plain(func_id) ; c_ho(var). %-----------------------------------------------------------------------% :- type code_info. :- type code_origin ---> o_user_body(context) ; o_user_decl(context) ; o_user_return(context) ; o_builtin ; o_introduced. :- func code_info_init(code_origin) = code_info. :- type bang_marker ---> has_bang_marker ; no_bang_marker. :- func code_info_context(code_info) = context. :- func code_info_origin(code_info) = code_origin. :- pred code_info_set_origin(code_origin::in, code_info::in, code_info::out) is det. :- func code_info_bang_marker(code_info) = bang_marker. :- pred code_info_set_bang_marker(bang_marker::in, code_info::in, code_info::out) is det. :- pred code_info_arity(code_info::in, arity::out) is semidet. % Throws an exception if the arity has not been set. % :- func code_info_arity_det(code_info) = arity. :- pred code_info_set_arity(arity::in, code_info::in, code_info::out) is det. :- func code_info_types(code_info) = list(type_). :- func code_info_maybe_types(code_info) = maybe(list(type_)). :- pred code_info_set_types(list(type_)::in, code_info::in, code_info::out) is det. % Merge to code_infos, The context of the first overrides the 2nd, % while the types and arity (result information) of the 2nd overrides % the first. This is suitable for composing let expressions from two % other expressions' code_infos. % :- func code_info_join(code_info, code_info) = code_info. %-----------------------------------------------------------------------% :- func expr_get_callees(expr) = set(func_id). %-----------------------------------------------------------------------% :- pred insert_result_expr(expr::in, expr::in, expr::out) is det. %-----------------------------------------------------------------------% :- pred make_renaming(set(var)::in, map(var, var)::out, varmap::in, varmap::out) is det. :- pred rename_expr(map(var, var)::in, expr::in, expr::out) is det. :- pred rename_pattern(map(var, var)::in, expr_pattern::in, expr_pattern::out) is det. :- pred expr_make_vars_unique(expr::in, expr::out, set(var)::in, set(var)::out, varmap::in, varmap::out) is det. :- pred expr_has_branch(expr::in) is semidet. %-----------------------------------------------------------------------% :- implementation. :- import_module string. :- import_module require. %-----------------------------------------------------------------------% :- type code_info ---> code_info( ci_origin :: code_origin, ci_bang_marker :: bang_marker, % How many results does this expression return? ci_arity :: maybe(arity), % The type of each result ci_types :: maybe(list(type_)) ). code_info_init(Origin) = code_info(Origin, no_bang_marker, no, no). code_info_context(Info) = Context :- Origin = Info ^ ci_origin, ( if origin_context(Origin, ContextP) then Context = ContextP else Context = nil_context ). code_info_origin(Info) = Info ^ ci_origin. code_info_set_origin(Origin, !Info) :- !Info ^ ci_origin := Origin. code_info_bang_marker(Info) = Info ^ ci_bang_marker. code_info_set_bang_marker(BangMarker, !Info) :- !Info ^ ci_bang_marker := BangMarker. code_info_arity(Info, Arity) :- yes(Arity) = Info ^ ci_arity. code_info_arity_det(Info) = Arity :- ( if code_info_arity(Info, ArityP) then Arity = ArityP else unexpected($file, $pred, "Arity has not been set, " ++ "typechecking must execute before expression arity is known") ). code_info_set_arity(Arity, !Info) :- !Info ^ ci_arity := yes(Arity). code_info_types(Info) = Types :- MaybeTypes = Info ^ ci_types, ( MaybeTypes = yes(Types) ; MaybeTypes = no, unexpected($file, $pred, "Types unknown") ). code_info_maybe_types(Info) = Info ^ ci_types. code_info_set_types(Types, !Info) :- !Info ^ ci_types := yes(Types). %-----------------------------------------------------------------------% code_info_join(CIA, CIB) = CI :- ( if ( CIA ^ ci_bang_marker = has_bang_marker ; CIB ^ ci_bang_marker = has_bang_marker ) then Bang = has_bang_marker else Bang = no_bang_marker ), Arity = CIB ^ ci_arity, Types = CIB ^ ci_types, Origin = origin_join(CIA ^ ci_origin, CIB ^ ci_origin), CI = code_info(Origin, Bang, Arity, Types). :- func origin_join(code_origin, code_origin) = code_origin. origin_join(O@o_user_body(_), _) = O. origin_join(O1@o_user_decl(_), O2) = O :- ( if O2 = o_user_body(_) then O = O2 else if origin_context(O2, C) then O = o_user_body(C) else O = O1 ). origin_join(O1@o_user_return(_), O2) = O :- ( if ( O2 = o_user_body(_) ; O2 = o_user_decl(_) ) then O = O2 else if origin_context(O2, C) then O = o_user_return(C) else O = O1 ). origin_join(o_builtin, O2) = O :- ( if O2 = o_introduced then O = o_builtin else O = O2 ). origin_join(o_introduced, O) = O. :- pred origin_context(code_origin::in, context::out) is semidet. origin_context(Origin, Context) :- require_complete_switch [Origin] ( Origin = o_user_body(Context) ; Origin = o_user_decl(Context) ; Origin = o_user_return(Context) ; Origin = o_builtin, Context = builtin_context ; Origin = o_introduced, fail ). %-----------------------------------------------------------------------% expr_get_callees(Expr) = Callees :- ExprType = Expr ^ e_type, ( ExprType = e_tuple(Exprs), Callees = union_list(map(expr_get_callees, Exprs)) ; ExprType = e_lets(Lets, InExpr), Callees = union_list( map(func(e_let(_, E)) = expr_get_callees(E), Lets)) `union` expr_get_callees(InExpr) ; ExprType = e_call(Callee, _, _), ( Callee = c_plain(FuncId), Callees = make_singleton_set(FuncId) ; Callee = c_ho(_), Callees = init ) ; ExprType = e_var(_), Callees = init ; ExprType = e_constant(Const), ( Const = c_func(Callee), % For the purposes of compiler analysis like typechecking this is a % callee. Callees = make_singleton_set(Callee) ; ( Const = c_number(_) ; Const = c_string(_) ; % XXX: This could be a problem if constructors can be used % as functions (in higher-order contexts) Const = c_ctor(_) ), Callees = init ) ; ExprType = e_construction(_, _), Callees = set.init ; ExprType = e_closure(Callee, _), Callees = make_singleton_set(Callee) ; ExprType = e_match(_, Cases), Callees = union_list(map(case_get_callees, Cases)) ). :- func case_get_callees(expr_case) = set(func_id). case_get_callees(e_case(_, Expr)) = expr_get_callees(Expr). %-----------------------------------------------------------------------% insert_result_expr(LastExpr, Expr0, Expr) :- ExprType = Expr0 ^ e_type, ( ( ExprType = e_call(_, _, _) ; ExprType = e_var(_) ; ExprType = e_constant(_) ; ExprType = e_construction(_, _) ; ExprType = e_closure(_, _) ), Expr = expr(e_lets([e_let([], Expr0)], LastExpr), code_info_join(Expr0 ^ e_info, LastExpr ^ e_info)) ; ExprType = e_tuple(Exprs), ( Exprs = [_ | _], Expr = expr(e_lets([e_let([], Expr0)], LastExpr), code_info_join(Expr0 ^ e_info, LastExpr ^ e_info)) ; Exprs = [], Expr = LastExpr ) ; ExprType = e_match(Var, Cases0), map(insert_result_case(LastExpr), Cases0, Cases), Expr = expr(e_match(Var, Cases), code_info_join(Expr0 ^ e_info, LastExpr ^ e_info)) ; ExprType = e_lets(Lets, InExpr0), insert_result_expr(LastExpr, InExpr0, InExpr), Expr = expr(e_lets(Lets, InExpr), code_info_join(Expr0 ^ e_info, InExpr ^ e_info)) ). :- pred insert_result_case(expr::in, expr_case::in, expr_case::out) is det. insert_result_case(LastExpr, e_case(Pat, Expr0), e_case(Pat, Expr)) :- insert_result_expr(LastExpr, Expr0, Expr). %-----------------------------------------------------------------------% make_renaming(Vars, Renaming, !Varset) :- foldl2(make_renaming_var, Vars, map.init, Renaming, !Varset). :- pred make_renaming_var(var::in, map(var, var)::in, map(var, var)::out, varmap::in, varmap::out) is det. make_renaming_var(Var0, !Renaming, !Varmap) :- add_fresh_var(get_var_name_no_suffix(!.Varmap, Var0), Var, !Varmap), det_insert(Var0, Var, !Renaming). rename_expr(Renaming, expr(ExprType0, Info), expr(ExprType, Info)) :- ( ExprType0 = e_tuple(Exprs0), map(rename_expr(Renaming), Exprs0, Exprs), ExprType = e_tuple(Exprs) ; ExprType0 = e_lets(Lets0, InExpr0), map(rename_let(Renaming), Lets0, Lets), rename_expr(Renaming, InExpr0, InExpr), ExprType = e_lets(Lets, InExpr) ; ExprType0 = e_call(Callee0, Args0, MaybeResources), map(rename_var(Renaming), Args0, Args), ( Callee0 = c_plain(_), Callee = Callee0 ; Callee0 = c_ho(CalleeVar0), rename_var(Renaming, CalleeVar0, CalleeVar), Callee = c_ho(CalleeVar) ), ExprType = e_call(Callee, Args, MaybeResources) ; ExprType0 = e_var(Var0), rename_var(Renaming, Var0, Var), ExprType = e_var(Var) ; ExprType0 = e_constant(_), ExprType = ExprType0 ; ExprType0 = e_construction(Constrs, Args0), map(rename_var(Renaming), Args0, Args), ExprType = e_construction(Constrs, Args) ; ExprType0 = e_closure(FuncId, Args0), map(rename_var(Renaming), Args0, Args), ExprType = e_closure(FuncId, Args) ; ExprType0 = e_match(Var0, Cases0), rename_var(Renaming, Var0, Var), map(rename_case(Renaming), Cases0, Cases), ExprType = e_match(Var, Cases) ). :- pred rename_let(map(var, var)::in, expr_let::in, expr_let::out) is det. rename_let(Renaming, e_let(Vars0, Expr0), e_let(Vars, Expr)) :- map(rename_var(Renaming), Vars0, Vars), rename_expr(Renaming, Expr0, Expr). :- pred rename_case(map(var, var)::in, expr_case::in, expr_case::out) is det. rename_case(Renaming, e_case(Pat0, Expr0), e_case(Pat, Expr)) :- rename_pattern(Renaming, Pat0, Pat), rename_expr(Renaming, Expr0, Expr). :- pred rename_var(map(var, var)::in, var::in, var::out) is det. rename_var(Renaming, Var0, Var) :- ( if search(Renaming, Var0, VarPrime) then Var = VarPrime else Var = Var0 ). %-----------------------------------------------------------------------% rename_pattern(_, p_num(Num), p_num(Num)). rename_pattern(Renaming, p_variable(Var0), p_variable(Var)) :- rename_var(Renaming, Var0, Var). rename_pattern(_, p_wildcard, p_wildcard). rename_pattern(Renaming, p_ctor(C, Args0), p_ctor(C, Args)) :- map(rename_var(Renaming), Args0, Args). %-----------------------------------------------------------------------% % TODO: This is higher complexity than it needs to be. if it finds a % variable that needs to be renamed it will perform the rename % (traversing the sub-expression(s)) and then traverse those again to % look for more variables to rename. % expr_make_vars_unique(Expr0, Expr, !SeenVars, !Varmap) :- expr(Type, Info) = Expr0, ( Type = e_tuple(Exprs0), map_foldl2(expr_make_vars_unique, Exprs0, Exprs, !SeenVars, !Varmap), Expr = expr(e_tuple(Exprs), Info) ; Type = e_lets(Lets0, In0), map_foldl3(let_make_vars_unique, Lets0, Lets, map.init, Renaming, !SeenVars, !Varmap), rename_expr(Renaming, In0, In1), expr_make_vars_unique(In1, In, !SeenVars, !Varmap), Expr = expr(e_lets(Lets, In), Info) ; Type = e_match(Var, Cases0), map_foldl2(case_make_vars_unique, Cases0, Cases, !SeenVars, !Varmap), Expr = expr(e_match(Var, Cases), Info) ; ( Type = e_call(_, _, _) ; Type = e_var(_) ; Type = e_constant(_) ; Type = e_construction(_, _) ; Type = e_closure(_, _) ), Expr = Expr0 ). :- pred let_make_vars_unique(expr_let::in, expr_let::out, map(var, var)::in, map(var, var)::out, set(var)::in, set(var)::out, varmap::in, varmap::out) is det. let_make_vars_unique(e_let(Vars0, Expr0), e_let(Vars, Expr), !Renaming, !SeenVars, !Varmap) :- % There are two steps. % First do the renaming computed after visiting earlier lets. ( if not is_empty(!.Renaming) then rename_expr(!.Renaming, Expr0, Expr1) else Expr1 = Expr0 ), % Then update the renaming for variables seen here. VarsToRename = list_to_set(Vars0) `intersect` !.SeenVars, ( if not is_empty(VarsToRename) then make_renaming(VarsToRename, Renaming, !Varmap), !:Renaming = merge(!.Renaming, Renaming), map(rename_var(Renaming), Vars0, Vars) else Vars = Vars0 ), !:SeenVars = !.SeenVars `union` list_to_set(Vars), expr_make_vars_unique(Expr1, Expr, !SeenVars, !Varmap). :- pred case_make_vars_unique(expr_case::in, expr_case::out, set(var)::in, set(var)::out, varmap::in, varmap::out) is det. case_make_vars_unique(e_case(Pat0, Expr0), e_case(Pat, Expr), !SeenVars, !Varmap) :- ( Pat0 = p_variable(Var0), ( if member(Var0, !.SeenVars) then VarToRenameSet = make_singleton_set(Var0), some [!Renaming] ( make_renaming(VarToRenameSet, Renaming, !Varmap), rename_var(Renaming, Var0, Var), rename_expr(Renaming, Expr0, Expr1) ) else Var = Var0, Expr1 = Expr0 ), insert(Var, !SeenVars), Pat = p_variable(Var) ; Pat0 = p_ctor(Ctors, Vars0), VarsToRename = !.SeenVars `intersect` list_to_set(Vars0), ( if not is_empty(VarsToRename) then make_renaming(VarsToRename, Renaming, !Varmap), map(rename_var(Renaming), Vars0, Vars), rename_expr(Renaming, Expr0, Expr1) else Vars = Vars0, Expr1 = Expr0 ), !:SeenVars = !.SeenVars `union` list_to_set(Vars), Pat = p_ctor(Ctors, Vars) ; ( Pat0 = p_num(_) ; Pat0 = p_wildcard ), Pat = Pat0, Expr1 = Expr0 ), expr_make_vars_unique(Expr1, Expr, !SeenVars, !Varmap). %-----------------------------------------------------------------------% expr_has_branch(expr(Type, _)) :- require_complete_switch [Type] ( Type = e_tuple(Exprs), any_true(expr_has_branch, Exprs) ; Type = e_lets(Lets, Expr), ( any_true((pred(e_let(_, E)::in) is semidet :- expr_has_branch(E) ), Lets) ; expr_has_branch(Expr) ) ; ( Type = e_call(_, _, _) ; Type = e_var(_) ; Type = e_constant(_) ; Type = e_construction(_, _) ; Type = e_closure(_, _) ), false ; Type = e_match(_, _) ). %-----------------------------------------------------------------------% %-----------------------------------------------------------------------% ================================================ FILE: src/core.function.m ================================================ %-----------------------------------------------------------------------% % Plasma function representation % vim: ts=4 sw=4 et % % Copyright (C) Plasma Team % Distributed under the terms of the MIT License see ../LICENSE.code % %-----------------------------------------------------------------------% :- module core.function. %-----------------------------------------------------------------------% :- interface. :- import_module context. :- import_module pz. :- import_module pz.code. %-----------------------------------------------------------------------% :- type function. % func_init_user(Name, Context, Sharing, ParamTypes, ReturnTypes, % Uses, Observes) = Function % % Create a user-provided function. % :- func func_init_user(q_name, context, sharing, list(type_), list(type_), set(resource_id), set(resource_id)) = function. % func_init_builtin_inline_pz(Name, Inputs, Outputs, Uses, Observes, % Defn) = Function % % Creates a builitn function defined by a list of PZ instructions. See % comment in builtins.m % :- func func_init_builtin_inline_pz(q_name, list(type_), list(type_), set(resource_id), set(resource_id), list(pz_instr)) = function. % func_init_builtin_rts(Name, Inputs, Outputs, Uses, Observes) = % Function % % Creates a builtin function that will be defined by the runtime system. % :- func func_init_builtin_rts(q_name, list(type_), list(type_), set(resource_id), set(resource_id)) = function. % func_init_builtin_core(Name, Inputs, Outputs, Uses, Observes) = % Function % % Creates a builtin function that has a "Plasma core" representation % compiled in each module and made available to optimisations. % :- func func_init_builtin_core(q_name, list(type_), list(type_), set(resource_id), set(resource_id)) = function. % func_init_anon(ModuleName, Sharing, Params, Results, Uses, Observes) % :- func func_init_anon(q_name, sharing, list(type_), list(type_), set(resource_id), set(resource_id)) = function. :- func func_get_name(function) = q_name. :- func func_get_context(function) = context. :- func func_get_imported(function) = imported. :- pred func_set_imported(function::in, function::out) is det. :- func func_get_sharing(function) = sharing. :- pred func_get_type_signature(function::in, list(type_)::out, list(type_)::out, arity::out) is det. % func_get_resource_signature(Func, Uses, Observes). % :- pred func_get_resource_signature(function::in, set(resource_id)::out, set(resource_id)::out) is det. :- type func_is_used ---> used_probably ; unused. :- func func_get_used(function) = func_is_used. :- pred func_set_used(func_is_used::in, function::in, function::out) is det. %-----------------------------------------------------------------------% :- pred func_set_captured_vars_types(list(type_)::in, function::in, function::out) is det. % Throws an exception if typechecking has not provided this. % :- func func_get_captured_vars_types(function) = list(type_). :- func func_maybe_captured_vars_types(function) = maybe(list(type_)). %-----------------------------------------------------------------------% :- pred func_is_builtin(function::in) is semidet. % The three main types of builtins. See the comment at the beginning of % builtins.m. This only makes sense for functions in the builtin % module. % :- type builtin_impl_type ---> bit_core % Builtins implemented by the compiler in core % representation. ; bit_inline_pz % Builtins implemented by the compiler by % replacing their use with PZ instructions (eg % math operators) ; bit_rts. % Bultins implemented by the RTS. % Get how this function's definition is provided if it is a builtin, % false otherwise. % :- pred func_builtin_type(function::in, builtin_impl_type::out) is semidet. :- pred func_set_builtin(builtin_impl_type::in, function::in, function::out) is det. :- pred func_builtin_inline_pz(function::in, list(pz_instr)::out) is semidet. :- pred func_set_foreign(function::in, function::out) is det. :- pred func_is_foreign(function::in) is semidet. :- type code_type ---> ct_plasma ; ct_foreign ; ct_builtin( builtin_impl_type ). :- func func_get_code_type(function) = code_type. %-----------------------------------------------------------------------% % func_set_body(Varmap, Params, Captured, Body, !func). % :- pred func_set_body(varmap::in, list(var)::in, list(var)::in, expr::in, function::in, function::out) is det. :- pred func_set_body(varmap::in, list(var)::in, list(var)::in, expr::in, map(var, type_)::in, function::in, function::out) is det. :- pred func_set_vartypes(map(var, type_)::in, function::in, function::out) is det. % func_get_body(Func, Varmap, ParamNames, Captured, Expr) % :- pred func_get_body(function::in, varmap::out, list(var)::out, list(var)::out, expr::out) is semidet. % func_get_body_det(Func, Varmap, ParamNames, Captured, Expr) % :- pred func_get_body_det(function::in, varmap::out, list(var)::out, list(var)::out, expr::out) is det. :- pred func_get_varmap(function::in, varmap::out) is semidet. :- pred func_get_vartypes(function::in, map(var, type_)::out) is semidet. :- func func_get_vartypes_det(function) = map(var, type_). :- pred func_raise_error(function::in, function::out) is det. :- pred func_has_error(function::in) is semidet. %-----------------------------------------------------------------------% :- func func_get_callees(function) = set(func_id). %-----------------------------------------------------------------------% %-----------------------------------------------------------------------% :- implementation. :- import_module string. :- import_module require. %-----------------------------------------------------------------------% :- type function ---> function( f_name :: q_name, f_signature :: signature, f_context :: context, f_sharing :: sharing, f_maybe_func_defn :: maybe(function_defn), % Some builtins may be defined by a list of PZ % instructions. f_maybe_ipz_defn :: maybe(list(pz_instr)), f_code_type :: code_type, f_imported :: imported, f_used :: func_is_used, f_has_errors :: has_errors ). :- type signature ---> signature( % The parameter and return types are given in the order they % appear in function's definition. fs_param_types :: list(type_), fs_return_types :: list(type_), fs_captured_types :: maybe(list(type_)), % It seems redundant to store the list of return types and % the arity. However in the future return types may be % inferred, and therefore won't be available all the time. fs_arity :: arity, fs_uses :: set(resource_id), fs_observes :: set(resource_id) ). :- type function_defn ---> function_defn( fd_var_map :: varmap, fd_param_names :: list(var), fd_maybe_var_types :: maybe(map(var, type_)), fd_captured :: list(var), fd_body :: expr ). :- type has_errors ---> does_not_have_errors ; has_errors. %-----------------------------------------------------------------------% func_init_user(Name, Context, Sharing, Params, Return, Uses, Observes) = func_init(Name, Context, Sharing, Params, Return, Uses, Observes). func_init_builtin_inline_pz(Name, Params, Return, Uses, Observes, PzInstrs) = func_init_builtin(Name, Params, Return, [], Uses, Observes, bit_inline_pz, no, yes(PzInstrs)). func_init_builtin_rts(Name, Params, Return, Uses, Observes) = func_init_builtin(Name, Params, Return, [], Uses, Observes, bit_rts, no, no). func_init_builtin_core(Name, Params, Return, Uses, Observes) = func_init_builtin(Name, Params, Return, [], Uses, Observes, bit_core, no, no). :- func func_init_builtin(q_name, list(type_), list(type_), list(type_), set(resource_id), set(resource_id), builtin_impl_type, maybe(function_defn), maybe(list(pz_instr))) = function. func_init_builtin(Name, Params, Return, Captured, Uses, Observes, BuiltinImplType, MbDefn, MbIPzDefn) = Func :- Context = builtin_context, Sharing = s_private, Arity = arity(length(Return)), CodeType = ct_builtin(BuiltinImplType), Func = function(Name, signature(Params, Return, yes(Captured), Arity, Uses, Observes), Context, Sharing, MbDefn, MbIPzDefn, CodeType, i_imported, used_probably, does_not_have_errors). func_init_anon(ModuleName, Sharing, Params, Return, Uses, Observes) = func_init(q_name_append_str(ModuleName, "Anon"), nil_context, Sharing, Params, Return, Uses, Observes). :- func func_init(q_name, context, sharing, list(type_), list(type_), set(resource_id), set(resource_id)) = function. func_init(Name, Context, Sharing, Params, Return, Uses, Observes) = Func :- Arity = arity(length(Return)), Func = function(Name, signature(Params, Return, no, Arity, Uses, Observes), Context, Sharing, no, no, ct_plasma, i_local, used_probably, does_not_have_errors). func_get_name(Func) = Func ^ f_name. func_get_context(Func) = Func ^ f_context. func_get_imported(Func) = Func ^ f_imported. func_set_imported(!Func) :- !Func ^ f_signature ^ fs_captured_types := yes([]), !Func ^ f_imported := i_imported. func_get_sharing(Func) = Func ^ f_sharing. func_get_type_signature(Func, Inputs, Outputs, Arity) :- Inputs = Func ^ f_signature ^ fs_param_types, Outputs = Func ^ f_signature ^ fs_return_types, Arity = Func ^ f_signature ^ fs_arity. func_get_resource_signature(Func, Uses, Observes) :- Uses = Func ^ f_signature ^ fs_uses, Observes = Func ^ f_signature ^ fs_observes. func_get_used(Func) = Func ^ f_used. func_set_used(Used, !Func) :- !Func ^ f_used := Used. %-----------------------------------------------------------------------% func_set_captured_vars_types(Types, !Func) :- !Func ^ f_signature ^ fs_captured_types := yes(Types). func_get_captured_vars_types(Func) = Types :- MaybeTypes = func_maybe_captured_vars_types(Func), ( MaybeTypes = yes(Types) ; MaybeTypes = no, unexpected($file, $pred, format("Captured vars' types unknown for %s", [s(q_name_to_string(Func ^ f_name))])) ). func_maybe_captured_vars_types(Func) = Func ^ f_signature ^ fs_captured_types. %-----------------------------------------------------------------------% func_is_builtin(Func) :- func_builtin_type(Func, _). func_builtin_type(Func, BuiltinType) :- ct_builtin(BuiltinType) = Func ^ f_code_type. func_set_builtin(BuiltinType, !Func) :- ( if not func_is_builtin(!.Func), not func_is_foreign(!.Func), no = !.Func ^ f_maybe_func_defn then !Func ^ f_code_type := ct_builtin(BuiltinType), func_set_captured_vars_types([], !Func) else unexpected($file, $pred, "Function is already builtin or already has a body") ). func_builtin_inline_pz(Func, PZInstrs) :- yes(PZInstrs) = Func ^ f_maybe_ipz_defn. func_set_foreign(!Func) :- ( if not func_is_builtin(!.Func), not func_is_foreign(!.Func), no = !.Func ^ f_maybe_func_defn then !Func ^ f_code_type := ct_foreign, func_set_captured_vars_types([], !Func) else unexpected($file, $pred, "Function is already builtin or already has a body") ). func_is_foreign(Func) :- Func ^ f_code_type = ct_foreign. func_get_code_type(Func) = Func ^ f_code_type. %-----------------------------------------------------------------------% func_set_body(Varmap, ParamNames, Captured, Expr, !Function) :- ( if func_get_vartypes(!.Function, Vartypes) then MaybeVartypes = yes(Vartypes) else MaybeVartypes = no ), Defn = function_defn(Varmap, ParamNames, MaybeVartypes, Captured, Expr), !Function ^ f_maybe_func_defn := yes(Defn). func_set_body(Varmap, ParamNames, Captured, Expr, VarTypes, !Function) :- Defn = function_defn(Varmap, ParamNames, yes(VarTypes), Captured, Expr), !Function ^ f_maybe_func_defn := yes(Defn). func_set_vartypes(VarTypes, !Function) :- MaybeDefn0 = !.Function ^ f_maybe_func_defn, ( MaybeDefn0 = no, unexpected($file, $pred, "No function body") ; MaybeDefn0 = yes(function_defn(Varmap, ParamNames, _, Captured, Expr)), Defn = function_defn(Varmap, ParamNames, yes(VarTypes), Captured, Expr), !Function ^ f_maybe_func_defn := yes(Defn) ). func_get_body(Func, Varmap, ParamNames, Captured, Expr) :- yes(Defn) = Func ^ f_maybe_func_defn, function_defn(Varmap, ParamNames, _VarTypes, Captured, Expr) = Defn. func_get_body_det(Func, Varmap, ParamNames, Captured, Expr) :- ( if func_get_body(Func, VarmapP, ParamNamesP, CapturedP, ExprP) then Varmap = VarmapP, ParamNames = ParamNamesP, Captured = CapturedP, Expr = ExprP else unexpected($file, $pred, "coudln't get predicate baody") ). func_get_varmap(Func, Varmap) :- func_get_body(Func, Varmap, _, _, _). func_get_vartypes(Func, VarTypes) :- yes(Defn) = Func ^ f_maybe_func_defn, yes(VarTypes) = Defn ^ fd_maybe_var_types. func_get_vartypes_det(Func) = VarTypes :- ( if func_get_vartypes(Func, VarTypesPrime) then VarTypes = VarTypesPrime else unexpected($file, $pred, "No VarTypes") ). func_raise_error(!Func) :- !Func ^ f_has_errors := has_errors. func_has_error(Func) :- Func ^ f_has_errors = has_errors. %-----------------------------------------------------------------------% func_get_callees(Func) = Callees :- MaybeDefn = Func ^ f_maybe_func_defn, ( MaybeDefn = yes(function_defn(_, _, _, _, Body)), Callees = expr_get_callees(Body) ; MaybeDefn = no, Callees = set.init ). %-----------------------------------------------------------------------% %-----------------------------------------------------------------------% ================================================ FILE: src/core.m ================================================ %-----------------------------------------------------------------------% % vim: ts=4 sw=4 et %-----------------------------------------------------------------------% :- module core. % % Copyright (C) Plasma Team % Distributed under the terms of the MIT see ../LICENSE.code % % Plasma core representation % %-----------------------------------------------------------------------% :- interface. :- include_module core.code. :- include_module core.function. :- include_module core.pretty. :- include_module core.resource. :- include_module core.types. :- include_module core.arity_chk. :- include_module core.branch_chk. :- include_module core.res_chk. :- include_module core.simplify. :- include_module core.type_chk. :- include_module core.util. %-----------------------------------------------------------------------% :- import_module assoc_list. :- import_module list. :- import_module set. :- import_module common_types. :- import_module core.function. :- import_module core.resource. :- import_module core.types. :- import_module q_name. %-----------------------------------------------------------------------% :- type core. :- func init(q_name) = core. :- func module_name(core) = q_name. :- pred core_allocate_function(func_id::out, core::in, core::out) is det. :- func core_all_functions(core) = assoc_list(func_id, function). :- func core_all_functions_set(core) = set(func_id). % All functions with bodies. % :- func core_all_defined_functions(core) = assoc_list(func_id, function). :- func core_all_defined_functions_set(core) = set(func_id). :- func core_all_exported_functions(core) = assoc_list(func_id, function). :- pred core_set_function(func_id::in, function::in, core::in, core::out) is det. :- pred core_get_function_det(core::in, func_id::in, function::out) is det. :- type core_entrypoint % The entrypoint is func() -> Int ---> entry_plain(func_id) % The entrypoint is func(argv : List(String)) -> Int ; entry_argv(func_id). :- func core_entry_candidates(core) = set(core_entrypoint). :- pred core_add_entry_function(core_entrypoint::in, core::in, core::out) is det. :- func core_lookup_function_name(core, func_id) = q_name. %-----------------------------------------------------------------------% % Return all the defined functions, topologically sorted into their % SCCs. % :- func core_all_defined_functions_sccs(core) = list(set(func_id)). %-----------------------------------------------------------------------% :- pred core_allocate_type_id(type_id::out, core::in, core::out) is det. :- func core_all_types(core) = assoc_list(type_id, user_type). :- func core_all_exported_types(core) = assoc_list(type_id, user_type). :- func core_get_type(core, type_id) = user_type. :- pred core_set_type(type_id::in, user_type::in, core::in, core::out) is det. :- func core_lookup_type_name(core, type_id) = q_name. :- pred core_allocate_ctor_id(ctor_id::out, core::in, core::out) is det. :- func core_lookup_constructor_name(core, ctor_id) = q_name. :- pred core_get_constructor_type(core::in, ctor_id::in, type_id::out) is det. :- pred core_get_constructor_det(core::in, ctor_id::in, constructor::out) is det. :- pred core_set_constructor(ctor_id::in, q_name::in, type_id::in, constructor::in, core::in, core::out) is det. %-----------------------------------------------------------------------% :- pred core_allocate_resource_id(resource_id::out, core::in, core::out) is det. :- pred core_set_resource(resource_id::in, resource::in, core::in, core::out) is det. :- func core_get_resource(core, resource_id) = resource. :- func core_all_exported_resources(core) = assoc_list(resource_id, resource). %-----------------------------------------------------------------------% %-----------------------------------------------------------------------% :- implementation. :- import_module digraph. :- import_module int. :- import_module map. :- import_module maybe. :- import_module pair. :- import_module varmap. :- import_module core.code. :- import_module util. :- import_module util.my_exception. %-----------------------------------------------------------------------% :- type core ---> core( c_module_name :: q_name, c_funcs :: map(func_id, function), c_next_func_id :: func_id, c_entry_candidates :: set(core_entrypoint), c_next_type_id :: type_id, c_types :: map(type_id, user_type), c_next_ctor_id :: ctor_id, c_constructors :: map(ctor_id, ctor_info), c_next_res_id :: resource_id, c_resources :: map(resource_id, resource) ). :- type ctor_info ---> ctor_info( ci_name :: q_name, ci_arity :: int, ci_type_id :: type_id, ci_constructor :: constructor ). %-----------------------------------------------------------------------% init(ModuleName) = core(ModuleName, % Functions init, func_id(0), init, % Types type_id(0), init, % Constructors ctor_id(0), init, % Resources resource_id(0), init ). module_name(Core) = Core ^ c_module_name. %-----------------------------------------------------------------------% core_allocate_function(FuncId, !Core) :- FuncId = !.Core ^ c_next_func_id, FuncId = func_id(N), !Core ^ c_next_func_id := func_id(N+1). core_all_functions(Core) = to_assoc_list(Core ^ c_funcs). core_all_functions_set(Core) = keys_as_set(Core ^ c_funcs). core_all_defined_functions(Core) = filter(is_defined, core_all_functions(Core)). core_all_defined_functions_set(Core) = list_to_set(map(fst, core_all_defined_functions(Core))). :- pred is_defined(pair(_, function)::in) is semidet. is_defined(_ - Func) :- func_get_body(Func, _, _, _, _). core_all_exported_functions(Core) = filter(is_exported, core_all_functions(Core)). :- pred is_exported(pair(_, function)::in) is semidet. is_exported(_ - Func) :- func_get_sharing(Func) = s_public. core_set_function(FuncId, Func, !Core) :- map.set(FuncId, Func, !.Core ^ c_funcs, Funcs), !Core ^ c_funcs := Funcs. core_get_function_det(Core, FuncId, Func) :- map.lookup(Core ^ c_funcs, FuncId, Func). core_entry_candidates(Core) = Core ^ c_entry_candidates. core_add_entry_function(Entrypoint, !Core) :- !Core ^ c_entry_candidates := insert(!.Core ^ c_entry_candidates, Entrypoint). core_lookup_function_name(Core, FuncId) = func_get_name(Func) :- core_get_function_det(Core, FuncId, Func). %-----------------------------------------------------------------------% core_all_defined_functions_sccs(Core) = SCCs :- AllFuncs = map(fst, core_all_defined_functions(Core)), AllFuncsSet = list_to_set(AllFuncs), some [!Graph] ( !:Graph = digraph.init, map_foldl(add_vertex, AllFuncs, _, !Graph), foldl(core_build_graph(Core, AllFuncsSet), AllFuncs, !Graph), SCCs = atsort(!.Graph) ). :- pred core_build_graph(core::in, set(func_id)::in, func_id::in, digraph(func_id)::in, digraph(func_id)::out) is det. core_build_graph(Core, AllFuncs, FuncId, !Graph) :- core_get_function_det(Core, FuncId, Func), Callees = func_get_callees(Func), FuncIdKey = lookup_key(!.Graph, FuncId), foldl(core_add_edge(AllFuncs, FuncIdKey), Callees, !Graph). :- pred core_add_edge(set(func_id)::in, digraph_key(func_id)::in, func_id::in, digraph(func_id)::in, digraph(func_id)::out) is det. core_add_edge(AllFuncs, CallerKey, Callee, !Graph) :- ( if set.member(Callee, AllFuncs) then CalleeKey = lookup_key(!.Graph, Callee), add_edge(CallerKey, CalleeKey, !Graph) else true ). %-----------------------------------------------------------------------% %-----------------------------------------------------------------------% core_allocate_type_id(TypeId, !Core) :- TypeId = !.Core ^ c_next_type_id, TypeId = type_id(N), !Core ^ c_next_type_id := type_id(N+1). core_all_types(Core) = to_assoc_list(Core ^ c_types). core_all_exported_types(Core) = filter(type_is_exported, core_all_types(Core)). :- pred type_is_exported(pair(_, user_type)::in) is semidet. type_is_exported(_ - Type) :- Sharing = utype_get_sharing(Type), sharing_is_exported(Sharing). core_get_type(Core, TypeId) = Type :- lookup(Core ^ c_types, TypeId, Type). core_set_type(TypeId, Type, !Core) :- set(TypeId, Type, !.Core ^ c_types, Map), !Core ^ c_types := Map. core_lookup_type_name(Core, TypeId) = utype_get_name(core_get_type(Core, TypeId)). %-----------------------------------------------------------------------% core_allocate_ctor_id(CtorId, !Core) :- CtorId = !.Core ^ c_next_ctor_id, CtorId = ctor_id(N), !Core ^ c_next_ctor_id := ctor_id(N+1). core_lookup_constructor_name(Core, CtorId) = Info ^ ci_name :- lookup(Core ^ c_constructors, CtorId, Info). core_get_constructor_type(Core, CtorId, Info ^ ci_type_id) :- lookup(Core ^ c_constructors, CtorId, Info). core_get_constructor_det(Core, CtorId, Info ^ ci_constructor) :- lookup(Core ^ c_constructors, CtorId, Info). core_set_constructor(CtorId, Name, TypeId, Cons, !Core) :- Info = ctor_info(Name, length(Cons ^ c_fields), TypeId, Cons), det_insert(CtorId, Info, !.Core ^ c_constructors, ConsMap), !Core ^ c_constructors := ConsMap. %----------------------------------------------------------------------- %----------------------------------------------------------------------- core_allocate_resource_id(ResId, !Core) :- ResId = !.Core ^ c_next_res_id, resource_id(N) = ResId, !Core ^ c_next_res_id := resource_id(N+1). core_set_resource(ResId, Res, !Core) :- map.set(ResId, Res, !.Core ^ c_resources, NewMap), !Core ^ c_resources := NewMap. core_get_resource(Core, ResId) = map.lookup(Core ^ c_resources, ResId). core_all_exported_resources(Core) = filter(resource_is_exported, to_assoc_list(Core ^ c_resources)). :- pred resource_is_exported(pair(resource_id, resource)::in) is semidet. resource_is_exported(_ - r_other(_, _, Sharing, _, _)) :- sharing_is_exported(Sharing). :- pred sharing_is_exported(sharing_opaque::in) is semidet. sharing_is_exported(so_public). sharing_is_exported(so_public_opaque). %-----------------------------------------------------------------------% ================================================ FILE: src/core.pretty.m ================================================ %-----------------------------------------------------------------------% % Plasma code pretty printer % vim: ts=4 sw=4 et % % Copyright (C) Plasma Team % Distributed under the terms of the MIT License see ../LICENSE.code % %-----------------------------------------------------------------------% :- module core.pretty. %-----------------------------------------------------------------------% :- interface. :- import_module cord. :- import_module string. :- import_module util. :- import_module util.pretty. :- func core_pretty(core) = cord(string). % Pretty print a function declaration (used by write_interface). % :- func func_decl_pretty(core, function) = list(pretty). % This is used by the code-generator's comments, so it returns a % string. % :- func func_call_pretty(core, function, varmap, list(var)) = string. :- func type_pretty(core, type_) = pretty. % Print the type declaration. If the type is abstract exported none of % the constructors will be printed. % % This is only used by write_interface, if we need to use it elsewhere % we probably should parameterise it and other pretty-printer functions % here. % :- func type_interface_pretty(core, user_type) = pretty. % Print the argument parts of a function type. You can either put % "func" in front of this or the name of the variable at a call site. % % It is also used only by the code generator's commenting. % :- func type_pretty_func(core, string, list(type_), list(type_), set(resource_id), set(resource_id)) = string. % func_pretty_template(Name, Inputs, Outputs, Uses, Observes) = Pretty. % % This function can print something in the style of a function % declaration. Whether the arguments are names, types, or both. % :- func func_pretty_template(pretty, list(pretty), list(pretty), list(pretty), list(pretty)) = pretty. % Pretty print a resource use (just it's name). % :- func resource_pretty(core, resource_id) = pretty. % Pretty print a resource definition. % :- func resource_interface_pretty(core, resource) = pretty. :- func constructor_name_pretty(core, set(ctor_id)) = pretty. %-----------------------------------------------------------------------% %-----------------------------------------------------------------------% :- implementation. :- import_module pair. :- import_module require. :- import_module builtins. :- import_module context. :- import_module core.types. :- import_module util.mercury. :- import_module varmap. %-----------------------------------------------------------------------% core_pretty(Core) = pretty(default_options, 0, Pretty) :- ModuleDecl = [p_str("module"), p_spc, q_name_pretty(module_name(Core))], Funcs = map(func_pretty(Core), core_all_functions(Core)), Pretty = [p_list(ModuleDecl ++ condense(Funcs)), p_nl_hard]. %-----------------------------------------------------------------------% type_interface_pretty(Core, Type) = p_expr(Pretty) :- Sharing = utype_get_sharing(Type), ( Sharing = so_private, unexpected($file, $pred, "st_private") ; Sharing = so_public, MaybeParams = utype_get_params(Type), ( MaybeParams = yes(Params) ; MaybeParams = no, unexpected($file, $pred, "No parameters for public type") ), PrettyHead = [p_str("type "), pretty_optional_args( q_name_pretty(utype_get_name(Type)), map(type_arg_pretty, Params))], MaybeCtors = utype_get_ctors(Type), ( MaybeCtors = yes(Ctors), PrettyBody = [p_str(" "), p_tabstop, p_str("= ")] ++ pretty_seperated( [p_nl_hard, p_str("| ")], map(ctor_pretty(Core), Ctors)) ; MaybeCtors = no, unexpected($file, $pred, "Public type without constructors") ), Pretty = PrettyHead ++ PrettyBody ; Sharing = so_public_opaque, Pretty = [p_str("type "), q_name_pretty(utype_get_name(Type)), p_str("/"), p_str(string(utype_get_arity(Type) ^ a_num))] ). :- func type_arg_pretty(string) = pretty. type_arg_pretty(Name) = p_expr([p_str("'"), p_str(Name)]). :- func ctor_pretty(core, ctor_id) = pretty. ctor_pretty(Core, CtorId) = Pretty :- core_get_constructor_det(Core, CtorId, Ctor), Pretty = pretty_optional_args(q_name_pretty(Ctor ^ c_name), map(field_pretty(Core), Ctor ^ c_fields)). :- func field_pretty(core, type_field) = pretty. field_pretty(Core, type_field(Name, Type)) = p_expr([q_name_pretty(Name), p_str(" : "), p_nl_soft, type_pretty(Core, Type)]). %-----------------------------------------------------------------------% :- func func_pretty(core, pair(func_id, function)) = list(pretty). func_pretty(Core, FuncId - Func) = FuncPretty :- FuncId = func_id(FuncIdInt), FuncIdPretty = [p_str(format("// func: %d", [i(FuncIdInt)])), p_nl_hard], FuncDecl = func_decl_pretty(Core, Func), ( if func_get_body(Func, _, _, _, _) then FuncPretty0 = [p_group_curly(FuncDecl, singleton("{"), func_body_pretty(Core, Func), singleton("}"))] else FuncPretty0 = [p_expr(FuncDecl ++ [p_str(";")])] ), FuncPretty = [p_nl_double] ++ FuncIdPretty ++ FuncPretty0. func_decl_pretty(Core, Func) = [p_str("func "), func_pretty_template(Name, Args, Returns, Uses, Observes)] :- Name = q_name_pretty(func_get_name(Func)), func_get_type_signature(Func, ParamTypes, ReturnTypes, _), ( if func_get_body(Func, Varmap, ParamNames, _Captured, _Expr) then Args = params_pretty(Core, Varmap, ParamNames, ParamTypes) else Args = map(type_pretty(Core), ParamTypes) ), Returns = map(type_pretty(Core), ReturnTypes), func_get_resource_signature(Func, UsesSet, ObservesSet), Uses = map(resource_pretty(Core), set.to_sorted_list(UsesSet)), Observes = map(resource_pretty(Core), set.to_sorted_list(ObservesSet)). func_call_pretty(Core, Func, Varmap, Args) = pretty_str([func_call_pretty_2(Core, Func, Varmap, Args)]). :- func func_call_pretty_2(core, function, varmap, list(var)) = pretty. func_call_pretty_2(Core, Func, Varmap, Args) = func_pretty_template(Name, ArgsPretty, [], [], []) :- Name = q_name_pretty(func_get_name(Func)), func_get_type_signature(Func, ParamTypes, _, _), ArgsPretty = params_pretty(Core, Varmap, Args, ParamTypes). :- func params_pretty(core, varmap, list(var), list(type_)) = list(pretty). params_pretty(Core, Varmap, Names, Types) = map_corresponding(param_pretty(Core, Varmap), Names, Types). :- func param_pretty(core, varmap, var, type_) = pretty. param_pretty(Core, Varmap, Var, Type) = p_expr([var_pretty(Varmap, Var), p_str(" : "), p_nl_soft, type_pretty(Core, Type)]). %-----------------------------------------------------------------------% :- func func_body_pretty(core, function) = list(pretty). func_body_pretty(Core, Func) = Pretty :- ( if func_get_body(Func, VarmapPrime, _, CapturedPrime, ExprPrime) then Varmap = VarmapPrime, Captured = CapturedPrime, Expr = ExprPrime else unexpected($file, $pred, "Abstract function") ), expr_pretty(Core, Varmap, Expr, ExprPretty, 0, _, map.init, _InfoMap), ( Captured = [], CapturedPretty = [] ; Captured = [_ | _], CapturedPretty = [p_nl_double, p_comment(singleton("// "), [p_str("Captured: "), p_nl_soft, vars_pretty(Varmap, Captured)] ) ] ), ( if func_get_vartypes(Func, VarTypes) then VarTypesPretty = [p_nl_double, p_comment(singleton("// "), [p_expr([p_str("Types of variables: "), p_nl_soft, p_list(pretty_seperated([p_nl_hard], map(var_type_map_pretty(Core, Varmap), to_assoc_list(VarTypes))))])])] else VarTypesPretty = [] ), % _InfoMap could be printed, but we should also print expression numbers % if that's the case. Context = code_info_context(Expr ^ e_info), ( if not is_nil_context(Context) then ContextPretty = [p_str("// "), p_str(context_string(Context)), p_nl_hard] else ContextPretty = [] ), Pretty = ContextPretty ++ [ExprPretty] ++ CapturedPretty ++ VarTypesPretty. %-----------------------------------------------------------------------% :- func var_type_map_pretty(core, varmap, pair(var, type_)) = pretty. var_type_map_pretty(Core, Varmap, Var - Type) = p_expr([VarPretty, p_str(": "), p_nl_soft, TypePretty]) :- VarPretty = var_pretty(Varmap, Var), TypePretty = type_pretty(Core, Type). %-----------------------------------------------------------------------% % Expression numbers are currently unused, and no meta information is % currently printed about expressions. As we need it we should consider how % best to do this. Or we should print information directly within the % pretty-printed expression. % Note that expression nubers start at 0 and are allocated to parents before % children. This allows us to avoid printing the number of the first child % of any expression, which makes pretty printed output less cluttered, as % these numbers would otherwise appear consecutively in many expressions. % This must be the same throughout the compiler so that anything % using expression numbers makes sense when looking at pretty printed % reports. :- pred expr_pretty(core::in, varmap::in, expr::in, pretty::out, int::in, int::out, map(int, code_info)::in, map(int, code_info)::out) is det. expr_pretty(Core, Varmap, Expr, Pretty, !ExprNum, !InfoMap) :- Expr = expr(ExprType, CodeInfo), MyExprNum = !.ExprNum, !:ExprNum = !.ExprNum + 1, det_insert(MyExprNum, CodeInfo, !InfoMap), ( ExprType = e_tuple(Exprs), map_foldl2(expr_pretty(Core, Varmap), Exprs, ExprsPretty, !ExprNum, !InfoMap), Pretty = pretty_callish(p_empty, ExprsPretty) ; ExprType = e_lets(Lets, In), map_foldl2(let_pretty(Core, Varmap), Lets, LetsPretty0, !ExprNum, !InfoMap), LetsPretty = list_join([p_nl_hard], map(func(L) = p_expr(L), LetsPretty0)), expr_pretty(Core, Varmap, In, InPretty, !ExprNum, !InfoMap), Pretty = p_expr([p_str("let "), p_tabstop] ++ LetsPretty ++ [p_nl_hard] ++ [InPretty]) ; ExprType = e_call(Callee, Args, _), ( Callee = c_plain(FuncId), CalleePretty = q_name_pretty( core_lookup_function_name(Core, FuncId)) ; Callee = c_ho(CalleeVar), CalleePretty = var_pretty(Varmap, CalleeVar) ), ArgsPretty = map(func(V) = var_pretty(Varmap, V), Args), Pretty = pretty_callish(CalleePretty, ArgsPretty) ; ExprType = e_var(Var), Pretty = var_pretty(Varmap, Var) ; ExprType = e_constant(Const), Pretty = const_pretty( func(F) = q_name_pretty(core_lookup_function_name(Core, F)), constructor_name_pretty(Core), Const) ; ExprType = e_construction(CtorIds, Args), PrettyName = constructor_name_pretty(Core, CtorIds), PrettyArgs = map(func(V) = var_pretty(Varmap, V), Args), Pretty = pretty_optional_args(PrettyName, PrettyArgs) ; ExprType = e_closure(FuncId, Args), PrettyFunc = q_name_pretty(core_lookup_function_name(Core, FuncId)), PrettyArgs = map(func(V) = var_pretty(Varmap, V), Args), Pretty = pretty_callish(p_str("closure"), [PrettyFunc | PrettyArgs]) ; ExprType = e_match(Var, Cases), VarPretty =var_pretty(Varmap, Var), map_foldl2(case_pretty(Core, Varmap), Cases, CasesPretty, !ExprNum, !InfoMap), Pretty = p_group_curly( [p_str("match ("), VarPretty, p_str(")")], singleton("{"), list_join([p_nl_hard], CasesPretty), singleton("}")) ). :- pred let_pretty(core::in, varmap::in, expr_let::in, list(pretty)::out, int::in, int::out, map(int, code_info)::in, map(int, code_info)::out) is det. let_pretty(Core, Varmap, e_let(Vars, Let), Pretty, !ExprNum, !InfoMap) :- expr_pretty(Core, Varmap, Let, LetPretty, !ExprNum, !InfoMap), ( Vars = [], Pretty = [p_str("="), p_spc] ++ [LetPretty] ; Vars = [_ | _], VarsPretty = list_join([p_str(", "), p_nl_soft], map(func(V) = var_pretty(Varmap, V), Vars)), Pretty = [p_list(VarsPretty)] ++ [p_spc, p_nl_soft, p_str("= ")] ++ [LetPretty] ). :- pred case_pretty(core::in, varmap::in, expr_case::in, pretty::out, int::in, int::out, map(int, code_info)::in, map(int, code_info)::out) is det. case_pretty(Core, Varmap, e_case(Pattern, Expr), Pretty, !ExprNum, !InfoMap) :- PatternPretty = pattern_pretty(Core, Varmap, Pattern), expr_pretty(Core, Varmap, Expr, ExprPretty, !ExprNum, !InfoMap), Pretty = p_expr([p_str("case "), PatternPretty, p_str(" -> "), p_nl_soft, ExprPretty]). :- func pattern_pretty(core, varmap, expr_pattern) = pretty. pattern_pretty(_, _, p_num(Num)) = p_str(string(Num)). pattern_pretty(_, Varmap, p_variable(Var)) = var_pretty(Varmap, Var). pattern_pretty(_, _, p_wildcard) = p_str("_"). pattern_pretty(Core, Varmap, p_ctor(CtorIds, Args)) = pretty_optional_args(NamePretty, ArgsPretty) :- NamePretty = constructor_name_pretty(Core, CtorIds), ArgsPretty = map(func(V) = var_pretty(Varmap, V), Args). %-----------------------------------------------------------------------% type_pretty(_, builtin_type(Builtin)) = q_name_pretty(q_name_append(builtin_module_name, Name)) :- builtin_type_name(Builtin, Name). type_pretty(_, type_variable(Var)) = p_expr([p_str("'"), p_str(Var)]). type_pretty(Core, type_ref(TypeId, Args)) = pretty_optional_args( q_name_pretty(core_lookup_type_name(Core, TypeId)), map(type_pretty(Core), Args)). type_pretty(Core, func_type(Args, Returns, Uses, Observes)) = type_pretty_func_2(Core, p_str("func"), Args, Returns, Uses, Observes). type_pretty_func(Core, Name, Args, Returns, Uses, Observes) = pretty_str([Pretty]) :- Pretty = type_pretty_func_2(Core, p_str(Name), Args, Returns, Uses, Observes). :- func type_pretty_func_2(core, pretty, list(type_), list(type_), set(resource_id), set(resource_id)) = pretty. type_pretty_func_2(Core, Name, Args, Returns, Uses, Observes) = func_pretty_template(Name, map(type_pretty(Core), Args), map(type_pretty(Core), Returns), map(resource_pretty(Core), set.to_sorted_list(Uses)), map(resource_pretty(Core), set.to_sorted_list(Observes))). func_pretty_template(Name, Args, Returns, Uses, Observes) = Pretty :- ReturnsPretty = maybe_pretty_args_maybe_prefix( [p_spc, p_nl_soft, p_str("-> ")], Returns), UsesPretty = maybe_pretty_args_maybe_prefix( [p_spc, p_nl_soft, p_str("uses ")], Uses), ObservesPretty = maybe_pretty_args_maybe_prefix( [p_spc, p_nl_soft, p_str("observes ")], Observes), Pretty = p_expr([pretty_callish(Name, Args), UsesPretty, ObservesPretty, ReturnsPretty]). %-----------------------------------------------------------------------% resource_pretty(Core, ResId) = p_str(resource_to_string(core_get_resource(Core, ResId))). resource_interface_pretty(_, r_io) = unexpected($file, $pred, "IO"). resource_interface_pretty(Core, r_other(Name, From, Sharing, _, _)) = Pretty :- ( Sharing = so_public, Pretty = p_expr([p_str("resource"), p_spc, q_name_pretty(Name), p_spc, p_str("from"), p_spc, resource_pretty(Core, From)]) ; Sharing = so_public_opaque, Pretty = p_expr([p_str("resource"), p_spc, q_name_pretty(Name)]) ; Sharing = so_private, Pretty = p_empty ). resource_interface_pretty(_, r_abstract(Name)) = p_expr([p_str("resource"), p_spc, q_name_pretty(Name)]). %-----------------------------------------------------------------------% constructor_name_pretty(Core, CtorIds) = PrettyName :- ( if is_singleton(CtorIds, CtorId) then PrettyName = q_name_pretty(core_lookup_constructor_name(Core, CtorId)) else if remove_least(CtorId, CtorIds, _) then % This is the first of many possible constructors, print only % the last part of the name. % TODO: We'll need to fix this if we allow renaming of symbols. QName = core_lookup_constructor_name(Core, CtorId), q_name_parts(QName, _, LastPart), PrettyName = nq_name_pretty(LastPart) else % Should never happen, but we can continue. PrettyName = p_str("???") ). %-----------------------------------------------------------------------% %-----------------------------------------------------------------------% ================================================ FILE: src/core.res_chk.m ================================================ %-----------------------------------------------------------------------% % vim: ts=4 sw=4 et %-----------------------------------------------------------------------% :- module core.res_chk. % % Copyright (C) Plasma Team % Distributed under the terms of the MIT see ../LICENSE.code % % Plasma resource checking - post typechecking % % We do some resource checking before type checking, but need to repeat it % here for higher-order code. Resource checking needs to interact with the % typechecker to pass resource usage attributes on higher order functions % around through a function definition. The type checker and this module % have to coordinate carefully. Here's how it works. % % Resource are provided by some pieces of code (callers) and required by % others (callees). These are: % % Required by: % + Callees at call sites of their environment, % + Function constructors of the new value, % + Returns from calls returning functions (out arguments), % + Parameters of function definitions % % Provided by: % + Environment at a call site, % + Arguments in function calls, % + Return parameters of function definitions % % Resource use attributes are "passed" around by constructions, % deconstructions, assignments and so on. % % The type checker introduces resource use attributes into the type system % only at those places resources are required, at other places it ignores % them. Then the solver propagates that information around. Therefore % within the type system resource annotations mean "this is the set of % resources that this function may need", and not "might have access to". % Then this module checks the locations where resources are provided, % ensuring that all the required resources (on the type annotation) are % provided by the environment or anther type. % %-----------------------------------------------------------------------% :- interface. :- import_module io. :- import_module compile_error. :- import_module util.log. :- import_module util.result. :- pred res_check(log_config::in, errors(compile_error)::out, core::in, core::out, io::di, io::uo) is det. %-----------------------------------------------------------------------% %-----------------------------------------------------------------------% :- implementation. :- import_module cord. :- import_module require. :- import_module context. :- import_module core.util. :- import_module util.mercury. %-----------------------------------------------------------------------% res_check(Verbose, Errors, !Core, !IO) :- process_noerror_funcs(Verbose, res_check_func, Errors, !Core, !IO). :- pred res_check_func(core::in, func_id::in, function::in, result_partial(function, compile_error)::out) is det. res_check_func(Core, _FuncId, Func0, Result) :- func_get_resource_signature(Func0, Using, Observing), ( if func_get_body(Func0, Varmap, Params, Captured, Expr0), func_get_vartypes(Func0, VarTypes) then Info = check_res_info(Core, Using, Observing, VarTypes), res_check_expr(Info, Expr0, Expr, ExprResult), func_set_body(Varmap, Params, Captured, Expr, VarTypes, Func0, Func) else unexpected($file, $pred, "Couldn't lookup function body or types") ), func_get_type_signature(Func, _, OutputTypes, _), ExprTypes = code_info_types(Expr ^ e_info), Context = func_get_context(Func), OutputErrors = foldl((func(MbE, Es) = maybe_cord(MbE) ++ Es), map_corresponding(check_output_res(Core, Context), OutputTypes, ExprTypes), init), ( ExprResult = ok(_), ( if not has_fatal_errors(OutputErrors) then Result = ok(Func, OutputErrors) else Result = errors(OutputErrors) ) ; ExprResult = errors(ExprErrors), Result = errors(ExprErrors ++ OutputErrors) ). :- func check_output_res(core, context, type_, type_) = maybe(error(compile_error)). check_output_res(Core, Context, TypeRequire, TypeProvide) = MaybeError :- ( if TypeRequire = func_type(_, _, UsesRequire, ObservesRequire), TypeProvide = func_type(_, _, UsesProvide, ObservesProvide) then ( if all_resources_in_parent(Core, UsesRequire, UsesProvide), all_resources_in_parent(Core, ObservesRequire, ObservesProvide `union` UsesProvide) then MaybeError = no else MaybeError = yes(error(Context, ce_resource_unavailable_output)) ) else % Don't do any stricter tests, the type checker will have done % them. MaybeError = no ). :- type check_res_info ---> check_res_info( cri_core :: core, cri_using :: set(resource_id), cri_observing :: set(resource_id), cri_vartypes :: map(var, type_) ). :- pred res_check_expr(check_res_info::in, expr::in, expr::out, result(bang_marker, compile_error)::out) is det. res_check_expr(Info, Expr0, Expr, Result) :- Expr0 = expr(ExprType0, CodeInfo0), ( ( ExprType0 = e_var(_) ; ExprType0 = e_construction(_, _) ; ExprType0 = e_constant(_) ; ExprType0 = e_closure(_, _) ), Result = ok(no_bang_marker), Expr = Expr0 ; ( ExprType0 = e_tuple(Exprs0), map2(res_check_expr(Info), Exprs0, Exprs, Results0), ExprType = e_tuple(Exprs) ; ExprType0 = e_lets(Lets0, InExpr0), map2(res_check_let(Info), Lets0, Lets, LetsResults), res_check_expr(Info, InExpr0, InExpr, InResult), Results0 = [InResult | LetsResults], ExprType = e_lets(Lets, InExpr) ; ExprType0 = e_match(Var, Cases0), map2(res_check_case(Info), Cases0, Cases, Results0), ExprType = e_match(Var, Cases) ), % On these nodes we must propagate the bang information from inner % expressions to outer ones. Results = result_list_to_result(Results0), ( Results = ok(InnerBangs), ( if any_true(unify(has_bang_marker), InnerBangs) then code_info_set_bang_marker(has_bang_marker, CodeInfo0, CodeInfo), Result = ok(has_bang_marker) else CodeInfo = CodeInfo0, Result = ok(no_bang_marker) ) ; Results = errors(InnerErrors), Result = errors(InnerErrors), CodeInfo = CodeInfo0 ), Expr = expr(ExprType, CodeInfo) ; ExprType0 = e_call(Callee, Args, Resources), Expr = Expr0, % Check that the call has all the correct resources available for % this callee. ( Resources = unknown_resources, unexpected($file, $pred, "Missing resource usage information") ; Resources = resources(Using, Observing), CallResult = res_check_call(Info, CodeInfo0, Using, Observing) ), ( Callee = c_plain(FuncId), core_get_function_det(Info ^ cri_core, FuncId, Func), func_get_type_signature(Func, InputParams, _, _) ; Callee = c_ho(HOVar), HOType = lookup(Info ^ cri_vartypes, HOVar), ( if HOType = func_type(InputParamsP, _, _, _) then InputParams = InputParamsP else unexpected($file, $pred, "Call to non-function") ) ), Context = code_info_context(CodeInfo0), ArgsErrors = cord_list_to_cord(map_corresponding( res_check_call_arg(Info, Context), InputParams, Args)), ( if is_empty(ArgsErrors) then Result = CallResult else ( CallResult = ok(_), Result = errors(ArgsErrors) ; CallResult = errors(Errors), Result = errors(Errors ++ ArgsErrors) ) ) ). :- pred res_check_let(check_res_info::in, expr_let::in, expr_let::out, result(bang_marker, compile_error)::out) is det. res_check_let(Info, e_let(Var, Expr0), e_let(Var, Expr), Result) :- res_check_expr(Info, Expr0, Expr, Result). :- pred res_check_case(check_res_info::in, expr_case::in, expr_case::out, result(bang_marker, compile_error)::out) is det. res_check_case(Info, e_case(Pat, Expr0), e_case(Pat, Expr), Result) :- res_check_expr(Info, Expr0, Expr, Result). :- func res_check_call(check_res_info, code_info, set(resource_id), set(resource_id)) = result(bang_marker, compile_error). res_check_call(Info, CodeInfo, CalleeUsing, CalleeObserving) = Result :- some [!Errors] ( !:Errors = init, FuncUsing = Info ^ cri_using, FuncObserving = Info ^ cri_observing, Core = Info ^ cri_core, Bang = code_info_bang_marker(CodeInfo), Context = code_info_context(CodeInfo), ( if all_resources_in_parent(Core, CalleeUsing, FuncUsing), all_resources_in_parent(Core, CalleeObserving, FuncUsing `union` FuncObserving) then true else add_error(Context, ce_resource_unavailable_call, !Errors) ), ( if is_empty(CalleeUsing `union` CalleeObserving) then ( Bang = has_bang_marker, add_error(Context, ce_unnecessary_bang, !Errors) ; Bang = no_bang_marker ) else ( Bang = has_bang_marker ; Bang = no_bang_marker, add_error(Context, ce_no_bang, !Errors) ) ), ( if is_empty(!.Errors) then Result = ok(Bang) else Result = errors(!.Errors) ) ). :- func res_check_call_arg(check_res_info, context, type_, var) = errors(compile_error). res_check_call_arg(Info, Context, Param, ArgVar) = res_check_call_arg_types(Info ^ cri_core, Context, Param, Arg) :- Arg = lookup(Info ^ cri_vartypes, ArgVar). :- func res_check_call_arg_types(core, context, type_, type_) = errors(compile_error). res_check_call_arg_types(_, _, builtin_type(_), _) = init. res_check_call_arg_types(Core, Context, func_type(_ParamInputs, _ParamOutputs, ParamUses, ParamObserves), Arg) = Errors :- ( if Arg = func_type(ArgInputs, ArgOutputs, ArgUses, ArgObserves) then ( if all_resources_in_parent(Core, ArgUses, ParamUses), all_resources_in_parent(Core, ArgObserves, ParamUses `union` ParamObserves) then FuncErrors = init else FuncErrors = error(Context, ce_resource_unavailable_arg) ), % TODO: Need to figure this out later. ( if ( member(Type, ArgInputs) ; member(Type, ArgOutputs) ), is_or_has_function_type_with_resource(Type) then my_exception.sorry($file, $pred, Context, "Nested function types") else true ), Errors = FuncErrors else unexpected($file, $pred, "Types don't match") ). res_check_call_arg_types(_, _, type_variable(_), _) = init. res_check_call_arg_types(Core, Context, type_ref(_, Params), Arg) = Errors :- ( if Arg = type_ref(_, Args) then Errors = cord_list_to_cord(map_corresponding( res_check_call_arg_types(Core, Context), Params, Args)) else unexpected($file, $pred, "Types don't match") ). :- pred is_or_has_function_type_with_resource(type_::in) is semidet. is_or_has_function_type_with_resource( func_type(InputTypes, OutputTypes, Uses, Observes)) :- ( not is_empty(Uses) ; not is_empty(Observes) ; member(Arg, InputTypes), is_or_has_function_type_with_resource(Arg) ; member(Arg, OutputTypes), is_or_has_function_type_with_resource(Arg) ). is_or_has_function_type_with_resource(type_ref(_, Args)) :- member(Arg, Args), is_or_has_function_type_with_resource(Arg). %-----------------------------------------------------------------------% :- pred all_resources_in_parent(core::in, set(resource_id)::in, set(resource_id)::in) is semidet. all_resources_in_parent(Core, CalleeRes, FuncRes) :- all [C] ( member(C, CalleeRes) => ( is_non_empty(FuncRes), ( member(C, FuncRes) ; CR = core_get_resource(Core, C), some [F] ( member(F, FuncRes) => resource_is_decendant(Core, CR, F) ) )) ). %-----------------------------------------------------------------------% %-----------------------------------------------------------------------% ================================================ FILE: src/core.resource.m ================================================ %-----------------------------------------------------------------------% % Plasma types representation % vim: ts=4 sw=4 et % % Copyright (C) Plasma Team % Distributed under the terms of the MIT License see ../LICENSE.code % %-----------------------------------------------------------------------% :- module core.resource. %-----------------------------------------------------------------------% :- interface. :- import_module context. :- import_module common_types. :- import_module q_name. %-----------------------------------------------------------------------% :- type resource ---> r_io ; r_other( ro_name :: q_name, ro_from :: resource_id, ro_sharing :: sharing_opaque, ro_imported :: imported, ro_context :: context ) % A resource imported from another module, this may only exist % during interface generation. ; r_abstract(q_name). :- func resource_to_string(resource) = string. :- pred resource_is_decendant(core::in, resource::in, resource_id::in) is semidet. %-----------------------------------------------------------------------% %-----------------------------------------------------------------------% :- implementation. :- import_module builtins. %-----------------------------------------------------------------------% resource_to_string(r_io) = q_name_to_string(q_name_append(builtin_module_name, nq_name_det("IO"))). resource_to_string(r_other(Symbol, _, _, _, _)) = q_name_to_string(Symbol). resource_to_string(r_abstract(Symbol)) = q_name_to_string(Symbol). resource_is_decendant(_, r_io, _) :- false. resource_is_decendant(Core, r_other(_, Parent, _, _, _), Ancestor) :- ( Parent = Ancestor ; resource_is_decendant(Core, core_get_resource(Core, Parent), Ancestor) ). %-----------------------------------------------------------------------% ================================================ FILE: src/core.simplify.m ================================================ %-----------------------------------------------------------------------% % vim: ts=4 sw=4 et %-----------------------------------------------------------------------% :- module core.simplify. % % Copyright (C) Plasma Team % Distributed under the terms of the MIT see ../LICENSE.code % % Plasma simplifcation step % % This compiler stage does a simplification pass. % %-----------------------------------------------------------------------% :- interface. :- import_module io. :- import_module util.log. :- import_module compile_error. :- import_module util.result. :- pred simplify(log_config::in, errors(compile_error)::out, core::in, core::out, io::di, io::uo) is det. %-----------------------------------------------------------------------% %-----------------------------------------------------------------------% :- implementation. :- import_module cord. :- import_module require. :- import_module core.util. %-----------------------------------------------------------------------% simplify(Verbose, Errors, !Core, !IO) :- % Simplify expressions process_noerror_funcs(Verbose, simplify_func, Errors, !Core, !IO), % Find dead code. For now all local functions are considered alive so % that we can test the code generator, even if they're not called. In % the future we can optimise them out. AllFuncs = core_all_functions_set(!.Core), LocalFuncs = core_all_defined_functions_set(!.Core), MaybeDeadFuncs = AllFuncs `difference` LocalFuncs, AliveFuncs = union_list(map(find_used_funcs(!.Core), set.to_sorted_list(LocalFuncs))), DeadFuncs = MaybeDeadFuncs `difference` AliveFuncs, foldl(mark_function_dead, to_sorted_list(DeadFuncs), !Core). %-----------------------------------------------------------------------% :- pred simplify_func(core::in, func_id::in, function::in, result_partial(function, compile_error)::out) is det. simplify_func(_Core, _FuncId, !.Func, ok(!:Func, init)) :- ( if func_get_body(!.Func, Varmap, Params, Captured, Expr0) then simplify_expr(map.init, Expr0, Expr), func_set_body(Varmap, Params, Captured, Expr, !Func) else unexpected($file, $pred, "Body missing") ). :- pred simplify_expr(map(var, var)::in, expr::in, expr::out) is det. simplify_expr(Renaming, !Expr) :- ExprType = !.Expr ^ e_type, ( ExprType = e_tuple(Exprs0), map(simplify_expr(Renaming), Exprs0, Exprs), ( if Exprs = [Expr] then !:Expr = Expr else !Expr ^ e_type := e_tuple(Exprs) ) ; ExprType = e_lets(Lets0, InExpr0), simplify_lets(Lets0, [], Lets, Renaming, RenamingIn), rename_expr(RenamingIn, InExpr0, InExpr1), simplify_expr(init, InExpr1, InExpr), !:Expr = simplify_let(Lets, InExpr, !.Expr ^ e_info) ; ExprType = e_call(_, _, _) ; ExprType = e_var(_) ; ExprType = e_constant(_) ; ExprType = e_construction(_, _) ; ExprType = e_closure(_, _) ; ExprType = e_match(Vars, Cases0), map(simplify_case(Renaming), Cases0, Cases), !Expr ^ e_type := e_match(Vars, Cases) ). :- pred maybe_fixup_moved_info(code_info::in, expr::in, expr::out) is det. maybe_fixup_moved_info(InInfo, !Expr) :- ( if code_info_origin(InInfo) = o_user_return(Context) then % If this expression was created when preparing a return % statement fixup the code info to point to the return % statement. code_info_set_origin(o_user_return(Context), !.Expr ^ e_info, Info), !Expr ^ e_info := Info else true ). % TODO: % * Remove single-use variables :- pred simplify_lets(list(expr_let)::in, list(expr_let)::in, list(expr_let)::out, map(var, var)::in, map(var, var)::out) is det. simplify_lets([], !Lets, !Renamings) :- reverse(!Lets). simplify_lets([L | Ls0], !RevLets, !Renamings) :- L = e_let(Vars, Expr0), simplify_expr(!.Renamings, Expr0, Expr1), rename_expr(!.Renamings, Expr1, Expr), ( if is_empty_tuple_expr(Expr) then expect(unify(Vars, []), $file, $pred, "Bad empty let"), % Discard L Ls = Ls0 else if Expr = expr(e_tuple(Exprs), _) then Lets = map_corresponding(func(V, E) = e_let([V], E), Vars, Exprs), Ls = Lets ++ Ls0 else if Expr = expr(e_lets(InnerLets, InnerExpr), _) then % Flattern inner lets. Ls = InnerLets ++ [e_let(Vars, InnerExpr)] ++ Ls0 else if Vars = [VarDup], Expr = expr(e_var(VarOrig), _) then % We can drop this variable assignment by renaming the new variable % in the following expressions. map.det_insert(VarDup, VarOrig, !Renamings), Ls = Ls0 else Ls = Ls0, !:RevLets = [e_let(Vars, Expr) | !.RevLets] ), simplify_lets(Ls, !RevLets, !Renamings). :- func simplify_let(list(expr_let), expr, code_info) = expr. simplify_let(Lets, InExpr, Info) = !:Expr :- InInfo = InExpr ^ e_info, ( if Lets = [] then !:Expr = InExpr, maybe_fixup_moved_info(InInfo, !Expr) else if is_empty_tuple_expr(InExpr), Lets = [e_let([], LetExpr)] then !:Expr = LetExpr, maybe_fixup_moved_info(InInfo, !Expr) else if is_empty_tuple_expr(InExpr), split_last(Lets, OtherLets, e_let([], LetExpr)) then % If LetExpr is also an empty tuple we would want to optimise % further. But the simplification above will prevent that. !:Expr = expr(e_lets(OtherLets, LetExpr), Info), maybe_fixup_moved_info(InInfo, !Expr), maybe_simplify_let_again(!Expr) else if % If the last let binds the same list of variables that is % returned by InExpr. Then we can optimise that binding and % variables away. A more general optimisation might be able to % reorder code to make this possible, we don't attempt that yet. is_vars_expr(InExpr, Vars), split_last(Lets, OtherLets, e_let(Vars, LetExpr)) then !:Expr = expr(e_lets(OtherLets, LetExpr), Info), maybe_fixup_moved_info(InInfo, !Expr), maybe_simplify_let_again(!Expr) else !:Expr = expr(e_lets(Lets, InExpr), Info) ). % Try another round of simplification. Sometimes reducing the let can % make some further optimsation possible. % :- pred maybe_simplify_let_again(expr::in, expr::out) is det. maybe_simplify_let_again(expr(ExprType, Info), Expr) :- ( ExprType = e_lets(Lets, InExpr), Expr = simplify_let(Lets, InExpr, Info) ; ( ExprType = e_tuple(_) ; ExprType = e_call(_, _, _) ; ExprType = e_var(_) ; ExprType = e_constant(_) ; ExprType = e_construction(_, _) ; ExprType = e_closure(_, _) ; ExprType = e_match(_, _) ), Expr = expr(ExprType, Info) ). :- pred simplify_case(map(var, var)::in, expr_case::in, expr_case::out) is det. simplify_case(Renaming, e_case(Pat, !.Expr), e_case(Pat, !:Expr)) :- simplify_expr(Renaming, !Expr). %-----------------------------------------------------------------------% :- pred is_empty_tuple_expr(expr::in) is semidet. is_empty_tuple_expr(Expr) :- Expr = expr(e_tuple([]), _). :- pred is_vars_expr(expr::in, list(var)::out) is semidet. is_vars_expr(expr(e_tuple(InnerExprs), _), condense(Vars)) :- map(is_vars_expr, InnerExprs, Vars). is_vars_expr(expr(e_var(Var), _), [Var]). %-----------------------------------------------------------------------% :- func find_used_funcs(core, func_id) = set(func_id). find_used_funcs(Core, FuncId) = Callees :- core_get_function_det(Core, FuncId, Func), Callees = func_get_callees(Func). :- pred mark_function_dead(func_id::in, core::in, core::out) is det. mark_function_dead(FuncId, !Core) :- some [!Func] ( core_get_function_det(!.Core, FuncId, !:Func), func_set_used(unused, !Func), core_set_function(FuncId, !.Func, !Core) ). %-----------------------------------------------------------------------% %-----------------------------------------------------------------------% ================================================ FILE: src/core.type_chk.m ================================================ %-----------------------------------------------------------------------% % Plasma typechecking % vim: ts=4 sw=4 et % % Copyright (C) Plasma Team % Distributed under the terms of the MIT see ../LICENSE.code % % This module typechecks plasma core using a solver over Prolog-like terms. % Solver variables and constraints are created as follows. % % Consider an expression which performs a list cons: % % cons(elem, list) % % cons is declared as func(t, List(t)) -> List(t) % % + Because we use an ANF-like representation associating a type with each % variable is almost sufficient, we also associate types with calls. Each % type is represented by a solver variable. In this example these are: % elem, list and the call to cons. Each of these can have constraints % thate describe any type information we already know: % elem = int % list = T0 % call(cons) = func(T1, list(T1)) -> list(T1) % based on declaration % T1 = int % from function application % list(T1) = T0 % % We assume that cons's type is fixed and will not be inferred by this % invocation of the solver. Other cases are handled seperately. % % The new type variable, and therefore solver variable, T1, is introduced. % T0 is also introduced to stand in for the type of the list. % % + The solver can combine these rules, unifing them and finding the unique % solution. Type variables that appear in the signature of the function are % allowed to be part of the solution, others are not as that would mean it % is ambigiously typed. % % Other type variables and constraints are. % % + The parameters and return values of the current function. Including % treatment of any type variables. % % Propagation is probably the only step required to find the correct types. % However labeling (search) can also occur. Type variables in the signature % must be handled specially, they must not be labeled during search and may % require extra rules (WIP). % %-----------------------------------------------------------------------% :- module core.type_chk. %-----------------------------------------------------------------------% :- interface. :- import_module io. :- import_module compile_error. :- import_module util.log. :- import_module util.result. :- pred type_check(log_config::in, errors(compile_error)::out, core::in, core::out, io::di, io::uo) is det. %-----------------------------------------------------------------------% %-----------------------------------------------------------------------% :- implementation. :- import_module cord. :- import_module map. :- import_module require. :- import_module string. :- import_module context. :- import_module core.pretty. :- import_module core.util. :- import_module util. :- import_module util.mercury. :- import_module util.pretty. :- include_module core.type_chk.solve. :- import_module core.type_chk.solve. %-----------------------------------------------------------------------% type_check(Verbose, Errors, !Core, !IO) :- % TODO: Add support for inference, which must be bottom up by SCC. process_noerror_scc_funcs(Verbose, typecheck_func, Errors, !Core, !IO). :- pred typecheck_func(core::in, func_id::in, function::in, result_partial(function, compile_error)::out) is det. typecheck_func(Core, FuncId, Func0, Result) :- % Now do the real typechecking. build_cp_func(Core, FuncId, Func0, init, Constraints), ( if func_get_varmap(Func0, VarmapPrime) then Varmap = VarmapPrime else unexpected($file, $pred, "Couldn't retrive varmap") ), MaybeMapping = solve(Core, Varmap, func_get_context(Func0), Constraints), ( MaybeMapping = ok(Mapping), update_types_func(Core, Mapping, Func0, Func), Result = ok(Func, init) ; MaybeMapping = errors(Errors), Result = errors(Errors) ). %-----------------------------------------------------------------------% :- pred build_cp_func(core::in, func_id::in, function::in, problem::in, problem::out) is det. build_cp_func(Core, FuncId, Func, !Problem) :- trace [io(!IO), compile_time(flag("typecheck_solve"))] ( % TODO: Fix this once we can typecheck SCCs as it might not make % sense anymore. FuncName = core_lookup_function_name(Core, FuncId), format("\nBuilding typechecking problem for %s\n", [s(q_name_to_string(FuncName))], !IO) ), func_get_type_signature(Func, InputTypes, OutputTypes, _), ( if func_get_body(Func, _, Inputs, _, Expr) then some [!TypeVars, !TypeVarSource] ( !:TypeVars = init_type_vars, Context = func_get_context(Func), start_type_var_mapping(!TypeVars), % Determine which type variables are free (universally % quantified). foldl2(set_free_type_vars(Context), OutputTypes, [], ParamFreeVarLits0, !TypeVars), foldl2(set_free_type_vars(Context), InputTypes, ParamFreeVarLits0, ParamFreeVarLits, !TypeVars), post_constraint(make_conjunction_from_lits(ParamFreeVarLits), !Problem), map_foldl3(build_cp_output(Context), OutputTypes, OutputConstrs, 0, _, !Problem, !TypeVars), map_corresponding_foldl2(build_cp_inputs(Context), InputTypes, Inputs, InputConstrs, !Problem, !TypeVars), post_constraint(make_conjunction(OutputConstrs ++ InputConstrs), !Problem), end_type_var_mapping(!TypeVars), build_cp_expr(Core, Expr, TypesOrVars, !Problem, !TypeVars), list.map_foldl(unify_with_output(Context), TypesOrVars, Constraints, 0, _), _ = !.TypeVars, % TODO: Is this needed? post_constraint(make_conjunction(Constraints), !Problem) ) else unexpected($module, $pred, "Imported pred") ). :- pred set_free_type_vars(context::in, type_::in, list(constraint_literal)::in, list(constraint_literal)::out, type_var_map(type_var)::in, type_var_map(type_var)::out) is det. set_free_type_vars(_, builtin_type(_), !Lits, !TypeVarMap). set_free_type_vars(Context, type_variable(TypeVar), Lits, [Lit | Lits], !TypeVarMap) :- maybe_add_free_type_var(Context, TypeVar, Lit, !TypeVarMap). set_free_type_vars(Context, type_ref(_, Args), !Lits, !TypeVarMap) :- foldl2(set_free_type_vars(Context), Args, !Lits, !TypeVarMap). set_free_type_vars(Context, func_type(Args, Returns, _, _), !Lits, !TypeVarMap) :- foldl2(set_free_type_vars(Context), Args, !Lits, !TypeVarMap), foldl2(set_free_type_vars(Context), Returns, !Lits, !TypeVarMap). :- pred build_cp_output(context::in, type_::in, constraint::out, int::in, int::out, P::in, P::out, type_var_map(string)::in, type_var_map(string)::out) is det <= var_source(P). build_cp_output(Context, Out, Constraint, !ResNum, !Problem, !TypeVars) :- build_cp_type(Context, dont_include_resources, Out, v_output(!.ResNum), Constraint, !Problem, !TypeVars), !:ResNum = !.ResNum + 1. :- pred build_cp_inputs(context::in, type_::in, var::in, constraint::out, P::in, P::out, type_var_map(string)::in, type_var_map(string)::out) is det <= var_source(P). build_cp_inputs(Context, Type, Var, Constraint, !Problem, !TypeVars) :- build_cp_type(Context, include_resources, Type, v_named(Var), Constraint, !Problem, !TypeVars). :- pred unify_with_output(context::in, type_or_var::in, constraint::out, int::in, int::out) is det. unify_with_output(Context, TypeOrVar, Constraint, !ResNum) :- OutputVar = v_output(!.ResNum), !:ResNum = !.ResNum + 1, ( TypeOrVar = type_(Type), Constraint = build_cp_simple_type(Context, Type, OutputVar) ; TypeOrVar = var(Var), Constraint = make_constraint(cl_var_var(Var, OutputVar, Context)) ). % An expressions type is either known directly (and has no holes), or is % the given variable's type. % :- type type_or_var ---> type_(simple_type) ; var(svar). :- type simple_type ---> builtin_type(builtin_type) ; type_ref(type_id). :- pred build_cp_expr(core::in, expr::in, list(type_or_var)::out, problem::in, problem::out, type_vars::in, type_vars::out) is det. build_cp_expr(Core, expr(ExprType, CodeInfo), TypesOrVars, !Problem, !TypeVars) :- Context = code_info_context(CodeInfo), ( ExprType = e_tuple(Exprs), map_foldl2(build_cp_expr(Core), Exprs, ExprsTypesOrVars, !Problem, !TypeVars), TypesOrVars = map(one_item, ExprsTypesOrVars) ; ExprType = e_lets(Lets, ExprIn), build_cp_expr_lets(Core, Lets, ExprIn, TypesOrVars, !Problem, !TypeVars) ; ExprType = e_call(Callee, Args, _), % Note that we deliberately ignore the resource set on calls here. % It is calculated from the callee after type-checking and checked % for correctness in a later pass. ( Callee = c_plain(FuncId), build_cp_expr_call(Core, FuncId, Args, Context, TypesOrVars, !Problem, !TypeVars) ; Callee = c_ho(HOVar), build_cp_expr_ho_call(HOVar, Args, CodeInfo, TypesOrVars, !Problem, !TypeVars) ) ; ExprType = e_match(Var, Cases), map_foldl2(build_cp_case(Core, Var), Cases, CasesTypesOrVars, !Problem, !TypeVars), unify_types_or_vars_list(Context, CasesTypesOrVars, TypesOrVars, Constraint), post_constraint(Constraint, !Problem) ; ExprType = e_var(Var), TypesOrVars = [var(v_named(Var))] ; ExprType = e_constant(Constant), build_cp_expr_constant(Core, Context, Constant, TypesOrVars, !Problem, !TypeVars) ; ExprType = e_construction(CtorIds, Args), build_cp_expr_construction(Core, CtorIds, Args, Context, TypesOrVars, !Problem, !TypeVars) ; ExprType = e_closure(FuncId, Captured), build_cp_expr_function(Core, Context, FuncId, Captured, TypesOrVars, !Problem, !TypeVars) ). :- pred build_cp_expr_lets(core::in, list(expr_let)::in, expr::in, list(type_or_var)::out, problem::in, problem::out, type_vars::in, type_vars::out) is det. build_cp_expr_lets(Core, Lets, ExprIn, TypesOrVars, !Problem, !TypeVars) :- foldl2(build_cp_expr_let(Core), Lets, !Problem, !TypeVars), build_cp_expr(Core, ExprIn, TypesOrVars, !Problem, !TypeVars). :- pred build_cp_expr_let(core::in, expr_let::in, problem::in, problem::out, type_vars::in, type_vars::out) is det. build_cp_expr_let(Core, e_let(Vars, Expr), !Problem, !TypeVars) :- build_cp_expr(Core, Expr, LetTypesOrVars, !Problem, !TypeVars), Context = code_info_context(Expr ^ e_info), map_corresponding( (pred(Var::in, TypeOrVar::in, Con::out) is det :- SVar = v_named(Var), ( TypeOrVar = var(EVar), Con = make_constraint(cl_var_var(SVar, EVar, Context)) ; TypeOrVar = type_(Type), Con = build_cp_simple_type(Context, Type, SVar) ) ), Vars, LetTypesOrVars, Cons), post_constraint(make_conjunction(Cons), !Problem). :- pred build_cp_expr_call(core::in, func_id::in, list(var)::in, context::in, list(type_or_var)::out, problem::in, problem::out, type_vars::in, type_vars::out) is det. build_cp_expr_call(Core, Callee, Args, Context, TypesOrVars, !Problem, !TypeVars) :- core_get_function_det(Core, Callee, Function), func_get_type_signature(Function, ParameterTypes, ResultTypes, _), start_type_var_mapping(!TypeVars), map_corresponding_foldl2(unify_param(Context), ParameterTypes, Args, ParamsLiterals, !Problem, !TypeVars), post_constraint(make_conjunction(ParamsLiterals), !Problem), % XXX: need a new type of solver var for ResultSVars, maybe need % expression numbers again? map_foldl2(unify_or_return_result(Context), ResultTypes, TypesOrVars, !Problem, !TypeVars), end_type_var_mapping(!TypeVars). % TODO: We're not carefully handling resources in arguments to higher order % calls. :- pred build_cp_expr_ho_call(var::in, list(var)::in, code_info::in, list(type_or_var)::out, problem::in, problem::out, type_vars::in, type_vars::out) is det. build_cp_expr_ho_call(HOVar, Args, CodeInfo, TypesOrVars, !Problem, !TypeVarSource) :- Context = code_info_context(CodeInfo), new_variables("ho_arg", length(Args), ArgVars, !Problem), ParamsConstraints = map_corresponding( (func(A, AV) = cl_var_var(v_named(A), AV, Context)), Args, ArgVars), % Need the arity. ( if code_info_arity(CodeInfo, Arity) then new_variables("ho_result", Arity ^ a_num, ResultVars, !Problem) else my_exception.sorry($file, $pred, Context, format("HO call sites either need static type information or " ++ "static arity information, we cannot infer both. " ++ "at %s", [s(context_string(Context))])) ), % The resource checking code in core.res_chk.m will check that the % correct resources are available here. HOVarConstraint = [cl_var_func(v_named(HOVar), ArgVars, ResultVars, unknown_resources, Context)], post_constraint( make_conjunction_from_lits(HOVarConstraint ++ ParamsConstraints), !Problem), TypesOrVars = map(func(V) = var(V), ResultVars). :- pred build_cp_case(core::in, var::in, expr_case::in, list(type_or_var)::out, problem::in, problem::out, type_vars::in, type_vars::out) is det. build_cp_case(Core, Var, e_case(Pattern, Expr), TypesOrVars, !Problem, !TypeVarSource) :- Context = code_info_context(Expr ^ e_info), build_cp_pattern(Core, Context, Pattern, Var, Constraint, !Problem, !TypeVarSource), post_constraint(Constraint, !Problem), build_cp_expr(Core, Expr, TypesOrVars, !Problem, !TypeVarSource). :- pred build_cp_pattern(core::in, context::in, expr_pattern::in, var::in, constraint::out, P::in, P::out, type_vars::in, type_vars::out) is det <= var_source(P). build_cp_pattern(_, Context, p_num(_), Var, Constraint, !Problem, !TypeVarSource) :- Constraint = make_constraint(cl_var_builtin(v_named(Var), int, Context)). build_cp_pattern(_, Context, p_variable(VarA), Var, Constraint, !Problem, !TypeVarSource) :- Constraint = make_constraint( cl_var_var(v_named(VarA), v_named(Var), Context)). build_cp_pattern(_, _, p_wildcard, _, make_constraint(cl_true), !Problem, !TypeVarSource). build_cp_pattern(Core, Context, p_ctor(CtorIds, Args), Var, Constraint, !Problem, !TypeVarSource) :- SVar = v_named(Var), map_foldl2((pred(C::in, Ds::out, P0::in, P::out, TV0::in, TV::out) is det :- core_get_constructor_type(Core, C, Type), build_cp_ctor_type(Core, C, SVar, Args, Context, Type, Ds, P0, P, TV0, TV) ), to_sorted_list(CtorIds), Disjuncts, !Problem, !TypeVarSource), Constraint = make_disjunction(Disjuncts). :- pred build_cp_expr_constant(core::in, context::in, const_type::in, list(type_or_var)::out, problem ::in, problem::out, type_vars::in, type_vars::out) is det. build_cp_expr_constant(_, Context, c_string(Str), TypesOrVars, !Problem, !TypeVars) :- ( if count_codepoints(Str) = 1 then % This could be a string or a single character. new_variable("string_or_codepoint", Var, !Problem), post_constraint(make_disjunction([ make_constraint(cl_var_builtin(Var, string, Context)), make_constraint(cl_var_builtin(Var, codepoint, Context))]), !Problem), TypesOrVars = [var(Var)] else TypesOrVars = [type_(builtin_type(string))] ). build_cp_expr_constant(_, _, c_number(_), [type_(builtin_type(int))], !Problem, !TypeVars). build_cp_expr_constant(Core, Context, c_func(FuncId), TypesOrVars, !Problem, !TypeVars) :- build_cp_expr_function(Core, Context, FuncId, [], TypesOrVars, !Problem, !TypeVars). build_cp_expr_constant(_, _, c_ctor(_), _, !Problem, !TypeVars) :- % These should be handled by e_construction nodes. Even those that are % constant (for now). unexpected($file, $pred, "Constructor"). :- pred build_cp_expr_construction(core::in, set(ctor_id)::in, list(var)::in, context::in, list(type_or_var)::out, problem::in, problem::out, type_vars::in, type_vars::out) is det. build_cp_expr_construction(Core, CtorIds, Args, Context, TypesOrVars, !Problem, !TypeVars) :- new_variable("Constructor expression", SVar, !Problem), TypesOrVars = [var(SVar)], map_foldl2((pred(C::in, Ds::out, P0::in, P::out, TV0::in, TV::out) is det :- core_get_constructor_type(Core, C, Type), build_cp_ctor_type(Core, C, SVar, Args, Context, Type, Ds, P0, P, TV0, TV) ), to_sorted_list(CtorIds), Disjuncts, !Problem, !TypeVars), post_constraint(make_disjunction(Disjuncts), !Problem). :- pred build_cp_expr_function(core::in, context::in, func_id::in, list(var)::in, list(type_or_var)::out, problem ::in, problem::out, type_vars::in, type_vars::out) is det. build_cp_expr_function(Core, Context, FuncId, Captured, [var(SVar)], !Problem, !TypeVars) :- new_variable("Function", SVar, !Problem), core_get_function_det(Core, FuncId, Func), func_get_type_signature(Func, InputTypes, OutputTypes, _), start_type_var_mapping(!TypeVars), map2_foldl2(build_cp_type_anon("HO Arg", Context), InputTypes, InputTypeVars, InputConstraints, !Problem, !TypeVars), map2_foldl2(build_cp_type_anon("HO Result", Context), OutputTypes, OutputTypeVars, OutputConstraints, !Problem, !TypeVars), MaybeCapturedTypes = func_maybe_captured_vars_types(Func), ( MaybeCapturedTypes = yes(CapturedTypes), map_corresponding_foldl2(build_cp_type(Context, include_resources), CapturedTypes, map(func(V) = v_named(V), Captured), CapturedConstraints, !Problem, !TypeVars) ; MaybeCapturedTypes = no, CapturedConstraints = [] ), end_type_var_mapping(!TypeVars), func_get_resource_signature(Func, Uses, Observes), Resources = resources(Uses, Observes), Constraint = make_constraint(cl_var_func(SVar, InputTypeVars, OutputTypeVars, Resources, Context)), post_constraint( make_conjunction([Constraint | CapturedConstraints ++ OutputConstraints ++ InputConstraints]), !Problem). %-----------------------------------------------------------------------% :- pred build_cp_ctor_type(core::in, ctor_id::in, svar::in, list(var)::in, context::in, type_id::in, constraint::out, P::in, P::out, type_vars::in, type_vars::out) is det <= var_source(P). build_cp_ctor_type(Core, CtorId, SVar, Args, Context, TypeId, Constraint, !Problem, !TypeVars) :- core_get_constructor_det(Core, CtorId, Ctor), Fields = Ctor ^ c_fields, ( if length(Fields, N), length(Args, N) then start_type_var_mapping(!TypeVars), TypeVarNames = Ctor ^ c_params, map_foldl(make_type_var, TypeVarNames, TypeVars, !TypeVars), map_corresponding_foldl2(build_cp_ctor_type_arg(Context), Args, Fields, ArgConstraints, !Problem, !TypeVars), % TODO: record how type variables are mapped and filled in the type % constraint below. end_type_var_mapping(!TypeVars), ResultConstraint = make_constraint(cl_var_usertype(SVar, TypeId, TypeVars, Context)), Constraint = make_conjunction([ResultConstraint | ArgConstraints]) else Constraint = disj([]) ). :- pred build_cp_ctor_type_arg(context::in, var::in, type_field::in, constraint::out, P::in, P::out, type_var_map(type_var)::in, type_var_map(type_var)::out) is det <= var_source(P). build_cp_ctor_type_arg(Context, Arg, Field, Constraint, !Problem, !TypeVarMap) :- Type = Field ^ tf_type, ArgVar = v_named(Arg), ( Type = builtin_type(Builtin), Constraint = make_constraint(cl_var_builtin(ArgVar, Builtin, Context)) ; Type = type_ref(TypeId, Args), new_variables("Ctor arg", length(Args), ArgsVars, !Problem), % TODO: Handle type variables nested within deeper type expressions. map_corresponding_foldl2(build_cp_type(Context, dont_include_resources), Args, ArgsVars, ArgConstraints, !Problem, !TypeVarMap), HeadConstraint = make_constraint(cl_var_usertype(ArgVar, TypeId, ArgsVars, Context)), Constraint = make_conjunction([HeadConstraint | ArgConstraints]) ; Type = func_type(_, _, _, _), my_exception.sorry($file, $pred, Context, "Function type") ; Type = type_variable(TypeVarStr), TypeVar = lookup_type_var(!.TypeVarMap, TypeVarStr), Constraint = make_constraint(cl_var_var(ArgVar, TypeVar, Context)) ). %-----------------------------------------------------------------------% :- pred unify_types_or_vars_list(context::in, list(list(type_or_var))::in, list(type_or_var)::out, constraint::out) is det. unify_types_or_vars_list(_, [], _, _) :- unexpected($file, $pred, "No cases"). unify_types_or_vars_list(Context, [ToVsHead | ToVsTail], ToVs, make_conjunction(Constraints)) :- unify_types_or_vars_list(Context, ToVsHead, ToVsTail, ToVs, Constraints). :- pred unify_types_or_vars_list(context::in, list(type_or_var)::in, list(list(type_or_var))::in, list(type_or_var)::out, list(constraint)::out) is det. unify_types_or_vars_list(_, ToVs, [], ToVs, []). unify_types_or_vars_list(Context, ToVsA, [ToVsB | ToVsTail], ToVs, CHeads ++ CTail) :- map2_corresponding(unify_type_or_var(Context), ToVsA, ToVsB, ToVs0, CHeads), unify_types_or_vars_list(Context, ToVs0, ToVsTail, ToVs, CTail). :- pred unify_type_or_var(context::in, type_or_var::in, type_or_var::in, type_or_var::out, constraint::out) is det. unify_type_or_var(Context, type_(TypeA), ToVB, ToV, Constraint) :- ( ToVB = type_(TypeB), ( if TypeA = TypeB then ToV = type_(TypeA) else compile_error($file, $pred, "Compilation error, cannot unify types") ), Constraint = make_constraint(cl_true) ; ToVB = var(Var), % It's important to return the var, rather than the type, so that % all the types end up getting unified with one-another by the % solver. ToV = var(Var), Constraint = build_cp_simple_type(Context, TypeA, Var) ). unify_type_or_var(Context, var(VarA), ToVB, ToV, Constraint) :- ( ToVB = type_(Type), unify_type_or_var(Context, type_(Type), var(VarA), ToV, Constraint) ; ToVB = var(VarB), ToV = var(VarA), ( if VarA = VarB then Constraint = make_constraint(cl_true) else Constraint = make_constraint(cl_var_var(VarA, VarB, Context)) ) ). :- pred unify_param(context::in, type_::in, var::in, constraint::out, P::in, P::out, type_var_map(string)::in, type_var_map(string)::out) is det <= var_source(P). unify_param(Context, PType, ArgVar, Constraint, !Problem, !TypeVars) :- % XXX: Should be using TVarmap to handle type variables correctly. build_cp_type(Context, dont_include_resources, PType, v_named(ArgVar), Constraint, !Problem, !TypeVars). :- pred unify_or_return_result(context::in, type_::in, type_or_var::out, problem::in, problem::out, type_var_map(string)::in, type_var_map(string)::out) is det. unify_or_return_result(_, builtin_type(Builtin), type_(builtin_type(Builtin)), !Problem, !TypeVars). unify_or_return_result(_, type_variable(TypeVar), var(SVar), !Problem, !TypeVars) :- get_or_make_type_var(TypeVar, SVar, !TypeVars). unify_or_return_result(Context, Type, var(SVar), !Problem, !TypeVars) :- ( Type = type_ref(_, _) ; Type = func_type(_, _, _, _) ), new_variable("?", SVar, !Problem), % TODO: Test functions in structures as returns. build_cp_type(Context, include_resources, Type, SVar, Constraint, !Problem, !TypeVars), post_constraint(Constraint, !Problem). %-----------------------------------------------------------------------% :- type include_resources ---> include_resources ; dont_include_resources. :- pred build_cp_type(context::in, include_resources::in, type_::in, svar::in, constraint::out, P::in, P::out, type_var_map(string)::in, type_var_map(string)::out) is det <= var_source(P). build_cp_type(Context, _, builtin_type(Builtin), Var, make_constraint(cl_var_builtin(Var, Builtin, Context)), !Problem, !TypeVarMap). build_cp_type(Context, _, type_variable(TypeVarStr), Var, Constraint, !Problem, !TypeVarMap) :- get_or_make_type_var(TypeVarStr, TypeVar, !TypeVarMap), Constraint = make_constraint(cl_var_var(Var, TypeVar, Context)). build_cp_type(Context, IncludeRes, type_ref(TypeId, Args), Var, make_conjunction([Constraint | ArgConstraints]), !Problem, !TypeVarMap) :- build_cp_type_args(Context, IncludeRes, Args, ArgVars, ArgConstraints, !Problem, !TypeVarMap), Constraint = make_constraint(cl_var_usertype(Var, TypeId, ArgVars, Context)). build_cp_type(Context, IncludeRes, func_type(Inputs, Outputs, Uses, Observes), Var, make_conjunction(Conjunctions), !Problem, !TypeVarMap) :- build_cp_type_args(Context, IncludeRes, Inputs, InputVars, InputConstraints, !Problem, !TypeVarMap), build_cp_type_args(Context, IncludeRes, Outputs, OutputVars, OutputConstraints, !Problem, !TypeVarMap), ( IncludeRes = include_resources, Resources = resources(Uses, Observes) ; IncludeRes = dont_include_resources, Resources = unknown_resources ), Constraint = make_constraint(cl_var_func(Var, InputVars, OutputVars, Resources, Context)), Conjunctions = [Constraint | InputConstraints ++ OutputConstraints]. :- pred build_cp_type_args(context::in, include_resources::in, list(type_)::in, list(svar)::out, list(constraint)::out, P::in, P::out, type_var_map(string)::in, type_var_map(string)::out) is det <= var_source(P). build_cp_type_args(Context, IncludeRes, Args, Vars, Constraints, !Problem, !TypeVarMap) :- NumArgs = length(Args), new_variables("?", NumArgs, Vars, !Problem), map_corresponding_foldl2(build_cp_type(Context, IncludeRes), Args, Vars, Constraints, !Problem, !TypeVarMap). :- func build_cp_simple_type(context, simple_type, svar) = constraint. build_cp_simple_type(Context, builtin_type(Builtin), Var) = make_constraint(cl_var_builtin(Var, Builtin, Context)). build_cp_simple_type(Context, type_ref(TypeId), Var) = make_constraint(cl_var_usertype(Var, TypeId, [], Context)). :- pred build_cp_type_anon(string::in, context::in, type_::in, svar::out, constraint::out, P::in, P::out, type_var_map(string)::in, type_var_map(string)::out) is det <= var_source(P). build_cp_type_anon(Comment, Context, Type, Var, Constraint, !Problem, !TypeVars) :- new_variable(Comment, Var, !Problem), build_cp_type(Context, include_resources, Type, Var, Constraint, !Problem, !TypeVars). %-----------------------------------------------------------------------% :- pred update_types_func(core::in, map(svar_user, type_)::in, function::in, function::out) is det. update_types_func(Core, TypeMap, !Func) :- some [!Expr] ( ( if func_get_body(!.Func, Varmap, Inputs, Captured, !:Expr) then func_get_type_signature(!.Func, _, OutputTypes, _), update_types_expr(Core, Varmap, TypeMap, at_root_expr, OutputTypes, _Types, !Expr), map.foldl(svar_type_to_var_type_map, TypeMap, map.init, VarTypes), func_set_body(Varmap, Inputs, Captured, !.Expr, !Func), func_set_vartypes(VarTypes, !Func), func_set_captured_vars_types( map(map.lookup(VarTypes), Captured), !Func) else unexpected($file, $pred, "imported pred") ) ). :- pred svar_type_to_var_type_map(svar_user::in, type_::in, map(var, type_)::in, map(var, type_)::out) is det. svar_type_to_var_type_map(vu_named(Var), Type, !Map) :- det_insert(Var, Type, !Map). svar_type_to_var_type_map(vu_output(_), _, !Map). :- type at_root_expr % The expressions type comes from the function outputs, and % must have any resources ignored. ---> at_root_expr ; at_other_expr. :- pred update_types_expr(core::in, varmap::in, map(svar_user, type_)::in, at_root_expr::in, list(type_)::in, list(type_)::out, expr::in, expr::out) is det. update_types_expr(Core, Varmap, TypeMap, AtRoot, !Types, !Expr) :- !.Expr = expr(ExprType0, CodeInfo0), ( ExprType0 = e_tuple(Exprs0), map2_corresponding((pred(T0::in, E0::in, T::out, E::out) is det :- update_types_expr(Core, Varmap, TypeMap, AtRoot, T0, T, E0, E) ), map(func(T) = [T], !.Types), Exprs0, Types0, Exprs), !:Types = map(one_item, Types0), ExprType = e_tuple(Exprs) ; ExprType0 = e_lets(Lets0, ExprIn0), map(update_types_let(Core, Varmap, TypeMap), Lets0, Lets), update_types_expr(Core, Varmap, TypeMap, AtRoot, !Types, ExprIn0, ExprIn), ExprType = e_lets(Lets, ExprIn) ; ExprType0 = e_call(Callee, Args, _), ( Callee = c_plain(FuncId), core_get_function_det(Core, FuncId, Func), func_get_resource_signature(Func, Uses, Observes), Resources = resources(Uses, Observes) ; Callee = c_ho(HOVar), lookup(TypeMap, vu_named(HOVar), HOType), ( if HOType = func_type(_, _, Uses, Observes) then Resources = resources(Uses, Observes) else unexpected($file, $pred, "Call to non-function") ) ), ExprType = e_call(Callee, Args, Resources) ; ExprType0 = e_match(Var, Cases0), % Get the set of e ctor ids for the patterns used here. lookup(TypeMap, vu_named(Var), VarType), MaybeTypeCtors = map_maybe(list_to_set, type_get_ctors(Core, VarType)), map2((pred(C0::in, C::out, T::out) is det :- update_types_case(Core, Varmap, TypeMap, AtRoot, MaybeTypeCtors, !.Types, T, C0, C) ), Cases0, Cases, Types0), ( if Types0 = [TypesP | _], all_same(Types0) then !:Types = TypesP else unexpected($file, $pred, "Mismatching types from match arms") ), ExprType = e_match(Var, Cases) ; ExprType0 = e_var(Var), ExprType = ExprType0, lookup(TypeMap, vu_named(Var), Type), ( if !.Types = [TestType], require_complete_switch [AtRoot] ( AtRoot = at_other_expr, TestType \= Type ; AtRoot = at_root_expr, \+ types_equal_except_resources(TestType, Type) ) then Pretties = [p_str("Types do not match for var: "), var_pretty(Varmap, Var), p_expr([p_str("passed in: "), type_pretty(Core, TestType)]), p_expr([p_str("typechecker: "), type_pretty(Core, Type)])], unexpected($file, $pred, append_list(list(pretty(default_options, 0, Pretties)))) else true ), !:Types = [Type] ; ExprType0 = e_constant(Const), ExprType = ExprType0, ConstType = const_type(Core, Const), % The type inference can't propage resource usage, we need to do that % for higher-order values here. It'll then be checked in the % resource checking pass. % TODO: If it's stored in a structure rather than returned probably % doesn't work? ( if !.Types = [func_type(Inputs, Outputs, _, _)], ConstType = func_type(_, _, Use, Observe) then !:Types = [func_type(Inputs, Outputs, Use, Observe)] else true ) ; ExprType0 = e_construction(Ctors0, Args), ( if !.Types = [CtorType] then MaybeTypeCtors = type_get_ctors(Core, CtorType), ( MaybeTypeCtors = yes(TypeCtors0), TypeCtors = list_to_set(TypeCtors0), Ctors = Ctors0 `intersect` TypeCtors, ( if count(Ctors) = 1 then true else unexpected($file, $pred, "matching ctors != 1") ), ExprType = e_construction(Ctors, Args) ; MaybeTypeCtors = no, unexpected($file, $pred, "Construction of a type that should use e_constant " ++ "or is abstract") ) else unexpected($file, $pred, "Bad arity") ) ; ExprType0 = e_closure(_, _), ExprType = ExprType0 ), code_info_set_types(!.Types, CodeInfo0, CodeInfo), !:Expr = expr(ExprType, CodeInfo). :- pred update_types_let(core::in, varmap::in, map(svar_user, type_)::in, expr_let::in, expr_let::out) is det. update_types_let(Core, Varmap, TypeMap, e_let(Vars, Expr0), e_let(Vars, Expr)) :- map((pred(V::in, T::out) is det :- lookup(TypeMap, vu_named(V), T) ), Vars, TypesLet), update_types_expr(Core, Varmap, TypeMap, at_other_expr, TypesLet, _, Expr0, Expr). :- pred update_types_case(core::in, varmap::in, map(svar_user, type_)::in, at_root_expr::in, maybe(set(ctor_id))::in, list(type_)::in, list(type_)::out, expr_case::in, expr_case::out) is det. update_types_case(Core, Varmap, TypeMap, AtRoot, MaybePossibleCtors, !Types, e_case(Pat0, Expr0), e_case(Pat, Expr)) :- ( MaybePossibleCtors = yes(PossibleCtors), update_ctors_pattern(PossibleCtors, Pat0, Pat) ; MaybePossibleCtors = no, % Patterns for these types don't need updating, they don't use % constructor IDs. Pat = Pat0 ), update_types_expr(Core, Varmap, TypeMap, AtRoot, !Types, Expr0, Expr). :- pred update_ctors_pattern(set(ctor_id)::in, expr_pattern::in, expr_pattern::out) is det. update_ctors_pattern(_, P@p_num(_), P). update_ctors_pattern(_, P@p_variable(_), P). update_ctors_pattern(_, p_wildcard, p_wildcard). update_ctors_pattern(PosCtors, p_ctor(Ctors0, Args), p_ctor(Ctors, Args)) :- Ctors = Ctors0 `intersect` PosCtors, ( if count(Ctors) = 1 then true else unexpected($file, $pred, "matching ctors != 1") ). %-----------------------------------------------------------------------% :- func const_type(core, const_type) = type_. const_type(_, c_string(_)) = builtin_type(string). const_type(_, c_number(_)) = builtin_type(int). const_type(_, c_ctor(_)) = my_exception.sorry($file, $pred, "Bare constructor"). const_type(Core, c_func(FuncId)) = func_type(Inputs, Outputs, Uses, Observes) :- core_get_function_det(Core, FuncId, Func), func_get_type_signature(Func, Inputs, Outputs, _), func_get_resource_signature(Func, Uses, Observes). %-----------------------------------------------------------------------% %-----------------------------------------------------------------------% ================================================ FILE: src/core.type_chk.solve.m ================================================ %-----------------------------------------------------------------------% % Solver for typechecking/inference. % vim: ts=4 sw=4 et % % Copyright (C) Plasma Team % Distributed under the terms of the MIT see ../LICENSE.code % % This module implements a FD solver over types. % % Use MCFLAGS=--trace-flag typecheck_solve to trace this module. % %-----------------------------------------------------------------------% :- module core.type_chk.solve. %-----------------------------------------------------------------------% :- interface. % Typechecking requires solving a constraint problem. % % Each expression in the function is a constraint variable. % Each type is a value, as a herbrand constraint. % % The variables representing the arguments of the function may remain % unconstrained, they are polymorphic. If there are no solutions then there % is a type error. :- import_module map. %-----------------------------------------------------------------------% :- type svar ---> v_named(varmap.var) % The type of an output value in this position. ; v_output(int) ; v_anon(int) ; v_type_var(int). % A subset of the above, just the "user" variables, those that the % typechecker itself uses. % :- type svar_user ---> vu_named(varmap.var) ; vu_output(int). :- type problem. :- func init = problem. % A typeclass is used here to allow callers to restrict the possible things % that may be done to a problem. In this case using only this typeclass % guarantee that some code won't post new constraints. :- typeclass var_source(S) where [ pred new_variable(string::in, svar::out, S::in, S::out) is det, pred new_variables(string::in, int::in, list(svar)::out, S::in, S::out) is det ]. :- instance var_source(problem). :- pred post_constraint(constraint::in, problem::in, problem::out) is det. %-----------------------------------------------------------------------% % Constraints are boolean expressions. Literals and their conjunctions and % disjunctions. Although an individual constraint is never more complex % than disjunctive normal form. This representation and algorithm is % simple. But it may be too simple to handle generics well and it is % definitely to simple to give useful/helpful type errors. :- type constraint_literal ---> cl_true ; cl_var_builtin(svar, builtin_type, context) ; cl_var_usertype(svar, type_id, list(svar), context) ; cl_var_func( clvf_var :: svar, clvf_inputs :: list(svar), clvf_outputs :: list(svar), clvf_resources :: maybe_resources, clvf_context :: context ) ; cl_var_free_type_var(svar, type_var, context) ; cl_var_var(svar, svar, context). :- type constraint ---> single(constraint_literal) ; conj(list(constraint)) ; disj(list(constraint)). :- func make_constraint(constraint_literal) = constraint. % Make the constraint that this variable has one of the given types. % In other words this is a disjunction. % % :- func make_constraint_user_types(set(type_id), svar) = constraint. :- func make_conjunction_from_lits(list(constraint_literal)) = constraint. % Make conjunctions and disjunctions and flatten them as they're % created.. % :- func make_conjunction(list(constraint)) = constraint. :- func make_disjunction(list(constraint)) = constraint. %:- pred post_constraint_abstract(svar::in, type_var::in, % problem(V)::in, problem(V)::out) is det. % % % post_constraint_match(V1, V2, !Problem) % % % % This constraint is a half-unification, or a pattern match, V1 and V2 % % must be "unifiable", V1 will be updated to match V2, but V2 will not % % be updated to match V1. For example: % % % % f = X => f = X % % X = f => f = f % % % % This is used to make an argument's type (V1) match the parameter % % type (V2) without constraining the parameter type. % % %:- pred post_constraint_match(svar::in, svar::in, % problem(V)::in, problem(V)::out) is det. :- func solve(core, varmap, context, problem) = result(map(svar_user, type_), compile_error). %-----------------------------------------------------------------------% % % Type variable handling. % % Type variables are scoped to their declarations. So x in one declaration is % a different variable from x in another. While the constraint problem is % built, we map these different variables (with or without the same names) % to distinct variables in the constraint problem. Therefore we track type % variables throughout building the problem but switch to and from building % and using a map (as we read each declaration). % :- type type_vars. :- type type_var_map(T). :- func init_type_vars = type_vars. :- pred start_type_var_mapping(type_vars::in, type_var_map(T)::out) is det. :- pred end_type_var_mapping(type_var_map(T)::in, type_vars::out) is det. :- pred get_or_make_type_var(T::in, svar::out, type_var_map(T)::in, type_var_map(T)::out) is det. :- pred make_type_var(T::in, svar::out, type_var_map(T)::in, type_var_map(T)::out) is det. :- func lookup_type_var(type_var_map(T), T) = svar. :- pred maybe_add_free_type_var(context::in, type_var::in, constraint_literal::out, type_var_map(type_var)::in, type_var_map(type_var)::out) is det. %-----------------------------------------------------------------------% %-----------------------------------------------------------------------% :- implementation. :- import_module io. :- import_module set. :- import_module set_tree234. % Use this set when we need better behaviour for larger sets. :- type big_set(T) == set_tree234(T). :- import_module string. :- import_module core.pretty. :- import_module util. :- type problem ---> problem( p_next_anon_var :: int, p_var_comments :: map(svar, string), % All the constraints one conjunction. p_constraints :: list(constraint) ). init = problem(0, init, []). :- instance var_source(problem) where [ (new_variable(Comment, v_anon(Var), !Problem) :- Var = !.Problem ^ p_next_anon_var, !Problem ^ p_next_anon_var := Var + 1, map.det_insert(v_anon(Var), Comment, !.Problem ^ p_var_comments, VarComments), !Problem ^ p_var_comments := VarComments ), (new_variables(Comment, N, Vars, !Problem) :- ( if N > 0 then new_variable(format("%s no %d", [s(Comment), i(N)]), V, !Problem), new_variables(Comment, N - 1, Vs, !Problem), Vars = [V | Vs] else Vars = [] )) ]. %-----------------------------------------------------------------------% post_constraint(Cons, !Problem) :- Conjs0 = !.Problem ^ p_constraints, ( Cons = conj(NewConjs), Conjs = NewConjs ++ Conjs0 ; ( Cons = single(_) ; Cons = disj(_) ), Conjs = [Cons | Conjs0] ), !Problem ^ p_constraints := Conjs. %-----------------------------------------------------------------------% make_constraint(Lit) = single(Lit). %-----------------------------------------------------------------------% make_conjunction_from_lits(Lits) = make_conjunction(map(func(L) = single(L), Lits)). make_conjunction(Conjs) = conj(foldl(make_conjunction_loop, Conjs, [])). :- func make_conjunction_loop(constraint, list(constraint)) = list(constraint). make_conjunction_loop(Conj@single(_), Conjs) = [Conj | Conjs]. make_conjunction_loop(conj(NewConjs), Conjs) = foldl(make_conjunction_loop, NewConjs, Conjs). make_conjunction_loop(Conj@disj(_), Conjs) = [Conj | Conjs]. make_disjunction(Disjs) = disj(foldl(make_disjunction_loop, Disjs, [])). :- func make_disjunction_loop(constraint, list(constraint)) = list(constraint). make_disjunction_loop(Disj@single(_), Disjs) = [Disj | Disjs]. make_disjunction_loop(Disj@conj(_), Disjs) = [Disj | Disjs]. make_disjunction_loop(disj(NewDisjs), Disjs) = foldl(make_disjunction_loop, NewDisjs, Disjs). %-----------------------------------------------------------------------% :- type pretty_info ---> pretty_info( pi_varmap :: varmap, pi_core :: core ). :- func pretty_problem(pretty_info, list(constraint)) = list(pretty). pretty_problem(PrettyInfo, Conjs) = pretty_constraints(PrettyInfo, Conjs) ++ [p_str(".")]. :- func pretty_constraints(pretty_info, list(constraint)) = list(pretty). pretty_constraints(PrettyInfo, Conjs) = condense(list_join([[p_str(","), p_nl_hard]], map(pretty_constraint(PrettyInfo), Conjs))). :- func pretty_constraint(pretty_info, constraint) = list(pretty). pretty_constraint(PrettyInfo, single(Lit)) = pretty_literal(PrettyInfo, Lit). pretty_constraint(PrettyInfo, conj(Conjs)) = pretty_constraints(PrettyInfo, Conjs). pretty_constraint(PrettyInfo, disj(Disjs)) = [p_str("( "), p_nl_hard] ++ list_join([p_nl_hard, p_str(";"), p_nl_hard], map((func(D) = p_expr(pretty_constraint(PrettyInfo, D))), Disjs)) ++ [p_nl_hard, p_str(")")]. :- func pretty_problem_flat(pretty_info, list(clause)) = list(pretty). pretty_problem_flat(PrettyInfo, Conjs) = condense(list_join([[p_str(","), p_nl_hard]], map(pretty_clause(PrettyInfo), Conjs))) ++ [p_str(".")]. :- func pretty_clause(pretty_info, clause) = list(pretty). pretty_clause(PrettyInfo, single(Lit)) = pretty_literal(PrettyInfo, Lit). pretty_clause(PrettyInfo, disj(Lit, Lits)) = [p_str("(")] ++ list_join([p_nl_hard, p_str(";"), p_nl_hard], map((func(L) = p_expr(pretty_literal(PrettyInfo, L))), [Lit | Lits])) ++ [p_nl_hard, p_str(")")]. :- func pretty_literal(pretty_info, constraint_literal) = list(pretty). pretty_literal(_, cl_true) = [p_str("true")]. pretty_literal(PrettyInfo, cl_var_builtin(Var, Builtin, Context)) = pretty_context_comment(Context) ++ [unify(pretty_var(PrettyInfo, Var), p_str(string(Builtin)))]. pretty_literal(PrettyInfo, cl_var_usertype(Var, Usertype, ArgVars, Context)) = pretty_context_comment(Context) ++ [unify(pretty_var(PrettyInfo, Var), pretty_user_type(PrettyInfo, Usertype, map(pretty_var(PrettyInfo), ArgVars)))]. pretty_literal(PrettyInfo, cl_var_func(Var, Inputs, Outputs, MaybeResources, Context)) = pretty_context_comment(Context) ++ [unify(pretty_var(PrettyInfo, Var), pretty_func_type(PrettyInfo, map(pretty_var(PrettyInfo), Inputs), map(pretty_var(PrettyInfo), Outputs), MaybeResources))]. pretty_literal(PrettyInfo, cl_var_free_type_var(Var, TypeVar, Context)) = pretty_context_comment(Context) ++ [unify(pretty_var(PrettyInfo, Var), p_str(TypeVar))]. pretty_literal(PrettyInfo, cl_var_var(Var1, Var2, Context)) = pretty_context_comment(Context) ++ [unify(pretty_var(PrettyInfo, Var1), pretty_var(PrettyInfo, Var2))]. :- func pretty_store(problem_solving) = pretty. pretty_store(problem(Vars, VarComments, Domains, PrettyInfo)) = Pretty :- Pretty = p_expr([p_str("Store: "), p_nl_hard] ++ VarDomsPretty), VarDomsPretty = pretty_seperated([p_nl_hard], map(pretty_var_domain(PrettyInfo, Domains, VarComments), to_sorted_list(Vars))). :- func pretty_var_domain(pretty_info, map(svar, domain), map(svar, string), svar) = pretty. pretty_var_domain(PrettyInfo, Domains, VarComments, Var) = Pretty :- Pretty = p_expr( [unify(pretty_var(PrettyInfo, Var), pretty_domain(PrettyInfo, Domain))] ++ Comment), Domain = get_domain(Domains, Var), ( if map.search(VarComments, Var, VarComment) then Comment = [p_str(" # "), p_str(VarComment)] else Comment = [] ). :- func pretty_var(pretty_info, svar) = pretty. pretty_var(PrettyInfo, Var) = p_str(String) :- ( Var = v_named(NamedVar), Name = get_var_name(PrettyInfo ^ pi_varmap, NamedVar), String = format("'Sv_%s", [s(Name)]) ; ( Var = v_output(N), Label = "Output" ; Var = v_anon(N), Label = "Anon" ; Var = v_type_var(N), Label = "TypeVar" ), String = format("'%s_%d", [s(Label), i(N)]) ). :- func pretty_var_user(pretty_info, svar_user) = pretty. pretty_var_user(PrettyInfo, vu_named(NamedVar)) = p_str(String) :- Name = get_var_name(PrettyInfo ^ pi_varmap, NamedVar), String = format("'Sv_%s", [s(Name)]). pretty_var_user(_, vu_output(N)) = p_str(String) :- String = format("'Output_%d", [i(N)]). :- func pretty_domain(pretty_info, domain) = pretty. pretty_domain(_, d_free) = p_str("_"). pretty_domain(_, d_builtin(Builtin)) = p_str(string(Builtin)). pretty_domain(PrettyInfo, d_type(TypeId, Domains)) = pretty_user_type(PrettyInfo, TypeId, map(pretty_domain(PrettyInfo), Domains)). pretty_domain(PrettyInfo, d_func(Inputs, Outputs, MaybeResources)) = pretty_func_type(PrettyInfo, map(pretty_domain(PrettyInfo), Inputs), map(pretty_domain(PrettyInfo), Outputs), MaybeResources). pretty_domain(_, d_univ_var(TypeVar)) = p_str("'" ++ TypeVar). :- func pretty_user_type(pretty_info, type_id, list(pretty)) = pretty. pretty_user_type(PrettyInfo, TypeId, Args) = pretty_callish(q_name_pretty_relative(ModuleName, TypeName), Args) :- ModuleName = module_name(PrettyInfo ^ pi_core), Type = core_get_type(PrettyInfo ^ pi_core, TypeId), TypeName = utype_get_name(Type). :- func pretty_domain_or_svar(pretty_info, svar, domain) = pretty. pretty_domain_or_svar(Info, SVar, Domain) = ( if Domain = d_free then pretty_var(Info, SVar) else pretty_domain(Info, Domain) ). :- func pretty_func_type(pretty_info, list(pretty), list(pretty), maybe_resources) = pretty. pretty_func_type(PrettyInfo, Inputs, Outputs, MaybeResources) = Pretty :- Pretty = func_pretty_template(p_str("func"), Inputs, Outputs, PrettyUses, PrettyObserves), ( MaybeResources = unknown_resources, PrettyUses = [], PrettyObserves = [] ; MaybeResources = resources(Uses, Observes), Core = PrettyInfo ^ pi_core, PrettyUses = map(resource_pretty(Core), to_sorted_list(Uses)), PrettyObserves = map(resource_pretty(Core), to_sorted_list(Observes)) ). :- func unify(pretty, pretty) = pretty. unify(A, B) = p_expr([A, p_str(" = "), B]). :- func pretty_context_comment(context) = list(pretty). pretty_context_comment(C) = ( if is_nil_context(C) then [] else [p_comment(singleton("% "), [p_str(context_string(C))]), p_nl_hard] ). %-----------------------------------------------------------------------% solve(Core, Varmap, FuncContext, problem(_, VarComments, Constraints)) = Result :- PrettyInfo = pretty_info(Varmap, Core), Problem0 = problem(AllVars, VarComments, init, PrettyInfo), % Flatten to CNF form. flattern(Constraints, Clauses, Aliases), AllVars = union_list(map(clause_vars, Clauses)), trace [io(!IO), compile_time(flag("typecheck_solve"))] ( Pretties = [p_str("Typecheck solver starting"), p_nl_double, p_expr([p_str("Problem:"), p_nl_hard] ++ pretty_problem(PrettyInfo, sort(Constraints))), p_nl_hard, p_expr([p_str("Aliases:"), p_nl_hard] ++ pretty_comma_seperated( map(pretty_simple_alias(pretty_var_user(PrettyInfo)), Aliases))), p_nl_hard, p_expr([p_str("Flattened problem:"), p_nl_hard] ++ pretty_problem_flat(PrettyInfo, Clauses))], write_string(pretty_str(Pretties), !IO), nl(!IO) ), run_clauses(Clauses, Problem0, Result0), ( Result0 = ok(Problem), trace [io(!IO), compile_time(flag("typecheck_solve"))] ( write_string("\nsolver finished\n", !IO) ), foldl(build_results(Problem ^ ps_domains), AllVars, init, Solution0), foldl((pred(simple_alias(A, B)::in, Map0::in, Map::out) is det :- map.lookup(Map0, A, V), map.det_insert(B, V, Map0, Map) ), Aliases, Solution0, Solution), Result = ok(Solution) ; Result0 = failed(Context, Why), Result = return_error(Context, ce_type_error(error_from_why_failed(PrettyInfo, Why))) ; Result0 = floundering(UnboundVars, FlounderingClauses, Domains), ( if promise_equivalent_solutions [Context0] ( clauses_context(FlounderingClauses, Context0), \+ is_nil_context(Context0) ) then Context = Context0 else % Use the context of the whole function. Context = FuncContext ), PrettyVars = map(pretty_var_domain(PrettyInfo, Domains, VarComments), UnboundVars), PrettyClauses = map( func(C) = p_expr(pretty_clause(PrettyInfo, C)), FlounderingClauses), Result = return_error(Context, ce_type_floundering(PrettyVars, PrettyClauses)) ). :- func error_from_why_failed(pretty_info, why_failed) = type_error. error_from_why_failed(PrettyInfo, mismatch(Domain1, Domain2, MaybeWhy0)) = type_unification_failed( pretty_domain(PrettyInfo, Domain1), pretty_domain(PrettyInfo, Domain2), MaybeWhy) :- ( MaybeWhy0 = yes(Why), MaybeWhy = yes(error_from_why_failed(PrettyInfo, Why)) ; MaybeWhy0 = no, MaybeWhy = no ). error_from_why_failed(PrettyInfo, occurs_in_type(OccursVar, UserType, Args)) = type_unification_occurs( pretty_var(PrettyInfo, OccursVar), pretty_user_type(PrettyInfo, UserType, map(curry(pretty_domain_or_svar(PrettyInfo)), Args))). error_from_why_failed(PrettyInfo, occurs_in_func(OccursVar, Inputs, Outputs)) = type_unification_occurs( pretty_var(PrettyInfo, OccursVar), pretty_func_type(PrettyInfo, map(curry(pretty_domain_or_svar(PrettyInfo)), Inputs), map(curry(pretty_domain_or_svar(PrettyInfo)), Outputs), unknown_resources)). % Note that this is probably O(N^2). While the solver itself is % O(NlogN). We do this because it simplifies the problem and allows % easier tracing of the type checker. The checker also has larger % constant factors so we'd need to measure before optimising anyway. % % The returned list of aliases (to be un-applied in order) contains only % those involving user variables. This should not be a problem since % those sort before other variables and therefore a normalised list of % clauses will place them first, causing substitutions to keep those in % the program. % :- pred flattern(list(constraint)::in, list(clause)::out, list(simple_alias(svar_user))::out) is det. flattern(Constraints, !:Clauses, Aliases) :- !:Clauses = to_sorted_list(to_normal_form(conj(Constraints))), flattern_2(!Clauses, [], Aliases). :- pred flattern_2(list(clause)::in, list(clause)::out, list(simple_alias(svar_user))::in, list(simple_alias(svar_user))::out) is det. flattern_2(!Clauses, !Aliases) :- ( if remove_first_match_map(is_simple_alias, Alias, !Clauses) then substitute(Alias, !Clauses), simple_alias(To0, From0) = Alias, ( if svar_to_svar_user(To0, To), svar_to_svar_user(From0, From) then !:Aliases = [simple_alias(To, From) | !.Aliases] else true ), foldl(simplify_clause, !.Clauses, init, ClausesSet), !:Clauses = to_sorted_list(ClausesSet), flattern_2(!Clauses, !Aliases) else true ). %-----------------------------------------------------------------------% :- type simple_alias(V) ---> simple_alias(V, V). :- type simple_alias == simple_alias(svar). :- pred is_simple_alias(clause::in, simple_alias::out) is semidet. is_simple_alias(single(cl_var_var(Var1, Var2, _)), simple_alias(Var1, Var2)). :- func pretty_simple_alias(func(V) = pretty, simple_alias(V)) = pretty. pretty_simple_alias(PrettyVar, simple_alias(V1, V2)) = unify(PrettyVar(V1), PrettyVar(V2)). :- pred substitute(simple_alias::in, list(clause)::in, list(clause)::out) is det. substitute(Alias, !Clauses) :- map(substitute_clause(Alias), !Clauses). :- pred substitute_clause(simple_alias::in, clause::in, clause::out) is det. substitute_clause(Alias, !Clause) :- ( !.Clause = single(Lit0), substitute_lit(Alias, Lit0, Lit), !:Clause = single(Lit) ; !.Clause = disj(Lit0, Lits0), substitute_lit(Alias, Lit0, Lit), map(substitute_lit(Alias), Lits0, Lits), !:Clause = disj(Lit, Lits) ). :- pred substitute_lit(simple_alias::in, constraint_literal::in, constraint_literal::out) is det. substitute_lit(_, cl_true, cl_true). substitute_lit(Alias, cl_var_builtin(V0, B, C), cl_var_builtin(V, B, C)) :- substitute_var(Alias, V0, V). substitute_lit(Alias, cl_var_usertype(V0, TypeId, Vars0, Context), cl_var_usertype(V, TypeId, Vars, Context)) :- substitute_var(Alias, V0, V), map(substitute_var(Alias), Vars0, Vars). substitute_lit(Alias, cl_var_func(V0, Is0, Os0, Res, C), cl_var_func(V, Is, Os, Res, C)) :- substitute_var(Alias, V0, V), map(substitute_var(Alias), Is0, Is), map(substitute_var(Alias), Os0, Os). substitute_lit(Alias, cl_var_free_type_var(V0, TV, C), cl_var_free_type_var(V, TV, C)) :- substitute_var(Alias, V0, V). substitute_lit(Alias, cl_var_var(Va0, Vb0, C), simplify_literal(cl_var_var(Va, Vb, C))) :- substitute_var(Alias, Va0, Va), substitute_var(Alias, Vb0, Vb). :- pred substitute_var(simple_alias::in, svar::in, svar::out) is det. substitute_var(simple_alias(V1, V2), V0, V) :- ( if V2 = V0 then V = V1 else V = V0 ). %-----------------------------------------------------------------------% :- type clause ---> single(constraint_literal) ; disj(constraint_literal, list(constraint_literal)). %-----------------------------------------------------------------------% :- func to_normal_form(constraint) = set(clause). to_normal_form(single(Lit0)) = Clauses :- Lit = simplify_literal(Lit0), ( if Lit = cl_true then Clauses = set.init else Clauses = make_singleton_set(single(Lit)) ). to_normal_form(conj(Conjs0)) = union_list(map(to_normal_form, Conjs0)). to_normal_form(disj(Disjs0)) = Conj :- Disjs1 = map(to_normal_form, Disjs0), ( Disjs1 = [], unexpected($file, $pred, "Empty disjunction") ; Disjs1 = [Conj] ; Disjs1 = [D | Ds@[_ | _]], Conj = foldl(disj_to_nf, Ds, D) ). :- pred simplify_clause(clause::in, big_set(clause)::in, big_set(clause)::out) is det. simplify_clause(single(Lit0), !Clauses) :- Lit = simplify_literal(Lit0), ( if Lit = cl_true then true else insert(single(Lit), !Clauses) ). simplify_clause(Disj@disj(_, _), !Clauses) :- % We don't need to simplify within disjunctions. insert(Disj, !Clauses). % Create the disjunction by combining a pair of disjuncts at a time. % % It is in the form (A1 /\ A2 /\ ...) v (B1 /\ B2 /\ ...) % % We take each literal in the first clause, and factor it into the % second clause. Resulting in: % % (A1 v B1) /\ (A1 v B2) /\ (A2 v B1) /\ (A2 v B2) % :- func disj_to_nf(set(clause), set(clause)) = set(clause). disj_to_nf(ConjsA, ConjsB) = set_cross(disj_to_nf_clause, ConjsA, ConjsB). :- func set_cross(func(A, B) = C, set(A), set(B)) = set(C). set_cross(F, As, Bs) = union_list(map( (func(A) = list_to_set(map((func(B) = F(A, B)), to_sorted_list(Bs)))), to_sorted_list(As))). :- func disj_to_nf_clause(clause, clause) = clause. disj_to_nf_clause(single(D1), single(D2)) = disj(D1, [D2]). disj_to_nf_clause(single(D1), disj(D2, Ds3)) = disj(D1, [D2 | Ds3]). disj_to_nf_clause(disj(D1, Ds2), single(D3)) = disj(D1, [D3 | Ds2]). disj_to_nf_clause(disj(D1, Ds2), disj(D3, Ds4)) = disj(D1, [D3 | Ds2 ++ Ds4]). :- func simplify_literal(constraint_literal) = constraint_literal. simplify_literal(cl_true) = cl_true. simplify_literal(L@cl_var_builtin(_, _, _)) = L. simplify_literal(L@cl_var_func(_, _, _, _, _)) = L. simplify_literal(L@cl_var_usertype(_, _, _, _)) = L. simplify_literal(L@cl_var_free_type_var(_, _, _)) = L. simplify_literal(cl_var_var(VarA, VarB, Context)) = Literal :- compare(C, VarA, VarB), ( C = (=), Literal = cl_true ; C = (<), Literal = cl_var_var(VarA, VarB, Context) ; C = (>), Literal = cl_var_var(VarB, VarA, Context) ). :- pred clauses_context(list(clause)::in, context::out) is nondet. clauses_context([C | Cs], Context) :- ( ( C = single(Lit), literal_context(Lit, Context) ; C = disj(Lit, Lits), ( literal_context(Lit, Context) ; member(L, Lits), literal_context(L, Context) ) ) ; clauses_context(Cs, Context) ). :- pred literal_context(constraint_literal::in, context::out) is semidet. literal_context(cl_var_builtin(_, _, Context), Context). literal_context(cl_var_usertype(_, _, _, Context), Context). literal_context(cl_var_func(_, _, _, _, Context), Context). literal_context(cl_var_free_type_var(_, _, Context), Context). literal_context(cl_var_var(_, _, Context), Context). %-----------------------------------------------------------------------% :- func clause_vars(clause) = set(svar). clause_vars(single(Lit)) = literal_vars(Lit). clause_vars(disj(Lit, Lits)) = literal_vars(Lit) `union` union_list(map(literal_vars, Lits)). :- func literal_vars(constraint_literal) = set(svar). literal_vars(cl_true) = init. literal_vars(cl_var_builtin(Var, _, _)) = make_singleton_set(Var). literal_vars(cl_var_func(Var, Inputs, Outputs, _, _)) = make_singleton_set(Var) `union` from_list(Inputs) `union` from_list(Outputs). literal_vars(cl_var_usertype(Var, _, ArgVars, _)) = insert(from_list(ArgVars), Var). literal_vars(cl_var_free_type_var(Var, _, _)) = make_singleton_set(Var). literal_vars(cl_var_var(VarA, VarB, _)) = from_list([VarA, VarB]). %-----------------------------------------------------------------------% :- type problem_solving ---> problem( ps_vars :: set(svar), ps_var_comments :: map(svar, string), ps_domains :: map(svar, domain), ps_pretty_info :: pretty_info % Not currently using propagators. % p_propagators :: map(svar, set(propagator(V))) ). :- type problem_result ---> ok(problem_solving) ; failed(context, why_failed) ; floundering(list(svar), list(clause), map(svar, domain)). :- type why_failed ---> mismatch( wfm_left :: domain, wfm_right :: domain, wfm_why :: maybe(why_failed) ) ; occurs_in_type( wfot_left :: svar, wfot_type :: type_id, wfot_right :: assoc_list(svar, domain) ) ; occurs_in_func( wfof_left :: svar, wfof_input :: assoc_list(svar, domain), wfof_output :: assoc_list(svar, domain) ). % We're not currently using propagators in the solver. % :- type propagator(V) % ---> propagator(constraint). :- pred run_clauses(list(clause)::in, problem_solving::in, problem_result::out) is det. run_clauses(Clauses, Problem, Result) :- run_clauses(Clauses, [], length(Clauses), domains_not_updated, Problem, Result). :- type domains_updated ---> domains_not_updated ; domains_updated. % Run the clauses until we can't make any further progress. % :- pred run_clauses(list(clause)::in, list(clause)::in, int::in, domains_updated::in, problem_solving::in, problem_result::out) is det. run_clauses([], [], _, _, Problem, ok(Problem)) :- trace [io(!IO), compile_time(flag("typecheck_solve"))] ( write_string("\nNo more clauses\n", !IO) ). run_clauses([], Cs@[_ | _], OldLen, Updated, Problem, Result) :- Len = length(Cs), ( if % Before running the delayed clauses we check to see if we are % indeed making progress. Len < OldLen ; Updated = domains_updated then trace [io(!IO), compile_time(flag("typecheck_solve"))] ( format("Running %d delayed clauses\n", [i(Len)], !IO) ), run_clauses(reverse(Cs), [], Len, domains_not_updated, Problem, Result) else if % We can accept the solution if the only unbound variables are % potentially existentially quantified. If they aren't then the % the typechecker itself will be able to raise an error. all [Var] ( member(Var, Problem ^ ps_vars) => ( require_complete_switch [Var] ( Var = v_anon(_) ; Var = v_type_var(_) ; ( Var = v_named(_) ; Var = v_output(_) ), Ground = groundness( get_domain(Problem ^ ps_domains, Var)), require_complete_switch [Ground] ( Ground = ground ; Ground = ground_maybe_resources ; Ground = bound_with_holes_or_free, false ) ) ) ) then trace [io(!IO), compile_time(flag("typecheck_solve"))] ( write_string("Delayed goals probably don't matter\n", !IO) ), Result = ok(Problem) else Result = floundering(to_sorted_list(unbound_vars(Problem)), Cs, Problem ^ ps_domains) ). run_clauses([C | Cs], Delays0, ProgressCheck, Updated0, !.Problem, Result) :- run_clause(C, Delays0, Delays, Updated0, Updated, !.Problem, ClauseResult), ( ClauseResult = ok(!:Problem), run_clauses(Cs, Delays, ProgressCheck, Updated, !.Problem, Result) ; ClauseResult = failed(_, _), Result = ClauseResult ; ClauseResult = floundering(_, _, _), Result = ClauseResult ). :- pred run_clause(clause::in, list(clause)::in, list(clause)::out, domains_updated::in, domains_updated::out, problem_solving::in, problem_result::out) is det. run_clause(Clause, !Delays, !Updated, Problem0, Result) :- ( Clause = single(Lit), run_literal(Lit, Success, Problem0, Problem) ; Clause = disj(Lit, Lits), run_disj([Lit | Lits], Success, Problem0, Problem) ), ( Success = success_updated, Result = ok(Problem), !:Updated = domains_updated ; Success = success_not_updated, Result = ok(Problem0) ; Success = failed(Context, Why), Result = failed(Context, Why) ; Success = failed_disj, compile_error($file, $pred, "Failed disjunction") ; ( Success = delayed_updated, Result = ok(Problem), !:Updated = domains_updated ; Success = delayed_not_updated, Result = ok(Problem0) ), !:Delays = [Clause | !.Delays] ). % A disjunction normally needs at least one literal to be true for the % disjunction to be true. However for typechecking we want to find a % unique solution to the type problem, therefore we need _exactly one_ % literal to be true. % % This will not implement choice points, and will only execute % disjunctions that we know will not generate choices. If a disjunction % would generate a choice then it will be delayed and hopefully executed % later. % % This is broken into two stages, first iterate over the literals until % we find the first true one, then iterate over the remaining literals % to ensure they're all false. If we find need to update the problem, % then delay. % :- pred run_disj(list(constraint_literal)::in, executed::out, problem_solving::in, problem_solving::out) is det. run_disj(Disjs, Delayed, !Problem) :- trace [io(!IO), compile_time(flag("typecheck_solve"))] ( io.write_string("Running disjunction\n", !IO) ), run_disj(Disjs, no, Delayed, !Problem), trace [io(!IO), compile_time(flag("typecheck_solve"))] ( io.write_string("Finished disjunction\n", !IO) ). :- pred run_disj(list(constraint_literal)::in, maybe(constraint_literal)::in, executed::out, problem_solving::in, problem_solving::out) is det. run_disj([], no, failed_disj, !Problem). run_disj([], yes(Lit), Success, Problem0, Problem) :- run_literal(Lit, Success, Problem0, Problem1), % Since all the other disjuncts have failed (or don't exist) then we may % update the problem, because we have proven that this disjunct % is always the only true one. ( if is_updated(Success) then Problem = Problem1 else Problem = Problem0 ). run_disj([Lit | Lits], MaybeDelayed, Success, Problem0, Problem) :- run_literal(Lit, Success0, Problem0, Problem1), ( ( Success0 = success_updated ; Success0 = delayed_updated ), trace [io(!IO), compile_time(flag("typecheck_solve"))] ( write_string(" disjunct updates domain, delaying\n", !IO) ), ( MaybeDelayed = yes(_), Success = delayed_not_updated, Problem = Problem0 ; MaybeDelayed = no, % If an item is the last one and it would update the problem % and might be true, then it'll eventually be re-executed above. run_disj(Lits, yes(Lit), Success, Problem0, Problem) ) ; Success0 = success_not_updated, % Switch to checking that the remaining items are false. run_disj_all_false(Lits, MaybeDelayed, Problem1, Success), Problem = Problem1 ; Success0 = delayed_not_updated, Success = delayed_not_updated, Problem = Problem0 ; ( Success0 = failed(_, _) % XXX: Keep the reason. ; Success0 = failed_disj ), run_disj(Lits, MaybeDelayed, Success, Problem0, Problem) ). :- pred run_disj_all_false(list(constraint_literal)::in, maybe(constraint_literal)::in, problem_solving::in, executed::out) is det. run_disj_all_false([], no, _, success_not_updated). run_disj_all_false([], yes(Lit), Problem, Success) :- run_literal(Lit, Success0, Problem, _), ( ( Success0 = success_updated ; Success0 = success_not_updated ), Success = delayed_not_updated ; ( Success0 = failed(_, _) ; Success0 = failed_disj ), Success = success_not_updated ; ( Success0 = delayed_not_updated ; Success0 = delayed_updated ), Success = delayed_not_updated ). run_disj_all_false([Lit | Lits], MaybeDelayed, Problem, Success) :- run_literal(Lit, Success0, Problem, _), ( ( Success0 = success_updated ; Success0 = delayed_updated ), trace [io(!IO), compile_time(flag("typecheck_solve"))] ( write_string(" disjunct would write updates, delaying\n", !IO) ), ( MaybeDelayed = yes(_), Success = delayed_not_updated ; MaybeDelayed = no, run_disj_all_false(Lits, yes(Lit), Problem, Success) ) ; Success0 = success_not_updated, unexpected($file, $pred, "Ambigious types") ; Success0 = delayed_not_updated, Success = delayed_not_updated ; ( Success0 = failed(_, _) ; Success0 = failed_disj ), run_disj_all_false(Lits, MaybeDelayed, Problem, Success) ). :- type executed ---> success_updated ; success_not_updated ; failed(context, why_failed) ; failed_disj % We've updated the problem but something in this constraint % can't be run now, so revisit the whole constraint later. ; delayed_updated ; delayed_not_updated. :- inst executed_no_delay for executed/0 ---> success_updated ; success_not_updated ; failed(ground, ground) ; failed_disj. :- pred is_updated(executed::in) is semidet. is_updated(success_updated). is_updated(delayed_updated). :- pred mark_delayed(executed::in, executed::out) is det. mark_delayed(success_updated, delayed_updated). mark_delayed(success_not_updated, delayed_not_updated). mark_delayed(Failed, _) :- ( Failed = failed(_, _) ; Failed = failed_disj ), unexpected($file, $pred, "Cannot delay after failure"). mark_delayed(delayed_updated, delayed_updated). mark_delayed(delayed_not_updated, delayed_not_updated). :- pred mark_updated(executed::in, executed::out) is det. mark_updated(success_updated, success_updated). mark_updated(success_not_updated, success_updated). mark_updated(Failed, _) :- ( Failed = failed(_, _) ; Failed = failed_disj ), unexpected($file, $pred, "Cannot update after failure"). mark_updated(delayed_updated, delayed_updated). mark_updated(delayed_not_updated, delayed_updated). % Run the literal immediately. Directly update domains and add % propagators. % :- pred run_literal(constraint_literal::in, executed::out, problem_solving::in, problem_solving::out) is det. run_literal(Lit, Success, !Problem) :- trace [io(!IO), compile_time(flag("typecheck_solve"))] ( PrettyInfo = !.Problem ^ ps_pretty_info, PrettyTitle = [p_str("Running step"), p_nl_hard], PrettyDomains = pretty_store(!.Problem), PrettyRun = p_expr([p_str("Run:"), p_nl_hard] ++ pretty_literal(PrettyInfo, Lit)), io.write_string(pretty_str( PrettyTitle ++ [PrettyDomains, p_nl_hard, PrettyRun, p_nl_hard]), !IO) ), run_literal_2(Lit, Success, !Problem), trace [io(!IO), compile_time(flag("typecheck_solve"))] ( io.format(" %s\n", [s(string(Success))], !IO) ). :- pred run_literal_2(constraint_literal::in, executed::out, problem_solving::in, problem_solving::out) is det. run_literal_2(cl_true, success_not_updated, !Problem). run_literal_2(Literal, Success, !Problem) :- ( Literal = cl_var_builtin(_, _, _) ; Literal = cl_var_var(_, _, _) ; Literal = cl_var_free_type_var(_, _, _) ; Literal = cl_var_func(_, _, _, _, _) ; Literal = cl_var_usertype(_, _, _, _) ), some [!Domains] ( !:Domains = !.Problem ^ ps_domains, PrettyInfo = !.Problem ^ ps_pretty_info, ( Literal = cl_var_builtin(LeftVar, Builtin, Context), RightDomain = d_builtin(Builtin), RightInnerVars = [], MaybeOccursInfo = no ; Literal = cl_var_var(LeftVar, RightVar0, Context), RightDomain = get_domain(!.Domains, RightVar0), RightInnerVars = [], MaybeOccursInfo = no ; Literal = cl_var_free_type_var(LeftVar, TypeVar, Context), RightDomain = d_univ_var(TypeVar), RightInnerVars = [], MaybeOccursInfo = no ; Literal = cl_var_func(LeftVar, InputsUnify, OutputsUnify, MaybeResourcesUnify, Context), InputDomainsUnify = map(get_domain(!.Domains), InputsUnify), OutputDomainsUnify = map(get_domain(!.Domains), OutputsUnify), RightDomain = d_func(InputDomainsUnify, OutputDomainsUnify, MaybeResourcesUnify), RightInnerVars = OutputsUnify ++ InputsUnify, MaybeOccursInfo = yes(occurs_in_func(LeftVar, map_corresponding(pair, InputsUnify, InputDomainsUnify), map_corresponding(pair, OutputsUnify, OutputDomainsUnify))) ; Literal = cl_var_usertype(LeftVar, TypeUnify, ArgsUnify, Context), ArgDomainsUnify = map(get_domain(!.Domains), ArgsUnify), RightDomain = d_type(TypeUnify, ArgDomainsUnify), RightInnerVars = ArgsUnify, MaybeOccursInfo = yes(occurs_in_type(LeftVar, TypeUnify, map_corresponding(pair, ArgsUnify, ArgDomainsUnify))) ), LeftDomain = get_domain(!.Domains, LeftVar), % RightInnerVars contains the set of vars inside structions on the % right. If the var on the left is in this set then the unification % is nonsensical. ( if MaybeOccursInfo = yes(OccursInfo), member(LeftVar, RightInnerVars) then Success = failed(Context, OccursInfo) else trace [io(!IO), compile_time(flag("typecheck_solve"))] ( Pretty = [p_str(" left: "), pretty_domain(PrettyInfo, LeftDomain), p_str(" right: "), pretty_domain(PrettyInfo, RightDomain), p_nl_hard], write_string(pretty_str(Pretty), !IO) ), Dom = unify_domains(LeftDomain, RightDomain), ( Dom = failed(Why), Success = failed(Context, Why) ; Dom = unified(NewDom, Updated), some [!Success] ( !:Success = success_not_updated, ( Updated = delayed, mark_delayed(!Success) ; ( Updated = new_domain, set(LeftVar, NewDom, !Domains), ( Literal = cl_var_builtin(_, _, _) ; Literal = cl_var_free_type_var(_, _, _) ; Literal = cl_var_var(_, RightVar, _), set(RightVar, NewDom, !Domains) ; Literal = cl_var_func(_, InputVars, OutputVars, _, _), ( if NewDom = d_func(InputDoms, OutputDoms, _) then foldl_corresponding(map.set, InputVars, InputDoms, !Domains), foldl_corresponding(map.set, OutputVars, OutputDoms, !Domains) else true ) ; Literal = cl_var_usertype(_, _, ArgVars, _), ( if NewDom = d_type(_, ArgDomains) then foldl_corresponding(map.set, ArgVars, ArgDomains, !Domains) else true ) ), !Problem ^ ps_domains := !.Domains, mark_updated(!Success) ; Updated = old_domain ), Groundness = groundness(NewDom), ( Groundness = bound_with_holes_or_free, mark_delayed(!Success) ; Groundness = ground_maybe_resources ; Groundness = ground ) ), Success = !.Success ), trace [io(!IO), compile_time(flag("typecheck_solve"))] ( Pretty = [p_str(" new: "), pretty_domain(PrettyInfo, NewDom), p_nl_hard], write_string(pretty_str(Pretty), !IO) ) ) ) ). :- func unbound_vars(problem_solving) = set(svar). unbound_vars(Problem) = Problem ^ ps_vars `difference` from_list(filter_map((func(V - D) = V is semidet :- G = groundness(D), ( G = ground_maybe_resources ; G = ground ) ), to_assoc_list(Problem ^ ps_domains))). %-----------------------------------------------------------------------% :- pred build_results(map(svar, domain)::in, svar::in, map(svar_user, type_)::in, map(svar_user, type_)::out) is det. build_results(_, v_anon(_), !Results). build_results(_, v_type_var(_), !Results). % XXX build_results(Map, Var, !Results) :- ( Var = v_named(V), VarUser = vu_named(V) ; Var = v_output(N), VarUser = vu_output(N) ), lookup(Map, Var, Domain), Type = domain_to_type(Var, Domain), det_insert(VarUser, Type, !Results). :- pred svar_to_svar_user(svar::in, svar_user::out) is semidet. svar_to_svar_user(v_named(N), vu_named(N)). svar_to_svar_user(v_output(O), vu_output(O)). :- func domain_to_type(V, domain) = type_. domain_to_type(Var, d_free) = unexpected($file, $pred, string.format("Free variable in '%s'", [s(string(Var))])). domain_to_type(_, d_builtin(Builtin)) = builtin_type(Builtin). domain_to_type(Var, d_type(TypeId, Args)) = type_ref(TypeId, map(domain_to_type(Var), Args)). domain_to_type(Var, d_func(Inputs, Outputs, MaybeResources)) = Type :- ( MaybeResources = unknown_resources, % The resource-checking pass will fix this. Used = set.init, Observed = set.init ; MaybeResources = resources(Used, Observed) ), Type = func_type(map(domain_to_type(Var), Inputs), map(domain_to_type(Var), Outputs), Used, Observed). domain_to_type(_, d_univ_var(TypeVar)) = type_variable(TypeVar). %-----------------------------------------------------------------------% :- type domain ---> d_free ; d_builtin(builtin_type) ; d_type(type_id, list(domain)) ; d_func(list(domain), list(domain), maybe_resources) % A type variable from the function's signature. ; d_univ_var(type_var). :- func get_domain(map(svar, domain), svar) = domain. get_domain(Map, Var) = ( if map.search(Map, Var, Domain) then Domain else d_free ). :- type groundness ---> bound_with_holes_or_free % Type information is ground but resource information always has % unknown groundness. ; ground_maybe_resources ; ground. :- func groundness(domain) = groundness. groundness(d_free) = bound_with_holes_or_free. groundness(d_builtin(_)) = ground. groundness(d_type(_, Args)) = Groundness :- ( if some [Arg] ( member(Arg, Args), ArgGroundness = groundness(Arg), ArgGroundness = bound_with_holes_or_free ) then Groundness = bound_with_holes_or_free else Groundness = ground ). groundness(d_func(Inputs, Outputs, _)) = Groundness :- ( if some [Arg] ( ( member(Arg, Inputs) ; member(Arg, Outputs) ), ArgGroundness = groundness(Arg), ArgGroundness = bound_with_holes_or_free ) then Groundness = bound_with_holes_or_free else Groundness = ground_maybe_resources ). groundness(d_univ_var(_)) = ground. %-----------------------------------------------------------------------% :- type unify_result(D) ---> unified(D, domain_status) ; failed(why_failed). :- type domain_status % new_domain can include delays ---> new_domain ; old_domain ; delayed. :- type unify_result == unify_result(domain). :- func unify_domains(domain, domain) = unify_result. unify_domains(Dom1, Dom2) = Dom :- ( Dom1 = d_free, ( Dom2 = d_free, Dom = unified(d_free, delayed) ; ( Dom2 = d_builtin(_) ; Dom2 = d_type(_, _) ; Dom2 = d_func(_, _, _) ; Dom2 = d_univ_var(_) ), Dom = unified(Dom2, new_domain) ) ; Dom1 = d_builtin(Builtin1), ( Dom2 = d_free, Dom = unified(Dom1, new_domain) ; Dom2 = d_builtin(Builtin2), ( if Builtin1 = Builtin2 then Dom = unified(Dom1, old_domain) else Dom = failed(mismatch(Dom1, Dom2, no)) ) ; ( Dom2 = d_type(_, _) ; Dom2 = d_func(_, _, _) ; Dom2 = d_univ_var(_) ), Dom = failed(mismatch(Dom1, Dom2, no)) ) ; Dom1 = d_type(Type1, Args1), ( Dom2 = d_free, Dom = unified(Dom1, new_domain) ; Dom2 = d_type(Type2, Args2), ( if Type1 = Type2, length(Args1, ArgsLen), length(Args2, ArgsLen) then MaybeNewArgs = unify_args_domains(Args1, Args2), ( MaybeNewArgs = unified(Args, ArgsUpdated), ( ArgsUpdated = new_domain, Dom = unified(d_type(Type1, Args), new_domain) ; ArgsUpdated = old_domain, Dom = unified(d_type(Type1, Args1), old_domain) ; ArgsUpdated = delayed, Dom = unified(d_type(Type1, Args), delayed) ) ; MaybeNewArgs = failed(Why), Dom = failed(mismatch(Dom1, Dom2, yes(Why))) ) else Dom = failed(mismatch(Dom1, Dom2, no)) ) ; ( Dom2 = d_builtin(_) ; Dom2 = d_func(_, _, _) ; Dom2 = d_univ_var(_) ), Dom = failed(mismatch(Dom1, Dom2, no)) ) ; Dom1 = d_func(Inputs1, Outputs1, MaybeRes1), ( Dom2 = d_free, Dom = unified(Dom1, new_domain) ; Dom2 = d_func(Inputs2, Outputs2, MaybeRes2), ( if length(Inputs1, InputsLen), length(Inputs2, InputsLen), length(Outputs1, OutputsLen), length(Outputs2, OutputsLen) then MaybeNewInputs = unify_args_domains(Inputs1, Inputs2), MaybeNewOutputs = unify_args_domains(Outputs1, Outputs2), ( MaybeNewInputs = failed(Why), Dom = failed(mismatch(Dom1, Dom2, yes(Why))) ; MaybeNewInputs = unified(Inputs, InputsUpdated), ( MaybeNewOutputs = failed(Why), Dom = failed(mismatch(Dom1, Dom2, yes(Why))) ; MaybeNewOutputs = unified(Outputs, OutputsUpdated), unify_resources(MaybeRes1, MaybeRes2, MaybeRes, ResUpdated), NewDom = d_func(Inputs, Outputs, MaybeRes), Dom = unified(NewDom, greatest_domain_status( greatest_domain_status(InputsUpdated, OutputsUpdated), ResUpdated)) ) ) else Dom = failed(mismatch(Dom1, Dom2, no)) ) ; ( Dom2 = d_builtin(_) ; Dom2 = d_type(_, _) ; Dom2 = d_univ_var(_) ), Dom = failed(mismatch(Dom1, Dom2, no)) ) ; Dom1 = d_univ_var(Var1), ( Dom2 = d_free, Dom = unified(Dom1, new_domain) ; Dom2 = d_univ_var(Var2), ( if Var1 = Var2 then Dom = unified(Dom1, old_domain) else Dom = failed(mismatch(Dom1, Dom2, no)) ) ; ( Dom2 = d_builtin(_) ; Dom2 = d_type(_, _) ; Dom2 = d_func(_, _, _) ), Dom = failed(mismatch(Dom1, Dom2, no)) ) ). :- func unify_args_domains(list(domain), list(domain)) = unify_result(list(domain)). unify_args_domains(Args1, Args2) = Doms :- MaybeNewArgs = map_corresponding(unify_domains, Args1, Args2), RevDoms = foldl(unify_args_domains_2, MaybeNewArgs, unified([], old_domain)), ( RevDoms = unified(Rev, Updated), Doms0 = reverse(Rev), Doms = unified(Doms0, Updated) ; RevDoms = failed(Why), Doms = failed(Why) ). :- func unify_args_domains_2(unify_result, unify_result(list(domain))) = unify_result(list(domain)). unify_args_domains_2(A, !.R) = !:R :- ( !.R = failed(_) ; !.R = unified(RD, Updated0), ( A = failed(Why), !:R = failed(Why) ; A = unified(AD, UpdatedA), !:R = unified([AD | RD], greatest_domain_status(Updated0, UpdatedA)) ) ). :- func greatest_domain_status(domain_status, domain_status) = domain_status. greatest_domain_status(A, B) = ( if A = new_domain ; B = new_domain then new_domain else if A = delayed ; B = delayed then delayed else if A = old_domain , B = old_domain then old_domain else unexpected($file, $pred, "Case not covered") ). %-----------------------------------------------------------------------% :- pred unify_resources(maybe_resources::in, maybe_resources::in, maybe_resources::out, domain_status::out) is det. unify_resources(unknown_resources, unknown_resources, unknown_resources, delayed). unify_resources(unknown_resources, resources(Us, Os), resources(Us, Os), new_domain). unify_resources(resources(Us, Os), unknown_resources, resources(Us, Os), new_domain). unify_resources(resources(UsA, OsA), resources(UsB, OsB), resources(Us, Os), Status) :- Us = union(UsA, UsB), Os = union(OsA, OsB), % Technically we could subtract the used items from the observed. but % that may make this computation non-monotonic and I think we need that % for the type solver to terminate. ( if equal(UsA, UsB), equal(OsA, OsB) then Status = delayed else Status = new_domain ). %-----------------------------------------------------------------------% :- type type_vars == int. :- type type_var_map(T) ---> type_var_map( tvm_source :: int, tvm_map :: map(T, int) ). init_type_vars = 0. start_type_var_mapping(Source, type_var_map(Source, init)). end_type_var_mapping(type_var_map(Source, _), Source). get_or_make_type_var(Name, Var, !Map) :- ( if search(!.Map ^ tvm_map, Name, Id) then Var = v_type_var(Id) else make_type_var(Name, Var, !Map) ). make_type_var(Name, Var, !Map) :- Id = !.Map ^ tvm_source, det_insert(Name, Id, !.Map ^ tvm_map, NewMap), Var = v_type_var(Id), !:Map = type_var_map(Id + 1, NewMap). lookup_type_var(Map, Name) = v_type_var(map.lookup(Map ^ tvm_map, Name)). maybe_add_free_type_var(Context, Name, cl_var_free_type_var(Var, Name, Context), !Map) :- get_or_make_type_var(Name, Var, !Map). %-----------------------------------------------------------------------% %-----------------------------------------------------------------------% ================================================ FILE: src/core.types.m ================================================ %-----------------------------------------------------------------------% % Plasma types representation % vim: ts=4 sw=4 et % % Copyright (C) Plasma Team % Distributed under the terms of the MIT License see ../LICENSE.code % %-----------------------------------------------------------------------% :- module core.types. %-----------------------------------------------------------------------% :- interface. :- import_module context. %-----------------------------------------------------------------------% :- type type_ ---> builtin_type(builtin_type) ; func_type( % Arg types list(type_), % Return types list(type_), % Uses set(resource_id), % Observes set(resource_id) ) ; type_variable(type_var) ; type_ref(type_id, list(type_)). :- type type_var == string. % XXX: Should probably handle type var renaming/remapping. % :- pred types_equal_except_resources(type_::in, type_::in) is semidet. :- type builtin_type ---> int ; codepoint ; string ; string_pos. :- pred builtin_type_name(builtin_type, nq_name). :- mode builtin_type_name(in, out) is det. :- mode builtin_type_name(out, in) is semidet. % All types have constructors, but some types don't have constructor % IDs (Strings, Ints, etc) and some don't provide them (abstract types). % :- func type_get_ctors(core, type_) = maybe(list(ctor_id)). % Return all the resources that appear in this type. % :- func type_get_resources(type_) = set(resource_id). :- func type_get_types(type_) = set(type_id). %-----------------------------------------------------------------------% :- type user_type. :- func type_init(q_name, list(string), list(ctor_id), sharing_opaque, imported, context) = user_type. :- func type_init_abstract(q_name, arity, context) = user_type. :- func utype_get_name(user_type) = q_name. :- func utype_get_params(user_type) = maybe(list(string)). :- func utype_get_ctors(user_type) = maybe(list(ctor_id)). :- func utype_get_sharing(user_type) = sharing_opaque. :- func utype_get_imported(user_type) = imported. :- func utype_get_arity(user_type) = arity. :- func utype_get_context(user_type) = context. :- func utype_get_resources(core, user_type) = set(resource_id). :- func utype_get_types(core, user_type) = set(type_id). %-----------------------------------------------------------------------% :- type constructor ---> constructor( c_name :: q_name, c_params :: list(type_var), c_fields :: list(type_field) ). :- type type_field ---> type_field( tf_name :: q_name, tf_type :: type_ ). %-----------------------------------------------------------------------% %-----------------------------------------------------------------------% :- implementation. %-----------------------------------------------------------------------% types_equal_except_resources(T1, T2) :- require_complete_switch [T1] ( T1 = builtin_type(B), T2 = builtin_type(B) ; T1 = type_variable(V), T2 = type_variable(V) ; T1 = type_ref(TypeId, ArgsA), T2 = type_ref(TypeId, ArgsB), all_true_corresponding(types_equal_except_resources, ArgsA, ArgsB) ; T1 = func_type(ArgsA, OutA, _, _), T2 = func_type(ArgsB, OutB, _, _), all_true_corresponding(types_equal_except_resources, ArgsA, ArgsB), all_true_corresponding(types_equal_except_resources, OutA, OutB) ). %-----------------------------------------------------------------------% :- pragma promise_equivalent_clauses(builtin_type_name/2). builtin_type_name(Type::in, nq_name_det(String)::out) :- builtin_type_name_2(Type, String). builtin_type_name(Type::out, Name::in) :- builtin_type_name_2(Type, nq_name_to_string(Name)). :- pred builtin_type_name_2(builtin_type, string). :- mode builtin_type_name_2(in, out) is det. :- mode builtin_type_name_2(out, in) is semidet. builtin_type_name_2(int, "Int"). builtin_type_name_2(codepoint, "CodePoint"). builtin_type_name_2(string, "String"). builtin_type_name_2(string_pos, "StringPos"). %-----------------------------------------------------------------------% type_get_ctors(_, builtin_type(_)) = no. type_get_ctors(_, func_type(_, _, _, _)) = no. type_get_ctors(_, type_variable(_)) = no. type_get_ctors(Core, type_ref(TypeId, _)) = utype_get_ctors(core_get_type(Core, TypeId)). %-----------------------------------------------------------------------% type_get_resources(builtin_type(_)) = set.init. type_get_resources(func_type(_, _, Uses, Observes)) = Uses `set.union` Observes. type_get_resources(type_variable(_)) = set.init. type_get_resources(type_ref(_, Args)) = set.union_list( map(type_get_resources, Args)). %-----------------------------------------------------------------------% :- type user_type ---> user_type( t_symbol :: q_name, t_params :: list(string), t_ctors :: list(ctor_id), t_sharing :: sharing_opaque, t_imported :: imported, t_context :: context ) ; abstract_type( at_symbol :: q_name, at_arity :: arity, at_context :: context ). type_init(Name, Params, Ctors, Sharing, Imported, Context) = user_type(Name, Params, Ctors, Sharing, Imported, Context). type_init_abstract(Name, Arity, Context) = abstract_type(Name, Arity, Context). utype_get_name(user_type(S, _, _, _, _, _)) = S. utype_get_name(abstract_type(S, _, _)) = S. utype_get_params(user_type(_, Params, _, _, _, _)) = yes(Params). utype_get_params(abstract_type(_, _, _)) = no. utype_get_ctors(Type) = ( if Ctors = Type ^ t_ctors then yes(Ctors) else no ). utype_get_sharing(user_type(_, _, _, Sharing, _, _)) = Sharing. utype_get_sharing(abstract_type(_, _, _)) = so_private. utype_get_imported(user_type(_, _, _, _, Imported, _)) = Imported. utype_get_imported(abstract_type(_, _, _)) = i_imported. utype_get_arity(user_type(_, Params, _, _, _, _)) = arity(length(Params)). utype_get_arity(abstract_type(_, Arity, _)) = Arity. utype_get_context(user_type(_, _, _, _, _, Context)) = Context. utype_get_context(abstract_type(_, _, Context)) = Context. %-----------------------------------------------------------------------% utype_get_resources(Core, user_type(_, _, Ctors, _, _, _)) = union_list(map(ctor_get_resources(Core), Ctors)). utype_get_resources(_, abstract_type(_, _, _)) = set.init. :- func ctor_get_resources(core, ctor_id) = set(resource_id). ctor_get_resources(Core, CtorId) = Res :- core_get_constructor_det(Core, CtorId, Ctor), Ctor = constructor(_, _, Fields), Res = union_list(map(field_get_resources, Fields)). :- func field_get_resources(type_field) = set(resource_id). field_get_resources(type_field(_, Type)) = type_get_resources(Type). %-----------------------------------------------------------------------% utype_get_types(Core, user_type(_, _, Ctors, _, _, _)) = union_list(map(ctor_get_types(Core), Ctors)). utype_get_types(_, abstract_type(_, _, _)) = set.init. :- func ctor_get_types(core, ctor_id) = set(type_id). ctor_get_types(Core, CtorId) = Types :- core_get_constructor_det(Core, CtorId, Ctor), Ctor = constructor(_, _, Fields), Types = union_list(map(field_get_types, Fields)). :- func field_get_types(type_field) = set(type_id). field_get_types(type_field(_, TypeExpr)) = type_get_types(TypeExpr). type_get_types(builtin_type(_)) = set.init. type_get_types(func_type(Params, Returns, _, _)) = union_list(map(type_get_types, Params)) `union` union_list(map(type_get_types, Returns)). type_get_types(type_variable(_)) = set.init. type_get_types(type_ref(TypeId, Args)) = set.make_singleton_set(TypeId) `union` union_list(map(type_get_types, Args)). %-----------------------------------------------------------------------% %-----------------------------------------------------------------------% ================================================ FILE: src/core.util.m ================================================ %-----------------------------------------------------------------------% % vim: ts=4 sw=4 et %-----------------------------------------------------------------------% :- module core.util. % % Copyright (C) Plasma Team % Distributed under the terms of the MIT see ../LICENSE.code % % Utility code for the core stage. % %-----------------------------------------------------------------------% :- interface. :- import_module io. :- import_module compile_error. :- import_module util.log. :- import_module util.result. %-----------------------------------------------------------------------% % Process all non-imported functions that havn't generated errors in % prior passes. % :- pred process_noerror_funcs(log_config, pred(core, func_id, function, result_partial(function, compile_error)), errors(compile_error), core, core, io, io). :- mode process_noerror_funcs(in, pred(in, in, in, out) is det, out, in, out, di, uo) is det. :- pred process_noerror_scc_funcs(log_config, pred(core, func_id, function, result_partial(function, compile_error)), errors(compile_error), core, core, io, io). :- mode process_noerror_scc_funcs(in, pred(in, in, in, out) is det, out, in, out, di, uo) is det. :- pred check_noerror_funcs(log_config, func(core, func_id, function) = errors(compile_error), errors(compile_error), core, core, io, io). :- mode check_noerror_funcs(in, func(in, in, in) = (out) is det, out, in, out, di, uo) is det. %-----------------------------------------------------------------------% :- pred create_anon_var_with_type(type_::in, var::out, varmap::in, varmap::out, map(var, type_)::in, map(var, type_)::out) is det. %-----------------------------------------------------------------------% %-----------------------------------------------------------------------% :- implementation. :- import_module cord. :- import_module string. %-----------------------------------------------------------------------% process_noerror_funcs(Verbose, Pred, Errors, !Core, !IO) :- Funcs = core_all_defined_functions(!.Core), map_foldl2(process_func(Verbose, Pred), Funcs, ErrorsList, !Core, !IO), Errors = cord_list_to_cord(ErrorsList). :- pred process_func(log_config, pred(core, func_id, function, result_partial(function, compile_error)), pair(func_id, function), errors(compile_error), core, core, io, io). :- mode process_func(in, pred(in, in, in, out) is det, in, out, in, out, di, uo) is det. process_func(Verbose, Pred, FuncId - Func0, Errors, !Core, !IO) :- ( if not func_has_error(Func0) then FuncName = func_get_name(Func0), verbose_output(Verbose, format(" processing %s\n", [s(q_name_to_string(FuncName))]), !IO), Pred(!.Core, FuncId, Func0, Result), ( Result = ok(Func, Errors) ; Result = errors(Errors), func_raise_error(Func0, Func) ), core_set_function(FuncId, Func, !Core) else Errors = init ). %-----------------------------------------------------------------------% process_noerror_scc_funcs(Verbose, Pred, Errors, !Core, !IO) :- SCCs = core_all_defined_functions_sccs(!.Core), FuncIds = map(make_func_pair(!.Core), condense(map(to_sorted_list, reverse(SCCs)))), map_foldl2(process_func(Verbose, Pred), FuncIds, ErrorsList, !Core, !IO), Errors = cord_list_to_cord(ErrorsList). :- func make_func_pair(core, func_id) = pair(func_id, function). make_func_pair(Core, FuncId) = FuncId - Func :- core_get_function_det(Core, FuncId, Func). %-----------------------------------------------------------------------% check_noerror_funcs(Verbose, Func, Errors, !Core, !IO) :- process_noerror_funcs(Verbose, (pred(C::in, Id::in, F::in, R::out) is det :- ErrorsI = Func(C, Id, F), ( if has_fatal_errors(ErrorsI) then R = errors(ErrorsI) else R = ok(F, ErrorsI) ) ), Errors, !Core, !IO). %-----------------------------------------------------------------------% create_anon_var_with_type(Type, Var, !Varmap, !Vartypes) :- add_anon_var(Var, !Varmap), det_insert(Var, Type, !Vartypes). %-----------------------------------------------------------------------% %-----------------------------------------------------------------------% ================================================ FILE: src/core_to_pz.closure.m ================================================ %-----------------------------------------------------------------------% % vim: ts=4 sw=4 et %-----------------------------------------------------------------------% :- module core_to_pz.closure. % % Copyright (C) Plasma Team % Distributed under the terms of the MIT License see ../LICENSE.code % % Structures and code to help construct closures. % %-----------------------------------------------------------------------% :- interface. %-----------------------------------------------------------------------% :- type closure_builder. :- func closure_builder_init(pzs_id) = closure_builder. :- pred closure_add_field(pz_data_value::in, field_num::out, closure_builder::in, closure_builder::out) is det. % Create the environment for the closure. % :- pred closure_finalize_data(closure_builder::in, pzd_id::out, pz::in, pz::out) is det. :- func closure_get_struct(closure_builder) = pzs_id. %-----------------------------------------------------------------------% %-----------------------------------------------------------------------% :- implementation. :- import_module int. %-----------------------------------------------------------------------% :- type closure_builder ---> closure_builder( cb_struct :: pzs_id, cb_rev_values :: list(pz_data_value), cb_next_field_num :: int ). closure_builder_init(Struct) = closure_builder(Struct, [], 1). %-----------------------------------------------------------------------% closure_add_field(DataValue, field_num(FieldNum), closure_builder(Struct, DataValues, FieldNum), closure_builder(Struct, [DataValue | DataValues], FieldNum + 1)). %-----------------------------------------------------------------------% closure_finalize_data(CB, DataId, !PZ) :- Values = reverse(CB ^ cb_rev_values), Types = duplicate(length(Values), pzw_ptr), pz_add_struct(CB ^ cb_struct, pz_struct(Types), !PZ), pz_new_data_id(DataId, !PZ), pz_add_data(DataId, pz_data(type_struct(CB ^ cb_struct), Values), !PZ). %-----------------------------------------------------------------------% closure_get_struct(CB) = CB ^ cb_struct. %-----------------------------------------------------------------------% %-----------------------------------------------------------------------% ================================================ FILE: src/core_to_pz.code.m ================================================ %-----------------------------------------------------------------------% % vim: ts=4 sw=4 et %-----------------------------------------------------------------------% :- module core_to_pz.code. % % Copyright (C) Plasma Team % Distributed under the terms of the MIT License see ../LICENSE.code % % Plasma core to pz conversion - code generation. % %-----------------------------------------------------------------------% :- interface. :- import_module builtins. :- import_module core. :- import_module core_to_pz.locn. :- import_module pz. %-----------------------------------------------------------------------% :- pred gen_func(compile_options::in, core::in, val_locn_map_static::in, pz_builtin_ids::in, map(string, pzd_id)::in, type_tag_map::in, constructor_data_map::in, pzs_id::in, pair(func_id, function)::in, pz::in, pz::out) is det. %-----------------------------------------------------------------------% %-----------------------------------------------------------------------% :- implementation. :- import_module assoc_list. :- import_module char. :- import_module cord. :- import_module int. :- import_module int32. :- import_module pair. :- import_module maybe. :- import_module string. :- import_module set. :- import_module uint8. :- import_module uint32. :- import_module context. :- import_module core.code. :- import_module core.pretty. :- import_module core_to_pz.closure. :- import_module util. :- import_module util.my_exception. :- import_module util.mercury. %-----------------------------------------------------------------------% gen_func(CompileOpts, Core, LocnMap, BuiltinProcs, FilenameDataMap, TypeTagInfo, TypeCtorTagInfo, ModEnvStructId, FuncId - Func, !PZ) :- Symbol = func_get_name(Func), func_get_type_signature(Func, Input0, Output0, _), Input = map(type_to_pz_width, Input0), Output = map(type_to_pz_width, Output0), Signature = pz_signature(Input, Output), ( if func_get_body(Func, Varmap, Inputs, Captured, BodyExpr), func_get_vartypes(Func, Vartypes) then % This can eventually be replaced by something smarter that % actually re-orders code as a compiler phase, for now this is % good enough to get some reasonble codegen. find_oneuse_vars(BodyExpr, set.init, _ZeroUse, set.init, OneUse), some [!LocnMap] ( !:LocnMap = LocnMap, StructMap = pz_get_struct_names_map(!.PZ), ( Captured = [], IsClosure = not_closure ; Captured = [_ | _], IsClosure = is_closure ), CGInfo = code_gen_info(CompileOpts, Core, BuiltinProcs, TypeTagInfo, TypeCtorTagInfo, FuncId, Vartypes, Varmap, IsClosure, OneUse, ModEnvStructId, StructMap, FilenameDataMap), vl_start_var_binding(!LocnMap), ( IsClosure = not_closure ; IsClosure = is_closure, EnvStructId = vl_lookup_closure(!.LocnMap, FuncId), vl_setup_closure(EnvStructId, field_num_first, !LocnMap), foldl2(set_captured_var_locn(CGInfo, EnvStructId), Captured, !LocnMap, field_num_next(field_num_first), _) ), gen_proc_body(CGInfo, !.LocnMap, Inputs, BodyExpr, Blocks) ), ProcId = vls_lookup_proc_id(LocnMap, FuncId), Proc = pz_proc(Symbol, Signature, yes(Blocks)), pz_add_proc(ProcId, Proc, !PZ) else unexpected($file, $pred, "Function missing body or types") ). :- pred gen_proc_body(code_gen_info::in, val_locn_map::in, list(var)::in, expr::in, list(pz_block)::out) is det. gen_proc_body(CGInfo, !.LocnMap, Params, Expr, Blocks) :- Varmap = CGInfo ^ cgi_varmap, some [!Blocks] ( !:Blocks = pz_blocks(0u32, map.init), alloc_block(EntryBlockId, !Blocks), initial_bind_map(Params, 0, Varmap, ParamDepthComments, !LocnMap), Depth = length(Params), gen_instrs(CGInfo, Expr, Depth, !.LocnMap, cont_return, ExprInstrs, !Blocks), % Finish block. create_block(EntryBlockId, ParamDepthComments ++ ExprInstrs, !Blocks), Blocks = values(to_sorted_assoc_list(!.Blocks ^ pzb_blocks)) ). :- pred set_captured_var_locn(code_gen_info::in, pzs_id::in, var::in, val_locn_map::in, val_locn_map::out, field_num::in, field_num::out) is det. set_captured_var_locn(CGInfo, EnvStructId, Var, !Map, !FieldNum) :- lookup(CGInfo ^ cgi_type_map, Var, Type), Width = type_to_pz_width(Type), vl_set_var_env(Var, EnvStructId, !.FieldNum, Width, !Map), !:FieldNum = field_num_next(!.FieldNum). %-----------------------------------------------------------------------% % fixup_stack(BottomItems, Items) % % Fixup the stack, This is used to remove some BottomItems from benieth % Items on the stack, so that the stack is at the correct depth and has % only Items on it. For example fixup_stack(2, 3) will take a stack % like: % % b1 b2 i1 i2 i3 % % And remove b1 and b2 creating: % % i1 i2 i3 % :- func fixup_stack(int, int) = cord(pz_instr_obj). fixup_stack(BottomItems, Items) = Fixup :- ( if BottomItems < 0 ; Items < 0 then unexpected($file, $pred, format("fixup_stack(%d, %d)", [i(BottomItems), i(Items)])) else Fixup0 = fixup_stack_2(BottomItems, Items), ( if is_empty(Fixup0) then Fixup = singleton(pzio_comment("no fixup")) else Fixup = cons(pzio_comment( format("fixup_stack(%d, %d)", [i(BottomItems), i(Items)])), map((func(I) = pzio_instr(I)), Fixup0)) ) ). :- func fixup_stack_2(int, int) = cord(pz_instr). fixup_stack_2(BottomItems, Items) = ( if BottomItems = 0 then % There are no items underneath the items we want to return. init else if Items = 0 then % There are no items on the top, so we can just drop BottomItems. cord.from_list(condense(duplicate(BottomItems, [pzi_drop]))) else cord.from_list([pzi_roll(BottomItems + Items), pzi_drop]) ++ fixup_stack_2(BottomItems - 1, Items) ). %-----------------------------------------------------------------------% :- type code_gen_info ---> code_gen_info( cgi_options :: compile_options, cgi_core :: core, cgi_builtin_ids :: pz_builtin_ids, cgi_type_tags :: map(type_id, type_tag_info), cgi_type_ctor_tags :: map({type_id, ctor_id}, constructor_data), cgi_this_func :: func_id, cgi_type_map :: map(var, type_), cgi_varmap :: varmap, cgi_func_is_closure :: is_closure, cgi_var_one_use :: set(var), cgi_mod_env_struct :: pzs_id, cgi_struct_names :: map(pzs_id, string), cgi_filename_data :: map(string, pzd_id) ). :- type is_closure % The function runs in some environment other than the module's % environment. ---> is_closure % The function runs in the module's environment. ; not_closure. % gen_instrs(Info, Expr, Depth, LocnMap, Cont, Instrs, !Blocks). % % Generate instructions (Instrs) for an expression (Expr) and it's % continuation (Cont). The continuation is important for handling % returns, switches and lets. It represents what to execute after this % expression. % :- pred gen_instrs(code_gen_info::in, expr::in, int::in, val_locn_map::in, continuation::in, cord(pz_instr_obj)::out, pz_blocks::in, pz_blocks::out) is det. gen_instrs(CGInfo, Expr, Depth, LocnMap, Continuation, CtxtInstrs ++ Instrs, !Blocks) :- Expr = expr(ExprType, CodeInfo), Context = code_info_context(CodeInfo), ( if not is_nil_context(Context) then FilenameDataId = lookup(CGInfo ^ cgi_filename_data, Context ^ c_file), PZContext = pz_context(Context, FilenameDataId) else PZContext = pz_nil_context ), CtxtInstrs = singleton(pzio_context(PZContext)), ( ExprType = e_call(Callee, Args, _), gen_call(CGInfo, Callee, Args, CodeInfo, Depth, LocnMap, Continuation, Instrs) ; ( ExprType = e_var(Var), InstrsMain = gen_var_access(CGInfo, LocnMap, Var, Depth) ; ExprType = e_constant(Const), ( Const = c_number(Num), InstrsMain = singleton(pzio_instr( pzi_load_immediate(pzw_fast, im_i32(det_from_int(Num))))) ; Const = c_string(String), ( if [builtin_type(string)] = code_info_types(CodeInfo) then Locn = vl_lookup_str(LocnMap, String), InstrsMain = gen_val_locn_access(CGInfo, Depth, LocnMap, Locn) else if [builtin_type(codepoint)] = code_info_types(CodeInfo) then % We can use det_from_int because Unicode won't exceed % range. InstrsMain = singleton(pzio_instr(pzi_load_immediate(pzw_32, im_u32(det_from_int(to_int(det_index(String, 0))))))) else unexpected($file, $pred, "String literal has invalid type") ) ; Const = c_func(FuncId), Locn = vl_lookup_proc(LocnMap, FuncId), ( Locn = pl_static_proc(PID), % Make a closure. TODO: To support closures in % Plasma we'll need to move this into a earlier % stage of the compiler. InstrsMain = from_list([ pzio_instr(pzi_get_env), pzio_instr(pzi_make_closure(PID)) ]) ; Locn = pl_other(ValLocn), InstrsMain = gen_val_locn_access(CGInfo, Depth, LocnMap, ValLocn) ; Locn = pl_instrs(_, no), % This should have been filtered out and wrapped in a % proc if it appears as a constant. unexpected($file, $pred, "Instructions") ; Locn = pl_instrs(_, yes(PID)), InstrsMain = from_list([ pzio_instr(pzi_get_env), pzio_instr(pzi_make_closure(PID)) ]) ) ; Const = c_ctor(_), my_exception.sorry($file, $pred, Context, "Type constructor as higher order value") ) ; ExprType = e_construction(CtorIds, Args), CtorId = one_item_in_set(CtorIds), TypeId = one_item(code_info_types(CodeInfo)), gen_instrs_args(CGInfo, LocnMap, Args, ArgsInstrs, Depth, _), InstrsMain = ArgsInstrs ++ gen_construction(CGInfo, TypeId, CtorId) ; ExprType = e_closure(FuncId, Captured), gen_closure(CGInfo, FuncId, Captured, Depth, LocnMap, InstrsMain) ), Arity = code_info_arity_det(CodeInfo), InstrsCont = gen_continuation(Continuation, Depth, Arity ^ a_num, "gen_instrs"), Instrs = InstrsMain ++ InstrsCont ; ExprType = e_tuple(Exprs), gen_tuple(CGInfo, Exprs, Depth, LocnMap, Continuation, Instrs, !Blocks) ; ExprType = e_lets(Lets, InExpr), gen_lets(CGInfo, Lets, InExpr, Depth, LocnMap, Continuation, Instrs, !Blocks) ; ExprType = e_match(Var, Cases), gen_match(CGInfo, Var, Cases, Depth, LocnMap, Continuation, Instrs, !Blocks) ). %-----------------------------------------------------------------------% :- pred gen_call(code_gen_info::in, callee::in, list(var)::in, code_info::in, int::in, val_locn_map::in, continuation::in, cord(pz_instr_obj)::out) is det. gen_call(CGInfo, Callee, Args, CodeInfo, Depth, LocnMap, Continuation, Instrs) :- Core = CGInfo ^ cgi_core, Varmap = CGInfo ^ cgi_varmap, gen_instrs_args(CGInfo, LocnMap, Args, InstrsArgs, Depth, _), ( Callee = c_plain(FuncId), core_get_function_det(Core, FuncId, Func), Decl = func_call_pretty(Core, Func, Varmap, Args), CallComment = singleton(pzio_comment(Decl)), Locn = vl_lookup_proc(LocnMap, FuncId), ( Locn = pl_instrs(Instrs0, _), % The function is implemented with a short sequence of % instructions. Instrs1 = singleton(pzio_comment("Callee is instructions")) ++ cord.from_list(map((func(I) = pzio_instr(I)), Instrs0)), PrepareStackInstrs = init ; Locn = pl_static_proc(PID), ( if is_closure = CGInfo ^ cgi_func_is_closure, FuncId \= CGInfo ^ cgi_this_func then % We're in a closure, but this plain call needs the % environment of the module, so we need a closue call. % TODO This causes a memory allocation that could be eleuded % if we added an instruction to execute a predicate with a % given environment (from the stack) as a closure call. But % rather than add that now first we should Fix Bug #333. LookupInstrs = gen_val_locn_access(CGInfo, Depth, LocnMap, vl_lookup_mod_env(LocnMap)), InstrsClosure = LookupInstrs ++ singleton( pzio_instr(pzi_make_closure(PID))), MbPZCallee = no else InstrsClosure = init, MbPZCallee = yes(pzc_proc_opt(PID)) ), ( if can_tailcall(CGInfo, c_plain(FuncId), Continuation) then % Note that we fixup the stack before making a tailcall % because the continuation isn't used. PrepareStackInstrs = fixup_stack(Depth, length(Args)), ( MbPZCallee = yes(PZCallee), Instr = pzi_tcall(PZCallee) ; MbPZCallee = no, Instr = pzi_tcall_ind ) else PrepareStackInstrs = init, ( MbPZCallee = yes(PZCallee), Instr = pzi_call(PZCallee) ; MbPZCallee = no, Instr = pzi_call_ind ) ), Instrs1 = InstrsClosure ++ singleton(pzio_instr(Instr)) ; Locn = pl_other(ValLocn), PrepareStackInstrs = init, Instrs1 = singleton(pzio_comment( "Accessing callee as value location")) ++ gen_val_locn_access(CGInfo, Depth, LocnMap, ValLocn) ++ singleton(pzio_instr(pzi_call_ind)) ) ; Callee = c_ho(HOVar), HOVarName = varmap.get_var_name(Varmap, HOVar), map.lookup(CGInfo ^ cgi_type_map, HOVar, HOType), ( if HOType = func_type(HOTypeArgs, HOTypeReturns, HOUses, HOObserves) then Pretty = type_pretty_func(Core, HOVarName, HOTypeArgs, HOTypeReturns, HOUses, HOObserves) else unexpected($file, $pred, "Called variable is not a function type") ), CallComment = singleton(pzio_comment(Pretty)), HOVarDepth = Depth + length(Args), Instrs1 = gen_var_access(CGInfo, LocnMap, HOVar, HOVarDepth) ++ singleton(pzio_instr(pzi_call_ind)), PrepareStackInstrs = init ), InstrsMain = CallComment ++ InstrsArgs ++ PrepareStackInstrs ++ Instrs1, Arity = code_info_arity_det(CodeInfo), ( if can_tailcall(CGInfo, Callee, Continuation) then % We did a tail call so there's no continuation. InstrsCont = empty else InstrsCont = gen_continuation(Continuation, Depth, Arity ^ a_num, "gen_instrs") ), Instrs = InstrsMain ++ InstrsCont. :- pred can_tailcall(code_gen_info::in, callee::in, continuation::in) is semidet. can_tailcall(CGInfo, Callee, Continuation) :- EnableTailcalls = CGInfo ^ cgi_options ^ co_enable_tailcalls, EnableTailcalls = enable_tailcalls, Core = CGInfo ^ cgi_core, Continuation = cont_return, Callee = c_plain(FuncId), core_get_function_det(Core, FuncId, Func), Imported = func_get_imported(Func), % XXX: This particular definition of importedness might not be % suitable if it diverges from where the actual code is. Imported = i_local. %-----------------------------------------------------------------------% :- pred gen_tuple(code_gen_info::in, list(expr)::in, int::in, val_locn_map::in, continuation::in, cord(pz_instr_obj)::out, pz_blocks::in, pz_blocks::out) is det. gen_tuple(_, [], Depth, _, Continuation, Instrs, !Blocks) :- Instrs = gen_continuation(Continuation, Depth, 0, "Empty tuple"). gen_tuple(CGInfo, [Arg], Depth, LocnMap, Continue, Instrs, !Blocks) :- gen_instrs(CGInfo, Arg, Depth, LocnMap, Continue, Instrs, !Blocks). gen_tuple(CGInfo, Args@[_, _ | _], Depth, LocnMap, Continue, Instrs, !Blocks) :- % LocnMap does not change in a list of arguments because arguments % do not affect one-another's environment. ( if all [Arg] member(Arg, Args) => Arity = code_info_arity_det(Arg ^ e_info), Arity ^ a_num = 1 then gen_tuple_loop(CGInfo, Args, Depth, LocnMap, init, InstrsArgs, !Blocks), TupleLength = length(Args), InstrsContinue = gen_continuation(Continue, Depth, TupleLength, "Tuple"), Instrs = InstrsArgs ++ InstrsContinue else unexpected($file, $pred, "Bad expression arity used in argument") ). :- pred gen_tuple_loop(code_gen_info::in, list(expr)::in, int::in, val_locn_map::in, cord(pz_instr_obj)::in, cord(pz_instr_obj)::out, pz_blocks::in, pz_blocks::out) is det. gen_tuple_loop(_, [], _, _, !Instrs, !Blocks). gen_tuple_loop(CGInfo, [Expr | Exprs], Depth, LocnMap, !Instrs, !Blocks) :- gen_instrs(CGInfo, Expr, Depth, LocnMap, cont_none(Depth), ExprInstrs, !Blocks), !:Instrs = !.Instrs ++ ExprInstrs, gen_tuple_loop(CGInfo, Exprs, Depth+1, LocnMap, !Instrs, !Blocks). %-----------------------------------------------------------------------% :- pred gen_lets(code_gen_info::in, list(expr_let)::in, expr::in, int::in, val_locn_map::in, continuation::in, cord(pz_instr_obj)::out, pz_blocks::in, pz_blocks::out) is det. gen_lets(CGInfo, Lets, InExpr, Depth, LocnMap, Continuation, Instrs, !Blocks) :- ( Lets = [], gen_instrs(CGInfo, InExpr, Depth, LocnMap, Continuation, Instrs, !Blocks) ; Lets = [L | Ls], L = e_let(Vars, LetExpr), ( if Vars = [Var], member(Var, CGInfo ^ cgi_var_one_use), no_bang_marker = code_info_bang_marker(LetExpr ^ e_info), not expr_has_branch(LetExpr) then % We can skip generation of this variable and generate it % directly when it is needed. vl_set_var_expr(Var, LetExpr, LocnMap, NextLocnMap), gen_lets(CGInfo, Ls, InExpr, Depth, NextLocnMap, Continuation, Instrs, !Blocks) else % Generate the instructions for the "In" part (the continuation % of the "Let" part). % Update the LocnMap for the "In" part of the expression. This % records the stack slot that we expect to find each variable. Varmap = CGInfo ^ cgi_varmap, vl_put_vars(Vars, Depth, Varmap, CommentBinds, LocnMap, InLocnMap), % Run the "In" expression. LetArity = code_info_arity_det(LetExpr ^ e_info), InDepth = Depth + LetArity ^ a_num, gen_lets(CGInfo, Ls, InExpr, InDepth, InLocnMap, Continuation, InInstrs, !Blocks), InContinuation = cont_comment( format("In at depth %d", [i(InDepth)]), cont_instrs(InDepth, CommentBinds ++ InInstrs)), % Generate the instructions for the "let" part, using the "in" % part as the continuation. gen_instrs(CGInfo, LetExpr, Depth, LocnMap, InContinuation, Instrs0, !Blocks), Instrs = cons(pzio_comment(format("Let at depth %d", [i(Depth)])), Instrs0) ) ). %-----------------------------------------------------------------------% :- pred gen_match(code_gen_info::in, var::in, list(expr_case)::in, int::in, val_locn_map::in, continuation::in, cord(pz_instr_obj)::out, pz_blocks::in, pz_blocks::out) is det. gen_match(CGInfo, Var, Cases, Depth, LocnMap, Continuation, Instrs, !Blocks) :- % We can assume that the cases are exhaustive, there's no need to % generate match-all code. A transformation on the core % representation will ensure this. % First, generate the bodies of each case. continuation_make_block(Continuation, BranchContinuation, !Blocks), list.foldl3(gen_case(CGInfo, Depth+1, LocnMap, BranchContinuation, VarType), Cases, 1, _, map.init, CaseInstrMap, !Blocks), % Determine the type of switch requred. These are: % Casecading. % Switch on primary tag (plus value or secondary tag) % % Later there may be more eg: to support efficient string matching. Or % add computed gotos. % % Nested matches, or multiple patterns per case will need to be added % later, what we do WRT switch type will need to be reconsidered. % lookup(CGInfo ^ cgi_type_map, Var, VarType), SwitchType = var_type_switch_type(CGInfo, VarType), % Generate the switch, using the bodies generated above. BeginComment = pzio_comment(format("Switch at depth %d", [i(Depth)])), GetVarInstrs = gen_var_access(CGInfo, LocnMap, Var, Depth), ( SwitchType = enum, TestsInstrs = gen_test_and_jump_enum(CGInfo, CaseInstrMap, VarType, Depth, Cases, 1) ; SwitchType = tags(_TypeId, TagInfo), gen_test_and_jump_tags(CGInfo, CaseInstrMap, VarType, TagInfo, Cases, TestsInstrs, !Blocks) ), Instrs = cord.singleton(BeginComment) ++ GetVarInstrs ++ TestsInstrs. :- type switch_type ---> enum ; tags(type_id, map(ptag, type_ptag_info)). :- func var_type_switch_type(code_gen_info, type_) = switch_type. var_type_switch_type(_, builtin_type(Builtin)) = SwitchType :- ( Builtin = int, % This is really stupid, but it'll do for now. SwitchType = enum ; ( Builtin = string ; Builtin = codepoint ), my_exception.sorry($file, $pred, "Cannot switch on strings/codepoints") ; Builtin = string_pos, unexpected($file, $pred, "Cannot switch on string_pos") ). var_type_switch_type(_, type_variable(_)) = unexpected($file, $pred, "Switch types must be concrete"). var_type_switch_type(_, func_type(_, _, _, _)) = unexpected($file, $pred, "Cannot switch on functions"). var_type_switch_type(CGInfo, type_ref(TypeId, _)) = SwitchType :- map.lookup(CGInfo ^ cgi_type_tags, TypeId, TagInfo), ( TagInfo = tti_untagged, SwitchType = enum ; TagInfo = tti_tagged(PTagInfos), SwitchType = tags(TypeId, PTagInfos) ; TagInfo = tti_abstract, unexpected($file, $pred, "Can't switch on abstract type") ). % The body of each case is placed in a new block. % % + If the pattern matches then we jump to that block, that block itself % will execute the expression then execute the continuation. % + Otherwise fall-through and try the next case. % % No indexing, jump tables or other optimisations are % implemented. % :- pred gen_case(code_gen_info::in, int::in, val_locn_map::in, continuation::in, type_::in, expr_case::in, int::in, int::out, map(int, pzb_id)::in, map(int, pzb_id)::out, pz_blocks::in, pz_blocks::out) is det. gen_case(CGInfo, !.Depth, LocnMap0, Continue, VarType, e_case(Pattern, Expr), !CaseNum, !InstrMap, !Blocks) :- alloc_block(BlockNum, !Blocks), det_insert(!.CaseNum, BlockNum, !InstrMap), !:CaseNum = !.CaseNum + 1, DepthCommentBeforeDecon = depth_comment_instr(!.Depth), % At the start of the new block we place code that will provide any % variables bound by the matching pattern. gen_deconstruction(CGInfo, Pattern, VarType, LocnMap0, LocnMap, !Depth, InstrsDecon), % Generate the body of the new block. gen_instrs(CGInfo, Expr, !.Depth, LocnMap, Continue, InstrsBranchBody, !Blocks), InstrsBranch = singleton(DepthCommentBeforeDecon) ++ InstrsDecon ++ InstrsBranchBody, create_block(BlockNum, InstrsBranch, !Blocks). :- func gen_test_and_jump_enum(code_gen_info, map(int, pzb_id), type_, int, list(expr_case), int) = cord(pz_instr_obj). gen_test_and_jump_enum(_, _, _, _, [], _) = cord.init. gen_test_and_jump_enum(CGInfo, BlockMap, Type, Depth, [Case | Cases], CaseNum) = InstrsCase ++ InstrsCases :- e_case(Pattern, _) = Case, lookup(BlockMap, CaseNum, BlockNum), InstrsCase = gen_case_match_enum(CGInfo, Pattern, Type, BlockNum, Depth), InstrsCases = gen_test_and_jump_enum(CGInfo, BlockMap, Type, Depth, Cases, CaseNum + 1). % The variable that we're switching on is on the top of the stack, and % we can use it directly. But we need to put it back when we're done. % :- func gen_case_match_enum(code_gen_info, expr_pattern, type_, pzb_id, int) = cord(pz_instr_obj). gen_case_match_enum(_, p_num(Num), _, BlockNum, Depth) = cord.from_list([ pzio_comment(format("Case for %d", [i(Num)])), % Save the switched-on value for the next case. pzio_instr(pzi_pick(1)), % Compare Num with TOS and jump if equal. % TODO: need to actually check the type and use the correct % immediate, this works for now because all numbers are 'fast'. pzio_instr(pzi_load_immediate(pzw_fast, im_i32(det_from_int(Num)))), pzio_instr(pzi_eq(pzw_fast)), depth_comment_instr(Depth + 1), pzio_instr(pzi_cjmp(BlockNum, pzw_fast))]). gen_case_match_enum(_, p_variable(_), _, BlockNum, Depth) = cord.from_list([ pzio_comment("Case match all and bind variable"), depth_comment_instr(Depth), pzio_instr(pzi_jmp(BlockNum))]). gen_case_match_enum(_, p_wildcard, _, BlockNum, Depth) = cord.from_list([ pzio_comment("Case match wildcard"), depth_comment_instr(Depth), pzio_instr(pzi_jmp(BlockNum))]). gen_case_match_enum(CGInfo, p_ctor(CtorIds, _), VarType, BlockNum, Depth) = SetupInstrs ++ MatchInstrs ++ JmpInstrs :- CtorId = one_item_in_set(CtorIds), SetupInstrs = from_list([ pzio_comment("Case match deconstruction"), depth_comment_instr(Depth), % Save the switched-on value for the next case. pzio_instr(pzi_pick(1))]), ( VarType = type_ref(TypeId, _), MatchInstrs = gen_match_ctor(CGInfo, TypeId, VarType, CtorId) ; ( VarType = builtin_type(_) ; VarType = type_variable(_) ; VarType = func_type(_, _, _, _) ), unexpected($file, $pred, "Deconstructions must be on user types") ), JmpInstrs = from_list([ depth_comment_instr(Depth + 1), pzio_instr(pzi_cjmp(BlockNum, pzw_fast))]). :- pred gen_test_and_jump_tags(code_gen_info::in, map(int, pzb_id)::in, type_::in, map(ptag, type_ptag_info)::in, list(expr_case)::in, cord(pz_instr_obj)::out, pz_blocks::in, pz_blocks::out) is det. gen_test_and_jump_tags(CGInfo, BlockMap, Type, PTagInfos, Cases, Instrs, !Blocks) :- % Get the ptag onto the TOS. BreakTagId = CGInfo ^ cgi_builtin_ids ^ pbi_break_tag, GetPtagInstrs = cord.from_list([ pzio_comment("Break the tag, leaving the ptag on the TOS"), pzio_instr(pzi_pick(1)), pzio_instr(pzi_call(pzc_import(BreakTagId)))]), % For every primary tag, test it, and jump to the case it maps to, % if there is none, jump to the default cease. foldl2(gen_test_and_jump_ptag(CGInfo, BlockMap, Cases, Type), PTagInfos, GetPtagInstrs, Instrs, !Blocks). :- pred gen_test_and_jump_ptag(code_gen_info::in, map(int, pzb_id)::in, list(expr_case)::in, type_::in, ptag::in, type_ptag_info::in, cord(pz_instr_obj)::in, cord(pz_instr_obj)::out, pz_blocks::in, pz_blocks::out) is det. gen_test_and_jump_ptag(CGInfo, BlockMap, Cases, Type, PTag, PTagInfo, !Instrs, !Blocks) :- Width = type_to_pz_width(Type), require(unify(Width, pzw_ptr), "Expected pointer width"), alloc_block(Next, !Blocks), Instrs = from_list([ pzio_instr(pzi_pick(1)), pzio_instr(pzi_load_immediate(pzw_ptr, im_u32(cast_from_int(to_int(PTag))))), pzio_instr(pzi_eq(pzw_ptr)), pzio_instr(pzi_cjmp(Next, pzw_fast)) ]), ( PTagInfo = tpti_constant(EnumMap), UnshiftValueId = CGInfo ^ cgi_builtin_ids ^ pbi_unshift_value, GetFieldInstrs = from_list([ pzio_comment("Drop the primary tag,"), pzio_instr(pzi_drop), pzio_comment("Unshift the tagged value."), pzio_instr(pzi_call(pzc_import(UnshiftValueId)))]), map_foldl(gen_test_and_jump_ptag_const(BlockMap, Cases), to_assoc_list(EnumMap), NextInstrsList, !Blocks), NextInstrs = GetFieldInstrs ++ cord_list_to_cord(NextInstrsList), create_block(Next, NextInstrs, !Blocks) ; PTagInfo = tpti_pointer(CtorId), % Drop the the saved copy of the tag and value off the stack. % Depending on the code we jump to there we may need to recreate the % value. We could optimise this _a lot_ better. DropInstrs = from_list([ pzio_comment("Drop the tag and value then jump"), pzio_instr(pzi_drop), pzio_instr(pzi_drop), pzio_instr(pzi_jmp(Dest))]), create_block(Next, DropInstrs, !Blocks), find_matching_case(Cases, 1, CtorId, _MatchParams, _Expr, CaseNum), lookup(BlockMap, CaseNum, Dest) ; PTagInfo = tpti_pointer_stag(STagMap), STagStruct = CGInfo ^ cgi_builtin_ids ^ pbi_stag_struct, GetStagInstrs = from_list([ pzio_comment("Drop the primary tag"), pzio_instr(pzi_drop), pzio_comment("The pointer is on TOS, get the stag from it"), pzio_instr(pzi_load(STagStruct, field_num(1), pzw_fast)), pzio_instr(pzi_drop) ]), map_foldl(gen_test_and_jump_ptag_stag(BlockMap, Cases), to_assoc_list(STagMap), SwitchStagInstrs, !Blocks), NextInstrs = GetStagInstrs ++ cord_list_to_cord(SwitchStagInstrs), create_block(Next, NextInstrs, !Blocks) ), !:Instrs = !.Instrs ++ Instrs. :- pred gen_test_and_jump_ptag_const(map(int, pzb_id)::in, list(expr_case)::in, pair(word_bits, ctor_id)::in, cord(pz_instr_obj)::out, pz_blocks::in, pz_blocks::out) is det. gen_test_and_jump_ptag_const(BlockMap, Cases, ConstVal - CtorId, Instrs, !Blocks) :- alloc_block(Drop, !Blocks), Instrs = from_list([ pzio_instr(pzi_pick(1)), pzio_instr(pzi_load_immediate(pzw_ptr, im_u32(ConstVal))), pzio_instr(pzi_eq(pzw_ptr)), pzio_instr(pzi_cjmp(Drop, pzw_fast)) ]), find_matching_case(Cases, 1, CtorId, _MatchParams, _Expr, CaseNum), lookup(BlockMap, CaseNum, Dest), DropInstrs = from_list([ pzio_comment("Drop the secondary tag then jump"), pzio_instr(pzi_drop), pzio_instr(pzi_jmp(Dest))]), create_block(Drop, DropInstrs, !Blocks). :- pred gen_test_and_jump_ptag_stag(map(int, pzb_id)::in, list(expr_case)::in, pair(stag, ctor_id)::in, cord(pz_instr_obj)::out, pz_blocks::in, pz_blocks::out) is det. gen_test_and_jump_ptag_stag(BlockMap, Cases, STag - CtorId, Instrs, !Blocks) :- alloc_block(Drop, !Blocks), Instrs = from_list([ pzio_instr(pzi_pick(1)), pzio_instr(pzi_load_immediate(pzw_fast, im_u32(STag))), pzio_instr(pzi_eq(pzw_fast)), pzio_instr(pzi_cjmp(Drop, pzw_fast)) ]), find_matching_case(Cases, 1, CtorId, _MatchParams, _Expr, CaseNum), lookup(BlockMap, CaseNum, Dest), DropInstrs = from_list([ pzio_comment("Drop the value then jump"), pzio_instr(pzi_drop), pzio_instr(pzi_jmp(Dest))]), create_block(Drop, DropInstrs, !Blocks). :- pred find_matching_case(list(expr_case)::in, int::in, ctor_id::in, list(var)::out, expr::out, int::out) is det. find_matching_case([], _, _, _, _, _) :- unexpected($file, $pred, "Case not found"). find_matching_case([Case | Cases], ThisCaseNum, CtorId, Vars, Expr, CaseNum) :- Case = e_case(Pattern, Expr0), ( Pattern = p_num(_), unexpected($file, $pred, "Type error: A number can't match a constructor") ; Pattern = p_variable(_), my_exception.sorry($file, $pred, "How to set vars"), Vars = [], Expr = Expr0, CaseNum = ThisCaseNum ; Pattern = p_wildcard, Vars = [], Expr = Expr0, CaseNum = ThisCaseNum ; Pattern = p_ctor(ThisCtorIds, ThisVars), ThisCtorId = one_item_in_set(ThisCtorIds), ( if CtorId = ThisCtorId then Vars = ThisVars, Expr = Expr0, CaseNum = ThisCaseNum else find_matching_case(Cases, ThisCaseNum + 1, CtorId, Vars, Expr, CaseNum) ) ). % Generate code that attempts to match a data constructor. It has the % stack usage (ptr - w) the input is a copy of the value to switch on, % the output is a boolean suitable for "cjmp". % % TODO: This could be made a call to a pz procedure. Making it a call % (outline) matches the pz style, letting the interpreter do the % inlining. It may also make separate compilation simpler. % :- func gen_match_ctor(code_gen_info, type_id, type_, ctor_id) = cord(pz_instr_obj). gen_match_ctor(CGInfo, TypeId, Type, CtorId) = Instrs :- map.lookup(CGInfo ^ cgi_type_ctor_tags, {TypeId, CtorId}, CtorData), TagInfo = CtorData ^ cd_tag_info, Width = type_to_pz_width(Type), ( TagInfo = ti_constant(PTag, WordBits), require(unify(Width, pzw_ptr), "Width must be pointer for constant"), ShiftMakeTagId = CGInfo ^ cgi_builtin_ids ^ pbi_shift_make_tag, Instrs = from_list([ % Compare tagged value with TOS and jump if equal. pzio_instr(pzi_load_immediate(pzw_ptr, im_u32(WordBits))), pzio_instr(pzi_load_immediate(pzw_ptr, im_u32(cast_from_int(to_int(PTag))))), pzio_instr(pzi_call(pzc_import(ShiftMakeTagId))), pzio_instr(pzi_eq(pzw_ptr))]) ; TagInfo = ti_constant_notag(Word), Instrs = from_list([ % Compare constant value with TOS and jump if equal. pzio_instr(pzi_load_immediate(Width, im_u32(Word))), pzio_instr(pzi_eq(Width))]) ; TagInfo = ti_tagged_pointer(PTag, _, MaybeSTag), require(unify(Width, pzw_ptr), "Width must be pointer for tagged pointer"), % TODO: This is currently unused. ( MaybeSTag = no, BreakTagId = CGInfo ^ cgi_builtin_ids ^ pbi_break_tag, % TODO rather than dropping the pointer we should save it and use it % for deconstruction later. Instrs = from_list([ pzio_instr(pzi_call(pzc_import(BreakTagId))), pzio_instr(pzi_roll(2)), pzio_instr(pzi_drop), pzio_instr(pzi_load_immediate(pzw_ptr, im_u32(cast_from_int(to_int(PTag))))), pzio_instr(pzi_eq(pzw_ptr))]) ; MaybeSTag = yes(_), my_exception.sorry($file, $pred, "Secondary tags") ) ). :- pred gen_deconstruction(code_gen_info::in, expr_pattern::in, type_::in, val_locn_map::in, val_locn_map::out, int::in, int::out, cord(pz_instr_obj)::out) is det. gen_deconstruction(_, p_num(_), _, !LocnMap, !Depth, Instrs) :- % Drop the switched on variable when entering the branch. Instrs = singleton(pzio_instr(pzi_drop)), !:Depth = !.Depth - 1. gen_deconstruction(_, p_wildcard, _, !LocnMap, !Depth, Instrs) :- % Drop the switched on variable when entering the branch. Instrs = singleton(pzio_instr(pzi_drop)), !:Depth = !.Depth - 1. gen_deconstruction(CGInfo, p_variable(Var), _, !LocnMap, !Depth, Instrs) :- Varmap = CGInfo ^ cgi_varmap, % Leave the value on the stack and update the bind map so that the % expression can find it. % NOTE: This call expects the depth where the variable begins. vl_put_vars([Var], !.Depth - 1, Varmap, Instrs, !LocnMap). gen_deconstruction(CGInfo, p_ctor(CtorIds, Args), VarType, !LocnMap, !Depth, Instrs) :- ( VarType = type_ref(TypeId, _), CtorId = one_item_in_set(CtorIds), map.lookup(CGInfo ^ cgi_type_ctor_tags, {TypeId, CtorId}, CtorData), TagInfo = CtorData ^ cd_tag_info, ( ( TagInfo = ti_constant(_, _) ; TagInfo = ti_constant_notag(_) ), % Discard the value, it doesn't bind any variables. Instrs = singleton(pzio_instr(pzi_drop)), !:Depth = !.Depth - 1 ; TagInfo = ti_tagged_pointer(_, StructId, MaybeSTag), ( MaybeSTag = no, FirstField = field_num(1) ; MaybeSTag = yes(_), FirstField = field_num(2) ), % Untag the pointer, TODO: skip this if it's known that the tag % is zero. BreakTag = CGInfo ^ cgi_builtin_ids ^ pbi_break_tag, InstrsUntag = cord.from_list([ pzio_comment("Untag pointer and deconstruct"), pzio_instr(pzi_call(pzc_import(BreakTag))), pzio_instr(pzi_drop)]), % TODO: Optimisation, only read the variables that are used in % the body. Further optimisation could leave some on the heap, % avoiding stack usage. core_get_constructor_det(CGInfo ^ cgi_core, CtorId, Ctor), Varmap = CGInfo ^ cgi_varmap, gen_decon_fields(Varmap, StructId, Args, Ctor ^ c_fields, FirstField, InstrsDeconstruct, !LocnMap, !Depth), InstrDrop = pzio_instr(pzi_drop), Instrs = InstrsUntag ++ InstrsDeconstruct ++ singleton(InstrDrop), !:Depth = !.Depth - 1 ) ; ( VarType = builtin_type(_) ; VarType = type_variable(_) ; VarType = func_type(_, _, _, _) ), unexpected($file, $pred, "Deconstructions must be on user types") ). :- pred gen_decon_fields(varmap::in, pzs_id::in, list(var)::in, list(type_field)::in, field_num::in, cord(pz_instr_obj)::out, val_locn_map::in, val_locn_map::out, int::in, int::out) is det. gen_decon_fields(_, _, [], [], _, init, !LocnMap, !Depth). gen_decon_fields(_, _, [], [_ | _], _, _, !LocnMap, !Depth) :- unexpected($file, $pred, "Mismatched arg/field lists"). gen_decon_fields(_, _, [_ | _], [], _, _, !LocnMap, !Depth) :- unexpected($file, $pred, "Mismatched arg/field lists"). gen_decon_fields(Varmap, StructId, [Arg | Args], [Field | Fields], FieldNo, InstrsField ++ InstrsFields, !LocnMap, !Depth) :- gen_decon_field(Varmap, StructId, Arg, Field, FieldNo, InstrsField, !LocnMap, !Depth), gen_decon_fields(Varmap, StructId, Args, Fields, field_num_next(FieldNo), InstrsFields, !LocnMap, !Depth). :- pred gen_decon_field(varmap::in, pzs_id::in, var::in, type_field::in, field_num::in, cord(pz_instr_obj)::out, val_locn_map::in, val_locn_map::out, int::in, int::out) is det. gen_decon_field(Varmap, StructId, Var, _Field, FieldNo, Instrs, !LocnMap, !Depth) :- Instrs = cord.from_list([ pzio_comment(format("reading field %d", [i(FieldNo ^ field_num_int)])), pzio_instr(pzi_load(StructId, FieldNo, pzw_ptr)), pzio_comment(format("%s is at depth %d", [s(get_var_name(Varmap, Var)), i(!.Depth)])) ]), % Update the LocnMap vl_put_var(Var, !.Depth, !LocnMap), % Load is (ptr - * ptr) so we increment the depth here. !:Depth = !.Depth + 1. %-----------------------------------------------------------------------% :- func gen_construction(code_gen_info, type_, ctor_id) = cord(pz_instr_obj). gen_construction(CGInfo, Type, CtorId) = Instrs :- ( Type = builtin_type(_), unexpected($file, $pred, "No builtin types are constructed with e_construction") ; Type = type_variable(_), unexpected($file, $pred, "Polymorphic values are never constructed") ; Type = type_ref(TypeId, _), map.lookup(CGInfo ^ cgi_type_ctor_tags, {TypeId, CtorId}, CtorData), CtorProc = CtorData ^ cd_construct_proc, Instrs = from_list([ pzio_comment("Call constructor"), pzio_instr(pzi_call(pzc_proc_opt(CtorProc)))]) ; Type = func_type(_, _, _, _), my_exception.sorry($file, $pred, "Function type") ). %-----------------------------------------------------------------------% :- pred gen_closure(code_gen_info::in, func_id::in, list(var)::in, int::in, val_locn_map::in, cord(pz_instr_obj)::out) is det. gen_closure(CGInfo, FuncId, Captured, !.Depth, LocnMap, Instrs) :- StructId = vl_lookup_closure(LocnMap, FuncId), AllocEnvInstrs = from_list([ pzio_comment("Constructing closure"), pzio_instr(pzi_alloc(StructId)) ]), !:Depth = !.Depth + 1, ModEnvLocn = vl_lookup_mod_env(LocnMap), SetModuleEnvFieldInstrs = gen_val_locn_access(CGInfo, !.Depth, LocnMap, ModEnvLocn) ++ from_list([pzio_instr(pzi_swap), pzio_instr(pzi_store(StructId, field_num_first, pzw_ptr))]), map_foldl( (pred(V::in, Is::out, FldN::in, field_num_next(FldN)::out) is det :- map.lookup(CGInfo ^ cgi_type_map, V, Type), Width = type_to_pz_width(Type), Is = gen_var_access(CGInfo, LocnMap, V, !.Depth) ++ from_list([ pzio_instr(pzi_swap), pzio_instr(pzi_store(StructId, FldN, Width)) ]) ), Captured, SetFieldsInstrs0, field_num_next(field_num_first), _), SetFieldsInstrs = cord_list_to_cord(SetFieldsInstrs0), ProcId = vl_lookup_proc_id(LocnMap, FuncId), MakeClosureInstrs = singleton(pzio_instr(pzi_make_closure(ProcId))), Instrs = AllocEnvInstrs ++ SetModuleEnvFieldInstrs ++ SetFieldsInstrs ++ MakeClosureInstrs. %-----------------------------------------------------------------------% :- type continuation ---> cont_return ; cont_jump(cj_depth :: int, cj_block :: pzb_id) ; cont_instrs(int, cord(pz_instr_obj)) ; cont_comment(string, continuation) ; cont_none(int). % gen_continuation(Continuation, Depth, NumItems, Why) = ContInstrs % % Generate the code for the continuation. The continuation may need to % adjust the stack which is currently Depth + NumItems. NumItems is the % number of items that the continuation will want to process. Why is a % label to help debug code generation, it shows why we're making this % continuation (ie the caller). % % TODO: Why doesn't the continuation itself know about NumItems? % :- func gen_continuation(continuation, int, int, string) = cord(pz_instr_obj). gen_continuation(Cont, Depth, Items, Why) = cons(pzio_comment(format( "Continuation at depth %d with %d items from %s", [i(Depth), i(Items), s(Why)])), gen_continuation_2(Cont, Depth, Items)). :- func gen_continuation_2(continuation, int, int) = cord(pz_instr_obj). gen_continuation_2(cont_return, Depth, Items) = snoc(fixup_stack(Depth, Items), pzio_instr(pzi_ret)). gen_continuation_2(cont_jump(WantDepth, Block), CurDepth, Items) = snoc(FixupStack, pzio_instr(pzi_jmp(Block))) :- % Fixup the stack to put it at Depth plus Items. % Wanted depth includes the items on the stack, so we add them here. BottomItems = CurDepth + Items - WantDepth, FixupStack = fixup_stack(BottomItems, Items). gen_continuation_2(cont_instrs(WantDepth, Instrs), CurDepth, Items) = FixupStack ++ CommentInstrs ++ Instrs :- % Fixup the stack to put it at Depth plus Items. % Wanted depth includes the items on the stack, so we add them here. BottomItems = CurDepth + Items - WantDepth, FixupStack = fixup_stack(BottomItems, Items), CommentInstrs = singleton(pzio_comment( format("Continuation depth is %d", [i(WantDepth)]))). gen_continuation_2(cont_comment(Comment, Continuation), CurDepth, Items) = cons(pzio_comment(Comment), gen_continuation_2(Continuation, CurDepth, Items)). gen_continuation_2(cont_none(WantDepth), CurDepth, Items) = singleton(pzio_comment("No continuation")) ++ fixup_stack(CurDepth - WantDepth, Items). :- pred continuation_make_block(continuation::in, continuation::out, pz_blocks::in, pz_blocks::out) is det. continuation_make_block(cont_return, cont_return, !Blocks). continuation_make_block(cont_jump(Depth, Block), cont_jump(Depth, Block), !Blocks). continuation_make_block(cont_instrs(Depth, Instrs), cont_jump(Depth, BlockId), !Blocks) :- alloc_block(BlockId, !Blocks), create_block(BlockId, Instrs, !Blocks). continuation_make_block(cont_comment(Comment, Cont0), cont_comment(Comment, Cont), !Blocks) :- continuation_make_block(Cont0, Cont, !Blocks). continuation_make_block(cont_none(Depth), cont_none(Depth), !Blocks). %-----------------------------------------------------------------------% :- func depth_comment_instr(int) = pz_instr_obj. depth_comment_instr(Depth) = pzio_comment(format("Depth: %d", [i(Depth)])). :- func gen_var_access(code_gen_info, val_locn_map, var, int) = cord(pz_instr_obj). gen_var_access(CGInfo, LocnMap, Var, Depth) = Instrs :- VarName = get_var_name(CGInfo ^ cgi_varmap, Var), CommentInstr = pzio_comment(format("get var %s", [s(VarName)])), ( if vl_search_var(LocnMap, Var, VarLocn) then Instrs = singleton(CommentInstr) ++ gen_val_locn_access(CGInfo, Depth, LocnMap, VarLocn) else core_get_function_det(CGInfo ^ cgi_core, CGInfo ^ cgi_this_func, Func), FuncName = func_get_name(Func), unexpected($file, $pred, format("The code generator could not find the location of " ++ "a variable '%s' when compiling '%s'. " ++ "This is most-likely a bug in an earlier pass", [s(VarName), s(q_name_to_string(FuncName))])) ). :- pred gen_instrs_args(code_gen_info::in, val_locn_map::in, list(var)::in, cord(pz_instr_obj)::out, int::in, int::out) is det. gen_instrs_args(CGInfo, LocnMap, Args, InstrsArgs, !Depth) :- map_foldl((pred(V::in, I::out, D0::in, D::out) is det :- I = gen_var_access(CGInfo, LocnMap, V, D0), D = D0 + 1 ), Args, InstrsArgs0, !Depth), InstrsArgs = cord_list_to_cord(InstrsArgs0). %-----------------------------------------------------------------------% :- func gen_val_locn_access(code_gen_info, int, val_locn_map, val_locn) = cord(pz_instr_obj). gen_val_locn_access(CGInfo, Depth, _, vl_stack(VarDepth, Next)) = Instrs ++ gen_val_locn_access_next(CGInfo, Next) :- RelDepth = Depth - VarDepth + 1, Instrs = from_list([ pzio_comment("value is on the stack"), pzio_instr(pzi_pick(RelDepth))]). gen_val_locn_access(CGInfo, _, _, vl_env(Next)) = from_list([ pzio_comment("value is available from the environment"), pzio_instr(pzi_get_env)]) ++ gen_val_locn_access_next(CGInfo, Next). gen_val_locn_access(CGInfo, Depth, LocnMap, vl_compute(Expr)) = Instrs :- % + Don't generate blocks (test that Expr has no case) % + Don't require continuation. gen_instrs(CGInfo, Expr, Depth, LocnMap, cont_none(Depth), Instrs, pz_blocks(0u32, map.init), pz_blocks(LastBlockNo, _)), ( if LastBlockNo \= 0u32 then unexpected($file, $pred, "Cannot create blocks here") else true ). :- func gen_val_locn_access_next(code_gen_info, val_locn_next) = cord(pz_instr_obj). gen_val_locn_access_next(_, vln_done) = init. gen_val_locn_access_next(CGInfo, vln_struct(StructId, Field, Width, Next)) = Instrs ++ gen_val_locn_access_next(CGInfo, Next) :- StructName = lookup(CGInfo ^ cgi_struct_names, StructId), Instrs = from_list([ pzio_comment(format("Lookup in %s", [s(StructName)])), pzio_instr(pzi_load(StructId, Field, Width)), pzio_instr(pzi_drop)]). %-----------------------------------------------------------------------% :- type pz_blocks ---> pz_blocks( pzb_next_block :: pzb_id, pzb_blocks :: map(pzb_id, pz_block) ). :- pred alloc_block(pzb_id::out, pz_blocks::in, pz_blocks::out) is det. alloc_block(BlockId, !Blocks) :- BlockId = !.Blocks ^ pzb_next_block, !Blocks ^ pzb_next_block := BlockId + 1u32. :- pred create_block(pzb_id::in, cord(pz_instr_obj)::in, pz_blocks::in, pz_blocks::out) is det. create_block(BlockId, Instrs, !Blocks) :- Block = pz_block(cord.list(Instrs)), BlockMap0 = !.Blocks ^ pzb_blocks, det_insert(BlockId, Block, BlockMap0, BlockMap), !Blocks ^ pzb_blocks := BlockMap. %-----------------------------------------------------------------------% :- pred initial_bind_map(list(var)::in, int::in, varmap::in, cord(pz_instr_obj)::out, val_locn_map::in, val_locn_map::out) is det. initial_bind_map(Vars, Depth, Varmap, Comments, !Map) :- vl_put_vars(Vars, Depth, Varmap, Comments, !Map). %-----------------------------------------------------------------------% % This algorithm walks the expression tree. % % When it encouters the introduction of a new variable via a let % expression (but not pattern matches) and the expression does not use % or observe a resource, it ads it to the !ZeroUses set. % % When it sees the use of a it: % + If the variable is in !SeenZero it moves it to !SeenOne. % + IF the variable is in !SeenOne it removes it. % % When it terminates the bindings in !SeenZero can be optimised away % completely, and those in !SeenOne can be moved into their only use % site. % :- pred find_oneuse_vars(expr::in, set(var)::in, set(var)::out, set(var)::in, set(var)::out) is det. find_oneuse_vars(expr(Type, _), !ZeroUses, !OneUse) :- ( Type = e_tuple(Exprs), foldl2(find_oneuse_vars, Exprs, !ZeroUses, !OneUse) ; Type = e_lets(Lets, Expr), foldl2(find_oneuse_vars_let, Lets, !ZeroUses, !OneUse), find_oneuse_vars(Expr, !ZeroUses, !OneUse) ; Type = e_call(Callee, Args, _), ( Callee = c_plain(_) ; Callee = c_ho(Var), find_oneuse_vars_var(Var, !ZeroUses, !OneUse) ), foldl2(find_oneuse_vars_var, Args, !ZeroUses, !OneUse) ; Type = e_var(Var), find_oneuse_vars_var(Var, !ZeroUses, !OneUse) ; Type = e_constant(_) ; Type = e_construction(_, Args), foldl2(find_oneuse_vars_var, Args, !ZeroUses, !OneUse) ; Type = e_closure(_, Args), foldl2(find_oneuse_vars_var, Args, !ZeroUses, !OneUse) ; Type = e_match(Var, Cases), find_oneuse_vars_var(Var, !ZeroUses, !OneUse), foldl2(find_oneuse_vars_case, Cases, !ZeroUses, !OneUse) ). :- pred find_oneuse_vars_let(expr_let::in, set(var)::in, set(var)::out, set(var)::in, set(var)::out) is det. find_oneuse_vars_let(e_let(Vars, Expr), !ZeroUses, !OneUse) :- find_oneuse_vars(Expr, !ZeroUses, !OneUse), union(list_to_set(Vars), !ZeroUses). :- pred find_oneuse_vars_case(expr_case::in, set(var)::in, set(var)::out, set(var)::in, set(var)::out) is det. find_oneuse_vars_case(e_case(Pat, Expr), !ZeroUses, !OneUse) :- ( Pat = p_num(_) ; Pat = p_variable(Var), insert(Var, !ZeroUses) ; Pat = p_wildcard ; Pat = p_ctor(_, Vars), union(list_to_set(Vars), !ZeroUses) ), find_oneuse_vars(Expr, !ZeroUses, !OneUse). :- pred find_oneuse_vars_var(var::in, set(var)::in, set(var)::out, set(var)::in, set(var)::out) is det. find_oneuse_vars_var(Var, !ZeroUse, !OneUse) :- ( if remove(Var, !OneUse) then true else if remove(Var, !ZeroUse) then insert(Var, !OneUse) else true ). %-----------------------------------------------------------------------% %-----------------------------------------------------------------------% ================================================ FILE: src/core_to_pz.data.m ================================================ %-----------------------------------------------------------------------% % vim: ts=4 sw=4 et %-----------------------------------------------------------------------% :- module core_to_pz.data. % % Copyright (C) Plasma Team % Distributed under the terms of the MIT License see ../LICENSE.code % % Plasma core to pz conversion - data layout decisions % %-----------------------------------------------------------------------% :- interface. :- import_module maybe. :- import_module string. :- import_module builtins. :- import_module common_types. :- import_module core. :- import_module core_to_pz.closure. :- import_module core_to_pz.locn. :- import_module pz. %-----------------------------------------------------------------------% :- type const_data ---> cd_string(string). :- pred gen_const_data(core::in, val_locn_map_static::in, val_locn_map_static::out, closure_builder::in, closure_builder::out, map(string, pzd_id)::in, map(string, pzd_id)::out, pz::in, pz::out) is det. %-----------------------------------------------------------------------% :- type constructor_data_map == map({type_id, ctor_id}, constructor_data). % How to represent this constructor in memory. % :- type constructor_data ---> constructor_data( cd_tag_info :: ctor_tag_info, cd_construct_proc :: pzp_id ). :- type ctor_tag_info ---> ti_constant( tic_ptag :: ptag, tic_word_bits :: word_bits ) ; ti_constant_notag( ticnw_bits :: word_bits ) ; ti_tagged_pointer( titp_ptag :: ptag, titp_struct :: pzs_id, titp_maybe_stag :: maybe(stag) ). :- type ptag == uint8. :- type stag == uint32. :- type word_bits == uint32. :- type type_tag_map == map(type_id, type_tag_info). :- type type_tag_info % Pure enums are untagged. ---> tti_untagged ; tti_tagged( map(ptag, type_ptag_info) ) ; tti_abstract. :- type type_ptag_info ---> tpti_constant(map(word_bits, ctor_id)) ; tpti_pointer(ctor_id) ; tpti_pointer_stag(map(stag, ctor_id)). :- pred gen_constructor_data(core::in, pz_builtin_ids::in, type_tag_map::out, constructor_data_map::out, pz::in, pz::out) is det. :- func data_rep_pretty({core, type_tag_map, constructor_data_map}) = cord(string). %-----------------------------------------------------------------------% :- func num_ptag_bits = int. :- func type_to_pz_width(type_) = pz_width. :- func bool_width = pz_width. %-----------------------------------------------------------------------% %-----------------------------------------------------------------------% :- implementation. :- import_module assoc_list. :- import_module char. :- import_module cord. :- import_module int. :- import_module uint32. :- import_module uint8. :- import_module context. :- import_module core.code. %-----------------------------------------------------------------------% gen_const_data(Core, !LocnMap, !ModuleClo, !FilenameDataMap, !PZ) :- foldl4(gen_const_data_func, core_all_functions(Core), !LocnMap, !ModuleClo, !FilenameDataMap, !PZ). :- pred gen_const_data_func(pair(func_id, function)::in, val_locn_map_static::in, val_locn_map_static::out, closure_builder::in, closure_builder::out, map(string, pzd_id)::in, map(string, pzd_id)::out, pz::in, pz::out) is det. gen_const_data_func(_ - Func, !LocnMap, !ModuleClo, !FilenameDataMap, !PZ) :- Filename = func_get_context(Func) ^ c_file, ( if not search(!.FilenameDataMap, Filename, _) then pz_new_data_id(FilenameDataId, !PZ), pz_add_data(FilenameDataId, pz_encode_string(Filename), !PZ), det_insert(Filename, FilenameDataId, !FilenameDataMap) else true ), ( if func_get_body(Func, _, _, _, Expr) then gen_const_data_expr(Expr, !LocnMap, !ModuleClo, !PZ) else true ). :- pred gen_const_data_expr(expr::in, val_locn_map_static::in, val_locn_map_static::out, closure_builder::in, closure_builder::out, pz::in, pz::out) is det. gen_const_data_expr(expr(ExprType, CodeInfo), !LocnMap, !ModuleClo, !PZ) :- ( ExprType = e_lets(Lets, Expr), foldl3(gen_const_data_lets, Lets, !LocnMap, !ModuleClo, !PZ), gen_const_data_expr(Expr, !LocnMap, !ModuleClo, !PZ) ; ExprType = e_tuple(Exprs), foldl3(gen_const_data_expr, Exprs, !LocnMap, !ModuleClo, !PZ) ; ExprType = e_call(_, _, _) ; ExprType = e_var(_) ; ExprType = e_constant(Const), ( Const = c_string(String), ( if [builtin_type(string)] = code_info_types(CodeInfo) then gen_const_data_string(String, !LocnMap, !ModuleClo, !PZ) else % The string literal is interpreted as a codepoint. true ) ; Const = c_number(_) ; Const = c_func(_) ; Const = c_ctor(_) ) ; ExprType = e_construction(_, _) ; ExprType = e_closure(_, _) ; ExprType = e_match(_, Cases), foldl3(gen_const_data_case, Cases, !LocnMap, !ModuleClo, !PZ) ). :- pred gen_const_data_lets(expr_let::in, val_locn_map_static::in, val_locn_map_static::out, closure_builder::in, closure_builder::out, pz::in, pz::out) is det. gen_const_data_lets(e_let(_, Expr), !LocnMap, !ModuleClo, !PZ) :- gen_const_data_expr(Expr, !LocnMap, !ModuleClo, !PZ). :- pred gen_const_data_case(expr_case::in, val_locn_map_static::in, val_locn_map_static::out, closure_builder::in, closure_builder::out, pz::in, pz::out) is det. gen_const_data_case(e_case(_, Expr), !LocnMap, !ModuleClo, !PZ) :- gen_const_data_expr(Expr, !LocnMap, !ModuleClo, !PZ). :- pred gen_const_data_string(string::in, val_locn_map_static::in, val_locn_map_static::out, closure_builder::in, closure_builder::out, pz::in, pz::out) is det. gen_const_data_string(String, !LocnMap, !ModuleClo, !PZ) :- ( if vls_has_str(!.LocnMap, String) then true else pz_new_data_id(DID, !PZ), pz_add_data(DID, pz_encode_string(String), !PZ), closure_add_field(pzv_data(DID), FieldNum, !ModuleClo), vls_insert_str(String, closure_get_struct(!.ModuleClo), FieldNum, type_to_pz_width(builtin_type(string)), !LocnMap) ). %-----------------------------------------------------------------------% gen_constructor_data(Core, BuiltinProcs, TypeTagMap, CtorTagMap, !PZ) :- Types = core_all_types(Core), foldl3(gen_constructor_data_type(Core, BuiltinProcs), Types, map.init, TypeTagMap, map.init, CtorTagMap, !PZ). :- pred gen_constructor_data_type(core::in, pz_builtin_ids::in, pair(type_id, user_type)::in, map(type_id, type_tag_info)::in, map(type_id, type_tag_info)::out, map({type_id, ctor_id}, constructor_data)::in, map({type_id, ctor_id}, constructor_data)::out, pz::in, pz::out) is det. gen_constructor_data_type(Core, BuiltinProcs, TypeId - Type, !TypeTagMap, !CtorDatas, !PZ) :- gen_constructor_tags(Core, Type, TypeTagInfo, CtorTagInfos, !PZ), det_insert(TypeId, TypeTagInfo, !TypeTagMap), MaybeCtorIds = utype_get_ctors(Type), ( MaybeCtorIds = yes(CtorIds), foldl2(gen_constructor_data_ctor(Core, BuiltinProcs, TypeId, Type, CtorTagInfos), CtorIds, !CtorDatas, !PZ) ; MaybeCtorIds = no % There's nothing to generate for abstractly-imported types ). :- pred gen_constructor_data_ctor(core::in, pz_builtin_ids::in, type_id::in, user_type::in, map(ctor_id, ctor_tag_info)::in, ctor_id::in, map({type_id, ctor_id}, constructor_data)::in, map({type_id, ctor_id}, constructor_data)::out, pz::in, pz::out) is det. gen_constructor_data_ctor(Core, BuiltinProcs, TypeId, Type, TagInfoMap, CtorId, !CtorDatas, !PZ) :- map.lookup(TagInfoMap, CtorId, TagInfo), maybe_gen_struct(Core, CtorId, TagInfo, !PZ), ModuleName = module_name(Core), core_get_constructor_det(Core, CtorId, Ctor), gen_constructor_proc(ModuleName, BuiltinProcs, Type, Ctor, TagInfo, ConstructProc, !PZ), CD = constructor_data(TagInfo, ConstructProc), map.det_insert({TypeId, CtorId}, CD, !CtorDatas). %-----------------------------------------------------------------------% :- pred maybe_gen_struct(core::in, ctor_id::in, ctor_tag_info::in, pz::in, pz::out) is det. maybe_gen_struct(Core, CtorId, TagInfo, !PZ) :- core_get_constructor_det(Core, CtorId, Ctor), Fields = Ctor ^ c_fields, NumFields = length(Fields), ( if NumFields > 0 then ( ( TagInfo = ti_constant(_, _) ; TagInfo = ti_constant_notag(_) ), unexpected($file, $pred, "Constant can't have fields") ; TagInfo = ti_tagged_pointer(_, StructId, MaybeSTag), ( MaybeSTag = yes(_), STagFields = 1 ; MaybeSTag = no, STagFields = 0 ) ), duplicate(NumFields + STagFields, pzw_ptr, StructFields), Struct = pz_struct(StructFields), pz_add_struct(StructId, Struct, !PZ) else true ). %-----------------------------------------------------------------------% :- pred gen_constructor_proc(q_name::in, pz_builtin_ids::in, user_type::in, constructor::in, ctor_tag_info::in, pzp_id::out, pz::in, pz::out) is det. gen_constructor_proc(ModuleName, BuiltinProcs, Type, Ctor, TagInfo, ProcId, !PZ) :- % TODO Move the construction out-of-line into a separate procedure, % this is also used when the constructor is used as a higher order % value. It may be later inlined. ( TagInfo = ti_constant(PTag, WordBits), ShiftMakeTag = BuiltinProcs ^ pbi_shift_make_tag, Instrs = from_list([pzio_comment("Construct tagged constant"), pzio_instr(pzi_load_immediate(pzw_ptr, im_u32(WordBits))), pzio_instr(pzi_load_immediate(pzw_ptr, im_u32(cast_from_int(to_int(PTag))))), pzio_instr(pzi_call(pzc_import(ShiftMakeTag)))]) ; TagInfo = ti_constant_notag(Word), Instrs = from_list([pzio_comment("Construct constant"), pzio_instr(pzi_load_immediate(pzw_ptr, im_u32(Word)))]) ; TagInfo = ti_tagged_pointer(PTag, Struct, MaybeSTag), MakeTag = BuiltinProcs ^ pbi_make_tag, InstrsAlloc = from_list([pzio_comment("Construct struct"), pzio_instr(pzi_alloc(Struct))]), list.map_foldl(gen_construction_store(Struct), Ctor ^ c_fields, InstrsStore0, FirstField, _), InstrsStore = cord.from_list(reverse(InstrsStore0)), ( MaybeSTag = no, FirstField = 1, InstrsPutTag = init ; MaybeSTag = yes(STag), FirstField = 2, InstrsPutTag = from_list([ pzio_instr(pzi_load_immediate(pzw_ptr, im_u32(STag))), pzio_instr(pzi_roll(2)), pzio_instr(pzi_store(Struct, field_num(1), pzw_ptr))]) ), InstrsTag = from_list([ pzio_instr(pzi_load_immediate(pzw_ptr, im_u32(cast_from_int(to_int(PTag))))), pzio_instr(pzi_call(pzc_import(MakeTag)))]), Instrs = InstrsAlloc ++ InstrsStore ++ InstrsPutTag ++ InstrsTag ), pz_new_proc_id(ProcId, !PZ), TypeName = utype_get_name(Type), CtorName = Ctor ^ c_name, q_name_parts(CtorName, MaybeModuleName, CtorNameSingle), ( MaybeModuleName = yes(CtorModuleName), Name = q_name_append_str(ModuleName, format("construct_%s_%s_%s", [s(replace_all(q_name_to_string(CtorModuleName), ".", "_")), s(nq_name_to_string(q_name_unqual(TypeName))), s(nq_name_to_string(CtorNameSingle))])) ; MaybeModuleName = no, Name = q_name_append_str(ModuleName, format("construct_%s_%s", [s(nq_name_to_string(q_name_unqual(TypeName))), s(nq_name_to_string(CtorNameSingle))])) ), Before = list.duplicate(length(Ctor ^ c_fields), pzw_ptr), After = [pzw_ptr], RetInstr = pzio_instr(pzi_ret), Proc = pz_proc(Name, pz_signature(Before, After), yes([pz_block(list(snoc(Instrs, RetInstr)))])), pz_add_proc(ProcId, Proc, !PZ). :- pred gen_construction_store(pzs_id::in, T::in, pz_instr_obj::out, int::in, int::out) is det. gen_construction_store(StructId, _, Instr, !FieldNo) :- Instr = pzio_instr(pzi_store(StructId, field_num(!.FieldNo), pzw_ptr)), !:FieldNo = !.FieldNo + 1. %-----------------------------------------------------------------------% % % Pointer tagging % =============== % % All memory allocations are machine-word aligned, this means that there are % two or three low-bits available for pointer tags (32bit or 64bit systems). % There may be high bits available also, especially on 64bit systems. For % now we assume that there are always two low bits available. % % TODO: Optimization % Using the third bit on a 64 bit system would be good. This can be handled % by compiling two versions of the program and storing them both in the .pz % file. One for 32-bit and one for 64-bit. This would happen at a late % stage of compilation and won't duplicate much work. It could be skipped % or stripped from the file to reduce file size if required. % % We use tagged pointers to implement discriminated unions. Most of what we % do here is based upon the Mercury project. Each pointer's 2 lowest bits % are the _primary tag_, a _secondary tag_ can be stored in the pointed-to % object when required. % % Each type's constructors are grouped into those that have arguments, and % those that do not. The first primary tag "00" is used for the group of % constants with the higher bits used to encode each constant. The % next remaining primary tags "01" "10" (and "00" if it was not used in the % first step") are given to the first two-three constructors with arguments % and the final tag "11" is used for all the remaining constructors, % utilizing a second tag as the first field in the pointed-to structure to % distinguish between them. % % This scheme has a specific benefit that is if there is only a single % no-argument constructor then it has the same value as the null pointer. % Therefore the cons cell has the same encoding as either a normal pointer % or the null pointer. Likewise a maybe value can be unboxed in some cases. % (Not implemented yet). % % Exception: strict enums % If a type is an enum _only_ then it doesn't require any tag bits and is % encoded simply as a raw value. This exception enables the bool type to % use 0 and 1 conveniently. % % TODO: Optimisation: % Some types don't need to fill out the rest of the field for a given ptag. % For example something like: % % type Type = C1 Int | C2 | C3. % % Can use a primary tag for each of C1, C2 and C3. and have fewer switches. % % TODO: Optimisation: % Special casing certain types, such as unboxing maybes, handling "no tag" % types, etc. % % TODO: Optimisation: % Some constants, such as 0, should be able to share a primary tag with a % pointers. % %-----------------------------------------------------------------------% :- pred gen_constructor_tags(core::in, user_type::in, type_tag_info::out, map(ctor_id, ctor_tag_info)::out, pz::in, pz::out) is det. gen_constructor_tags(Core, Type, TypeTagInfo, !:CtorTagInfos, !PZ) :- MaybeCtorIds = utype_get_ctors(Type), ( MaybeCtorIds = yes(CtorIds), map((pred(CId::in, {CId, C}::out) is det :- core_get_constructor_det(Core, CId, C) ), CtorIds, Ctors), count_constructor_types(Ctors, NumNoArgs, NumWithArgs), ( if NumWithArgs = 0 then % This is a simple enum and therefore we can use strict enum % tagging. TypeTagInfo = tti_untagged, map_foldl(make_strict_enum_tag_info, CtorIds, CtorTagInfos, 0u32, _), !:CtorTagInfos = from_assoc_list(from_corresponding_lists(CtorIds, CtorTagInfos)) else !:CtorTagInfos = map.init, some [!PTagMap] ( !:PTagMap = map.init, ( if NumNoArgs \= 0 then foldl3(make_enum_tag_info(0u8), Ctors, 0u32, _, !CtorTagInfos, !PTagMap), NextPTag = 1u8 else NextPTag = 0u8 ), ( if % We need secondary tags if there are more than % num_ptag_vals constructors with fields plus a ptag for the % constructors without fields. ( NumNoArgs = 0, NumWithArgs > num_ptag_vals ; NumNoArgs \= 0, NumWithArgs + 1 > num_ptag_vals ) then NeedSecTags = need_secondary_tags else NeedSecTags = dont_need_secondary_tags ), TypeName = utype_get_name(Type), foldl5(make_ctor_tag_info(TypeName, NeedSecTags), Ctors, NextPTag, _, 0u32, _, !CtorTagInfos, !PTagMap, !PZ), TypeTagInfo = tti_tagged(!.PTagMap) ) ) ; MaybeCtorIds = no, % We don't create constructor tags for abstractly-imported types. TypeTagInfo = tti_abstract, !:CtorTagInfos = init ). :- pred count_constructor_types(list({ctor_id, constructor})::in, int::out, int::out) is det. count_constructor_types([], 0, 0). count_constructor_types([{_, Ctor} | Ctors], NumNoArgs, NumWithArgs) :- count_constructor_types(Ctors, NumNoArgs0, NumWithArgs0), Args = Ctor ^ c_fields, ( Args = [], NumNoArgs = NumNoArgs0 + 1, NumWithArgs = NumWithArgs0 ; Args = [_ | _], NumNoArgs = NumNoArgs0, NumWithArgs = NumWithArgs0 + 1 ). % make_enum_tag_info(PTag, Ctor, ThisWordBits, NextWordBits, % !TagInfoMap). % :- pred make_enum_tag_info(ptag::in, {ctor_id, constructor}::in, word_bits::in, word_bits::out, map(ctor_id, ctor_tag_info)::in, map(ctor_id, ctor_tag_info)::out, map(ptag, type_ptag_info)::in, map(ptag, type_ptag_info)::out) is det. make_enum_tag_info(PTag, {CtorId, Ctor}, !WordBits, !CtorTagMap, !TypePTagMap) :- Fields = Ctor ^ c_fields, ( Fields = [], det_insert(CtorId, ti_constant(PTag, !.WordBits), !CtorTagMap), add_ptag_constant(PTag, !.WordBits, CtorId, !TypePTagMap), !:WordBits = !.WordBits + 1u32 ; Fields = [_ | _] ). % make_strict_enum_tag_info(Ctor, ThisWordBits, NextWordBits, % !TagInfoMap). % :- pred make_strict_enum_tag_info(ctor_id::in, ctor_tag_info::out, word_bits::in, word_bits::out) is det. make_strict_enum_tag_info(_, TagInfo, !WordBits) :- TagInfo = ti_constant_notag(!.WordBits), !:WordBits = !.WordBits + 1u32. % Used to inform make_ctor_tag_info if secondary tags will be used some % constructors of this type. This is used to deterime if the first % constructor to use the final primary tag should have a secondary tag % to differentiate itself from further constructors that would share the % primary tag. If no further constructors exist, then a secondary tag % isn't required. % :- type need_secondary_tags ---> need_secondary_tags ; dont_need_secondary_tags. :- pred make_ctor_tag_info(q_name::in, need_secondary_tags::in, {ctor_id, constructor}::in, ptag::in, ptag::out, stag::in, stag::out, map(ctor_id, ctor_tag_info)::in, map(ctor_id, ctor_tag_info)::out, map(ptag, type_ptag_info)::in, map(ptag, type_ptag_info)::out, pz::in, pz::out) is det. make_ctor_tag_info(TypeName, NeedSecTag, {CtorId, Ctor}, !PTag, !STag, !CtorTagMap, !TypePTagMap, !PZ) :- Fields = Ctor ^ c_fields, ( Fields = [] ; Fields = [_ | _], StructName = q_name_to_string(TypeName) ++ "_" ++ q_name_to_string(Ctor ^ c_name), pz_new_struct_id(StructId, StructName, !PZ), ( if ( !.PTag < det_from_int(num_ptag_vals - 1) ; !.PTag = det_from_int(num_ptag_vals - 1), NeedSecTag = dont_need_secondary_tags ) then det_insert(CtorId, ti_tagged_pointer(!.PTag, StructId, no), !CtorTagMap), det_insert(!.PTag, tpti_pointer(CtorId), !TypePTagMap), !:PTag = !.PTag + 1u8 else det_insert(CtorId, ti_tagged_pointer(!.PTag, StructId, yes(!.STag)), !CtorTagMap), add_ptag_stag(!.PTag, !.STag, CtorId, !TypePTagMap), !:STag = !.STag + 1u32 ) ). %-----------------------------------------------------------------------% :- pred add_ptag_constant(ptag::in, word_bits::in, ctor_id::in, map(ptag, type_ptag_info)::in, map(ptag, type_ptag_info)::out) is det. add_ptag_constant(PTag, Constant, CtorId, !Map) :- ( if search(!.Map, PTag, Entry0) then ( Entry0 = tpti_constant(ConstMap0) ; ( Entry0 = tpti_pointer(_) ; Entry0 = tpti_pointer_stag(_) ), unexpected($file, $pred, "Constants and pointers cannot share a ptag") ) else ConstMap0 = map.init ), det_insert(Constant, CtorId, ConstMap0, ConstMap), set(PTag, tpti_constant(ConstMap), !Map). :- pred add_ptag_stag(ptag::in, stag::in, ctor_id::in, map(ptag, type_ptag_info)::in, map(ptag, type_ptag_info)::out) is det. add_ptag_stag(PTag, STag, CtorId, !Map) :- ( if search(!.Map, PTag, Entry0) then ( Entry0 = tpti_pointer_stag(STagMap0) ; ( Entry0 = tpti_pointer(_) ; Entry0 = tpti_constant(_) ), unexpected($file, $pred, "If one ctor for this ptag has an stag, then all must.") ) else STagMap0 = map.init ), det_insert(STag, CtorId, STagMap0, STagMap), set(PTag, tpti_pointer_stag(STagMap), !Map). %-----------------------------------------------------------------------% % This prints the data representation in a way that it can be used for % reference, not in a way to cross-check that it's correct. data_rep_pretty({Core, TypeTagMap, CtorTagMap}) = pretty(default_options, 0, Pretty) :- ModuleDecl = p_expr( [p_str("module"), p_spc, q_name_pretty(module_name(Core))]), BoolWidth = p_expr(p_words("bool width is") ++ [p_spc, p_str(string(data.bool_width))]), PTagBits = p_expr( p_words(format("There are %d primary tag bits for %d primary tags.", [i(num_ptag_bits), i(num_ptag_vals)]))), TypeTagMapPretty = pretty_seperated([p_nl_double], map(type_tag_pretty(Core, CtorTagMap), map.to_assoc_list(TypeTagMap))), Pretty = [p_list([ModuleDecl, p_nl_double, BoolWidth, p_nl_hard, PTagBits, p_nl_double] ++ TypeTagMapPretty)]. :- func type_tag_pretty(core, constructor_data_map, pair(type_id, type_tag_info)) = pretty. type_tag_pretty(Core, CtorTagMap, TypeId - TTI) = p_expr([p_str("type"), p_spc, q_name_pretty(TypeName), p_str(" - "), p_str(TTIStr)] ++ More) :- TypeName = core_lookup_type_name(Core, TypeId), ( TTI = tti_untagged, TTIStr = "untagged", MaybeCtors = utype_get_ctors(core_get_type(Core, TypeId)), ( MaybeCtors = yes(Ctors) ; MaybeCtors = no, unexpected($file, $pred, "Abstract") ), More = [p_nl_hard] ++ pretty_seperated([p_nl_hard], map(untagged_ctor_pretty(Core, CtorTagMap, TypeId), Ctors)) ; TTI = tti_tagged(TagInfoMap), TTIStr = "tagged", More = [p_nl_hard] ++ pretty_seperated([p_nl_hard], map(ptag_pretty(Core), to_assoc_list(TagInfoMap))) ; TTI = tti_abstract, TTIStr = "abstract", More = [] ). :- func untagged_ctor_pretty(core, constructor_data_map, type_id, ctor_id) = pretty. untagged_ctor_pretty(Core, CtorMap, TypeId, CtorId) = p_expr([p_ctor(Core, CtorId), p_str(" - "), p_str(string(Bits))]) :- CtorTagInfo = lookup(CtorMap, {TypeId, CtorId}) ^ cd_tag_info, ( ( CtorTagInfo = ti_constant(_, _) ; CtorTagInfo = ti_tagged_pointer(_, _, _) ), unexpected($file, $pred, "Tagged") ; CtorTagInfo = ti_constant_notag(Bits) ). :- func ptag_pretty(core, pair(ptag, type_ptag_info)) = pretty. ptag_pretty(Core, PTag - Info) = p_expr([p_str("ptag"), p_spc, p_str(string(PTag)), p_str(": ")] ++ ptag_info_pretty(Core, Info)). :- func ptag_info_pretty(core, type_ptag_info) = list(pretty). ptag_info_pretty(Core, tpti_constant(Map)) = p_words("Non-tag bits are a constant") ++ [p_nl_hard, p_list(map(bits_ctor_pretty(Core), to_assoc_list(Map)))]. ptag_info_pretty(Core, tpti_pointer(Ctor)) = p_words("pointer for") ++ [p_spc, p_ctor(Core, Ctor)]. ptag_info_pretty(Core, tpti_pointer_stag(Map)) = map(stag_ctor_pretty(Core), to_assoc_list(Map)). :- func bits_ctor_pretty(core, pair(word_bits, ctor_id)) = pretty. bits_ctor_pretty(Core, Bits - Ctor) = p_expr([p_str(string(Bits)), p_str(" - "), p_ctor(Core, Ctor)]). :- func stag_ctor_pretty(core, pair(stag, ctor_id)) = pretty. stag_ctor_pretty(Core, Stag - Ctor) = p_expr([p_str(string(Stag)), p_str(" - "), p_ctor(Core, Ctor)]). :- func p_ctor(core, ctor_id) = pretty. p_ctor(Core, CtorId) = q_name_pretty(core_lookup_constructor_name(Core, CtorId)). %-----------------------------------------------------------------------% % This must be equal to or less than the number of taog bits set in the % runtime. See runtime/pz_run.h. num_ptag_bits = 2. :- func num_ptag_vals = int. num_ptag_vals = pow(2, num_ptag_bits). %-----------------------------------------------------------------------% type_to_pz_width(Type) = Width :- ( Type = builtin_type(BuiltinType), ( BuiltinType = int, Width = pzw_fast ; BuiltinType = codepoint, Width = pzw_32 ; BuiltinType = string, Width = pzw_ptr ; BuiltinType = string_pos, Width = pzw_ptr ) ; ( Type = type_variable(_) ; Type = type_ref(_, _) ; Type = func_type(_, _, _, _) ), Width = pzw_ptr ). % This must match the calculation above, and is provided to avoid a % dependency in builtins.m bool_width = pzw_ptr. %-----------------------------------------------------------------------% %-----------------------------------------------------------------------% ================================================ FILE: src/core_to_pz.locn.m ================================================ %-----------------------------------------------------------------------% % vim: ts=4 sw=4 et %-----------------------------------------------------------------------% :- module core_to_pz.locn. % % Copyright (C) Plasma Team % Distributed under the terms of the MIT License see ../LICENSE.code % % Plasma core to pz conversion - value location information % %-----------------------------------------------------------------------% :- interface. :- import_module cord. :- import_module maybe. %-----------------------------------------------------------------------% % The location of a value, this is made of two types. % % val_locn says where to start looking, either on the stack or with the % current environment. Once you have then then... % % val_locn_next says what to do with the current location, if you're % done or weather you should follow some structure. % :- type val_locn % The value is on the stack. ---> vl_stack(int, val_locn_next) % The value _is_ the current env. ; vl_env(val_locn_next) % The value needs to be computed using this expression. ; vl_compute(expr). :- type val_locn_next ---> vln_done % The value is within some structure (like the environment). ; vln_struct(pzs_id, field_num, pz_width, val_locn_next). :- type proc_locn ---> pl_instrs(list(pz_instr), maybe(pzp_id)) ; pl_static_proc(pzp_id) ; pl_other(val_locn). %-----------------------------------------------------------------------% % % The location map information is divided into two halves, the static % information which is static per PZ procedure. And the dynamic % information, which changes with code generation (for example as values are % pushed onto the stack). % :- type val_locn_map_static. :- func vls_init(pzs_id) = val_locn_map_static. :- pred vls_set_proc(func_id::in, pzp_id::in, val_locn_map_static::in, val_locn_map_static::out) is det. :- pred vls_set_proc_instrs(func_id::in, list(pz_instr)::in, val_locn_map_static::in, val_locn_map_static::out) is det. :- pred vls_set_proc_imported(func_id::in, pzi_id::in, field_num::in, val_locn_map_static::in, val_locn_map_static::out) is det. :- func vls_lookup_proc_id(val_locn_map_static, func_id) = pzp_id. :- pred vls_set_closure(func_id::in, pzs_id::in, val_locn_map_static::in, val_locn_map_static::out) is det. :- func vls_lookup_closure(val_locn_map_static, func_id) = pzs_id. :- pred vls_has_str(val_locn_map_static::in, string::in) is semidet. :- pred vls_insert_str(string::in, pzs_id::in, field_num::in, pz_width::in, val_locn_map_static::in, val_locn_map_static::out) is det. %-----------------------------------------------------------------------% :- type val_locn_map. :- pred vl_start_var_binding(val_locn_map_static::in, val_locn_map::out) is det. % vl_setup_closure(StructId, FieldNo, !LocnMap). % % The code using !:LocnMap map executes within a closure. The root % (module) environment can be found by dereferencing the environment % using FieldNo of StructId. :- pred vl_setup_closure(pzs_id::in, field_num::in, val_locn_map::in, val_locn_map::out) is det. :- pred vl_put_var(var::in, int::in, val_locn_map::in, val_locn_map::out) is det. :- pred vl_set_var_env(var::in, pzs_id::in, field_num::in, pz_width::in, val_locn_map::in, val_locn_map::out) is det. :- pred vl_set_var_expr(var::in, expr::in, val_locn_map::in, val_locn_map::out) is det. :- pred vl_put_vars(list(var)::in, int::in, varmap::in, cord(pz_instr_obj)::out, val_locn_map::in, val_locn_map::out) is det. :- func vl_lookup_proc(val_locn_map, func_id) = proc_locn. :- func vl_lookup_proc_id(val_locn_map, func_id) = pzp_id. :- func vl_lookup_closure(val_locn_map, func_id) = pzs_id. % This is semidet so our caller can give a clearer exception if it % fails. % :- pred vl_search_var(val_locn_map::in, var::in, val_locn::out) is semidet. :- func vl_lookup_str(val_locn_map, string) = val_locn. :- func vl_lookup_mod_env(val_locn_map) = val_locn. %-----------------------------------------------------------------------% %-----------------------------------------------------------------------% :- implementation. :- import_module int. %-----------------------------------------------------------------------% :- type val_locn_map_static ---> val_locn_map_static( vls_mod_env :: pzs_id, vls_const_data :: map(const_data, val_locn), vls_proc_id_map :: map(func_id, proc_locn_internal), % Not exactly location data, but it is accessed and created % similarly. vls_closures :: map(func_id, pzs_id) ). % Used internally. proc_locn is just how the the result is returned. % :- type proc_locn_internal ---> pli_instrs(list(pz_instr), maybe(pzp_id)) ; pli_static_proc(pzp_id) ; pli_import(pzi_id, field_num). %-----------------------------------------------------------------------% vls_init(ModEnvStruct) = val_locn_map_static(ModEnvStruct, init, init, init). %-----------------------------------------------------------------------% vls_set_proc(FuncId, ProcId, !Map) :- ( if search(!.Map ^ vls_proc_id_map, FuncId, Locn0) then ( ( Locn0 = pli_static_proc(_) ; Locn0 = pli_import(_, _) ), unexpected($file, $pred, "Already set") ; Locn0 = pli_instrs(Instrs, MaybeProc), ( MaybeProc = yes(_), unexpected($file, $pred, "Already set") ; MaybeProc = no, Locn = pli_instrs(Instrs, yes(ProcId)) ) ) else Locn = pli_static_proc(ProcId) ), map.set(FuncId, Locn, !.Map ^ vls_proc_id_map, ProcMap), !Map ^ vls_proc_id_map := ProcMap. vls_set_proc_instrs(FuncId, Instrs, !Map) :- ( if search(!.Map ^ vls_proc_id_map, FuncId, Locn0) then ( ( Locn0 = pli_instrs(_, _) ; Locn0 = pli_import(_, _) ), unexpected($file, $pred, "Already set") ; Locn0 = pli_static_proc(ProcId), Locn = pli_instrs(Instrs, yes(ProcId)) ) else Locn = pli_instrs(Instrs, no) ), map.set(FuncId, Locn, !.Map ^ vls_proc_id_map, ProcMap), !Map ^ vls_proc_id_map := ProcMap. vls_set_proc_imported(FuncId, ImportId, FieldNum, !Map) :- map.det_insert(FuncId, pli_import(ImportId, FieldNum), !.Map ^ vls_proc_id_map, ProcMap), !Map ^ vls_proc_id_map := ProcMap. %-----------------------------------------------------------------------% vls_lookup_proc_id(Map, FuncId) = ProcId :- map.lookup(Map ^ vls_proc_id_map, FuncId, Locn), ( Locn = pli_static_proc(ProcId) ; Locn = pli_instrs(_, MaybeProcId), ( MaybeProcId = yes(ProcId) ; MaybeProcId = no, unexpected($file, $pred, "Builtin with no proc") ) ; Locn = pli_import(_, _), unexpected($file, $pred, "Non-static proc") ). %-----------------------------------------------------------------------% vls_set_closure(FuncId, EnvStructId, !Map) :- map.det_insert(FuncId, EnvStructId, !.Map ^ vls_closures, ClosuresMap), !Map ^ vls_closures := ClosuresMap. vls_lookup_closure(Map, FuncId) = EnvStructId :- map.lookup(Map ^ vls_closures, FuncId, EnvStructId). %-----------------------------------------------------------------------% vls_has_str(Map, Str) :- map.contains(Map ^ vls_const_data, cd_string(Str)). %-----------------------------------------------------------------------% vls_insert_str(String, Struct, Field, Width, !Map) :- map.det_insert(cd_string(String), vl_env(vln_struct(Struct, Field, Width, vln_done)), !.Map ^ vls_const_data, ConstMap), !Map ^ vls_const_data := ConstMap. %-----------------------------------------------------------------------% %-----------------------------------------------------------------------% :- type val_locn_map ---> vlm_root( vlmr_static :: val_locn_map_static, vlmr_vars :: map(var, val_locn) ) ; vlm_clos( vlme_static :: val_locn_map_static, vlme_vars :: map(var, val_locn), vlme_struct :: pzs_id, vlme_field :: field_num, vlme_width :: pz_width ). %-----------------------------------------------------------------------% vl_start_var_binding(Static, vlm_root(Static, map.init)). %-----------------------------------------------------------------------% vl_setup_closure(Struct, Field, vlm_root(Static, Vars), vlm_clos(Static, Vars, Struct, Field, pzw_ptr)). vl_setup_closure(_, _, vlm_clos(_, _, _, _, _), _) :- unexpected($file, $pred, "Closures must be flat"). %-----------------------------------------------------------------------% vl_put_var(Var, Depth, !Map) :- vl_set_var_1(Var, vl_stack(Depth, vln_done), !Map). vl_set_var_env(Var, Struct, Field, Width, !Map) :- vl_set_var_1(Var, vl_env(vln_struct(Struct, Field, Width, vln_done)), !Map). vl_set_var_expr(Var, Expr, !Map) :- vl_set_var_1(Var, vl_compute(Expr), !Map). %-----------------------------------------------------------------------% vl_put_vars([], _, _, init, !Map). vl_put_vars([Var | Vars], Depth0, Varmap, Comments, !Map) :- Depth = Depth0 + 1, vl_put_var(Var, Depth, !Map), Comment = pzio_comment(format("%s is at depth %d", [s(get_var_name(Varmap, Var)), i(Depth)])), vl_put_vars(Vars, Depth, Varmap, Comments0, !Map), Comments = cons(Comment, Comments0). %-----------------------------------------------------------------------% :- pred vl_set_var_1(var::in, val_locn::in, val_locn_map::in, val_locn_map::out) is det. vl_set_var_1(Var, Locn, vlm_root(Static, !.VarsMap), vlm_root(Static, !:VarsMap)) :- map.det_insert(Var, Locn, !VarsMap). vl_set_var_1(Var, Locn, vlm_clos(Sta, !.VarsMap, Str, F, W), vlm_clos(Sta, !:VarsMap, Str, F, W)) :- map.det_insert(Var, Locn, !VarsMap). %-----------------------------------------------------------------------% vl_lookup_proc(vlm_root(Static, _), FuncId) = Locn :- map.lookup(Static ^ vls_proc_id_map, FuncId, Locn0), Locn = proc_locn_from_internal(Static ^ vls_mod_env, Locn0). vl_lookup_proc(vlm_clos(Static, _, Struct, Field, Width), FuncId) = Locn :- map.lookup(Static ^ vls_proc_id_map, FuncId, Locn0), Locn1 = proc_locn_from_internal(Static ^ vls_mod_env, Locn0), Locn = proc_maybe_in_struct(Struct, Field, Width, Locn1). vl_lookup_proc_id(LocnMap, FuncId) = vls_lookup_proc_id(vl_static(LocnMap), FuncId). %-----------------------------------------------------------------------% vl_lookup_closure(LocnMap, FuncId) = StructId :- map.lookup(vl_static(LocnMap) ^ vls_closures, FuncId, StructId). %-----------------------------------------------------------------------% vl_search_var(vlm_root(_, VarsMap), Var, Locn) :- map.search(VarsMap, Var, Locn). vl_search_var(vlm_clos(_, VarsMap, _, _, _), Var, Locn) :- map.search(VarsMap, Var, Locn). %-----------------------------------------------------------------------% vl_lookup_str(vlm_root(Static, _), Str) = Locn :- map.lookup(Static ^ vls_const_data, cd_string(Str), Locn). vl_lookup_str(vlm_clos(Static, _, Struct, Field, Width), Str) = val_maybe_in_struct(Struct, Field, Width, Locn0) :- map.lookup(Static ^ vls_const_data, cd_string(Str), Locn0). %-----------------------------------------------------------------------% vl_lookup_mod_env(vlm_root(_, _)) = vl_env(vln_done). vl_lookup_mod_env(vlm_clos(_, _, S, F, W)) = vl_env(vln_struct(S, F, W, vln_done)). %-----------------------------------------------------------------------% :- func proc_locn_from_internal(pzs_id, proc_locn_internal) = proc_locn. proc_locn_from_internal(_, pli_instrs(Instrs, MbProcId)) = pl_instrs(Instrs, MbProcId). proc_locn_from_internal(_, pli_static_proc(ProcId)) = pl_static_proc(ProcId). proc_locn_from_internal(ModEnvStruct, pli_import(_, FieldNum)) = pl_other(vl_env(vln_struct(ModEnvStruct, FieldNum, pzw_ptr, vln_done))). :- func proc_maybe_in_struct(pzs_id, field_num, pz_width, proc_locn) = proc_locn. proc_maybe_in_struct(Struct, Field, Width, Locn0) = Locn :- ( ( Locn0 = pl_instrs(_, _) ; Locn0 = pl_static_proc(_) ), Locn = Locn0 ; Locn0 = pl_other(ValLocn0), Locn = pl_other(val_maybe_in_struct(Struct, Field, Width, ValLocn0)) ). :- func val_maybe_in_struct(pzs_id, field_num, pz_width, val_locn) = val_locn. val_maybe_in_struct(_, _, _, Val@vl_stack(_, _)) = Val. val_maybe_in_struct(_, _, _, Val@vl_compute(_)) = Val. val_maybe_in_struct(StructId, Field, Width, vl_env(Next0)) = vl_env(vln_struct(StructId, Field, Width, Next0)). :- func vl_static(val_locn_map) = val_locn_map_static. vl_static(vlm_root(Static, _)) = Static. vl_static(vlm_clos(Static, _, _, _, _)) = Static. %-----------------------------------------------------------------------% %-----------------------------------------------------------------------% ================================================ FILE: src/core_to_pz.m ================================================ %-----------------------------------------------------------------------% % vim: ts=4 sw=4 et %-----------------------------------------------------------------------% :- module core_to_pz. % % Copyright (C) Plasma Team % Distributed under the terms of the MIT License see ../LICENSE.code % % Plasma core to pz conversion % %-----------------------------------------------------------------------% :- interface. :- include_module core_to_pz.data. :- import_module io. :- import_module core. :- import_module core_to_pz.data. :- import_module options. :- import_module pz. :- import_module pz.pz_ds. :- import_module util. :- import_module util.log. %-----------------------------------------------------------------------% :- pred core_to_pz(log_config::in, compile_options::in, core::in, pz::out, type_tag_map::out, constructor_data_map::out, io::di, io::uo) is det. %-----------------------------------------------------------------------% :- func bool_width = pz_width. %-----------------------------------------------------------------------% %-----------------------------------------------------------------------% :- implementation. :- import_module cord. :- import_module list. :- import_module map. :- import_module pair. :- import_module require. :- import_module set. :- import_module string. :- import_module builtins. :- import_module common_types. :- import_module core.code. :- import_module core.function. :- import_module core.types. :- import_module pz.code. :- import_module q_name. :- import_module util.mercury. :- import_module util.pretty. :- import_module varmap. :- include_module core_to_pz.code. :- include_module core_to_pz.closure. :- include_module core_to_pz.locn. :- import_module core_to_pz.code. :- import_module core_to_pz.closure. :- import_module core_to_pz.locn. %-----------------------------------------------------------------------% core_to_pz(Verbose, CompileOpts, !.Core, !:PZ, TypeTagMap, TypeCtorTagMap, !IO) :- !:PZ = init_pz([module_name(!.Core)], pzft_object), % Get ImportIds for builtin procedures. setup_pz_builtin_procs(BuiltinProcs, !PZ), % Make decisions about how data should be stored in memory. % This covers what tag values to use for each constructor and the IDs of % each structure. pz_new_struct_id(EnvStructId, "Module struct", !PZ), verbose_output(Verbose, "Generating type layout (constructor tags)\n", !IO), gen_constructor_data(!.Core, BuiltinProcs, TypeTagMap, TypeCtorTagMap, !PZ), some [!ModuleClo, !LocnMap, !FilenameDataMap] ( !:ModuleClo = closure_builder_init(EnvStructId), !:LocnMap = vls_init(EnvStructId), !:FilenameDataMap = map.init, % Generate constants. verbose_output(Verbose, "Generating constants\n", !IO), gen_const_data(!.Core, !LocnMap, !ModuleClo, !FilenameDataMap, !PZ), % Generate functions. Funcs = core_all_functions(!.Core), foldl3(make_proc_and_struct_ids, Funcs, !LocnMap, !ModuleClo, !PZ), DefinedFuncs = core_all_defined_functions(!.Core), verbose_output(Verbose, format("Generating %d functions\n", [i(length(DefinedFuncs))]), !IO), foldl(gen_func(CompileOpts, !.Core, !.LocnMap, BuiltinProcs, !.FilenameDataMap, TypeTagMap, TypeCtorTagMap, EnvStructId), DefinedFuncs, !PZ), % Finalize the module closure. verbose_output(Verbose, "Generating module closure\n", !IO), closure_finalize_data(!.ModuleClo, EnvDataId, !PZ), ExportFuncs0 = core_all_exported_functions(!.Core), % Export and mark the entrypoint. verbose_output(Verbose, "Generating entrypoint and exports\n", !IO), Candidates = core_entry_candidates(!.Core), set.fold(create_entry_candidate(!.Core, !.LocnMap, EnvDataId), Candidates, !PZ), CandidateIDs = map(entry_get_func_id, Candidates), ExportFuncs = filter( pred(Id - _::in) is semidet :- not member(Id, CandidateIDs), ExportFuncs0), % Export the other exported functions. map_foldl(create_export(!.LocnMap, EnvDataId), ExportFuncs, _, !PZ) ). :- func entry_get_func_id(core_entrypoint) = func_id. entry_get_func_id(entry_plain(FuncId)) = FuncId. entry_get_func_id(entry_argv(FuncId)) = FuncId. :- pred create_entry_candidate(core::in, val_locn_map_static::in, pzd_id::in, core_entrypoint::in, pz::in, pz::out) is det. create_entry_candidate(Core, LocnMap, EnvDataId, Entrypoint, !PZ) :- ( Entrypoint = entry_plain(EntryFuncId), Signature = pz_es_plain ; Entrypoint = entry_argv(EntryFuncId), Signature = pz_es_args ), core_get_function_det(Core, EntryFuncId, EntryFunc), create_export(LocnMap, EnvDataId, EntryFuncId - EntryFunc, EntryClo, !PZ), pz_add_entry_candidate(EntryClo, Signature, !PZ). :- pred create_export(val_locn_map_static::in, pzd_id::in, pair(func_id, function)::in, pzc_id::out, pz::in, pz::out) is det. create_export(LocnMap, ModuleDataId, FuncId - Function, ClosureId, !PZ) :- ProcId = vls_lookup_proc_id(LocnMap, FuncId), pz_new_closure_id(ClosureId, !PZ), pz_add_closure(ClosureId, pz_closure(ProcId, ModuleDataId), !PZ), pz_export_closure(ClosureId, func_get_name(Function), !PZ). %-----------------------------------------------------------------------% % Create proc and struct IDs for functions and any closure environments % they require, add these to maps and return them. % :- pred make_proc_and_struct_ids(pair(func_id, function)::in, val_locn_map_static::in, val_locn_map_static::out, closure_builder::in, closure_builder::out, pz::in, pz::out) is det. make_proc_and_struct_ids(FuncId - Function, !LocnMap, !BuildModClosure, !PZ) :- Name = q_name_to_string(func_get_name(Function)), ShouldGenerate = should_generate(Function), ( ShouldGenerate = need_codegen, assert_has_body(Function), make_proc_id_core_or_rts(FuncId, Function, !LocnMap, !BuildModClosure, !PZ) ; ShouldGenerate = need_inline_pz_and_codegen, ( if func_builtin_inline_pz(Function, PZInstrs) then vls_set_proc_instrs(FuncId, PZInstrs, !LocnMap) else unexpected($file, $pred, format( "Inline PZ builtin ('%s') without list of instructions", [s(Name)])) ), assert_has_body(Function), make_proc_id_core_or_rts(FuncId, Function, !LocnMap, !BuildModClosure, !PZ) ; ShouldGenerate = need_extern_import, assert_has_no_body(Function), make_proc_id_core_or_rts(FuncId, Function, !LocnMap, !BuildModClosure, !PZ) ; ShouldGenerate = need_extern_local, assert_has_no_body(Function), make_proc_id_foreign(FuncId, Function, !LocnMap, !BuildModClosure, !PZ) ; ShouldGenerate = dead_code ), Captured = func_get_captured_vars_types(Function), ( Captured = [] ; Captured = [_ | _], pz_new_struct_id(EnvStructId, "Closure of " ++ Name, !PZ), vls_set_closure(FuncId, EnvStructId, !LocnMap), EnvStruct = pz_struct([pzw_ptr | map(type_to_pz_width, Captured)]), pz_add_struct(EnvStructId, EnvStruct, !PZ) ). :- type generate % We need to do codegen for this function. Eg it is a function % defined in this module. ---> need_codegen % We need to map calls to this function to a sequence of pz % instructions, but also generate a body for it. Eg: it is a % builtin operator and could be called directly (replace with % instructions) or used as a higher order value (provide a % pointer). ; need_inline_pz_and_codegen % The body of this function is defined externally (eg builtin % code), and it is imported from another module: we don't need % to create a symbol for linking. ; need_extern_import % The body of this function is defined externally (eg foreign % code), but it belongs to this module and we need to tell the % linker that the definition will be provided at runtime. ; need_extern_local % No codegen or linking at all. ; dead_code. :- func should_generate(function) = generate. should_generate(Function) = Generate :- IsUsed = func_get_used(Function), ( IsUsed = used_probably, CodeType = func_get_code_type(Function), ( CodeType = ct_foreign, Generate = need_extern_local ; CodeType = ct_builtin(BuiltinType), ( BuiltinType = bit_core, Generate = need_codegen ; BuiltinType = bit_inline_pz, % Everything with inline PZ also gets codegen. TODO we % should check if address is taken to skip that most of the % time. Generate = need_inline_pz_and_codegen ; BuiltinType = bit_rts, Generate = need_extern_import ) ; CodeType = ct_plasma, Imported = func_get_imported(Function), ( Imported = i_local, Generate = need_codegen ; Imported = i_imported, Generate = need_extern_import ) ) ; IsUsed = unused, Generate = dead_code ). :- pred assert_has_body(function::in) is det. assert_has_body(Function) :- ( if func_get_body(Function, _, _, _, _) then true else Name = q_name_to_string(func_get_name(Function)), unexpected($file, $pred, format("Function ('%s') has no body", [s(Name)])) ). :- pred assert_has_no_body(function::in) is det. assert_has_no_body(Function) :- ( if not func_builtin_inline_pz(Function, _), not func_get_body(Function, _, _, _, _) then true else Name = q_name_to_string(func_get_name(Function)), unexpected($file, $pred, format("Function ('%s') doesn't have a body", [s(Name)])) ). :- pred make_proc_id_core_or_rts(func_id::in, function::in, val_locn_map_static::in, val_locn_map_static::out, closure_builder::in, closure_builder::out, pz::in, pz::out) is det. make_proc_id_core_or_rts(FuncId, Function, !LocnMap, !BuildModClosure, !PZ) :- ( if func_get_body(Function, _, _, _, _) then pz_new_proc_id(ProcId, !PZ), vls_set_proc(FuncId, ProcId, !LocnMap) else pz_new_import(ImportId, pz_import(func_get_name(Function), pzit_import), !PZ), closure_add_field(pzv_import(ImportId), FieldNum, !BuildModClosure), vls_set_proc_imported(FuncId, ImportId, FieldNum, !LocnMap) ). :- pred make_proc_id_foreign(func_id::in, function::in, val_locn_map_static::in, val_locn_map_static::out, closure_builder::in, closure_builder::out, pz::in, pz::out) is det. make_proc_id_foreign(FuncId, Function, !LocnMap, !BuildModClosure, !PZ) :- pz_new_import(ImportId, pz_import(func_get_name(Function), pzit_foreign), !PZ), closure_add_field(pzv_import(ImportId), FieldNum, !BuildModClosure), vls_set_proc_imported(FuncId, ImportId, FieldNum, !LocnMap). %-----------------------------------------------------------------------% bool_width = data.bool_width. %-----------------------------------------------------------------------% %-----------------------------------------------------------------------% ================================================ FILE: src/dump_stage.m ================================================ %-----------------------------------------------------------------------% % Dump stages utility % vim: ts=4 sw=4 et % % Copyright (C) Plasma Team % Distributed under the terms of the MIT License see ../LICENSE.code % % A utility predicate to dump intermediate compiler stages. % %-----------------------------------------------------------------------% :- module dump_stage. %-----------------------------------------------------------------------% :- interface. :- import_module cord. :- import_module io. :- import_module options. :- import_module q_name. %-----------------------------------------------------------------------% :- pred maybe_dump_stage(general_options, q_name, string, func(D) = cord(string), D, io, io). :- mode maybe_dump_stage(in, in, in, func(in) = (out) is det, in, di, uo) is det. %-----------------------------------------------------------------------% %-----------------------------------------------------------------------% :- implementation. :- import_module list. :- import_module string. %-----------------------------------------------------------------------% maybe_dump_stage(GeneralOpts, ModuleName, Stage, Format, Data, !IO) :- DumpStages = GeneralOpts ^ go_dump_stages, ( DumpStages = dump_stages, dump_stage(GeneralOpts, Stage, ModuleName, append_list(list(Format(Data))), !IO) ; DumpStages = dont_dump_stages ). :- pred dump_stage(general_options::in, string::in, q_name::in, string::in, io::di, io::uo) is det. dump_stage(GeneralOpts, Name, ModuleName, Dump, !IO) :- Filename = format("%s/%s.plasma-dump_%s", [s(GeneralOpts ^ go_dir), s(q_name_to_string(ModuleName)), s(Name)]), io.open_output(Filename, OpenRes, !IO), ( OpenRes = ok(Stream), io.write_string(Stream, Dump, !IO), io.close_output(Stream, !IO) ; OpenRes = error(Error), format(io.stderr_stream, "%s: %s\n", [s(Filename), s(error_message(Error))], !IO), io.set_exit_status(1, !IO) ). %-----------------------------------------------------------------------% %-----------------------------------------------------------------------% ================================================ FILE: src/file_utils.m ================================================ %-----------------------------------------------------------------------% % vim: ts=4 sw=4 et %-----------------------------------------------------------------------% :- module file_utils. % % Copyright (C) Plasma Team % Distributed under the terms of the MIT License see ../LICENSE.code % % File handling utils specific to Plasma. These are general for the % different compiler tools but not general enough to go into the utils % package. % %-----------------------------------------------------------------------% :- interface. :- import_module io. :- import_module string. :- import_module q_name. %-----------------------------------------------------------------------% :- type dir_info. :- func init = dir_info. %-----------------------------------------------------------------------% :- type find_file_result ---> yes(string) ; no ; error( e_path :: string, e_error :: string ). % find_module_file(Path, Extension, ModuleName, Result, !DirInfo). % % Find the interface on the disk. For now we look in one directory % only, later we'll implement include paths. % :- pred find_module_file(string::in, string::in, q_name::in, find_file_result::out, dir_info::in, dir_info::out, io::di, io::uo) is det. %-----------------------------------------------------------------------% % Normalises case and strips - _ and . % :- func strip_file_name_punctuation(string) = string. %-----------------------------------------------------------------------% % Return a canonical file name without an extension for the Plasma % module name. % :- func canonical_base_name(q_name) = string. %-----------------------------------------------------------------------% %-----------------------------------------------------------------------% :- implementation. :- import_module char. :- import_module list. :- import_module maybe. :- import_module require. :- import_module constant. :- import_module util. :- import_module util.my_exception. :- import_module util.my_io. :- import_module util.path. %-----------------------------------------------------------------------% :- type dir_info == maybe(list(string)). init = no. %-----------------------------------------------------------------------% find_module_file(Path, Extension, ModuleName, Result, no, DirInfo, !IO) :- get_dir_list(Path, MaybeDirList, !IO), ( MaybeDirList = ok(DirInfo0), find_module_file(Path, Extension, ModuleName, Result, yes(DirInfo0), DirInfo, !IO) ; MaybeDirList = error(DirError), DirInfo = no, Result = error(Path, DirError) ). find_module_file(_, Extension, ModuleName, Result, yes(DirInfo), yes(DirInfo), !IO) :- filter(matching_module_file(ModuleName, Extension), DirInfo, Matches), ( Matches = [], Result = no ; Matches = [FileName], Result = yes(FileName) ; Matches = [_, _ | _], unexpected($file, $pred, "Ambigious files found") ). :- pred matching_module_file(q_name::in, string::in, string::in) is semidet. matching_module_file(ModuleName, Extension, FileName) :- filename_extension(Extension, FileName, FileNameBase), strip_file_name_punctuation(q_name_to_string(ModuleName)) = strip_file_name_punctuation(FileNameBase). %-----------------------------------------------------------------------% strip_file_name_punctuation(Input) = strip_file_name_punctuation(skip_char, Input). :- func strip_file_name_punctuation(pred(char), string) = string. :- mode strip_file_name_punctuation(pred(in) is semidet, in) = out is det. strip_file_name_punctuation(IsPunct, Input) = Output :- to_char_list(Input, InputList), filter_map((pred(C0::in, C::out) is semidet :- ( if IsPunct(C0) then false % Strip character else C = to_lower(C0) ) ), InputList, OutputList), from_char_list(OutputList, Output). :- pred skip_char(char::in) is semidet. skip_char('_'). skip_char('-'). skip_char('.'). %-----------------------------------------------------------------------% % This should work on all our filesystems, but by defining it in one place % we could modify it if we needed to. canonical_base_name(Name) = q_name_to_string(Name). %-----------------------------------------------------------------------% %-----------------------------------------------------------------------% ================================================ FILE: src/foreign.m ================================================ %-----------------------------------------------------------------------% % Plasma foreign stub generation % vim: ts=4 sw=4 et % % Copyright (C) Plasma Team % Distributed under the terms of the MIT License see ../LICENSE.code % % This module includes code for generating the code that registers foreign % code with the runtime system. % %-----------------------------------------------------------------------% :- module foreign. %-----------------------------------------------------------------------% :- interface. :- import_module io. :- import_module ast. :- import_module compile_error. :- import_module options. :- import_module util. :- import_module util.result. %-----------------------------------------------------------------------% :- type foreign_info. :- func make_foreign(ast) = result(foreign_info, compile_error). :- pred write_foreign(general_options::in, string::in, foreign_info::in, io::di, io::uo) is det. %-----------------------------------------------------------------------% %-----------------------------------------------------------------------% :- implementation. :- import_module cord. :- import_module list. :- import_module maybe. :- import_module string. :- import_module compile. :- import_module q_name. :- import_module util.mercury. :- import_module util.my_exception. :- import_module util.my_io. %-----------------------------------------------------------------------% :- type foreign_info ---> foreign_info( fi_module_name :: q_name, fi_includes :: list(foreign_include), fi_funcs :: list(foreign_func) ). %-----------------------------------------------------------------------% make_foreign(PlasmaAst) = MaybeForeignInfo :- MaybeIncludes = find_foreign_includes(PlasmaAst), Funcs = find_foreign_funcs(PlasmaAst), ( MaybeIncludes = ok(Includes), MaybeForeignInfo = ok(foreign_info(PlasmaAst ^ a_module_name, Includes, Funcs)) ; MaybeIncludes = errors(Errors), MaybeForeignInfo = errors(Errors) ). %-----------------------------------------------------------------------% write_foreign(GeneralOpts, OutputHeader, ForeignInfo, !IO) :- WriteOutput = GeneralOpts ^ go_write_output, ( WriteOutput = write_output, OutputFile = GeneralOpts ^ go_output_file, write_foreign_hooks(OutputFile, OutputHeader, ForeignInfo ^ fi_module_name, ForeignInfo ^ fi_includes, ForeignInfo ^ fi_funcs, Result, !IO), ( Result = ok ; Result = error(ErrMsg), exit_error(ErrMsg, !IO) ) ; WriteOutput = dont_write_output ). %-----------------------------------------------------------------------% :- type foreign_include ---> foreign_include(string). :- func find_foreign_includes(ast) = result(list(foreign_include), compile_error). find_foreign_includes(Ast) = MaybeForeignIncludes :- Ast = ast(_, _, Entries), filter_entries(Entries, _, _, _, _, Pragmas), foldl_result(find_foreign_include_pragma, Pragmas, [], MaybeForeignIncludes0), MaybeForeignIncludes = result_map(reverse, MaybeForeignIncludes0). :- pred find_foreign_include_pragma(ast_pragma::in, list(foreign_include)::in, result(list(foreign_include), compile_error)::out) is det. find_foreign_include_pragma(ast_pragma(Name, Args, Context), Includes0, MaybeIncludes) :- ( if Name = "foreign_include" then ( if Args = [ast_pragma_arg(String)] then Include = foreign_include(String), MaybeIncludes = ok([Include | Includes0]) else MaybeIncludes = return_error(Context, ce_pragma_bad_argument) ) else MaybeIncludes = ok(Includes0) ). %-----------------------------------------------------------------------% :- type foreign_func ---> foreign_func( ff_plasma_name :: nq_name, ff_foreign_name :: string ). :- func find_foreign_funcs(ast) = list(foreign_func). find_foreign_funcs(Ast) = ForeignFuncs :- Ast = ast(_, _, Entries), filter_entries(Entries, _, _, _, Funcs, _), filter_map( (pred(nq_named(Name, Func)::in, ForeignFunc::out) is semidet :- Body = Func ^ af_body, Body = ast_body_foreign(ForeignSym), ForeignFunc = foreign_func(Name, ForeignSym) ), Funcs, ForeignFuncs). %-----------------------------------------------------------------------% :- pred write_foreign_hooks(string::in, string::in, q_name::in, list(foreign_include)::in, list(foreign_func)::in, maybe_error::out, io::di, io::uo) is det. write_foreign_hooks(FilenameCode, FilenameHeader, ModuleName, ForeignIncludes, ForeignFuncs, Result, !IO) :- write_temp(open_output, close_output, write_foreign_hooks_code(ModuleName, ForeignIncludes, ForeignFuncs), FilenameCode, ResultCode, !IO), write_temp(open_output, close_output, write_foreign_hooks_header(ModuleName), FilenameHeader, ResultHeader, !IO), move_temps_if_successful([ResultCode, ResultHeader], Result, !IO). :- pred write_foreign_hooks_code(q_name::in, list(foreign_include)::in, list(foreign_func)::in, output_stream::in, maybe_error::out, io::di, io::uo) is det. write_foreign_hooks_code(ModuleName, ForeignIncludes, ForeignFuncs, File, ok, !IO) :- format(File, "// Foreign hooks for %s\n\n", [s(q_name_to_string(ModuleName))], !IO), % XXX Fix include path. write_string(File, "#include \"../../../runtime/pz_common.h\"\n", !IO), write_string(File, "#include \"../../../runtime/pz_foreign.h\"\n", !IO), write_string(File, "#include \"../../../runtime/pz_generic_run.h\"\n\n", !IO), foldl(write_include(File), ForeignIncludes, !IO), nl(File, !IO), write_string(File, "using namespace pz;\n\n", !IO), format(File, "bool pz_init_foreign_code_%s(void *f_, void *gc_) {\n", [s(q_name_clobber(ModuleName))], !IO), write_string(File, " GCTracer &gc = *reinterpret_cast(gc_);\n", !IO), write_string(File, " Foreign *f = reinterpret_cast(f_);\n", !IO), foldl(write_register_foreign_func(File, ModuleName), ForeignFuncs, !IO), write_string(File, " return true;\n", !IO), write_string(File, "}\n", !IO). :- pred write_foreign_hooks_header(q_name::in, output_stream::in, maybe_error::out, io::di, io::uo) is det. write_foreign_hooks_header(ModuleName, File, ok, !IO) :- format(File, "// Foreign hooks for %s\n\n", [s(q_name_to_string(ModuleName))], !IO), format(File, "bool pz_init_foreign_code_%s(void *f, void *gc);\n", [s(q_name_clobber(ModuleName))], !IO), nl(File, !IO). :- pred write_include(output_stream::in, foreign_include::in, io::di, io::uo) is det. write_include(File, foreign_include(Path), !IO) :- io.format(File, "#include \"../%s\"\n", [s(Path)], !IO). :- pred write_register_foreign_func(output_stream::in, q_name::in, foreign_func::in, io::di, io::uo) is det. write_register_foreign_func(File, ModuleName, foreign_func(FuncName, ForeignSym), !IO) :- format(File, " if (!f->register_foreign_code(String(\"%s\"), String(\"%s\"), %s, gc)) {\n", [s(q_name_to_string(ModuleName)), s(nq_name_to_string(FuncName)), s(ForeignSym)], !IO), write_string(File, " return false;\n", !IO), write_string(File, " }\n", !IO). %-----------------------------------------------------------------------% %-----------------------------------------------------------------------% ================================================ FILE: src/lex.automata.m ================================================ %-----------------------------------------------------------------------------% % vim: ts=4 sw=4 et tw=0 wm=0 ff=unix %-----------------------------------------------------------------------------% % lex.automata.m % Copyright (C) 2001 Ralph Becket % Copyright (C) 2002, 2010 The University of Melbourne % % This file may only be copied under the terms of the GNU Library General % Public License - see the file COPYING.LIB in the Mercury distribution. % % Fri Aug 18 15:48:09 BST 2000 % % Basic types and insts etc. for DFAs and NFAs over chars. % % THIS FILE IS HEREBY CONTRIBUTED TO THE MERCURY PROJECT TO % BE RELEASED UNDER WHATEVER LICENCE IS DEEMED APPROPRIATE % BY THE ADMINISTRATORS OF THE MERCURY PROJECT. % %-----------------------------------------------------------------------------% :- module lex.automata. :- interface. :- import_module list. :- import_module set. %-----------------------------------------------------------------------------% % States are labelled with non-negative integers. % :- type state_no == int. :- type state_mc ---> state_mc( smc_start_state :: state_no, smc_stop_states :: set(state_no), smc_state_transitions :: list(transition) ). :- inst null_transition_free_state_mc == bound(state_mc(ground, ground, atom_transitions)). :- type transitions == list(transition). :- inst atom_transitions == list_skel(atom_transition). :- inst null_transitions == list_skel(null_transition). :- type transition ---> null(state_no, state_no) ; trans(state_no, charset, state_no). :- inst atom_transition == bound(trans(ground, ground, ground)). :- inst null_transition == bound(null(ground, ground)). %-----------------------------------------------------------------------------% :- end_module lex.automata. %-----------------------------------------------------------------------------% ================================================ FILE: src/lex.buf.m ================================================ %-----------------------------------------------------------------------------% % vim: ts=4 sw=4 et tw=0 wm=0 ff=unix %-----------------------------------------------------------------------------% % lex.buf.m % Copyright (C) 2001 Ralph Becket % Copyright (C) 2002, 2010 The University of Melbourne % % This file may only be copied under the terms of the GNU Library General % Public License - see the file COPYING.LIB in the Mercury distribution. % % Sat Aug 19 16:56:30 BST 2000 % % This module implements the rolling char buffer. The char % buffer is optimised for efficiency. % % The buffer stores chars read from an input source (e.g. IO % or string). Because the lexer can want to `unread' chars % (when a long candidate lexeme fails), the buffer may % contain `read ahead' chars. The structure of the buffer % is as follows: % % buf[0] buf[len] % | len = end - start | % v v % +---------------------------------------------------+ % |.|.|.|.|.|a|b|c|d|e|f|g|h|i|j|k|l| | | | | | | | | | % +---------------------------------------------------+ % ^ ^ ^ ^ ^ % | | | | | % origin start cursor end terminus % % origin, start etc. are all recorded in terms of offsets % (number of chars) from the start of the input stream, % counting the first char read as being at offset 1. Hence, % the char at the cursor is at buf[cursor - origin]. % % READING CHARS % % * In the diagram, `g' is the next char that will be read. % % Thu cursor marks the point of the next char to be read in. % % If the cursor advances to the end, then a new char is read % from the input and inserted into the buffer at the end and % the end marker is incremented. % % If the end marker advances to the terminus, then the % buffer is extended and the terminus adjusted % appropriately. The buffer may take this opportunity to % garbage collect the inaccessible chars between the origin % and the start marker. % % EOF % % * In the diagram, if EOF had been detected then the end % marker would give the offset at which it occurred. % % When EOF is read from the input stream, a special eof flag % is set (and the end marker, of course, will give its offset). % Any attempt to read at or past this point will cause the % buffer to return the EOF signal. % % REWINDING % % * In the diagram, the cursor may be rewound to any point % between the start marker and itself, inclusive. % % At any point, the cursor may be reset to any point between % itself and the start marker inclusive. % % % At any point, the user may ask for the offset of the cursor. % % STRING EXTRACTION % % * In the diagram, the string read in so far is "abcdef". % % The buffer provides a facility to return the substring % consisting of the chars between the start marker and up % to, but not including, that under the cursor. % % COMMITS % % * In the diagram, a commit will move the start marker to % be the same as the cursor. % % The user can issue a commit order to the buffer which % moves the start pointer to where the cursor is, preventing % rewinds back past this point. This is important since it % means that the region prior to the cursor in the buffer is % now available for garbage collection. % %-----------------------------------------------------------------------------% :- module lex.buf. :- interface. :- import_module array. :- import_module bool. :- import_module char. :- import_module string. %-----------------------------------------------------------------------------% % XXX We need a char and/or byte array datatype; % array(char) uses one word for each char, which is % rather wasteful. % :- type buf == array(char). % T is the type of the input source (typically io.state or string); % the user must initialise the buffer by specifying an appropriate % read predicate. % :- type buf_state(T) ---> buf_state( buf_origin :: offset, buf_start :: offset, buf_cursor :: offset, buf_end :: offset, buf_terminus :: offset, buf_eof_seen :: bool, % If `yes' then buf_end % has the offset buf_read_pred :: read_pred(T) ). :- inst buf_state == bound(buf_state(ground, ground, ground, ground, ground, ground, read_pred)). % Returns an empty buffer and an initialised buf_state. % :- pred init(read_pred(T), buf_state(T), buf). :- mode init(in(read_pred), out(buf_state), array_uo) is det. % Reads the next char and advances the cursor. Updates the % buf_state, the buf and the input. % :- pred read(read_result, buf_state(T), buf_state(T), buf, buf, T, T). :- mode read(out, in(buf_state), out(buf_state), array_di, array_uo, di, uo) is det. % Returns the offset of the start marker. % :- func start_offset(buf_state(T)) = offset. :- mode start_offset(in(buf_state)) = out is det. % Returns the offset of the cursor. % :- func cursor_offset(buf_state(T)) = offset. :- mode cursor_offset(in(buf_state)) = out is det. % Rewinds the buffer. An exception is raised if the offset provided % is not legitimate. % :- func rewind_cursor(offset, buf_state(T)) = buf_state(T). :- mode rewind_cursor(in, in(buf_state)) = out(buf_state) is det. % Extracts the string of chars between the start and cursor. % :- func string_to_cursor(buf_state(T), buf) = string. :- mode string_to_cursor(in(buf_state), array_ui) = out is det. % Advances the start marker to the cursor. Rewinds past the % cursor will therefore no longer be possible. % :- func commit(buf_state(T)) = buf_state(T). :- mode commit(in(buf_state)) = out(buf_state) is det. %-----------------------------------------------------------------------------% %-----------------------------------------------------------------------------% :- implementation. :- import_module exception. % The amount the buffer is grown by if (a) more space is % required and (b) the available space is smaller than % this amount. % :- func low_water_mark = int. low_water_mark = 256. :- func initial_buf_size = int. initial_buf_size = 1024. % XXX Debugging values. % % % :- func low_water_mark = int. % low_water_mark = 16. % % :- func initial_buf_size = int. % initial_buf_size = 32. %-----------------------------------------------------------------------------% init(BufReadPred, BufState, Buf) :- BufState = buf_state(0, 0, 0, 0, initial_buf_size, no, BufReadPred), Buf = array.init(initial_buf_size, ('@')). %-----------------------------------------------------------------------------% read(Result, BufState0, BufState, Buf0, Buf, Src0, Src) :- Origin = BufState0 ^ buf_origin, Start = BufState0 ^ buf_start, Cursor = BufState0 ^ buf_cursor, End = BufState0 ^ buf_end, Terminus = BufState0 ^ buf_terminus, EOFSeen = BufState0 ^ buf_eof_seen, ReadP = BufState0 ^ buf_read_pred, ( if Cursor < End then Result = ok(array.lookup(Buf0, Cursor - Origin)), BufState = ( BufState0 ^ buf_cursor := Cursor + 1 ), Buf = Buf0, Src = Src0 else /* Cursor = End */ if EOFSeen = yes then Result = eof, BufState = BufState0, Buf = Buf0, Src = Src0 else if End < Terminus then ReadP(Cursor, Result, Src0, Src), ( if Result = ok(Char) then Buf = array.set(Buf0, End - Origin, Char), BufState = (( BufState0 ^ buf_cursor := Cursor + 1 ) ^ buf_end := End + 1 ) else Buf = Buf0, BufState = BufState0 ) else /* Need to GC and/or extend the buffer */ GarbageLength = Start - Origin, adjust_buf(GarbageLength, ExtraLength, Buf0, Buf1), NewOrigin = Origin + GarbageLength, NewTerminus = Terminus + GarbageLength + ExtraLength, BufState1 = (( BufState0 ^ buf_origin := NewOrigin ) ^ buf_terminus := NewTerminus ), read(Result, BufState1, BufState, Buf1, Buf, Src0, Src) ). %-----------------------------------------------------------------------------% % Garbage collects the chars between the origin and start and % extends the buffer if the remaining space is below the low % water mark. % :- pred adjust_buf(int, int, buf, buf). :- mode adjust_buf(in, out, array_di, array_uo) is det. adjust_buf(GarbageLength, ExtraLength, Buf0, Buf) :- Size0 = array.size(Buf0), ( if GarbageLength < low_water_mark then /* We need to grow the buffer */ array.init(Size0 + low_water_mark, ('@'), Buf1), ExtraLength = low_water_mark else Buf1 = Buf0, ExtraLength = 0 ), Buf = shift_buf(0, Size0 - GarbageLength, GarbageLength, Buf0, Buf1). %-----------------------------------------------------------------------------% :- func shift_buf(int, int, int, buf, buf) = buf. :- mode shift_buf(in, in, in, array_ui, array_di) = array_uo is det. shift_buf(I, Hi, Disp, Src, Tgt) = ( if I < Hi then shift_buf(I + 1, Hi, Disp, Src, array.set(Tgt, I, array.lookup(Src, I + Disp))) else Tgt ). %-----------------------------------------------------------------------------% start_offset(BufState) = BufState ^ buf_start. %-----------------------------------------------------------------------------% cursor_offset(BufState) = BufState ^ buf_cursor. %-----------------------------------------------------------------------------% rewind_cursor(Offset, BufState) = ( if ( Offset < BufState ^ buf_start ; BufState ^ buf_cursor < Offset ) then throw("buf: rewind/2: offset arg outside valid range") else BufState ^ buf_cursor := Offset ). %-----------------------------------------------------------------------------% string_to_cursor(BufState, Buf) = String :- From = BufState ^ buf_start - BufState ^ buf_origin, Length = (BufState ^ buf_cursor - 1 - BufState ^ buf_start), To = From + Length, String = string.from_char_list(array.fetch_items(Buf, From, To)). %-----------------------------------------------------------------------------% commit(BufState) = ( BufState ^ buf_start := BufState ^ buf_cursor ). %-----------------------------------------------------------------------------% :- end_module lex.buf. %-----------------------------------------------------------------------------% ================================================ FILE: src/lex.convert_NFA_to_DFA.m ================================================ %---------------------------------------------------------------------------- % vim: ts=4 sw=4 et tw=0 wm=0 ff=unix %---------------------------------------------------------------------------- % % lex.convert_NFA_to_DFA.m % Copyright (C) 2001 Ralph Becket % Copyright (C) 2002, 2010 The University of Melbourne % Copyright (C) 2020 Plasma Team % % This file may only be copied under the terms of the GNU Library General % Public License - see the file COPYING.LIB in the Mercury distribution. % % Fri Aug 18 12:30:25 BST 2000 % % Powerset construction used to transform NFAs into DFAs. % %-----------------------------------------------------------------------------% :- module lex.convert_NFA_to_DFA. :- interface. :- import_module lex.automata. :- func convert_NFA_to_DFA(state_mc) = state_mc. :- mode convert_NFA_to_DFA(in(null_transition_free_state_mc)) = out(null_transition_free_state_mc) is det. %-----------------------------------------------------------------------------% %-----------------------------------------------------------------------------% :- implementation. :- import_module char. :- import_module counter. :- import_module int. :- import_module list. :- import_module map. :- import_module set. :- import_module sparse_bitset. %-----------------------------------------------------------------------------% :- type state_sets == set(state_set). :- type state_set == set(state_no). :- type state_set_transitions == list(state_set_transition). :- type state_set_transition ---> trans(state_set, charset, state_set). :- type state_set_no_map == map(state_set, int). %-----------------------------------------------------------------------------% convert_NFA_to_DFA(NFA) = NFA :- % An NFA with no transitions is probably a bug... NFA ^ smc_state_transitions = []. convert_NFA_to_DFA(NFA) = DFA :- NFA ^ smc_state_transitions = [_ | _], % Do some unpacking of the NFA. % NFAStopStates = NFA ^ smc_stop_states, NFATransitions = NFA ^ smc_state_transitions, DFAStartStateSet = set.make_singleton_set(NFA ^ smc_start_state), DFAStartStateSets = set.make_singleton_set(DFAStartStateSet), % Calculate the powerset version of the DFA from the NFA. % compute_DFA_state_sets_and_transitions( NFATransitions, DFAStartStateSets, DFAStartStateSets, DFAStateSets, [], DFAStateSetTransitions ), DFAStopStateSets = compute_DFA_stop_state_sets(NFAStopStates, DFAStateSets), % Replace the powerset state_no identifiers with numbers. % DFAStateNos = number_state_sets(DFAStateSets), map.lookup(DFAStateNos, DFAStartStateSet, DFAStartState), DFAStopStates = set.map(map.lookup(DFAStateNos), DFAStopStateSets), DFATransitions = map_state_set_transitions_to_numbers( DFAStateNos, DFAStateSetTransitions ), % Pack up the result. % DFA = state_mc(DFAStartState, DFAStopStates, DFATransitions). %-----------------------------------------------------------------------------% % If S is a state_no set, then S -c-> S' where % S' = {y | x in S, x -c-> y} % % We iterate to the least fixed point starting with the start % state_no set. % :- pred compute_DFA_state_sets_and_transitions( transitions, state_sets, state_sets, state_sets, state_set_transitions, state_set_transitions). :- mode compute_DFA_state_sets_and_transitions(in, in, in, out, in, out) is det. compute_DFA_state_sets_and_transitions(Ts, NewSs0, Ss0, Ss, STs0, STs) :- ( if set.is_empty(NewSs0) then Ss = Ss0, STs0 = STs else NewSTs = list.condense( list.map(state_set_transitions(Ts),set.to_sorted_list(NewSs0)) ), STs1 = list.append(NewSTs, STs0), TargetSs = set.list_to_set( list.map(( func(trans(_, _, S)) = S ), NewSTs) ), NewSs = TargetSs `set.difference` Ss0, Ss1 = NewSs `set.union` Ss0, compute_DFA_state_sets_and_transitions(Ts, NewSs, Ss1, Ss, STs1, STs) ). %-----------------------------------------------------------------------------% % Given a state_no set and a set of transition chars for that % state_no set, find the set of state_no set transitions (said % Peter Piper): % % state_set_transitions(S) = {S -c-> S' | x in S, S' = {y | x -c-> y}} % :- func state_set_transitions(transitions, state_set) = state_set_transitions. state_set_transitions(Ts, S) = STs :- TCs = to_sorted_list(transition_chars(Ts, S)), STs = list.map(state_set_transition(Ts, S), TCs). %-----------------------------------------------------------------------------% % Given a state_no set, find all the transition chars: % % transition_chars(S) = {c | x in S, some [y] x -c-> y} % :- func transition_chars(transitions, state_set) = charset. transition_chars(Ts, S) = Charset :- Sets = list.map(transition_chars_for_state(Ts), set.to_sorted_list(S)), Charset = union_list(Sets). %-----------------------------------------------------------------------------% :- func transition_chars_for_state(transitions, state_no) = charset. :- mode transition_chars_for_state(in, in) = out is det. transition_chars_for_state(Ts, X) = union_list(list.filter_map(transition_char_for_state(X), Ts)). %-----------------------------------------------------------------------------% :- func transition_char_for_state(state_no, transition) = charset. :- mode transition_char_for_state(in, in) = out is semidet. transition_char_for_state(X, trans(X, C, _Y)) = C. %-----------------------------------------------------------------------------% % Given a state_no set and a char, find the state_no set transition: % % state_set_transition(S, c) = S -c-> target_state_set(S, c) % :- func state_set_transition(transitions, state_set, char) = state_set_transition. state_set_transition(Ts, FromStateSet, C) = trans(FromStateSet, Charset, TargetStateSet) :- Charset = sparse_bitset.make_singleton_set(C), TargetStateSet = target_state_set(Ts, FromStateSet, C). %-----------------------------------------------------------------------------% % Given a state_no set and a char, find the target state_no set: % % target_state_set(S, c) = {y | x in S, x -c-> y} % :- func target_state_set(transitions, state_set, char) = state_set. target_state_set(Ts, S, C) = set.power_union(set.map(target_state_set_0(Ts, C), S)). %-----------------------------------------------------------------------------% :- func target_state_set_0(transitions, char, state_no) = state_set. target_state_set_0(Ts, C, X) = set.list_to_set(list.filter_map(target_state(X, C), Ts)). %-----------------------------------------------------------------------------% :- func target_state(state_no, char, transition) = state_no. :- mode target_state(in, in, in) = out is semidet. target_state(X, C, trans(X, Charset, Y)) = Y :- contains(Charset, C). %-----------------------------------------------------------------------------% :- func compute_DFA_stop_state_sets(state_set, state_sets) = state_sets. compute_DFA_stop_state_sets(StopStates, StateSets) = set.filter_map(stop_state_set(StopStates), StateSets). %-----------------------------------------------------------------------------% :- func stop_state_set(state_set, state_set) = state_set. :- mode stop_state_set(in, in) = out is semidet. stop_state_set(StopStates, StateSet) = StateSet :- not set.is_empty(StopStates `set.intersect` StateSet). %-----------------------------------------------------------------------------% :- func number_state_sets(state_sets) = state_set_no_map. number_state_sets(Ss) = StateNos :- list.foldl2( ( pred(S::in, N::in, (N + 1)::out, Map0::in, Map::out) is det :- Map = map.set(Map0, S, N) ), set.to_sorted_list(Ss), 0, _, map.init, StateNos ). %-----------------------------------------------------------------------------% :- func map_state_set_transitions_to_numbers(state_set_no_map::in, state_set_transitions::in) = (transitions::out(atom_transitions)). map_state_set_transitions_to_numbers(_Map, []) = []. map_state_set_transitions_to_numbers(Map, [ST | STs]) = [T | Ts] :- Ts = map_state_set_transitions_to_numbers(Map, STs), ST = trans(SX, C, SY), X = map.lookup(Map, SX), Y = map.lookup(Map, SY), T = trans(X, C ,Y). %-----------------------------------------------------------------------------% :- end_module lex.convert_NFA_to_DFA. %-----------------------------------------------------------------------------% ================================================ FILE: src/lex.lexeme.m ================================================ %---------------------------------------------------------------------------- % vim: ts=4 sw=4 et tw=0 wm=0 ff=unix % % % lex.lexeme.m % Sat Aug 19 08:22:32 BST 2000 % Copyright (C) 2001 Ralph Becket % Copyright (C) 2001 The Rationalizer Intelligent Software AG % The changes made by Rationalizer are contributed under the terms % of the GNU Lesser General Public License, see the file COPYING.LGPL % in this directory. % Copyright (C) 2002, 2010-2011 The University of Melbourne % % This file may only be copied under the terms of the GNU Library General % Public License - see the file COPYING.LIB in the Mercury distribution. % % A lexeme combines a token with a regexp. The lexer compiles % lexemes and returns the longest successful parse in the input % stream or an error if no match occurs. % %-----------------------------------------------------------------------------% :- module lex.lexeme. :- interface. :- import_module array. :- import_module bool. :- import_module bitmap. :- import_module char. %-----------------------------------------------------------------------------% :- type compiled_lexeme(T) ---> compiled_lexeme( token :: token_creator(T), state :: state_no, transition_map :: transition_map ). :- inst compiled_lexeme ---> compiled_lexeme(token_creator, ground, ground). :- type transition_map ---> transition_map( accepting_states :: bitmap, rows :: array(row) ). % A transition row is an array of packed_transitions. % :- type row == array(packed_transition). % A packed_transition combines a target state_no % and the transition char codepoint for which the % transition is valid. % :- type packed_transition ---> packed_transition(btr_state :: state_no, char :: char). :- type packed_transitions == list(packed_transition). :- func compile_lexeme(lexeme(T)) = compiled_lexeme(T). % next_state(CLXM, CurrentState, Char, NextState, IsAccepting) % succeeds iff there is a transition in CLXM from CurrentState % to NextState via Char; IsAccepting is `yes' iff NextState is % an accepting state_no. % :- pred next_state(compiled_lexeme(T), state_no, char, state_no, bool). :- mode next_state(in(compiled_lexeme), in, in, out, out) is semidet. % Succeeds iff a compiled_lexeme is in an accepting state_no. % :- pred in_accepting_state(compiled_lexeme(T)). :- mode in_accepting_state(in(compiled_lexeme)) is semidet. %-----------------------------------------------------------------------------% %-----------------------------------------------------------------------------% :- implementation. :- import_module lex.automata. :- import_module lex.regexp. :- import_module lex.convert_NFA_to_DFA. :- import_module list. :- import_module set. %-----------------------------------------------------------------------------% compile_lexeme(Lexeme) = CompiledLexeme :- Lexeme = (RegExp - TokenCreator), NFA = remove_null_transitions(regexp_to_NFA(RegExp)), DFA = convert_NFA_to_DFA(NFA), StartState = DFA ^ smc_start_state, StopStates = DFA ^ smc_stop_states, Transitions = DFA ^ smc_state_transitions, N = 1 + find_top_state(Transitions), Accepting = set_accepting_states(StopStates, bitmap.init(N, no)), Rows = array(set_up_rows(0, N, Transitions)), TransitionMap = transition_map(Accepting, Rows), CompiledLexeme = compiled_lexeme(TokenCreator, StartState, TransitionMap). %-----------------------------------------------------------------------------% :- func find_top_state(transitions) = int. :- mode find_top_state(in(atom_transitions)) = out is det. find_top_state([]) = 0. find_top_state([trans(X, _, Y) | Ts]) = max(X, max(Y, find_top_state(Ts))). %-----------------------------------------------------------------------------% :- func set_accepting_states(set(state_no), bitmap) = bitmap. :- mode set_accepting_states(in, bitmap_di) = bitmap_uo is det. set_accepting_states(States, Bitmap0) = set_accepting_states_0(set.to_sorted_list(States), Bitmap0). :- func set_accepting_states_0(list(state_no), bitmap) = bitmap. :- mode set_accepting_states_0(in, bitmap_di) = bitmap_uo is det. set_accepting_states_0([], Bitmap) = Bitmap. set_accepting_states_0([St | States], Bitmap) = set_accepting_states_0(States, bitmap.set(Bitmap, St)). %-----------------------------------------------------------------------------% :- func set_up_rows(int, int, transitions) = list(row). :- mode set_up_rows(in, in, in(atom_transitions)) = out is det. set_up_rows(I, N, Transitions) = Rows :- ( if I >= N then Rows = [] else Rows = [compile_transitions_for_state(I, [], Transitions) | set_up_rows(I + 1, N, Transitions)] ). %-----------------------------------------------------------------------------% :- func compile_transitions_for_state(int, packed_transitions, transitions) = row. :- mode compile_transitions_for_state(in, in, in(atom_transitions)) = array_uo is det. compile_transitions_for_state(_, IBTs, []) = array(IBTs). compile_transitions_for_state(I, IBTs, [T | Ts]) = compile_transitions_for_state( I, ( if T = trans(I, Charset, Y) then sparse_bitset.foldl( func(Char, Tx) = [packed_transition(Y, Char) | Tx], Charset, IBTs) else IBTs ), Ts ). %-----------------------------------------------------------------------------% next_state(CLXM, CurrentState, Char, NextState, IsAccepting) :- Rows = CLXM ^ transition_map ^ rows, AcceptingStates = CLXM ^ transition_map ^ accepting_states, find_next_state(Char, Rows ^ elem(CurrentState), NextState), IsAccepting = AcceptingStates ^ bit(NextState). %-----------------------------------------------------------------------------% :- pred find_next_state(char, array(packed_transition), state_no). :- mode find_next_state(in, in, out) is semidet. find_next_state(Char, PackedTransitions, State) :- Lo = array.min(PackedTransitions), Hi = array.max(PackedTransitions), find_next_state_0(Lo, Hi, Char, PackedTransitions, State). :- pred find_next_state_0(int, int, char, array(packed_transition), state_no). :- mode find_next_state_0(in, in, in, in, out) is semidet. find_next_state_0(Lo, Hi, Char, PackedTransitions, State) :- Lo =< Hi, PackedTransition = PackedTransitions ^ elem(Lo), ( if PackedTransition ^ char = Char then State = PackedTransition ^ btr_state else find_next_state_0(Lo + 1, Hi, Char, PackedTransitions, State) ). %-----------------------------------------------------------------------------% in_accepting_state(CLXM) :- bitmap.is_set( CLXM ^ transition_map ^ accepting_states, CLXM ^ state ). %-----------------------------------------------------------------------------% :- end_module lex.lexeme. %-----------------------------------------------------------------------------% ================================================ FILE: src/lex.m ================================================ %-----------------------------------------------------------------------------% % vim: ts=4 sw=4 et tw=0 wm=0 ff=unix %-----------------------------------------------------------------------------% % % lex.m % Copyright (C) 2001-2002 Ralph Becket % Sun Aug 20 09:08:46 BST 2000 % Copyright (C) 2001-2002 The Rationalizer Intelligent Software AG % The changes made by Rationalizer are contributed under the terms % of the GNU Lesser General Public License, see the file COPYING.LGPL % in this directory. % Copyright (C) 2002, 2006, 2010-2011 The University of Melbourne % % This file may only be copied under the terms of the GNU Library General % Public License - see the file COPYING.LIB in the Mercury distribution. % % This module puts everything together, compiling a list of lexemes % into state machines and turning the input stream into a token stream. % % Note that the astral charaters (in unicode) are not included in the range % of unicode characters, as the astral planes are very sparsely assigned. % %-----------------------------------------------------------------------------% :- module lex. :- interface. :- import_module char. :- import_module io. :- import_module list. :- import_module pair. :- import_module string. :- import_module sparse_bitset. :- import_module enum. %-----------------------------------------------------------------------------% :- type token_creator(Token) == (func(string) = Token). :- inst token_creator == (func(in) = out is det). :- type lexeme(Token) == pair(regexp, token_creator(Token)). :- inst lexeme(Inst) ---> (ground - Inst). :- type lexer(Token, Source). :- type lexer_state(Token, Source). :- type offset == int. % Byte offset into the source data. % Any errors should be reported by raising an exception. % :- type read_result ---> ok(char) ; eof. % read_pred(Offset, Result, SrcIn, SrcOut) reads the char at % Offset from SrcIn and returns SrcOut. % :- type read_pred(T) == pred(offset, read_result, T, T). :- inst read_pred == ( pred(in, out, di, uo) is det ). % ignore_pred(Token): if it does not fail, Token must be ignored % :- type ignore_pred(Tok) == pred(Tok). :- inst ignore_pred == ( pred(in) is semidet ). % Represents a set of Unicode characters % :- type charset == sparse_bitset(char). % The type of regular expressions. % :- type regexp. % The typeclass for types having a natural converter to regexp's % :- typeclass regexp(T) where [ func re(T) = regexp ]. % Handling regexp's based on the typeclass regexp(T) % :- func null = regexp. :- func T1 ++ T2 = regexp <= (regexp(T1), regexp(T2)). :- func *(T) = regexp <= (regexp(T)). % One of the following two functions may be deprecated % in future, depending upon whether there's a concensus % concerning which is preferable. Both express % alternation. % :- func T1 \/ T2 = regexp <= (regexp(T1), regexp(T2)). :- func (T1 or T2) = regexp <= (regexp(T1), regexp(T2)). % Some instances of typeclass regexp(T) % :- instance regexp(regexp). :- instance regexp(char). :- instance regexp(string). :- instance regexp(sparse_bitset(T)) <= (regexp(T),enum(T)). % Some basic non-primitive regexps. % :- func any(string) = regexp. % any("abc") = ('a') or ('b') or ('c') :- func anybut(string) = regexp. % anybut("abc") is complement of any("abc") :- func ?(T) = regexp <= regexp(T). % ?(R) = R or null :- func +(T) = regexp <= regexp(T). % +(R) = R ++ *(R) :- func range(char, char) = regexp. % range('a', 'z') = any("ab...xyz") :- func (T * int) = regexp <= regexp(T). % R * N = R ++ ... ++ R % Some useful single-char regexps. % :- func digit = regexp. % digit = any("0123456789") :- func lower = regexp. % lower = any("abc...z") :- func upper = regexp. % upper = any("ABC...Z") :- func alpha = regexp. % alpha = lower or upper :- func alphanum = regexp. % alphanum = alpha or digit :- func identstart = regexp. % identstart = alpha or "_" :- func ident = regexp. % ident = alphanum or "_" :- func tab = regexp. % tab = re("\t") :- func spc = regexp. % spc = re(" ") :- func wspc = regexp. % wspc = any(" \t\n\r\f\v") :- func dot = regexp. % dot = anybut("\r\n") % Some useful compound regexps. % :- func nl = regexp. % nl = ?("\r") ++ re("\n") :- func nat = regexp. % nat = +(digit) :- func signed_int = regexp. % signed_int = ?("+" or "-") ++ nat :- func real = regexp. % real = \d+((.\d+([eE]int)?)|[eE]int) :- func identifier = regexp. % identifier = identstart ++ *(ident) :- func whitespace = regexp. % whitespace = +(wspc) :- func junk = regexp. % junk = +(dot) % A range of charicters, inclusive of both the first and last values. % :- type char_range ---> char_range( cr_first :: int, cr_last :: int ). % charset(Start, End) = charset(Start `..` End) % % Throws an exception if Start > End. % :- func charset(int, int) = charset. % Function to create a sparse bitset from a range of Unicode % codepoints. These codepoints are checked for validity, any invalid % codepoints are ignored. Throws an exception if cr_first value is less % than cr_last. % :- func charset(char_range) = charset. % Creates a union of all char ranges in the list. Returns the empty % set if the list is empty. Any invalid codepoints are ignored. % :- func charset_from_ranges(list(char_range)) = charset. % Latin is comprised of the following Unicode blocks: % * Basic Latin % * Latin1 Supplement % * Latin Extended-A % * Latin Extended-B % :- func latin_chars = charset is det. % Utility predicate to create ignore_pred's. % Use it in the form `ignore(my_token)' to ignore just `my_token'. % :- pred ignore(Token::in, Token::in) is semidet. % Utility function to return noval tokens. % Use it in the form `return(my_token) inside a lexeme definition. % :- func return(T, string) = T. % Utility operator to create lexemes. % :- func (T1 -> token_creator(Tok)) = pair(regexp, token_creator(Tok)) <= regexp(T1). % Construct a lexer from which we can generate running % instances. % % NOTE: If several lexemes match the same string only % the token generated by the one closest to the start % of the list of lexemes is returned. % :- func init(list(lexeme(Tok)), read_pred(Src)) = lexer(Tok, Src). :- mode init(in, in(read_pred)) = out is det. % Construct a lexer from which we can generate running % instances. If we construct a lexer with init/4, we % can additionally ignore specific tokens. % % NOTE: If several lexemes match the same string only % the token generated by the one closest to the start % of the list of lexemes is returned. % :- func init(list(lexeme(Tok)), read_pred(Src), ignore_pred(Tok)) = lexer(Tok, Src). :- mode init(in, in(read_pred), in(ignore_pred)) = out is det. % Handy read predicates. % :- pred read_from_stdin(offset, read_result, io, io). :- mode read_from_stdin(in, out, di, uo) is det. :- pred read_from_stream(text_input_stream, offset, read_result, io, io). :- mode read_from_stream(in, in, out, di, uo) is det. :- pred read_from_string(offset, read_result, string, string). :- mode read_from_string(in, out, di, uo) is det. % Generate a running instance of a lexer on some input source. % If you want to lex strings, you must ensure they are unique % by calling either copy/1 or unsafe_promise_unique/1 on the % source string argument. % % Note that you can't get the input source back until you stop % lexing. % :- func start(lexer(Tok, Src), Src) = lexer_state(Tok, Src). :- mode start(in, di) = uo is det. % Read the next token from the input stream. % % CAVEAT: if the token returned happened to match the empty % string then you must use read_char/3 (below) to consume % the next char in the input stream before calling read/3 % again, since matching the empty string does not consume % any chars from the input stream and will otherwise mean % you simply get the same match ad infinitum. % % An alternative solution is to always include a "catch all" % lexeme that matches any unexpected char at the end of the % list of lexemes. % :- pred read(io.read_result(Tok), lexer_state(Tok, Src), lexer_state(Tok, Src)). :- mode read(out, di, uo) is det. % Calling offset_from_start/3 immediately prior to calling read/3 % will give the offset in chars from the start of the input stream % for the result returned by the read/3 operation. % :- pred offset_from_start(offset, lexer_state(Tok, Src), lexer_state(Tok, Src)). :- mode offset_from_start(out, di, uo) is det. % Stop a running instance of a lexer and retrieve the input source. % :- func stop(lexer_state(_Tok, Src)) = Src. :- mode stop(di) = uo is det. % Sometimes (e.g. when lexing the io.io) you want access to the % input stream without interrupting the lexing process. This pred % provides that sort of access. % :- pred manipulate_source(pred(Src, Src), lexer_state(Tok, Src), lexer_state(Tok, Src)). :- mode manipulate_source(pred(di, uo) is det, di, uo) is det. % This is occasionally useful. It reads the next char from the % input stream, without attempting to match it against a lexeme. % :- pred read_char(read_result, lexer_state(Tok, Src), lexer_state(Tok, Src)). :- mode read_char(out, di, uo) is det. %-----------------------------------------------------------------------------% %-----------------------------------------------------------------------------% :- implementation. :- include_module lex.automata. :- include_module lex.buf. :- include_module lex.convert_NFA_to_DFA. :- include_module lex.lexeme. :- include_module lex.regexp. :- import_module array. :- import_module bool. :- import_module exception. :- import_module maybe. :- import_module require. :- import_module int. :- import_module map. :- import_module lex.automata. :- import_module lex.buf. :- import_module lex.convert_NFA_to_DFA. :- import_module lex.lexeme. :- import_module lex.regexp. %-----------------------------------------------------------------------------% :- type lexer(Token, Source) ---> lexer( lex_compiled_lexemes :: list(live_lexeme(Token)), lex_ignore_pred :: ignore_pred(Token), lex_buf_read_pred :: read_pred(Source) ). :- inst lexer ---> lexer(ground, ignore_pred, read_pred). :- type lexer_instance(Token, Source) ---> lexer_instance( init_lexemes :: list(live_lexeme(Token)), init_winner_func :: init_winner_func(Token), live_lexemes :: list(live_lexeme(Token)), current_winner :: winner(Token), buf_state :: buf_state(Source), ignore_pred :: ignore_pred(Token) ). :- inst lexer_instance ---> lexer_instance( live_lexeme_list, init_winner_func, live_lexeme_list, winner, buf.buf_state, ignore_pred ). :- type live_lexeme(Token) == compiled_lexeme(Token). :- inst live_lexeme == compiled_lexeme. :- inst live_lexeme_list == list.list_skel(live_lexeme). :- type init_winner_func(Token) == ( func(offset) = winner(Token) ). :- inst init_winner_func == ( func(in) = out is det ). :- type winner(Token) == maybe(pair(token_creator(Token), offset)). :- inst winner ---> yes(pair(token_creator, ground)) ; no. %-----------------------------------------------------------------------------% ignore(Tok, Tok). %-----------------------------------------------------------------------------% return(Token, _) = Token. %-----------------------------------------------------------------------------% (R1 -> TC) = (re(R1) - TC). %-----------------------------------------------------------------------------% init(Lexemes, BufReadPred) = init(Lexemes, BufReadPred, DontIgnoreAnything) :- DontIgnoreAnything = ( pred(_::in) is semidet :- semidet_fail ). init(Lexemes, BufReadPred, IgnorePred) = lexer(CompiledLexemes, IgnorePred, BufReadPred) :- CompiledLexemes = list.map(compile_lexeme, Lexemes). %-----------------------------------------------------------------------------% start(Lexer0, Src) = State :- Lexer = lexer_inst_cast(Lexer0), init_lexer_instance(Lexer, Instance, Buf), State = args_lexer_state(Instance, Buf, Src). :- func lexer_inst_cast(lexer(Tok, Src)::in) = (lexer(Tok, Src)::out(lexer)) is det. :- pragma foreign_proc("C", lexer_inst_cast(Lexer0::in) = (Lexer::out(lexer)), [will_not_call_mercury, promise_pure, thread_safe], " Lexer = Lexer0; "). :- pragma foreign_proc("Java", lexer_inst_cast(Lexer0::in) = (Lexer::out(lexer)), [will_not_call_mercury, promise_pure, thread_safe], " Lexer = Lexer0; "). :- pragma foreign_proc("C#", lexer_inst_cast(Lexer0::in) = (Lexer::out(lexer)), [will_not_call_mercury, promise_pure, thread_safe], " Lexer = Lexer0; "). %-----------------------------------------------------------------------------% :- pred init_lexer_instance(lexer(Tok, Src), lexer_instance(Tok, Src), buf). :- mode init_lexer_instance(in(lexer), out(lexer_instance), array_uo) is det. init_lexer_instance(Lexer, Instance, Buf) :- buf.init(Lexer ^ lex_buf_read_pred, BufState, Buf), Start = BufState ^ start_offset, InitWinnerFunc = initial_winner_func(InitLexemes), InitLexemes = Lexer ^ lex_compiled_lexemes, InitWinner = InitWinnerFunc(Start), IgnorePred = Lexer ^ lex_ignore_pred, Instance = lexer_instance(InitLexemes, InitWinnerFunc, InitLexemes, InitWinner, BufState, IgnorePred). %-----------------------------------------------------------------------------% % Lexing may *start* with a candidate winner if one of the lexemes % accepts the empty string. We pick the first such, if any, since % that lexeme has priority. % :- func initial_winner_func(list(live_lexeme(Token))) = init_winner_func(Token). :- mode initial_winner_func(in(live_lexeme_list) ) = out(init_winner_func) is det. initial_winner_func([] ) = ( func(_) = no ). initial_winner_func( [L | Ls]) = ( if in_accepting_state(L) then ( func(Offset) = yes(L ^ token - Offset) ) else initial_winner_func(Ls) ). %----------------------------------------------------------------------------% offset_from_start(Offset, !State) :- Offset = !.State ^ run ^ buf_state ^ buf_cursor, !:State = unsafe_promise_unique(!.State). %-----------------------------------------------------------------------------% stop(State) = Src :- lexer_state_args(State, _Instance, _Buf, Src). %-----------------------------------------------------------------------------% read(Result, State0, State) :- lexer_state_args(State0, Instance0, Buf0, Src0), BufState0 = Instance0 ^ buf_state, Start = BufState0 ^ start_offset, InitWinner = ( Instance0 ^ init_winner_func )(Start), Instance1 = ( Instance0 ^ current_winner := InitWinner ), read_2(Result, Instance1, Instance, Buf0, Buf, Src0, Src), State = args_lexer_state(Instance, Buf, Src). :- pred read_2(io.read_result(Tok), lexer_instance(Tok, Src), lexer_instance(Tok, Src), buf, buf, Src, Src). :- mode read_2(out, in(lexer_instance), out(lexer_instance), array_di, array_uo, di, uo) is det. % Basically, just read chars from the buf and advance the live lexemes % until we have a winner or hit an error (no parse). % read_2(Result, !Instance, !Buf, !Src) :- BufState0 = !.Instance ^ buf_state, buf.read(BufReadResult, BufState0, BufState, !Buf, !Src), ( BufReadResult = ok(Char), process_char(Result, Char, !Instance, BufState, !Buf, !Src) ; BufReadResult = eof, process_eof(Result, !Instance, BufState, !.Buf) ). %-----------------------------------------------------------------------------% :- pred process_char(io.read_result(Tok), char, lexer_instance(Tok, Src), lexer_instance(Tok, Src), buf_state(Src), buf, buf, Src, Src). :- mode process_char(out, in, in(lexer_instance), out(lexer_instance), in(buf_state), array_di, array_uo, di, uo) is det. process_char(Result, Char, !Instance, BufState, !Buf, !Src) :- LiveLexemes0 = !.Instance ^ live_lexemes, Winner0 = !.Instance ^ current_winner, advance_live_lexemes(Char, BufState ^ cursor_offset, LiveLexemes0, LiveLexemes, Winner0, Winner), ( LiveLexemes = [], % Nothing left to consider. process_any_winner(Result, Winner, !Instance, BufState, !Buf, !Src) ; LiveLexemes = [_ | _], % Still some open possibilities. !:Instance = (((!.Instance ^ live_lexemes := LiveLexemes ) ^ current_winner := Winner ) ^ buf_state := BufState ), read_2(Result, !Instance, !Buf, !Src) ). %-----------------------------------------------------------------------------% :- pred process_any_winner(io.read_result(Tok), winner(Tok), lexer_instance(Tok, Src), lexer_instance(Tok, Src), buf_state(Src), buf, buf, Src, Src). :- mode process_any_winner(out, in(winner), in(lexer_instance), out(lexer_instance), in(buf_state), array_di, array_uo, di, uo) is det. process_any_winner(Result, yes(TokenCreator - Offset), Instance0, Instance, BufState0, Buf0, Buf, Src0, Src) :- BufState1 = rewind_cursor(Offset, BufState0), String = string_to_cursor(BufState1, Buf0), Token = TokenCreator(String), IgnorePred = Instance0 ^ ignore_pred, InitWinner = ( Instance0 ^ init_winner_func )(Offset), Instance1 = ((( Instance0 ^ live_lexemes := Instance0 ^ init_lexemes ) ^ current_winner := InitWinner ) ^ buf_state := commit(BufState1) ), ( if IgnorePred(Token) then % We have to be careful to avoid an infinite loop here. % If the longest match was the empty string, then the % next char in the input stream cannot start a match, % so it must be reported as an error. % ( if String = "" then buf.read(BufResult, BufState1, BufState, Buf0, Buf, Src0, Src), ( BufResult = ok(_), Result = error("input not matched by any regexp", Offset) ; BufResult = eof, Result = eof ), Instance = ( Instance1 ^ buf_state := commit(BufState) ) else read_2(Result, Instance1, Instance, Buf0, Buf, Src0, Src) ) else Result = ok(Token), Instance = Instance1, Buf = Buf0, Src = Src0 ). process_any_winner(Result, no, !Instance, BufState0, !Buf, !Src) :- Start = BufState0 ^ start_offset, BufState = rewind_cursor(Start + 1, BufState0), Result = error("input not matched by any regexp", Start), InitWinner = ( !.Instance ^ init_winner_func )(Start), !:Instance = ((( !.Instance ^ live_lexemes := !.Instance ^ init_lexemes ) ^ current_winner := InitWinner ) ^ buf_state := commit(BufState) ). %-----------------------------------------------------------------------------% :- pred process_eof(io.read_result(Tok), lexer_instance(Tok, Src), lexer_instance(Tok, Src), buf_state(Src), buf). :- mode process_eof(out, in(lexer_instance), out(lexer_instance), in(buf_state), array_ui) is det. process_eof(Result, !Instance, !.BufState, !.Buf) :- CurrentWinner = !.Instance ^ current_winner, ( CurrentWinner = no, Offset = !.BufState ^ cursor_offset, Result = eof ; CurrentWinner = yes(TokenCreator - Offset), String = string_to_cursor(!.BufState, !.Buf), Token = TokenCreator(String), IgnorePred = !.Instance ^ ignore_pred, Result = ( if IgnorePred(Token) then eof else ok(Token) ) ), InitWinner = ( !.Instance ^ init_winner_func )(Offset), !:Instance = ((( !.Instance ^ live_lexemes := !.Instance ^ init_lexemes ) ^ current_winner := InitWinner ) ^ buf_state := commit(!.BufState) ). %-----------------------------------------------------------------------------% % Note that in the case where two or more lexemes match the same % string, the win is given to the earliest such lexeme in the list. % This matches the behaviour of standard C lex. % :- pred advance_live_lexemes(char, offset, list(live_lexeme(Token)), list(live_lexeme(Token)), winner(Token), winner(Token)). :- mode advance_live_lexemes(in, in, in(live_lexeme_list), out(live_lexeme_list), in(winner), out(winner)) is det. advance_live_lexemes(_Char, _Offset, [], [], !Winner). advance_live_lexemes(Char, Offset, [L | Ls0], Ls, !Winner) :- State0 = L ^ state, ( if next_state(L, State0, Char, State, IsAccepting) then ( IsAccepting = no ; IsAccepting = yes, !:Winner = ( if !.Winner = yes(_ - Offset) then !.Winner else yes(L ^ token - Offset) ) ), advance_live_lexemes(Char, Offset, Ls0, Ls1, !Winner), Ls = [( L ^ state := State ) | Ls1] else advance_live_lexemes(Char, Offset, Ls0, Ls, !Winner) ). %-----------------------------------------------------------------------------% :- pred live_lexeme_in_accepting_state(list(live_lexeme(Tok)), token_creator(Tok)). :- mode live_lexeme_in_accepting_state(in(live_lexeme_list), out(token_creator)) is semidet. live_lexeme_in_accepting_state([L | Ls], Token) :- ( if in_accepting_state(L) then Token = L ^ token else live_lexeme_in_accepting_state(Ls, Token) ). %-----------------------------------------------------------------------------% %-----------------------------------------------------------------------------% % It's much more convenient (especially for integration with, e.g. % parsers such as moose) to package up the lexer_instance, buf % and Src in a single object. :- type lexer_state(Tok, Src) ---> lexer_state( run :: lexer_instance(Tok, Src), buf :: buf, src :: Src ). %-----------------------------------------------------------------------------% :- func args_lexer_state(lexer_instance(Tok, Src), buf, Src) = lexer_state(Tok, Src). :- mode args_lexer_state(in(lexer_instance), array_di, di) = uo is det. args_lexer_state(Instance, Buf, Src) = LexerState :- unsafe_promise_unique(lexer_state(Instance, Buf, Src), LexerState). %-----------------------------------------------------------------------------% :- pred lexer_state_args(lexer_state(Tok, Src), lexer_instance(Tok, Src), buf, Src). :- mode lexer_state_args(di, out(lexer_instance), array_uo, uo) is det. lexer_state_args(lexer_state(Instance, Buf0, Src0), Instance, Buf, Src) :- unsafe_promise_unique(Buf0, Buf), unsafe_promise_unique(Src0, Src). %-----------------------------------------------------------------------------% manipulate_source(P, !State) :- lexer_state_args(!.State, Instance, Buf, Src0), P(Src0, Src), !:State = args_lexer_state(Instance, Buf, Src). %----------------------------------------------------------------------------% read_char(Result, !State) :- lexer_state_args(!.State, Instance0, Buf0, Src0), BufState0 = Instance0 ^ buf_state, buf.read(Result, BufState0, BufState, Buf0, Buf, Src0, Src), Instance = ( Instance0 ^ buf_state := commit(BufState) ), !:State = args_lexer_state(Instance, Buf, Src). %-----------------------------------------------------------------------------% read_from_stdin(_Offset, Result) --> io.read_char(IOResult), { IOResult = ok(Char), Result = ok(Char) ; IOResult = eof, Result = eof ; IOResult = error(_E), throw(IOResult) }. read_from_stream(Stream, _Offset, Result) --> io.read_char(Stream, IOResult), { IOResult = ok(Char), Result = ok(Char) ; IOResult = eof, Result = eof ; IOResult = error(_E), throw(IOResult) }. %-----------------------------------------------------------------------------% % XXX This is bad for long strings! We should cache the string % length somewhere rather than recomputing it each time we read % a char. % read_from_string(Offset, Result, String, unsafe_promise_unique(String)) :- ( if Offset < string.length(String) then Result = ok(string.unsafe_index(String, Offset)) else Result = eof ). %-----------------------------------------------------------------------------% % The type of regular expressions. :- type regexp ---> eps % The empty regexp ; atom(char) % Match a single char ; conc(regexp, regexp) % Concatenation ; alt(regexp, regexp) % Alternation ; star(regexp) % Kleene closure ; charset(charset). % Matches any char in the set %-----------------------------------------------------------------------------% :- instance regexp(regexp) where [ re(RE) = RE ]. :- instance regexp(char) where [ re(C) = atom(C) ]. :- instance regexp(string) where [ re(S) = R :- ( if S = "" then R = null else R = string.foldl(func(Char, R0) = R1 :- ( if R0 = eps then R1 = re(Char) else R1 = R0 ++ re(Char) ), S, eps) ) ]. :- instance regexp(sparse_bitset(T)) <= (regexp(T),enum(T)) where [ re(SparseBitset) = charset(Charset) :- Charset = sparse_bitset.foldl( func(Enum, Set0) = insert(Set0, char.det_from_int(to_int(Enum))), SparseBitset, sparse_bitset.init) ]. %-----------------------------------------------------------------------------% % Basic primitive regexps. null = eps. R1 ++ R2 = conc(re(R1), re(R2)). R1 \/ R2 = alt(re(R1), re(R2)). (R1 or R2) = alt(re(R1), re(R2)). *(R1) = star(re(R1)). %-----------------------------------------------------------------------------% % Some basic non-primitive regexps. % int_is_valid_char(Int) = Char. % % True iff Int is Char and is in [0x0..0x10ffff] and not a surrogate % character. % :- func int_is_valid_char(int) = char is semidet. int_is_valid_char(Value) = Char :- char.from_int(Value, Char), not char.is_surrogate(Char). charset(Start, End) = build_charset(Start, End, sparse_bitset.init) :- expect(Start =< End, $file, $pred, "Start must be less than or equal to End"). charset(char_range(First, Last)) = charset(First, Last). :- func build_charset(int, int, charset) = charset. build_charset(First, Last, Charset0) = Charset :- if First =< Last then ( if int_is_valid_char(First) = Char then Charset1 = sparse_bitset.insert(Charset0, Char) else Charset1 = Charset0 ), Charset = build_charset(First + 1, Last, Charset1) else Charset = Charset0. charset_from_ranges(ListOfRanges) = union_list(map(charset, ListOfRanges)). latin_chars = charset_from_ranges([ char_range(0x40, 0x7d), char_range(0xc0, 0xff), char_range(0x100, 0x2ff) ]). :- func valid_unicode_chars = charset. valid_unicode_chars = charset(char_range(0x01, 0xffff)). :- func iso_chars = charset. iso_chars = charset(char_range(0x01, 0xff)). any(S) = R :- ( if S = "" then R = null else R = re(sparse_bitset.list_to_set(string.to_char_list(S))) ). anybut(S) = R :- ExcludedChars = sparse_bitset.list_to_set(string.to_char_list(S)), R = re(sparse_bitset.difference(iso_chars, ExcludedChars)). ?(R) = (R or null). +(R) = (R ++ *(R)). range(Start, End) = re(charset(char.to_int(Start), char.to_int(End))). R * N = Result :- ( N < 0 -> unexpected($file, $pred, "N must be a non-negative number") ; N = 0 -> Result = null ; N = 1 -> Result = re(R) ; Result = conc(re(R), (R * (N - 1))) ). %-----------------------------------------------------------------------------% % Some useful single-char regexps. % We invite the compiler to memo the values of these constants that % (a) are likely to be quite common in practice and (b) take *some* % time to compute. % :- pragma memo(digit/0). :- pragma memo(lower/0). :- pragma memo(upper/0). :- pragma memo(wspc/0). :- pragma memo(dot/0). digit = any("0123456789"). lower = any("abcdefghijklmnopqrstuvwxyz"). upper = any("ABCDEFGHIJKLMNOPQRSTUVWXYZ"). wspc = any(" \t\n\r\f\v"). dot = anybut("\r\n"). alpha = (lower or upper). alphanum = (alpha or digit). identstart = (alpha or ('_')). ident = (alphanum or ('_')). tab = re('\t'). spc = re(' '). %-----------------------------------------------------------------------------% % Some useful compound regexps. nl = (?('\r') ++ '\n'). % matches both Posix and Windows newline. nat = +(digit). signed_int = ?("+" or "-") ++ nat. real = signed_int ++ ( ("." ++ nat ++ ?(("e" or "E") ++ signed_int)) or ( ("e" or "E") ++ signed_int) ). identifier = (identstart ++ *(ident)). whitespace = +(wspc). junk = +(dot). %-----------------------------------------------------------------------------% %-----------------------------------------------------------------------------% ================================================ FILE: src/lex.regexp.m ================================================ %-----------------------------------------------------------------------------% % vim: ts=4 sw=4 et tw=0 wm=0 ff=unix %-----------------------------------------------------------------------------% % % lex.regexp.m % Fri Aug 18 06:43:09 BST 2000 % Copyright (C) 2001 Ralph Becket % Copyright (C) 2001 The Rationalizer Intelligent Software AG % The changes made by Rationalizer are contributed under the terms % of the GNU Lesser General Public License, see the file COPYING.LGPL % in this directory. % Copyright (C) 2002, 2010 The University of Melbourne % % This file may only be copied under the terms of the GNU Library General % Public License - see the file COPYING.LIB in the Mercury distribution. % % Thu Jul 26 07:45:47 UTC 2001 % % Converts basic regular expressions into non-deterministic finite % automata (NFAs). % %-----------------------------------------------------------------------------% :- module lex.regexp. :- interface. :- import_module lex.automata. % Turn a regexp into an NFA. % :- func regexp_to_NFA(regexp) = state_mc. % Turn an NFA into a null transition-free NFA. % :- func remove_null_transitions(state_mc) = state_mc. :- mode remove_null_transitions(in) = out(null_transition_free_state_mc) is det. %-----------------------------------------------------------------------------% %-----------------------------------------------------------------------------% :- implementation. :- import_module assoc_list. :- import_module counter. :- import_module list. :- import_module map. :- import_module set. :- import_module std_util. :- import_module string. :- import_module sparse_bitset. %-----------------------------------------------------------------------------% regexp_to_NFA(R) = NFA :- C0 = counter.init(0), counter.allocate(Start, C0, C1), counter.allocate(Stop, C1, C), compile(Start, R, Stop, Transitions, C, _), NFA = state_mc(Start, set.make_singleton_set(Stop), Transitions). %-----------------------------------------------------------------------------% :- pred compile(state_no, regexp, state_no, transitions, counter, counter). :- mode compile(in, in, in, out, in, out) is det. % The primitive regexps. compile(X, eps, Y, [null(X, Y)]) --> []. compile(X, atom(C), Y, [trans(X, make_singleton_set(C), Y)]) --> []. compile(X, charset(Charset), Y, [trans(X, Charset, Y)]) --> []. compile(X, conc(RA,RB), Y, TsA ++ TsB) --> counter.allocate(Z), compile(X, RA, Z, TsA), compile(Z, RB, Y, TsB). compile(X, alt(RA, RB), Y, TsA ++ TsB) --> compile(X, RA, Y, TsA), compile(X, RB, Y, TsB). compile(X, star(R), Y, TsA ++ TsB) --> compile(X, null, Y, TsA), compile(X, R, X, TsB). %-----------------------------------------------------------------------------% % If we have a non-looping null transition from X to Y then % we need to add all the transitions from Y to X. % % We do this by first finding the transitive closure of the % null transition graph and then, for each edge X -> Y in that % graph, adding X -C-> Z for all C and Z s.t. Y -C-> Z. % remove_null_transitions(NFA0) = NFA :- Ts = NFA0 ^ smc_state_transitions, split_transitions(Ts, NullTs, CharTs), trans_closure(NullTs, map.init, _Ins, map.init, Outs), NullFreeTs = add_atom_transitions(Outs, CharTs), StopStates0 = NFA0 ^ smc_stop_states, StopStates1 = set.list_to_set( list.filter_map( nulls_to_stop_state(Outs, NFA0 ^ smc_stop_states), NullTs ) ), StopStates = StopStates0 `set.union` StopStates1, NFA = (( NFA0 ^ smc_state_transitions := NullFreeTs ) ^ smc_stop_states := StopStates). %-----------------------------------------------------------------------------% :- pred split_transitions(transitions, transitions, transitions). :- mode split_transitions(in, out(null_transitions), out(atom_transitions)). split_transitions([], [], []). split_transitions([null(X, Y) | Ts], [null(X, Y) | NTs], CTs) :- split_transitions(Ts, NTs, CTs). split_transitions([trans(X, C, Y) | Ts], NTs, [trans(X, C, Y) | CTs]) :- split_transitions(Ts, NTs, CTs). %-----------------------------------------------------------------------------% :- type null_map == map(state_no, set(state_no)). :- pred trans_closure(transitions, null_map, null_map, null_map, null_map). :- mode trans_closure(in(null_transitions), in, out, in, out) is det. trans_closure([], !Ins, !Outs). trans_closure([T | Ts], !Ins, !Outs) :- T = null(X, Y), XInAndX = set.insert(null_map_lookup(X, !.Ins), X), YOutAndY = set.insert(null_map_lookup(Y, !.Outs), Y), !:Outs = set.fold(add_to_null_mapping(YOutAndY), XInAndX, !.Outs), !:Ins = set.fold(add_to_null_mapping(XInAndX), YOutAndY, !.Ins), trans_closure(Ts, !Ins, !Outs). %-----------------------------------------------------------------------------% :- func null_map_lookup(state_no, null_map) = set(state_no). null_map_lookup(X, Map) = ( if map.search(Map, X, Ys) then Ys else set.init ). %-----------------------------------------------------------------------------% :- func add_to_null_mapping(set(state_no), state_no, null_map) = null_map. add_to_null_mapping(Xs, Y, Map) = map.set(Map, Y, Xs `set.union` null_map_lookup(Y, Map)). %-----------------------------------------------------------------------------% % XXX add_atom_transitions (and its callees) originally used the inst- % subtyping given in the commented out mode declarations. Limitations in % the compiler meant that this code compiled when it was originally written % but with more recent versions of the compiler it causes a compilation % error due to the aforementioned limitations having been lifted. % % As a workaround we perform a runtime check in maybe_copy_transition/4 % below and then use an unsafe cast (defined via a foreign_proc) to restore % the subtype inst. Doing so means that other code in this library that % uses the same inst-subtyping continues to work without modification. % % If / when the standard library has versions of list.condense, list.map etc % that preserve subtype insts then the original modes can be restored (and % the workarounds deleted). % :- func add_atom_transitions(null_map, transitions) = transitions. :- mode add_atom_transitions(in, in(atom_transitions)) = out(atom_transitions). add_atom_transitions(Outs, CTs) = NullFreeTs :- NullFreeTs0 = list.sort_and_remove_dups( list.condense( [ CTs | list.map( add_atom_transitions_0(CTs), map.to_assoc_list(Outs) ) ] ) ), unsafe_cast_to_atom_transitions(NullFreeTs0, NullFreeTs). :- pred unsafe_cast_to_atom_transitions(transitions::in, transitions::out(atom_transitions)) is det. :- pragma foreign_proc("C", unsafe_cast_to_atom_transitions(X::in, Y::out(atom_transitions)), [promise_pure, will_not_call_mercury, thread_safe, will_not_modify_trail], " Y = X; "). :- pragma foreign_proc("Java", unsafe_cast_to_atom_transitions(X::in, Y::out(atom_transitions)), [promise_pure, will_not_call_mercury, thread_safe], " Y = X; "). :- pragma foreign_proc("C#", unsafe_cast_to_atom_transitions(X::in, Y::out(atom_transitions)), [promise_pure, will_not_call_mercury, thread_safe], " Y = X; "). %-----------------------------------------------------------------------------% :- func add_atom_transitions_0(transitions, pair(state_no, set(state_no))) = transitions. %:- mode add_atom_transitions_0(in(atom_transitions), in) = % out(atom_transitions) is det. add_atom_transitions_0(CTs, X - Ys) = list.condense( list.map(add_atom_transitions_1(CTs, X), set.to_sorted_list(Ys)) ). %-----------------------------------------------------------------------------% :- func add_atom_transitions_1(transitions, state_no, state_no) = transitions. %:- mode add_atom_transitions_1(in(atom_transitions), in, in) = % out(atom_transitions) is det. add_atom_transitions_1(CTs0, X, Y) = CTs :- list.filter_map(maybe_copy_transition(X, Y), CTs0, CTs). %-----------------------------------------------------------------------------% :- pred maybe_copy_transition(state_no, state_no, transition, transition). %:- mode maybe_copy_transition(in,in,in(atom_transition),out(atom_transition)) % is semidet. :- mode maybe_copy_transition(in, in, in, out) is semidet. maybe_copy_transition(_, _, null(_, _) , _) :- unexpected($file, $pred, "null transition"). maybe_copy_transition(X, Y, trans(Y, C, Z), trans(X, C, Z)). %-----------------------------------------------------------------------------% :- func nulls_to_stop_state(null_map, set(state_no), transition) = state_no. :- mode nulls_to_stop_state(in, in, in) = out is semidet. nulls_to_stop_state(Outs, StopStates, null(X, _Y)) = X :- some [Z] ( set.member(Z, map.lookup(Outs, X)), set.member(Z, StopStates) ). %-----------------------------------------------------------------------------% :- end_module lex.regexp. %-----------------------------------------------------------------------------% ================================================ FILE: src/options.m ================================================ %-----------------------------------------------------------------------% % Plasma compiler options % vim: ts=4 sw=4 et % % Copyright (C) Plasma Team % Distributed under the terms of the MIT License see ../LICENSE.code % % The options structure for the Plasma compiler. % %-----------------------------------------------------------------------% :- module options. %-----------------------------------------------------------------------% :- interface. :- import_module bool. :- import_module maybe. :- import_module util. :- import_module util.log. %-----------------------------------------------------------------------% :- type general_options ---> general_options( % High-level options go_dir :: string, % The directory of % the input file. go_source_dir :: string, % Trim this prefix % from paths in error % messages. go_input_file :: string, go_output_file :: string, go_import_whitelist_file :: maybe(string), go_module_name_check :: maybe(string), go_warn_as_error :: bool, % Diagnostic options. go_verbose :: log_config, go_dump_stages :: dump_stages, go_write_output :: write_output, go_report_timing :: report_timing ). :- type compile_options ---> compile_options( % Feature/optimisation options % Although we're not generally implementing optimisations or % these options control some optional transformations during % compilation, by making them options they're easier toe % test. co_do_simplify :: do_simplify, co_enable_tailcalls :: enable_tailcalls ). :- type dump_stages ---> dump_stages ; dont_dump_stages. :- type write_output ---> write_output ; dont_write_output. :- type report_timing ---> no_timing ; report_command_times. :- type do_simplify ---> do_simplify_pass ; skip_simplify_pass. :- type enable_tailcalls ---> enable_tailcalls ; dont_enable_tailcalls. %-----------------------------------------------------------------------% %-----------------------------------------------------------------------% ================================================ FILE: src/parse.m ================================================ %-----------------------------------------------------------------------% % vim: ts=4 sw=4 et %-----------------------------------------------------------------------% :- module parse. % % Copyright (C) Plasma Team % Distributed under the terms of the MIT License see ../LICENSE.code % % Plasma parser % %-----------------------------------------------------------------------% :- interface. :- import_module io. :- import_module ast. :- import_module parse_util. :- import_module util. :- import_module util.result. %-----------------------------------------------------------------------% :- pred parse(string::in, result(ast, read_src_error)::out, io::di, io::uo) is det. :- pred parse_interface(string::in, result(ast_interface, read_src_error)::out, io::di, io::uo) is det. :- pred parse_typeres(string::in, result(ast_typeres, read_src_error)::out, io::di, io::uo) is det. %-----------------------------------------------------------------------% %-----------------------------------------------------------------------% :- implementation. :- import_module char. :- import_module int. :- import_module list. :- import_module maybe. :- import_module require. :- import_module std_util. :- import_module solutions. :- import_module string. :- import_module unit. :- import_module common_types. :- import_module context. :- import_module lex. :- import_module parsing. :- import_module q_name. :- import_module util.my_exception. :- import_module util.my_string. :- import_module varmap. %-----------------------------------------------------------------------% parse(Filename, Result, !IO) :- parse_file(Filename, lexemes, ignore_tokens, check_token, parse_plasma, Result, !IO). parse_interface(Filename, Result, !IO) :- parse_file(Filename, lexemes, ignore_tokens, check_token, parse_plasma_interface(parse_interface_entry), Result, !IO). parse_typeres(Filename, Result, !IO) :- parse_file(Filename, lexemes, ignore_tokens, check_token, parse_plasma_interface(parse_typeres_entry), Result, !IO). %-----------------------------------------------------------------------% %-----------------------------------------------------------------------% :- type token_type ---> module_ ; export ; entrypoint ; import ; type_ ; func_ ; resource ; from ; uses ; observes ; opaque ; as ; foreign ; var ; return ; match ; if_ ; then_ ; else_ ; and_ ; or_ ; not_ ; pragma_ ; ident ; number ; string ; l_curly ; r_curly ; l_paren ; r_paren ; l_square ; r_square ; l_angle ; r_angle ; l_square_colon ; r_square_colon ; apostrophe ; colon ; comma ; period ; plus ; minus ; star ; slash ; percent ; bar ; bang ; double_plus ; l_angle_equal ; r_angle_equal ; double_equal ; bang_equal ; equals ; l_arrow ; r_arrow ; underscore ; newline ; comment ; whitespace ; eof. :- instance ident_parsing(token_type) where [ ident_ = ident, period_ = period ]. :- func lexemes = list(lexeme(lex_token(token_type))). lexemes = [ ("module" -> return(module_)), ("export" -> return(export)), ("entrypoint" -> return(entrypoint)), ("import" -> return(import)), ("type" -> return(type_)), ("func" -> return(func_)), ("resource" -> return(resource)), ("from" -> return(from)), ("uses" -> return(uses)), ("observes" -> return(observes)), ("opaque" -> return(opaque)), ("as" -> return(as)), ("foreign" -> return(foreign)), ("var" -> return(var)), ("return" -> return(return)), ("match" -> return(match)), ("if" -> return(if_)), ("then" -> return(then_)), ("else" -> return(else_)), ("not" -> return(not_)), ("and" -> return(and_)), ("or" -> return(or_)), ("pragma" -> return(pragma_)), ("{" -> return(l_curly)), ("}" -> return(r_curly)), ("(" -> return(l_paren)), (")" -> return(r_paren)), ("[" -> return(l_square)), ("]" -> return(r_square)), ("<" -> return(l_angle)), (">" -> return(r_angle)), ("[:" -> return(l_square_colon)), (":]" -> return(r_square_colon)), ("'" -> return(apostrophe)), (":" -> return(colon)), ("," -> return(comma)), ("." -> return(period)), ("+" -> return(plus)), ("-" -> return(minus)), ("*" -> return(star)), ("/" -> return(slash)), ("%" -> return(percent)), ("|" -> return(bar)), ("!" -> return(bang)), ("<" -> return(l_angle)), (">" -> return(r_angle)), ("++" -> return(double_plus)), ("<=" -> return(l_angle_equal)), (">=" -> return(r_angle_equal)), ("==" -> return(double_equal)), ("!=" -> return(bang_equal)), ("=" -> return(equals)), ("<-" -> return(l_arrow)), ("->" -> return(r_arrow)), ("_" -> return(underscore)), (nat -> return(number)), (parse.identifier -> return(ident)), % TODO: don't terminate the string on a \" escape sequence. ("\"" ++ *(anybut("\"")) ++ "\"" -> return(string)), (("//" ++ *(anybut("\n"))) -> return(comment)), (c_style_comment -> return(comment)), ("\n" -> return(newline)), (any(" \t\v\f") -> return(whitespace)) ]. :- func identifier = regexp. identifier = alpha ++ *(lex.ident). % Due to a limitiation in the regex library this wont match /* **/ and % other strings where there is a * next to the final */ % :- func c_style_comment = regexp. c_style_comment = "/*" ++ Middle ++ "*/" :- Middle = *(anybut("*") or ("*" ++ anybut("/"))). :- pred ignore_tokens(token_type::in) is semidet. ignore_tokens(whitespace). ignore_tokens(newline). ignore_tokens(comment). :- pred check_token(token(token_type)::in, maybe(read_src_error)::out) is det. check_token(token(Token, Data, _), Result) :- ( if % Comments Token = comment, % that begin with /* (not //) append("/*", _, Data), Length = length(Data) then ( if % and contain */ are probably a mistake due to the greedy match % for the middle part of those comments. sub_string_search(Data, "*/", Index), % Except when it's the last part of the comment. Index \= Length - 2 then Result = yes(rse_tokeniser_greedy_comment) else if % Have a general warning to help people avoid the odd % condition above. index(Data, Length - 3, '*'), Length > 4 then Result = yes(rse_tokeniser_starstarslash_comment) else Result = no ) else Result = no ). %-----------------------------------------------------------------------% %-----------------------------------------------------------------------% :- type tokens == list(token(token_type)). % Some grammar rules are conditionally enabled depending on what we're % parsing. :- type parse_type ---> parse_source ; parse_interface. :- pred parse_plasma(tokens::in, result(ast, read_src_error)::out) is det. % I will show the EBNF in comments. NonTerminals appear in % CamelCase and terminals appear in lower_underscore_case. % % Plasma := ModuleDecl ToplevelItem* % % ModuleDecl := module ident % parse_plasma(!.Tokens, Result) :- get_context(!.Tokens, Context), match_token(module_, ModuleMatch, !Tokens), parse_q_name(NameResult, !Tokens), zero_or_more_last_error(parse_entry, ok(Items), LastError, !Tokens), ( if ModuleMatch = ok(_), NameResult = ok(Name) then ( !.Tokens = [], Result = ok(ast(Name, Context, Items)) ; !.Tokens = [token(Tok, _, TokCtxt) | _], LastError = error(LECtxt, Got, Expect), ( if compare((<), LECtxt, TokCtxt) then Result = return_error(TokCtxt, rse_parse_junk_at_end(string(Tok))) else Result = return_error(LECtxt, rse_parse_error(Got, Expect)) ) ) else Result0 = combine_errors_2(ModuleMatch, NameResult) `with_type` parse_res(unit), ( Result0 = error(C, G, E), Result = return_error(C, rse_parse_error(G, E)) ; Result0 = ok(_), unexpected($file, $pred, "ok/1, expecting error/1") ) ). % ToplevelItem := ImportDirective % | TypeDefinition % | ResourceDefinition % | Definition % | Pragma % :- pred parse_entry(parse_res(ast_entry)::out, tokens::in, tokens::out) is det. % Defintiions exist at the top level and also within code blocks. For % now that's just function definitions but it'll include other things in % the future. % % Definition := FuncDefinition % parse_entry(Result, !Tokens) :- or([ parse_import, parse_map(func({N, X}) = ast_type(N, X), parse_type(parse_nq_name)), parse_map(func({N, X}) = ast_resource(N, X), parse_resource(parse_nq_name)), parse_map(func({N, X}) = ast_function(N, X), parse_func(parse_nq_name, parse_source)), parse_pragma], Result, !Tokens). % ImportDirective := import QualifiedIdent % | import QualifiedIdent as ident % :- pred parse_import(parse_res(ast_entry)::out, tokens::in, tokens::out) is det. parse_import(Result, !Tokens) :- get_context(!.Tokens, Context), match_token(import, ImportMatch, !Tokens), parse_q_name(NameResult, !Tokens), ( if ImportMatch = ok(_), NameResult = ok(Name) then TokensAs = !.Tokens, match_token(as, AsMatch, !Tokens), match_token(ident, AsIdentResult, !Tokens), ( AsMatch = ok(_), ( AsIdentResult = ok(AsIdent), Result = ok(ast_import(ast_import(Name, yes(AsIdent), Context))) ; AsIdentResult = error(C, G, E), Result = error(C, G, E) ) ; AsMatch = error(_, _, _), Result = ok(ast_import(ast_import(Name, no, Context))), !:Tokens = TokensAs ) else Result = combine_errors_2(ImportMatch, NameResult) ). :- pred parse_type(parsing.parser(N, token_type), parse_res({N, ast_type(N)}), tokens, tokens). :- mode parse_type(in(parsing.parser), out, in, out) is det. parse_type(ParseName, Result, !Tokens) :- parse_export_opaque(Sharing, !Tokens), get_context(!.Tokens, Context), match_token(type_, MatchType, !Tokens), ParseName(NameResult, !Tokens), ( if MatchType = ok(_), NameResult = ok(Name) then match_token(slash, MatchSlash, !Tokens), ( MatchSlash = ok(_), % Abstract type parse_number(NumberRes, !Tokens), ( NumberRes = ok(Arity), Result = ok({Name, ast_type_abstract(arity(Arity), Context)}) ; NumberRes = error(C, G, E), Result = error(C, G, E) ) ; MatchSlash = error(_, _, _), % Concrete type optional(within(l_paren, one_or_more_delimited(comma, parse_type_var), r_paren), ok(MaybeParams), !Tokens), match_token(equals, MatchEquals, !Tokens), one_or_more_delimited(bar, parse_type_constructor(ParseName), CtrsResult, !Tokens), ( if MatchEquals = ok(_), CtrsResult = ok(Constructors) then Params = map( func(T) = ( if N = T ^ atv_name then N else unexpected($file, $pred, "not a type variable")), maybe_default([], MaybeParams)), Result = ok({Name, ast_type(Params, Constructors, Sharing, Context)}) else Result = combine_errors_2(MatchEquals, CtrsResult) ) ) else Result = combine_errors_2(MatchType, NameResult) ). :- pred parse_type_constructor(parsing.parser(N, token_type), parse_res(at_constructor(N)), tokens, tokens). :- mode parse_type_constructor(in(parsing.parser), out, in, out) is det. parse_type_constructor(ParseName, Result, !Tokens) :- get_context(!.Tokens, Context), ParseName(CNameResult, !Tokens), optional(within(l_paren, one_or_more_delimited(comma, parse_type_ctr_field), r_paren), ok(MaybeFields), !Tokens), ( CNameResult = ok(CName), Result = ok(at_constructor(CName, maybe_default([], MaybeFields), Context)) ; CNameResult = error(C, G, E), Result = error(C, G, E) ). :- pred parse_type_ctr_field(parse_res(at_field)::out, tokens::in, tokens::out) is det. parse_type_ctr_field(Result, !Tokens) :- get_context(!.Tokens, Context), match_token(ident, NameResult, !Tokens), match_token(colon, MatchColon, !Tokens), parse_type_expr(TypeResult, !Tokens), ( if NameResult = ok(Name), MatchColon = ok(_), TypeResult = ok(Type) then Result = ok(at_field(Name, Type, Context)) else Result = combine_errors_3(NameResult, MatchColon, TypeResult) ). % TypeExpr := TypeVar % | TypeCtor ( '(' TypeExpr ( ',' TypeExpr )* ')' )? % | 'func' '(' ( TypeExpr ( ',' TypeExpr )* )? ')' RetTypes? % % RetTypes := '->' TypeExpr % | '->' '(' TypeExpr ( ',' TypeExpr )* ')' % % Type := QualifiedIdent % % TODO: Update to respect case of type names/vars % :- pred parse_type_expr(parse_res(ast_type_expr)::out, tokens::in, tokens::out) is det. parse_type_expr(Result, !Tokens) :- or([parse_type_var, parse_type_construction, parse_func_type], Result, !Tokens). :- pred parse_type_var(parse_res(ast_type_expr)::out, tokens::in, tokens::out) is det. parse_type_var(Result, !Tokens) :- get_context(!.Tokens, Context), match_token(apostrophe, MatchSigil, !Tokens), match_token(ident, Result0, !Tokens), ( if MatchSigil = ok(_), Result0 = ok(S) then Result = ok(ast_type_var(S, Context)) else Result = combine_errors_2(MatchSigil, Result0) ). :- pred parse_type_construction(parse_res(ast_type_expr)::out, tokens::in, tokens::out) is det. parse_type_construction(Result, !Tokens) :- get_context(!.Tokens, Context), parse_q_name(ConstructorResult, !Tokens), % TODO: We could generate more helpful parse errors here, for example by % returning the error from within the optional thing if the l_paren is % seen. optional(within(l_paren, one_or_more_delimited(comma, parse_type_expr), r_paren), ok(MaybeArgs), !Tokens), ( ConstructorResult = ok(Name), ( MaybeArgs = no, Args = [] ; MaybeArgs = yes(Args) ), Result = ok(ast_type(Name, Args, Context)) ; ConstructorResult = error(C, G, E), Result = error(C, G, E) ). % Note that the return type cannot contain a comma, or that would be the % end of the type as a whole. So we use parens (that should be optional % when there's only a single result) to group multiple returns. % % TODO: This is an exception to the established pattern and so we should % update the rest of the grammar to match it (allowing optional parens). % :- pred parse_func_type(parse_res(ast_type_expr)::out, tokens::in, tokens::out) is det. parse_func_type(Result, !Tokens) :- get_context(!.Tokens, Context), match_token(func_, MatchFunc, !Tokens), ( MatchFunc = ok(_), within(l_paren, zero_or_more_delimited(comma, parse_type_expr), r_paren, ParamsResult, !Tokens), zero_or_more(parse_uses, ok(Usess), !Tokens), Uses = condense(Usess), optional(parse_returns, ok(MaybeReturns), !Tokens), Returns = maybe_default([], MaybeReturns), ( ParamsResult = ok(Params), Result = ok(ast_type_func(Params, Returns, Uses, Context)) ; ParamsResult = error(C, G, E), Result = error(C, G, E) ) ; MatchFunc = error(C, G, E), Result = error(C, G, E) ). % ResourceDefinition := 'resource' QualifiedIdent 'from' QualifiedIdent % :- pred parse_resource(parsing.parser(N, token_type), parse_res({N, ast_resource}), tokens, tokens). :- mode parse_resource(in(parsing.parser), out, in, out) is det. parse_resource(ParseName, Result, !Tokens) :- parse_export_opaque(Sharing, !Tokens), get_context(!.Tokens, Context), match_token(resource, ResourceMatch, !Tokens), % Not really an any ident, but this should make errors easier to % understand. A user will get a "resource uknown" if they use the wrong % case rather than a syntax error. ParseName(NameResult, !Tokens), parse_resource_from(FromResult, !Tokens), ( if ResourceMatch = ok(_), NameResult = ok(Name), FromResult = ok(FromIdent) then Result = ok({Name, ast_resource(FromIdent, Sharing, Context)}) else Result = combine_errors_3(ResourceMatch, NameResult, FromResult) ). % Parse a resource from an interface file. % % ResourceInterface := 'resource' QualifiedIdent ('from' QualifiedIdent)? % :- pred parse_resource_interface(parse_res({q_name, maybe(ast_resource)})::out, tokens::in, tokens::out) is det. parse_resource_interface(Result, !Tokens) :- get_context(!.Tokens, Context), match_token(resource, ResourceMatch, !Tokens), parse_q_name(NameResult, !Tokens), ( if ResourceMatch = ok(_), NameResult = ok(Name) then optional(parse_resource_from, ok(FromResult), !Tokens), ( FromResult = yes(FromName), Result = ok({Name, yes(ast_resource(FromName, so_private, Context))}) ; FromResult = no, Result = ok({Name, no}) ) else Result = combine_errors_2(ResourceMatch, NameResult) ). % Parse the body of a resource definition. % :- pred parse_resource_from(parse_res(q_name)::out, tokens::in, tokens::out) is det. parse_resource_from(Result, !Tokens) :- match_token(from, FromMatch, !Tokens), parse_q_name(IdentResult, !Tokens), ( if FromMatch = ok(_), IdentResult = ok(Name) then Result = ok(Name) else Result = combine_errors_2(FromMatch, IdentResult) ). % FuncDefinition := 'func' Name '(' ( Param ( ',' Param )* )? ')' % Uses* ReturnTypes? FuncBody % % Depending on the ParseName value that's passed in. % Name := ident % | QualifiedIdent % % Param := ident : TypeExpr % | TypeExpr (Only in interfaces) % % Uses := uses QualifiedIdent % | uses '(' QualifiedIdentList ')' % | observes QualifiedIdent % | observes '(' QualifiedIdentList ')' % % ReturnTypes := '->' TypeExpr % | '->' '(' TypeExpr ( ',' TypeExpr )* ')' % % FuncBody := Block % | Foreign % :- pred parse_func(parsing.parser(Name, token_type), parse_type, parse_res({Name, ast_function}), tokens, tokens). :- mode parse_func(in(parsing.parser), in, out, in, out) is det. parse_func(ParseName, ParseType, Result, !Tokens) :- maybe_parse_func_export(Sharing, Entrypoint, !Tokens), parse_func_decl(ParseName, ParseType, DeclResult, !Tokens), ( DeclResult = ok({Name, Decl}), or([parse_map(func(Bs) = ast_body_block(Bs), parse_block), parse_foreign], BodyResult, !Tokens), ( BodyResult = ok(Body), Result = ok({Name, ast_function(Decl, Body, Sharing, Entrypoint)}) ; BodyResult = error(C, G, E), Result = error(C, G, E) ) ; DeclResult = error(C, G, E), Result = error(C, G, E) ). % NestedFuncDefinition := 'func' Ident '(' ( Param ( ',' Param )* )? ')' % Uses* ReturnTypes? Block % % Param := ident : TypeExpr % % Uses := uses QualifiedIdent % | uses '(' QualifiedIdentList ')' % | observes QualifiedIdent % | observes '(' QualifiedIdentList ')' % % ReturnTypes := '->' TypeExpr % | '->' '(' TypeExpr ( ',' TypeExpr )* ')' % :- pred parse_nested_func(parse_res(ast_block_thing), tokens, tokens). :- mode parse_nested_func(out, in, out) is det. parse_nested_func(Result, !Tokens) :- parse_func_decl(parse_nq_name, parse_source, DeclResult, !Tokens), ( DeclResult = ok({Name, Decl}), parse_block(BodyResult, !Tokens), ( BodyResult = ok(Body), Result = ok(astbt_function(Name, ast_nested_function(Decl, Body))) ; BodyResult = error(C, G, E), Result = error(C, G, E) ) ; DeclResult = error(C, G, E), Result = error(C, G, E) ). :- pred parse_func_decl(pred(parse_res(Name), tokens, tokens), parse_type, parse_res({Name, ast_function_decl}), tokens, tokens). :- mode parse_func_decl(pred(out, in, out) is det, in, out, in, out) is det. parse_func_decl(ParseName, ParseType, Result, !Tokens) :- get_context(!.Tokens, Context), match_token(func_, MatchFunc, !Tokens), ( MatchFunc = ok(_), ParseName(NameResult, !Tokens), parse_param_list(ParseType, ParamsResult, !Tokens), zero_or_more(parse_uses, ok(Uses), !Tokens), optional(parse_returns, ok(MaybeReturns), !Tokens), ( if NameResult = ok(Name), ParamsResult = ok(Params) then Result = ok({Name, ast_function_decl(Params, maybe_default([], MaybeReturns), condense(Uses), Context)}) else Result = combine_errors_2(NameResult, ParamsResult) ) ; MatchFunc = error(C, G, E), Result = error(C, G, E) ). :- pred parse_param_list(parse_type::in, parse_res(list(ast_param))::out, tokens::in, tokens::out) is det. parse_param_list(ParseType, Result, !Tokens) :- within(l_paren, zero_or_more_delimited(comma, parse_param(ParseType)), r_paren, Result, !Tokens). :- pred parse_param(parse_type::in, parse_res(ast_param)::out, tokens::in, tokens::out) is det. parse_param(parse_source, Result, !Tokens) :- parse_named_param(Result, !Tokens). parse_param(parse_interface, Result, !Tokens) :- or([parse_named_param, parse_unnamed_param], Result, !Tokens). :- pred parse_named_param(parse_res(ast_param)::out, tokens::in, tokens::out) is det. parse_named_param(Result, !Tokens) :- parse_ident_or_wildcard(NameOrWildResult, !Tokens), match_token(colon, ColonMatch, !Tokens), parse_type_expr(TypeResult, !Tokens), ( if NameOrWildResult = ok(NameOrWild), ColonMatch = ok(_), TypeResult = ok(Type) then Result = ok(ast_param(NameOrWild, Type)) else Result = combine_errors_3(NameOrWildResult, ColonMatch, TypeResult) ). :- pred parse_unnamed_param(parse_res(ast_param)::out, tokens::in, tokens::out) is det. parse_unnamed_param(Result, !Tokens) :- parse_map(func(Type) = ast_param(wildcard, Type), parse_type_expr, Result, !Tokens). :- pred parse_returns(parse_res(list(ast_type_expr))::out, tokens::in, tokens::out) is det. parse_returns(Result, !Tokens) :- match_token(r_arrow, MatchRArrow, !Tokens), decl_list(parse_type_expr, ReturnTypesResult, !Tokens), ( if MatchRArrow = ok(_), ReturnTypesResult = ok(ReturnTypes) then Result = ok(ReturnTypes) else Result = combine_errors_2(MatchRArrow, ReturnTypesResult) ). :- pred parse_uses(parse_res(list(ast_uses))::out, tokens::in, tokens::out) is det. parse_uses(Result, !Tokens) :- get_context(!.Tokens, Context), next_token("Uses or observes clause", UsesObservesResult, !Tokens), ( UsesObservesResult = ok(token_and_string(UsesObserves, TokenString)), ( if ( UsesObserves = uses, UsesType = ut_uses ; UsesObserves = observes, UsesType = ut_observes ) then decl_list(parse_q_name, ResourcesResult, !Tokens), Result = map((func(Rs) = map((func(R) = ast_uses(UsesType, R)), Rs) ), ResourcesResult) else Result = error(Context, TokenString, "Uses or observes clause") ) ; UsesObservesResult = error(C, G, E), Result = error(C, G, E) ). % Foreign := 'foreign' '(' Ident ')' % % A foreign code declration. Plasma will attempt to link the foreign % symbol named with the Ident. % :- pred parse_foreign(parse_res(ast_body)::out, tokens::in, tokens::out) is det. parse_foreign(Result, !Tokens) :- match_token(foreign, ForeignMatch, !Tokens), within(l_paren, match_token(ident), r_paren, MaybeName, !Tokens), ( if ForeignMatch = ok(_), MaybeName = ok(Name) then Result = ok(ast_body_foreign(Name)) else Result = combine_errors_2(ForeignMatch, MaybeName) ). % Block := '{' ( Statment | Definition )* ReturnExpr? '}' % ReturnExpr := 'return' TupleExpr % % ReturnExpr is parsed here to avoid an ambiguity that could arise if % the expression it is returning is a match or if expression, since it % could also be the beginning of the following statement. By requiring % that the return statement is the last statement (which makes sense) % there can be no next statement and match/if is the expression being % returned. TODO: This could be a problem if we add yield statements, % which probably can be followed by other statements. % :- pred parse_block(parse_res(list(ast_block_thing))::out, tokens::in, tokens::out) is det. parse_block(Result, !Tokens) :- match_token(l_curly, MatchLCurly, !Tokens), zero_or_more_last_error(parse_block_thing, Stmts0Result, LastError, !Tokens), ( if MatchLCurly = ok(_), Stmts0Result = ok(Stmts0) then optional(parse_stmt_return, ok(MaybeReturn), !Tokens), match_token(r_curly, MatchRCurly, !Tokens), ( MatchRCurly = ok(_), ( MaybeReturn = yes(Return), Stmts = Stmts0 ++ [astbt_statement(Return)] ; MaybeReturn = no, Stmts = Stmts0 ), Result = ok(Stmts) ; MatchRCurly = error(C, G, E), ( MaybeReturn = yes(_), Result = error(C, G, E) ; MaybeReturn = no, LastError = error(LastC, LastG, LastE), ( if LastC ^ c_line > C ^ c_line then % We partially parsed a statement above Result = error(LastC, LastG, LastE) else % We stopped parsing the zero_or_more_last_error above for % the same reason there's no return statement and no closing % brace. Result = error(C, G, "statement or closing brace") ) ) ) else Result = combine_errors_2(MatchLCurly, Stmts0Result) ). :- pred parse_block_thing(parse_res(ast_block_thing)::out, tokens::in, tokens::out) is det. parse_block_thing(Result, !Tokens) :- or([ parse_map(func(S) = astbt_statement(S), parse_statement), parse_nested_func], Result, !Tokens). % Statement := 'var' Ident ( ',' Ident )+ % | `match` Expr '{' Case+ '}' % | ITE % | CallInStmt % | IdentList '=' Expr % | Ident ArraySubscript '<=' Expr % | Definition % % CallInStmt := ExprPart '!'? '(' Expr ( , Expr )* ')' % % The '!' is an optional part of the grammer even though no sensible % program would omit it in this context (either it would be an error % because the callee uses a resource or the compiler would optimise the % call away). % % Case := Pattern '->' Block % % ITE := 'if' Expr Block else ElsePart % ElsePart := ITE | Block % :- pred parse_statement(parse_res(ast_statement)::out, tokens::in, tokens::out) is det. parse_statement(Result, !Tokens) :- or([ parse_stmt_match, parse_stmt_ite, parse_stmt_assign, parse_stmt_call, parse_stmt_var, parse_stmt_array_set], Result, !Tokens). :- pred parse_stmt_return(parse_res(ast_statement)::out, tokens::in, tokens::out) is det. parse_stmt_return(Result, !Tokens) :- get_context(!.Tokens, Context), match_token(return, ReturnMatch, !Tokens), zero_or_more_delimited(comma, parse_expr, ok(Vals), !Tokens), Result = map((func(_) = ast_statement(s_return_statement(Vals), Context)), ReturnMatch). :- pred parse_stmt_match(parse_res(ast_statement)::out, tokens::in, tokens::out) is det. parse_stmt_match(Result, !Tokens) :- get_context(!.Tokens, Context), match_token(match, MatchMatch, !Tokens), parse_expr(MExprResult, !Tokens), within_use_last_error(l_curly, one_or_more_last_error(parse_match_case), r_curly, CasesResult, !Tokens), ( if MatchMatch = ok(_), MExprResult = ok(MExpr), CasesResult = ok(Cases) then Result = ok(ast_statement(s_match_statement(MExpr, Cases), Context)) else Result = combine_errors_3(MatchMatch, MExprResult, CasesResult) ). :- pred parse_match_case(parse_res(ast_match_case)::out, tokens::in, tokens::out) is det. parse_match_case(Result, !Tokens) :- parse_pattern(PatternResult, !Tokens), match_token(r_arrow, MatchArrow, !Tokens), parse_block(StmtsResult, !Tokens), ( if PatternResult = ok(Pattern), MatchArrow = ok(_), StmtsResult = ok(Stmts) then Result = ok(ast_match_case(Pattern, Stmts)) else Result = combine_errors_3(PatternResult, MatchArrow, StmtsResult) ). :- pred parse_stmt_call(parse_res(ast_statement)::out, tokens::in, tokens::out) is det. parse_stmt_call(Result, !Tokens) :- get_context(!.Tokens, Context), parse_call_in_stmt(CallResult, !Tokens), ( CallResult = ok(Call), Result = ok(ast_statement(s_call(Call), Context)) ; CallResult = error(C, G, E), Result = error(C, G, E) ). % Parse a call as it occurs within a statement. % :- pred parse_call_in_stmt(parse_res(ast_call_like)::out, tokens::in, tokens::out) is det. parse_call_in_stmt(Result, !Tokens) :- parse_expr_2(CalleeResult, !Tokens), optional(match_token(bang), ok(MaybeBang), !Tokens), % TODO: Use last error. within(l_paren, zero_or_more_delimited(comma, parse_expr), r_paren, ArgsResult, !Tokens), ( if CalleeResult = ok(Callee), ArgsResult = ok(Args) then ( MaybeBang = no, Result = ok(ast_call_like(Callee, Args)) ; MaybeBang = yes(_), Result = ok(ast_bang_call(Callee, Args)) ) else Result = combine_errors_2(CalleeResult, ArgsResult) ). :- pred parse_stmt_var(parse_res(ast_statement)::out, tokens::in, tokens::out) is det. parse_stmt_var(Result, !Tokens) :- get_context(!.Tokens, Context), match_token(var, VarMatch, !Tokens), match_token(ident, IdentResult, !Tokens), ( if VarMatch = ok(_), IdentResult = ok(Var) then Result = ok(ast_statement(s_var_statement(Var), Context)) else Result = combine_errors_2(VarMatch, IdentResult) ). :- pred parse_stmt_assign(parse_res(ast_statement)::out, tokens::in, tokens::out) is det. parse_stmt_assign(Result, !Tokens) :- get_context(!.Tokens, Context), one_or_more_delimited(comma, parse_pattern, LHSResult, !Tokens), parse_assigner(ValResult, !Tokens), ( if LHSResult = ok(LHSs), ValResult = ok(Val) then Result = ok(ast_statement(s_assign_statement(LHSs, Val), Context)) else Result = combine_errors_2(LHSResult, ValResult) ). :- pred parse_assigner(parse_res(list(ast_expression))::out, tokens::in, tokens::out) is det. parse_assigner(Result, !Tokens) :- match_token(equals, EqualsMatch, !Tokens), one_or_more_delimited(comma, parse_expr, ValsResult, !Tokens), ( if EqualsMatch = ok(_) then Result = ValsResult else Result = combine_errors_2(EqualsMatch, ValsResult) ). :- pred parse_ident_or_wildcard(parse_res(var_or_wildcard(string))::out, tokens::in, tokens::out) is det. parse_ident_or_wildcard(Result, !Tokens) :- match_token(ident, ResultIdent, !.Tokens, TokensIdent), ( ResultIdent = ok(Ident), !:Tokens = TokensIdent, Result = ok(var(Ident)) ; ResultIdent = error(C, G, E), match_token(underscore, ResultWildcard, !Tokens), ( ResultWildcard = ok(_), Result = ok(wildcard) ; ResultWildcard = error(_, _, _), Result = error(C, G, E) ) ). :- pred parse_stmt_array_set(parse_res(ast_statement)::out, tokens::in, tokens::out) is det. parse_stmt_array_set(Result, !Tokens) :- get_context(!.Tokens, Context), match_token(ident, NameResult, !Tokens), within(l_square, parse_expr, r_square, IndexResult, !Tokens), % TODO: Use := for array assignment. match_token(l_angle_equal, ArrowMatch, !Tokens), parse_expr(ValueResult, !Tokens), ( if NameResult = ok(Name), IndexResult = ok(Index), ArrowMatch = ok(_), ValueResult = ok(Value) then Result = ok(ast_statement( s_array_set_statement(Name, Index, Value), Context)) else Result = combine_errors_4(NameResult, IndexResult, ArrowMatch, ValueResult) ). :- pred parse_stmt_ite(parse_res(ast_statement)::out, tokens::in, tokens::out) is det. parse_stmt_ite(Result, !Tokens) :- get_context(!.Tokens, Context), match_token(if_, MatchIf, !Tokens), ( MatchIf = ok(_), parse_expr(CondResult, !Tokens), parse_block(ThenResult, !Tokens), match_token(else_, MatchElse, !Tokens), or([parse_stmt_ite_as_block, parse_block], ElseResult, !Tokens), ( if CondResult = ok(Cond), ThenResult = ok(Then), MatchElse = ok(_), ElseResult = ok(Else) then Result = ok(ast_statement(s_ite(Cond, Then, Else), Context)) else Result = combine_errors_4(CondResult, ThenResult, MatchElse, ElseResult) ) ; MatchIf = error(C, G, E), Result = error(C, G, E) ). :- pred parse_stmt_ite_as_block(parse_res(list(ast_block_thing))::out, tokens::in, tokens::out) is det. parse_stmt_ite_as_block(Result, !Tokens) :- parse_stmt_ite(Result0, !Tokens), Result = map((func(X) = [astbt_statement(X)]), Result0). % Expressions may be: % % A branch expression % Expr := 'match' Expr '{' Case+ '}' % | 'if' Expr 'then' Expr 'else' Expr % A binary and unary expressions % | Expr BinOp Expr % | UOp Expr % A call or construction % | ExprPart '!'? '(' Expr ( , Expr )* ')' % An array subscript % | ExprPart '[' Expr ']' % A higher precedence expression. % | ExprPart % % Which may be: % ExprPart := '(' Expr ')' % A list or array % | '[' ListExpr ']' % | '[:' TupleExpr? ':]' % A value: % | QualifiedIdent % A constant: % | const_str % | const_int % % ListExpr := e % | Expr ( ',' Expr )* ( ':' Expr )? % % Case := Pattern '->' TupleExpr % % The relative precedences of unary and binary operators is covered in % the reference manual % https://plasmalang.org/docs/plasma_ref.html#_expressions % :- pred parse_expr(parse_res(ast_expression)::out, tokens::in, tokens::out) is det. parse_expr(Result, !Tokens) :- or([parse_expr_match, parse_expr_if, parse_binary_expr(max_binop_level)], Result, !Tokens). :- pred parse_expr_match(parse_res(ast_expression)::out, tokens::in, tokens::out) is det. parse_expr_match(Result, !Tokens) :- match_token(match, MatchMatch, !Tokens), ( MatchMatch = ok(_), parse_expr(MatchExprResult, !Tokens), match_token(l_curly, MatchLCurly, !Tokens), one_or_more(parse_expr_match_case, CasesResult, !Tokens), match_token(r_curly, MatchRCurly, !Tokens), ( if MatchExprResult = ok(MatchExpr), MatchLCurly = ok(_), CasesResult = ok(Cases), MatchRCurly = ok(_) then Result = ok(e_match(MatchExpr, Cases)) else Result = combine_errors_4(MatchExprResult, MatchLCurly, CasesResult, MatchRCurly) ) ; MatchMatch = error(C, G, E), Result = error(C, G, E) ). :- pred parse_expr_match_case(parse_res(ast_expr_match_case)::out, tokens::in, tokens::out) is det. parse_expr_match_case(Result, !Tokens) :- parse_pattern(PatternResult, !Tokens), match_token(r_arrow, MatchArrow, !Tokens), one_or_more_delimited(comma, parse_expr, ExprsResult, !Tokens), ( if PatternResult = ok(Pattern), MatchArrow = ok(_), ExprsResult = ok(Exprs) then Result = ok(ast_emc(Pattern, Exprs)) else Result = combine_errors_3(PatternResult, MatchArrow, ExprsResult) ). :- pred parse_expr_if(parse_res(ast_expression)::out, tokens::in, tokens::out) is det. parse_expr_if(Result, !Tokens) :- match_token(if_, MatchIf, !Tokens), ( MatchIf = ok(_), parse_expr(CondResult, !Tokens), match_token(then_, MatchThen, !Tokens), one_or_more_delimited(comma, parse_expr, ThenResult, !Tokens), match_token(else_, MatchElse, !Tokens), one_or_more_delimited(comma, parse_expr, ElseResult, !Tokens), ( if CondResult = ok(Cond), MatchThen = ok(_), ThenResult = ok(Then), MatchElse = ok(_), ElseResult = ok(Else) then Result = ok(e_if(Cond, Then, Else)) else Result = combine_errors_5(CondResult, MatchThen, ThenResult, MatchElse, ElseResult) ) ; MatchIf = error(C, G, E), Result = error(C, G, E) ). :- pred operator_table(int, token_type, ast_bop). :- mode operator_table(in, in, out) is semidet. :- mode operator_table(out, out, out) is multi. operator_table(1, star, b_mul). operator_table(1, slash, b_div). operator_table(1, percent, b_mod). operator_table(2, plus, b_add). operator_table(2, minus, b_sub). operator_table(3, l_angle, b_lt). operator_table(3, r_angle, b_gt). operator_table(3, l_angle_equal, b_lteq). operator_table(3, r_angle_equal, b_gteq). operator_table(3, double_equal, b_eq). operator_table(3, bang_equal, b_neq). operator_table(4, and_, b_logical_and). operator_table(5, or_, b_logical_or). operator_table(6, double_plus, b_concat). :- func max_binop_level = int. max_binop_level = Max :- solutions((pred(Level::out) is multi :- operator_table(Level, _, _)), Levels), Max = foldl((func(X, M) = (if X > M then X else M)), Levels, 1). :- pred parse_binary_expr(int::in, parse_res(ast_expression)::out, tokens::in, tokens::out) is det. parse_binary_expr(Level, Result, !Tokens) :- parse_binary_expr_2(Level, ExprLResult, !Tokens), ( ExprLResult = ok(ExprL), parse_binary_expr_lassoc(Level, ExprL, Result, !Tokens) ; ExprLResult = error(_, _, _), Result = ExprLResult ). :- pred parse_binary_expr_lassoc(int::in, ast_expression::in, parse_res(ast_expression)::out, tokens::in, tokens::out) is det. parse_binary_expr_lassoc(Level, ExprL0, Result, !Tokens) :- BeforeOpTokens = !.Tokens, next_token("operator", OpResult, !Tokens), ( if OpResult = ok(token_and_string(Op, _)), operator_table(Level, Op, EOp) then parse_binary_expr_2(Level, ExprNResult, !Tokens), ( ExprNResult = ok(ExprN), ExprL = e_b_op(ExprL0, EOp, ExprN), parse_binary_expr_lassoc(Level, ExprL, Result, !Tokens) ; ExprNResult = error(_, _, _), Result = ExprNResult ) else !:Tokens = BeforeOpTokens, Result = ok(ExprL0) ). :- pred parse_binary_expr_2(int::in, parse_res(ast_expression)::out, tokens::in, tokens::out) is det. parse_binary_expr_2(Level, Result, !Tokens) :- ( if Level > 0 then parse_binary_expr(Level - 1, ExprLResult, !Tokens), ( ExprLResult = ok(ExprL), BeforeOpTokens = !.Tokens, next_token("operator", OpResult, !Tokens), ( if OpResult = ok(token_and_string(Op, _)), operator_table(Level, Op, EOp) then parse_binary_expr(Level - 1, ExprRResult, !Tokens), ( ExprRResult = ok(ExprR), Result = ok(e_b_op(ExprL, EOp, ExprR)) ; ExprRResult = error(C, G, E), Result = error(C, G, E) ) else Result = ok(ExprL), !:Tokens = BeforeOpTokens ) ; ExprLResult = error(C, G, E), Result = error(C, G, E) ) else parse_unary_expr(Result, !Tokens) ). :- pred parse_unary_expr(parse_res(ast_expression)::out, tokens::in, tokens::out) is det. parse_unary_expr(Result, !Tokens) :- StartTokens = !.Tokens, next_token("expression", TokenResult, !Tokens), ( TokenResult = ok(token_and_string(Token, _)), ( if ( Token = minus, UOp = u_minus ; Token = not_, UOp = u_not ) then parse_unary_expr(ExprResult, !Tokens), Result = map((func(E) = e_u_op(UOp, E)), ExprResult) else !:Tokens = StartTokens, parse_expr_1(Result, !Tokens) ) ; TokenResult = error(C, G, E), Result = error(C, G, E) ). % This precidence level covers calls and array subscriptions. % :- pred parse_expr_1(parse_res(ast_expression)::out, tokens::in, tokens::out) is det. parse_expr_1(Result, !Tokens) :- parse_expr_2(Part1Result0, !Tokens), ( Part1Result0 = ok(Part1), parse_expr_part_2(Part1, Result, !Tokens) ; Part1Result0 = error(C, G, E), Result = error(C, G, E) ). :- pred parse_expr_part_2(ast_expression::in, parse_res(ast_expression)::out, tokens::in, tokens::out) is det. parse_expr_part_2(Part1, Result, !Tokens) :- Part1Tokens = !.Tokens, next_token("Call arguments or array subscript", NextResult, !Tokens), ( NextResult = ok(token_and_string(Next, _)), ( if ( Next = l_paren, require_det ( parse_call_part2(Part1, Result1, !Tokens) ) ; Next = bang, require_det ( match_token(l_paren, ParenResult, !Tokens), ( ParenResult = ok(_), parse_call_part2(Part1, Result0, !Tokens), Result1 = map(make_bang_call, Result0) ; ParenResult = error(C, G, E), Result1 = error(C, G, E) ) ) ; Next = l_square, require_det ( parse_array_subscript_part2(Part1, Result1, !Tokens) ) ) then ( Result1 = ok(Expr), parse_expr_part_2(Expr, Result, !Tokens) ; Result1 = error(_, _, _), !:Tokens = Part1Tokens, Result = ok(Part1) ) else !:Tokens = Part1Tokens, Result = ok(Part1) ) ; NextResult = error(_, _, _), !:Tokens = Part1Tokens, Result = ok(Part1) ). :- pred parse_expr_2(parse_res(ast_expression)::out, tokens::in, tokens::out) is det. parse_expr_2(Result, !Tokens) :- or([ parse_const_expr, within(l_paren, parse_expr, r_paren), within(l_square, parse_list_expr, r_square), parse_array_expr, parse_expr_symbol ], Result, !Tokens). :- pred parse_const_expr(parse_res(ast_expression)::out, tokens::in, tokens::out) is det. parse_const_expr(Result, !Tokens) :- ( if parse_string(ok(String), !Tokens) then Result = ok(e_const(c_string(String))) else if parse_number(ok(Num), !Tokens) then Result = ok(e_const(c_number(Num))) else get_context(!.Tokens, Context), Result = error(Context, "", "expression") ). :- pred parse_array_expr(parse_res(ast_expression)::out, tokens::in, tokens::out) is det. parse_array_expr(Result, !Tokens) :- within(l_square_colon, zero_or_more_delimited(comma, parse_expr), r_square_colon, Result0, !Tokens), Result = map((func(Exprs) = e_array(Exprs)), Result0). :- pred parse_string(parse_res(string)::out, tokens::in, tokens::out) is det. parse_string(Result, !Tokens) :- match_token(string, Result0, !Tokens), Result = map(unescape_string, Result0). :- pred parse_number(parse_res(int)::out, tokens::in, tokens::out) is det. parse_number(Result, !Tokens) :- optional(match_token(minus), ok(MaybeMinus), !Tokens), match_token(number, Result0, !Tokens), ( MaybeMinus = yes(_), Convert = (func(N) = string.det_to_int(N) * -1) ; MaybeMinus = no, Convert = string.det_to_int ), Result = map(Convert, Result0). :- pred parse_list_expr(parse_res(ast_expression)::out, tokens::in, tokens::out) is det. parse_list_expr(Result, !Tokens) :- StartTokens = !.Tokens, one_or_more_delimited(comma, parse_expr, HeadsResult, !Tokens), ( HeadsResult = ok(Heads), BeforeBarTokens = !.Tokens, match_token(bar, MatchBar, !Tokens), ( MatchBar = ok(_), parse_expr(TailResult, !Tokens), ( TailResult = ok(Tail), Result = ok(make_cons_list(Heads, Tail)) ; TailResult = error(C, G, E), Result = error(C, G, E) ) ; MatchBar = error(_, _, _), !:Tokens = BeforeBarTokens, Result = ok(make_cons_list(Heads, e_const(c_list_nil))) ) ; HeadsResult = error(_, _, _), !:Tokens = StartTokens, Result = ok(e_const(c_list_nil)) ). :- pred parse_expr_symbol(parse_res(ast_expression)::out, tokens::in, tokens::out) is det. parse_expr_symbol(Result, !Tokens) :- parse_q_name(QNameResult, !Tokens), Result = map((func(Name) = e_symbol(Name)), QNameResult). :- pred parse_call_part2(ast_expression::in, parse_res(ast_expression)::out, tokens::in, tokens::out) is det. parse_call_part2(Callee, Result, !Tokens) :- zero_or_more_delimited(comma, parse_expr, ok(Args), !Tokens), match_token(r_paren, MatchParen, !Tokens), ( MatchParen = ok(_), Result = ok(e_call_like(ast_call_like(Callee, Args))) ; MatchParen = error(C, G, E), Result = error(C, G, E) ). :- pred parse_array_subscript_part2(ast_expression::in, parse_res(ast_expression)::out, tokens::in, tokens::out) is det. parse_array_subscript_part2(Expr, Result, !Tokens) :- parse_expr(SubscriptResult, !Tokens), match_token(r_square, MatchClose, !Tokens), ( if SubscriptResult = ok(Subscript), MatchClose = ok(_) then Result = ok(e_b_op(Expr, b_array_subscript, Subscript)) else Result = combine_errors_2(SubscriptResult, MatchClose) ). % Pattern := Number % | QualifiedIdent ( '(' Pattern ',' ( Pattern ',' )+ ')' )? % :- pred parse_pattern(parse_res(ast_pattern)::out, tokens::in, tokens::out) is det. parse_pattern(Result, !Tokens) :- or([ parse_constr_pattern, parse_list_pattern, parse_number_pattern, parse_wildcard_pattern, parse_var_pattern ], Result, !Tokens). :- pred parse_constr_pattern(parse_res(ast_pattern)::out, tokens::in, tokens::out) is det. parse_constr_pattern(Result, !Tokens) :- parse_q_name(Result0, !Tokens), ( Result0 = ok(Symbol), optional(within(l_paren, one_or_more_delimited(comma, parse_pattern), r_paren), ok(MaybeArgs), !Tokens), ( MaybeArgs = yes(Args), Result = ok(p_constr(Symbol, Args)) ; MaybeArgs = no, Result = ok(p_symbol(Symbol)) ) ; Result0 = error(C, G, E), Result = error(C, G, E) ). :- pred parse_list_pattern(parse_res(ast_pattern)::out, tokens::in, tokens::out) is det. parse_list_pattern(Result, !Tokens) :- within(l_square, parse_list_pattern_2, r_square, Result0, !Tokens), Result = map(id, Result0). :- pred parse_list_pattern_2(parse_res(ast_pattern)::out, tokens::in, tokens::out) is det. parse_list_pattern_2(Result, !Tokens) :- ( if peek_token(!.Tokens, yes(r_square)) then Result = ok(p_list_nil) else one_or_more_delimited(comma, parse_pattern, HeadsResult, !Tokens), ( HeadsResult = ok(Heads), BeforeBarTokens = !.Tokens, match_token(bar, MatchBar, !Tokens), ( MatchBar = ok(_), parse_pattern(TailResult, !Tokens), ( TailResult = ok(Tail), Result = ok(make_p_list_cons(Heads, Tail)) ; TailResult = error(C, G, E), Result = error(C, G, E) ) ; MatchBar = error(_, _, _), !:Tokens = BeforeBarTokens, Result = ok(make_p_list_cons(Heads, p_list_nil)) ) ; HeadsResult = error(C, G, E), Result = error(C, G, E) ) ). :- func make_p_list_cons(list(ast_pattern), ast_pattern) = ast_pattern. make_p_list_cons([], Tail) = Tail. make_p_list_cons([Head | Heads], Tail) = p_list_cons(Head, make_p_list_cons(Heads, Tail)). :- pred parse_number_pattern(parse_res(ast_pattern)::out, tokens::in, tokens::out) is det. parse_number_pattern(Result, !Tokens) :- parse_number(Result0, !Tokens), Result = map((func(N) = p_number(N)), Result0). :- pred parse_wildcard_pattern(parse_res(ast_pattern)::out, tokens::in, tokens::out) is det. parse_wildcard_pattern(Result, !Tokens) :- match_token(underscore, Result0, !Tokens), Result = map((func(_) = p_wildcard), Result0). :- pred parse_var_pattern(parse_res(ast_pattern)::out, tokens::in, tokens::out) is det. parse_var_pattern(Result, !Tokens) :- match_token(var, MatchVar, !Tokens), match_token(ident, Result0, !Tokens), ( if MatchVar = ok(_), Result0 = ok(S) then Result = ok(p_var(S)) else Result = combine_errors_2(MatchVar, Result0) ). %-----------------------------------------------------------------------% :- pred maybe_parse_func_export(sharing::out, is_entrypoint::out, tokens::in, tokens::out) is det. maybe_parse_func_export(Sharing, IsEntrypoint, !Tokens) :- parse_export(Sharing0, !Tokens), optional(match_token(entrypoint), ok(MaybeEntrypoint), !Tokens), ( MaybeEntrypoint = yes(_), ( Sharing0 = s_private, % the export keyword might have come after entrypoint, so check % again. parse_export(Sharing, !Tokens) ; Sharing0 = s_public, Sharing = s_public ), IsEntrypoint = is_entrypoint ; MaybeEntrypoint = no, IsEntrypoint = not_entrypoint, Sharing = Sharing0 ). :- pred parse_export_opaque(sharing_opaque::out, tokens::in, tokens::out) is det. parse_export_opaque(Result, !Tokens) :- optional(match_token(export), ok(Export), !Tokens), ( Export = yes(_), optional(match_token(opaque), ok(Opaque), !Tokens), ( Opaque = yes(_), Result = so_public_opaque ; Opaque = no, Result = so_public ) ; Export = no, Result = so_private ). :- pred parse_export(sharing::out, tokens::in, tokens::out) is det. parse_export(Sharing, !Tokens) :- optional(match_token(export), ok(MaybeExport), !Tokens), ( MaybeExport = yes(_), Sharing = s_public ; MaybeExport = no, Sharing = s_private ). %-----------------------------------------------------------------------% % Pragma := 'pragma' Ident ('(' ( PragmaArg PragmaArgs )? ')') % % PragmaArgs := ',' PragmaArg PragmaArgs % | empty % % PragmaArg := String % :- pred parse_pragma(parse_res(ast_entry)::out, tokens::in, tokens::out) is det. parse_pragma(Result, !Tokens) :- get_context(!.Tokens, Context), match_token(pragma_, MatchPragma, !Tokens), match_token(ident, MatchIdent, !Tokens), within(l_paren, zero_or_more_delimited(comma, parse_pragma_arg), r_paren, MatchArgs, !Tokens), ( if MatchPragma = ok(_), MatchIdent = ok(Ident), MatchArgs = ok(Args) then Result = ok(ast_pragma(ast_pragma(Ident, Args, Context))) else Result = combine_errors_3(MatchPragma, MatchIdent, MatchArgs) ). :- pred parse_pragma_arg(parse_res(ast_pragma_arg)::out, tokens::in, tokens::out) is det. parse_pragma_arg(Result, !Tokens) :- parse_string(StringRes, !Tokens), ( StringRes = ok(String), Result = ok(ast_pragma_arg(String)) ; StringRes = error(C, G, E), Result = error(C, G, E) ). %-----------------------------------------------------------------------% %-----------------------------------------------------------------------% :- pred parse_plasma_interface( pred(parse_res(E), tokens, tokens), tokens, result(ast(E), read_src_error)). :- mode parse_plasma_interface( pred(out, in, out) is det, in, out) is det. parse_plasma_interface(ParseEntry, !.Tokens, Result) :- get_context(!.Tokens, Context), match_token(module_, ModuleMatch, !Tokens), parse_q_name(NameResult, !Tokens), zero_or_more_last_error(ParseEntry, ok(Items), LastError, !Tokens), ( if ModuleMatch = ok(_), NameResult = ok(Name) then ( !.Tokens = [], Result = ok(ast(Name, Context, Items)) ; !.Tokens = [token(Tok, _, TokCtxt) | _], LastError = error(LECtxt, Got, Expect), ( if compare((<), LECtxt, TokCtxt) then Result = return_error(TokCtxt, rse_parse_junk_at_end(string(Tok))) else Result = return_error(LECtxt, rse_parse_error(Got, Expect)) ) ) else Result0 = combine_errors_2(ModuleMatch, NameResult) `with_type` parse_res(unit), ( Result0 = error(C, G, E), Result = return_error(C, rse_parse_error(G, E)) ; Result0 = ok(_), unexpected($file, $pred, "ok/1, expecting error/1") ) ). :- pred parse_interface_entry(parse_res(ast_interface_entry)::out, tokens::in, tokens::out) is det. parse_interface_entry(Result, !Tokens) :- or([parse_map(func({N, T}) = asti_resource(N, T), parse_resource_interface), parse_map(func({N, T}) = asti_type(N, T), parse_type(parse_q_name)), parse_map(func({N, D}) = asti_function(N, D), parse_func_decl(parse_q_name, parse_interface)) ], Result, !Tokens). :- pred parse_typeres_entry(parse_res(ast_typeres_entry)::out, tokens::in, tokens::out) is det. parse_typeres_entry(Result, !Tokens) :- or([parse_map(func(N) = asti_resource_abs(N), parse_abs_thing(resource)), parse_map(func({N, T}) = asti_type_abs(N, type_arity(T)), parse_type(parse_q_name)) ], Result, !Tokens). :- pred parse_abs_thing(token_type::in, parse_res(q_name)::out, tokens::in, tokens::out) is det. parse_abs_thing(Token, Result, !Tokens) :- match_token(Token, ResourceMatch, !Tokens), ( ResourceMatch = ok(_), parse_q_name(Result, !Tokens) ; ResourceMatch = error(C, G, E), Result = error(C, G, E) ). %-----------------------------------------------------------------------% %-----------------------------------------------------------------------% % A comma-seperated list with parens or a singleton item. % % This is used for lists where a comma in the list could either be the % end of the whole list and the legal beginning of something else, or % parens can be used to allow a list here. This can be used for things % like the return types of function types when the function type is in % list of its own. % :- pred decl_list(parsing.parser(R, token_type)::in(parsing.parser), parse_res(list(R))::out, tokens::in, tokens::out) is det. decl_list(Parser, Result, !Tokens) :- ( if peek_token(!.Tokens, yes(l_paren)) then within(l_paren, one_or_more_delimited(comma, Parser), r_paren, Result, !Tokens) else Parser(Result0, !Tokens), Result = map((func(R) = [R]), Result0) ). %-----------------------------------------------------------------------% :- func make_cons_list(list(ast_expression), ast_expression) = ast_expression. make_cons_list([], Tail) = Tail. make_cons_list([X | Xs], Tail) = List :- List0 = make_cons_list(Xs, Tail), List = e_b_op(X, b_list_cons, List0). :- func make_bang_call(ast_expression) = ast_expression. make_bang_call(Expr0) = Expr :- ( if Expr0 = e_call_like(ast_call_like(Callee, Args)) then Expr = e_call_like(ast_bang_call(Callee, Args)) else unexpected($file, $pred, "Not a call") ). %-----------------------------------------------------------------------% %-----------------------------------------------------------------------% ================================================ FILE: src/parse_util.m ================================================ %-----------------------------------------------------------------------% % vim: ts=4 sw=4 et %-----------------------------------------------------------------------% :- module parse_util. % % Parsing and lexing utils. % % Copyright (C) Plasma Team % Distributed under the terms of the MIT License see ../LICENSE.code % %-----------------------------------------------------------------------% :- interface. :- import_module io. :- import_module list. :- import_module maybe. :- import_module lex. :- import_module parsing. :- import_module util. :- import_module util.result. %-----------------------------------------------------------------------% :- type parser(T, R) == pred(list(token(T)), result(R, read_src_error)). :- inst parser == ( pred(in, out) is det ). :- type check_token(T) == pred(token(T), maybe(read_src_error)). :- inst check_token == ( pred(in, out) is det ). % parse_file(FileName, Lexemes, IgnoreToken, CheckToken, Parser, Result), % :- pred parse_file(string::in, list(lexeme(lex_token(T)))::in, lex.ignore_pred(T)::in(ignore_pred), check_token(T)::in(check_token), parse_util.parser(T, R)::in(parse_util.parser), result(R, read_src_error)::out, io::di, io::uo) is det. % parse_file(FileName, Lexemes, IgnoreToken, Parser, Result), % :- pred parse_file(string::in, list(lexeme(lex_token(T)))::in, lex.ignore_pred(T)::in(ignore_pred), parse_util.parser(T, R)::in(parse_util.parser), result(R, read_src_error)::out, io::di, io::uo) is det. %-----------------------------------------------------------------------% % A token during lexical analysis. Context information is added later % and the pzt_token type is then used. % :- type lex_token(T) ---> lex_token(T, string). :- func return(T) = token_creator(lex_token(T)). %-----------------------------------------------------------------------% :- type read_src_error ---> rse_io_error(string) ; rse_tokeniser_error(string) ; rse_tokeniser_greedy_comment ; rse_tokeniser_starstarslash_comment ; rse_parse_error(pe_got :: string, pe_expect :: string) ; rse_parse_junk_at_end(string). :- instance error(read_src_error). %-----------------------------------------------------------------------% :- pred tokenize(text_input_stream::in, lexer(lex_token(T), string)::in, ignore_pred(T)::in(ignore_pred), check_token(T)::in(check_token), string::in, result(list(token(T)), read_src_error)::out, io::di, io::uo) is det. %-----------------------------------------------------------------------% %-----------------------------------------------------------------------% :- implementation. :- import_module char. :- import_module cord. :- import_module int. :- import_module string. :- import_module context. :- import_module util.pretty. %-----------------------------------------------------------------------% parse_file(Filename, Lexemes, IgnoreTokens, CheckToken, Parse, Result, !IO) :- io.open_input(Filename, OpenResult, !IO), ( OpenResult = ok(File), Lexer = lex.init(Lexemes, lex.read_from_string, ignore_nothing), tokenize(File, Lexer, IgnoreTokens, CheckToken, Filename, TokensResult, !IO), io.close_input(File, !IO), ( TokensResult = ok(Tokens), Parse(Tokens, Result0), ( Result0 = ok(Node), Result = ok(Node) ; Result0 = errors(Errors), Result = errors(Errors) ) ; TokensResult = errors(Errors), Result = errors(Errors) ) ; OpenResult = error(IOError), Result = return_error(context(Filename), rse_io_error(error_message(IOError))) ). parse_file(Filename, Lexemes, IgnoreTokens, Parse, Result, !IO) :- parse_file(Filename, Lexemes, IgnoreTokens, check_ok, Parse, Result, !IO). :- pred check_ok(T::in, maybe(read_src_error)::out) is det. check_ok(_, no). %-----------------------------------------------------------------------% return(T) = (func(S) = lex_token(T, S)). %-----------------------------------------------------------------------% :- instance error(read_src_error) where [ func(error_or_warning/1) is rse_error_or_warning, pretty(_, E, rse_pretty(E), []) ]. :- func rse_error_or_warning(read_src_error) = error_or_warning. rse_error_or_warning(rse_io_error(_)) = error. rse_error_or_warning(rse_tokeniser_error(_)) = error. rse_error_or_warning(rse_tokeniser_greedy_comment) = error. rse_error_or_warning(rse_tokeniser_starstarslash_comment) = warning. rse_error_or_warning(rse_parse_error(_, _)) = error. rse_error_or_warning(rse_parse_junk_at_end(_)) = error. :- func rse_pretty(read_src_error) = list(pretty). rse_pretty(rse_io_error(Message)) = p_words(Message). rse_pretty(rse_tokeniser_error(Message)) = p_words("Tokenizer error,") ++ p_spc_nl ++ p_words(Message). rse_pretty(rse_tokeniser_greedy_comment) = p_words("The tokeniser got confused, " ++ "until we improve it please don't end comments with **/"). rse_pretty(rse_tokeniser_starstarslash_comment) = p_words("The tokeniser can get confused, " ++ "until we improve it please don't end comments with **/"). rse_pretty(rse_parse_error(Got, Expected)) = p_words("Parse error, read") ++ p_spc_nl ++ [p_str(Got)] ++ p_spc_nl ++ [p_str("expected")] ++ p_spc_nl ++ [p_str(Expected)]. rse_pretty(rse_parse_junk_at_end(Got)) = p_words("Parse error: junk at end of input:") ++ p_spc_nl ++ [p_str(Got)]. %-----------------------------------------------------------------------% tokenize(File, Lexer, IgnoreTokens, CheckToken, Filename, MaybeTokens, !IO) :- io.read_file_as_string(File, ReadResult, !IO), ( ReadResult = ok(String0), copy(String0, String), tokenize_string(Filename, Lexer, IgnoreTokens, CheckToken, String, MaybeTokens) ; ReadResult = error(_, IOError), MaybeTokens = return_error(context(Filename, -1, -1), rse_io_error(error_message(IOError))) ). :- pred tokenize_string(string::in, lexer(lex_token(T), string)::in, ignore_pred(T)::in(ignore_pred), check_token(T)::in(check_token), string::di, result(list(token(T)), read_src_error)::out) is det. tokenize_string(Filename, Lexer, IgnoreToken, CheckToken, String, MaybeTokens) :- LS0 = lex.start(Lexer, String), tokenize_string(IgnoreToken, CheckToken, Filename, pos(1, 1), [], init, MaybeTokens, LS0, LS), _ = lex.stop(LS). :- pred tokenize_string(ignore_pred(T)::in(ignore_pred), check_token(T)::in(check_token), string::in, pos::in, list(token(T))::in, errors(read_src_error)::in, result(list(token(T)), read_src_error)::out, lexer_state(lex_token(T), string)::di, lexer_state(lex_token(T), string)::uo) is det. tokenize_string(IgnoreTokens, CheckToken, Filename, Pos0, RevTokens0, !.Errors, MaybeTokens, !LS) :- pos(Line, Col) = Pos0, Context = context(Filename, Line, Col), lex.read(MaybeToken, !LS), ( MaybeToken = ok(lex_token(Token, String)), advance_position(String, Pos0, Pos), TAC = token(Token, String, Context), CheckToken(TAC, CheckRes), ( CheckRes = no ; CheckRes = yes(Error), add_error(Context, Error, !Errors) ), ( if IgnoreTokens(Token) then RevTokens = RevTokens0 else RevTokens = [TAC | RevTokens0] ), tokenize_string(IgnoreTokens, CheckToken, Filename, Pos, RevTokens, !.Errors, MaybeTokens, !LS) ; MaybeToken = eof, ( if is_empty(!.Errors) then MaybeTokens = ok(reverse(RevTokens0)) else MaybeTokens = errors(!.Errors) ) ; MaybeToken = error(Message, _Line), MaybeTokens = return_error(Context, rse_tokeniser_error(Message)) ). %-----------------------------------------------------------------------% :- type pos ---> pos( p_line :: int, p_col :: int ). :- pred advance_position(string::in, pos::in, pos::out) is det. advance_position(String, !Pos) :- foldl(advance_position_char, String, !Pos). :- pred advance_position_char(char::in, pos::in, pos::out) is det. advance_position_char(Char, !Pos) :- ( if Char = '\n' ; Char = '\r' then !:Pos = pos(!.Pos ^ p_line + 1, 1) else !:Pos = pos(!.Pos ^ p_line, !.Pos ^ p_col + 1) ). %-----------------------------------------------------------------------% :- pred ignore_nothing(Token::in) is semidet. ignore_nothing(_) :- semidet_false. %-----------------------------------------------------------------------% %-----------------------------------------------------------------------% ================================================ FILE: src/parsing.m ================================================ %-----------------------------------------------------------------------% % vim: ts=4 sw=4 et %-----------------------------------------------------------------------% :- module parsing. % % Parsing utils. % % Copyright (C) Plasma Team % Distributed under the terms of the MIT License see ../LICENSE.code % %-----------------------------------------------------------------------% :- interface. :- import_module list. :- import_module maybe. :- import_module unit. :- import_module context. :- import_module q_name. %-----------------------------------------------------------------------% :- type token(T) ---> token( t_terminal :: T, t_data :: string, t_context :: context ). :- type parse_res(R) ---> ok(R) ; error(context, pe_got :: string, pe_expect :: string). :- inst res_ok for parse_res/1 ---> ok(ground). :- inst res_error for parse_res/1 ---> error(ground, ground, ground). :- type parser(R, T) == pred(parse_res(R), list(token(T)), list(token(T))). :- inst parser == ( pred(out, in, out) is det ). :- type parser_last_error(R, T) == pred(parse_res(R), parse_res(unit), list(token(T)), list(token(T))). :- inst parser_last_error == ( pred(out, out(res_error), in, out) is det ). %-----------------------------------------------------------------------% :- pred optional(parser(R, T)::in(parser), parse_res(maybe(R))::out(res_ok), list(token(T))::in, list(token(T))::out) is det. :- pred optional_last_error(parser(R, T)::in(parser), parse_res(maybe(R))::out(res_ok), parse_res(unit)::out(res_error), list(token(T))::in, list(token(T))::out) is det. :- pred zero_or_more(parser(R, T)::in(parser), parse_res(list(R))::out(res_ok), list(token(T))::in, list(token(T))::out) is det. :- pred zero_or_more_last_error(parser(R, T)::in(parser), parse_res(list(R))::out(res_ok), parse_res(unit)::out(res_error), list(token(T))::in, list(token(T))::out) is det. :- pred zero_or_more_delimited(T::in, parser(R, T)::in(parser), parse_res(list(R))::out(res_ok), list(token(T))::in, list(token(T))::out) is det. :- pred one_or_more(parser(R, T)::in(parser), parse_res(list(R))::out, list(token(T))::in, list(token(T))::out) is det. :- pred one_or_more_last_error(parser(R, T)::in(parser), parse_res(list(R))::out, parse_res(unit)::out(res_error), list(token(T))::in, list(token(T))::out) is det. :- pred one_or_more_delimited(T::in, parser(R, T)::in(parser), parse_res(list(R))::out, list(token(T))::in, list(token(T))::out) is det. :- pred or(list(parser(R, T))::in(list(parser)), parse_res(R)::out, list(token(T))::in, list(token(T))::out) is det. :- pred within(T::in, parser(R, T)::in(parser), T::in, parse_res(R)::out, list(token(T))::in, list(token(T))::out) is det. :- pred within_use_last_error(T::in, parser_last_error(R, T)::in(parser_last_error), T::in, parse_res(R)::out, list(token(T))::in, list(token(T))::out) is det. %-----------------------------------------------------------------------% :- pred parse_map(func(A) = B, parser(A, T), parse_res(B), list(token(T)), list(token(T))). :- mode parse_map(func(in) = out is det, in(parser), out, in, out) is det. %-----------------------------------------------------------------------% :- func combine_errors_2(parse_res(R1), parse_res(R2)) = parse_res(R). :- func combine_errors_3(parse_res(R1), parse_res(R2), parse_res(R3)) = parse_res(R). :- func combine_errors_4(parse_res(R1), parse_res(R2), parse_res(R3), parse_res(R4)) = parse_res(R). :- func combine_errors_5(parse_res(R1), parse_res(R2), parse_res(R3), parse_res(R4), parse_res(R5)) = parse_res(R). :- func combine_errors_6(parse_res(R1), parse_res(R2), parse_res(R3), parse_res(R4), parse_res(R5), parse_res(R6)) = parse_res(R). :- func latest_error(parse_res(R1), parse_res(R2)) = parse_res(R). :- mode latest_error(in, in(res_error)) = out(res_error) is det. :- mode latest_error(in(res_error), in) = out(res_error) is det. :- func map(func(X) = Y, parse_res(X)) = parse_res(Y). %-----------------------------------------------------------------------% :- pred match_token(T::in, parse_res(string)::out, list(token(T))::in, list(token(T))::out) is det. :- pred match_tokens(list(T)::in, parse_res(unit)::out, list(token(T))::in, list(token(T))::out) is det. :- type token_and_string(T) ---> token_and_string(T, string). :- pred next_token(string::in, parse_res(token_and_string(T))::out, list(token(T))::in, list(token(T))::out) is det. :- pred peek_token(list(token(T))::in, maybe(T)::out) is det. %-----------------------------------------------------------------------% :- pred get_context(list(token(T))::in, context::out) is det. %-----------------------------------------------------------------------% :- typeclass ident_parsing(T) where [ func ident_ = T, func period_ = T ]. :- pred parse_nq_name(parse_res(nq_name)::out, list(token(T))::in, list(token(T))::out) is det <= ident_parsing(T). :- pred parse_q_name(parse_res(q_name)::out, list(token(T))::in, list(token(T))::out) is det <= ident_parsing(T). %-----------------------------------------------------------------------% %-----------------------------------------------------------------------% :- implementation. :- import_module require. :- import_module string. %-----------------------------------------------------------------------% optional(Parse, Result, !Tokens) :- optional_last_error(Parse, Result, _, !Tokens). optional_last_error(Parse, Result, LastError, !Tokens) :- StartTokens = !.Tokens, Parse(Result0, !Tokens), ( Result0 = ok(X), Result = ok(yes(X)), LastError = error(nil_context, "", "") ; Result0 = error(C, G, E), !:Tokens = StartTokens, Result = ok(no), LastError = error(C, G, E) ). %-----------------------------------------------------------------------% zero_or_more(Parse, Result, !Tokens) :- zero_or_more_last_error(Parse, Result, _, !Tokens). zero_or_more_last_error(Parse, Result, LastError, !Tokens) :- StartTokens = !.Tokens, Parse(ResultX, !Tokens), ( ResultX = ok(X), zero_or_more_last_error(Parse, ResultXS, LastError, !Tokens), ResultXS = ok(XS), Result = ok([X | XS]) ; ResultX = error(C, G, E), !:Tokens = StartTokens, Result = ok([]), LastError = error(C, G, E) ). zero_or_more_delimited(Delim, Parse, Result, !Tokens) :- Parse(ResultX, !.Tokens, Tokens0), ( ResultX = ok(X), !:Tokens = Tokens0, delimited_list(Delim, Parse, ok(Xs), !Tokens), Result = ok([X | Xs]) ; ResultX = error(_, _, _), Result = ok([]) ). one_or_more(Parse, Result, !Tokens) :- StartTokens = !.Tokens, Parse(ResultX, !Tokens), ( ResultX = ok(X), zero_or_more(Parse, ok(XS), !Tokens), Result = ok([X | XS]) ; ResultX = error(C, G, E), !:Tokens = StartTokens, Result = error(C, G, E) ). one_or_more_last_error(Parse, Result, LastError, !Tokens) :- StartTokens = !.Tokens, Parse(ResultX, !Tokens), ( ResultX = ok(X), zero_or_more_last_error(Parse, ResultXS, LastError, !Tokens), ResultXS = ok(XS), Result = ok([X | XS]) ; ResultX = error(C, G, E), !:Tokens = StartTokens, Result = error(C, G, E), LastError = error(C, G, E) ). one_or_more_delimited(Delim, Parse, Result, !Tokens) :- StartTokens = !.Tokens, Parse(ResultX, !Tokens), ( ResultX = ok(X), delimited_list(Delim, Parse, ok(XS), !Tokens), Result = ok([X | XS]) ; ResultX = error(C, G, E), !:Tokens = StartTokens, Result = error(C, G, E) ). :- pred delimited_list(T::in, parser(R, T)::in(parser), parse_res(list(R))::out(res_ok), list(token(T))::in, list(token(T))::out) is det. delimited_list(Delim, Parse, Result, !Tokens) :- match_token(Delim, DelimMatch, !.Tokens, Tokens0), Parse(ResultX, Tokens0, Tokens1), ( if DelimMatch = ok(_), ResultX = ok(X) then !:Tokens = Tokens1, delimited_list(Delim, Parse, ok(Xs), !Tokens), Result = ok([X | Xs]) else Result = ok([]) ). %-----------------------------------------------------------------------% or(Parsers, Result, !Tokens) :- or_loop(error(nil_context, "", ""), Parsers, Result, !Tokens). :- pred or_loop(parse_res(R)::in(res_error), list(parser(R, T))::in(list(parser)), parse_res(R)::out, list(token(T))::in, list(token(T))::out) is det. or_loop(PrevError, [], PrevError, !Tokens). or_loop(PrevError, [Parser | Parsers], Result, !Tokens) :- StartTokens = !.Tokens, Parser(Result0, !Tokens), ( Result0 = ok(_), Result = Result0 ; Result0 = error(_, _, _), !:Tokens = StartTokens, NextError = latest_error(PrevError, Result0), or_loop(NextError, Parsers, Result, !Tokens) ). within(Open, Parser, Close, Result, !Tokens) :- match_token(Open, OpenResult, !Tokens), ( OpenResult = ok(_), Parser(Result0, !Tokens), match_token(Close, CloseResult, !Tokens), ( if OpenResult = ok(_), Result0 = ok(X), CloseResult = ok(_) then Result = ok(X) else Result = combine_errors_2(Result0, CloseResult) ) ; OpenResult = error(C, G, E), Result = error(C, G, E) ). within_use_last_error(Open, Parser, Close, Result, !Tokens) :- match_token(Open, OpenResult, !Tokens), ( OpenResult = ok(_), Parser(Result0, LastError, !Tokens), match_token(Close, CloseResult, !Tokens), ( if OpenResult = ok(_), Result0 = ok(X), CloseResult = ok(_) then Result = ok(X) else Result = combine_errors_2( latest_error(Result0, LastError) `with_type` parse_res(unit), CloseResult) ) ; OpenResult = error(C, G, E), Result = error(C, G, E) ). %-----------------------------------------------------------------------% parse_map(Map, Parser, Result, !Tokens) :- Parser(Result0, !Tokens), ( Result0 = ok(A), Result = ok(Map(A)) ; Result0 = error(C, G, E), Result = error(C, G, E) ). %-----------------------------------------------------------------------% combine_errors_2(ok(_), ok(_)) = unexpected($pred, "not an error"). combine_errors_2(ok(_), error(C, G, E)) = error(C, G, E). combine_errors_2(error(C, G, E), _) = error(C, G, E). combine_errors_3(ok(_), ok(_), ok(_)) = unexpected($pred, "not an error"). combine_errors_3(ok(_), ok(_), error(C, G, E)) = error(C, G, E). combine_errors_3(ok(_), error(C, G, E), _) = error(C, G, E). combine_errors_3(error(C, G, E), _, _) = error(C, G, E). combine_errors_4(ok(_), ok(_), ok(_), ok(_)) = unexpected($pred, "not an error"). combine_errors_4(ok(_), ok(_), ok(_), error(C, G, E)) = error(C, G, E). combine_errors_4(ok(_), ok(_), error(C, G, E), _) = error(C, G, E). combine_errors_4(ok(_), error(C, G, E), _, _) = error(C, G, E). combine_errors_4(error(C, G, E), _, _, _) = error(C, G, E). combine_errors_5(ok(_), ok(_), ok(_), ok(_), ok(_)) = unexpected($pred, "not an error"). combine_errors_5(ok(_), ok(_), ok(_), ok(_), error(C, G, E)) = error(C, G, E). combine_errors_5(ok(_), ok(_), ok(_), error(C, G, E), _) = error(C, G, E). combine_errors_5(ok(_), ok(_), error(C, G, E), _, _) = error(C, G, E). combine_errors_5(ok(_), error(C, G, E), _, _, _) = error(C, G, E). combine_errors_5(error(C, G, E), _, _, _, _) = error(C, G, E). combine_errors_6(ok(_), ok(_), ok(_), ok(_), ok(_), ok(_)) = unexpected($pred, "not an error"). combine_errors_6(ok(_), ok(_), ok(_), ok(_), ok(_), error(C, G, E)) = error(C, G, E). combine_errors_6(ok(_), ok(_), ok(_), ok(_), error(C, G, E), _) = error(C, G, E). combine_errors_6(ok(_), ok(_), ok(_), error(C, G, E), _, _) = error(C, G, E). combine_errors_6(ok(_), ok(_), error(C, G, E), _, _, _) = error(C, G, E). combine_errors_6(ok(_), error(C, G, E), _, _, _, _) = error(C, G, E). combine_errors_6(error(C, G, E), _, _, _, _, _) = error(C, G, E). latest_error(ok(_), error(C, G, E)) = error(C, G, E). latest_error(error(C, G, E), ok(_)) = error(C, G, E). latest_error(error(C1, G1, E1), error(C2, G2, E2)) = Err :- compare(CR, C1, C2), ( ( CR = (>) ; CR = (=) ), Err = error(C1, G1, E1) ; CR = (<), Err = error(C2, G2, E2) ). map(M, ok(X)) = ok(M(X)). map(_, error(C, G, E)) = error(C, G, E). %-----------------------------------------------------------------------% match_token(TA, error(nil_context, "EOF", string(TA)), [], []). match_token(TA, Result, Ts0@[token(TB, String, Context) | Ts1], Ts) :- ( if TA = TB then Result = ok(String), Ts = Ts1 else Result = error(Context, string(TB), string(TA)), Ts = Ts0 ). match_tokens([], ok(unit), !Tokens). match_tokens([T|Ts], Result, !Tokens) :- match_token(T, Result0, !Tokens), ( Result0 = ok(_), match_tokens(Ts, Result, !Tokens) ; Result0 = error(C, G, E), Result = error(C, G, E) ). next_token(Expect, error(nil_context, "EOF", Expect), [], []). next_token(_, ok(token_and_string(Token, String)), [token(Token, String, _) | Tokens], Tokens). peek_token([], no). peek_token([token(Token, _, _) | _], yes(Token)). %-----------------------------------------------------------------------% get_context([], nil_context). get_context([token(_, _, Context) | _], Context). %-----------------------------------------------------------------------% parse_nq_name(Result, !Tokens) :- match_token(ident_, Result0, !Tokens), Result = map(func(S) = nq_name_det(S), Result0). parse_q_name(Result, !Tokens) :- zero_or_more(parse_qualifier, ok(Qualifiers), !Tokens), match_token(ident_, IdentResult, !Tokens), Result = map((func(S) = q_name_from_strings_2(Qualifiers, S)), IdentResult). :- pred parse_qualifier(parse_res(string)::out, list(token(T))::in, list(token(T))::out) is det <= ident_parsing(T). parse_qualifier(Result, !Tokens) :- match_token(ident_, IdentResult, !Tokens), match_token(period_, DotMatch, !Tokens), ( if IdentResult = ok(Ident), DotMatch = ok(_) then Result = ok(Ident) else Result = combine_errors_2(IdentResult, DotMatch) ). %-----------------------------------------------------------------------% %-----------------------------------------------------------------------% ================================================ FILE: src/plzasm.m ================================================ %-----------------------------------------------------------------------% % Plasma assembler % vim: ts=4 sw=4 et % % Copyright (C) Plasma Team % Distributed under the terms of the MIT License see ../LICENSE.code % % This program assembles and links the pz intermediate representation. % %-----------------------------------------------------------------------% :- module plzasm. %-----------------------------------------------------------------------% :- interface. :- import_module io. :- pred main(io::di, io::uo) is det. %-----------------------------------------------------------------------% %-----------------------------------------------------------------------% :- implementation. :- import_module bool. :- import_module char. :- import_module getopt. :- import_module list. :- import_module maybe. :- import_module string. :- import_module asm. :- import_module asm_ast. :- import_module constant. :- import_module pz. :- import_module pz.write. :- import_module pzt_parse. :- import_module util. :- import_module util.my_exception. :- import_module util.mercury. :- import_module util.path. :- import_module util.result. %-----------------------------------------------------------------------% main(!IO) :- io.command_line_arguments(Args0, !IO), process_options(Args0, OptionsResult, !IO), ( OptionsResult = ok(PZAsmOpts), Mode = PZAsmOpts ^ pzo_mode, ( Mode = assemble(InputFile, OutputFile), promise_equivalent_solutions [!:IO] ( run_and_catch(do_assemble(InputFile, OutputFile), plzasm, HadErrors, !IO), ( HadErrors = had_errors, io.set_exit_status(1, !IO) ; HadErrors = did_not_have_errors ) ) ; Mode = help, usage(!IO) ; Mode = version, version("Plasma Abstract Machine Assembler", !IO) ) ; OptionsResult = error(ErrMsg), exit_error(ErrMsg, !IO) ). :- pred do_assemble(string::in, string::in, io::di, io::uo) is det. do_assemble(InputFile, OutputFile, !IO) :- pzt_parse.parse(InputFile, MaybePZAst, !IO), ( MaybePZAst = ok(PZAst), assemble(PZAst, MaybePZ), ( MaybePZ = ok(PZ), write_pz(OutputFile, PZ, Result, !IO), ( Result = ok ; Result = error(ErrMsg), exit_error(ErrMsg, !IO) ) ; MaybePZ = errors(Errors), report_errors("", Errors, !IO), set_exit_status(1, !IO) ) ; MaybePZAst = errors(Errors), report_errors("", Errors, !IO), set_exit_status(1, !IO) ). %-----------------------------------------------------------------------% :- type pzasm_options ---> pzasm_options( pzo_mode :: pzo_mode, pzo_verbose :: bool ). :- type pzo_mode ---> assemble( pzma_input_file :: string, pzma_output_file :: string ) ; help ; version. :- pred process_options(list(string)::in, maybe_error(pzasm_options)::out, io::di, io::uo) is det. process_options(Args0, Result, !IO) :- OptionOpts = option_ops_multi(short_option, long_option, option_default), getopt.process_options(OptionOpts, Args0, Args, MaybeOptions), ( MaybeOptions = ok(OptionTable), lookup_bool_option(OptionTable, help, Help), lookup_bool_option(OptionTable, version, Version), lookup_bool_option(OptionTable, verbose, Verbose), ( if Help = yes then Result = ok(pzasm_options(help, Verbose)) else if Version = yes then Result = ok(pzasm_options(version, Verbose)) else ( if Args = [InputFile] then ( if lookup_string_option(OptionTable, output, Output0), Output0 \= "" then Output = Output0 else file_change_extension_det(constant.pz_text_extension, constant.output_extension, InputFile, Output) ), Result = ok(pzasm_options(assemble(InputFile, Output), Verbose)) else Result = error("Error processing command line options: " ++ "Expected exactly one input file") ) ) ; MaybeOptions = error(ErrMsg), Result = error("Error processing command line options: " ++ option_error_to_string(ErrMsg)) ). :- pred usage(io::di, io::uo) is det. usage(!IO) :- io.write_string("Plasma assembler\n\n", !IO), io.write_string( " The plasma assembler creates plasma bytecode files from\n" ++ " a text representation.\n\n", !IO), io.write_string("Usage:\n\n", !IO), io.progname_base("plzasm", ProgName, !IO), io.format(" %s [-v] [-o | --output ] \n", [s(ProgName)], !IO), io.format(" %s -h\n\n", [s(ProgName)], !IO). :- type option ---> help ; verbose ; version ; output. :- pred short_option(char::in, option::out) is semidet. short_option('h', help). short_option('v', verbose). short_option('o', output). :- pred long_option(string::in, option::out) is semidet. long_option("help", help). long_option("verbose", verbose). long_option("version", version). long_option("output", output). :- pred option_default(option::out, option_data::out) is multi. option_default(help, bool(no)). option_default(verbose, bool(no)). option_default(version, bool(no)). option_default(output, string("")). %-----------------------------------------------------------------------% %-----------------------------------------------------------------------% ================================================ FILE: src/plzbuild.m ================================================ %-----------------------------------------------------------------------% % Plasma builder % vim: ts=4 sw=4 et % % Copyright (C) Plasma Team % Distributed under the terms of the MIT License see ../LICENSE.code % % This program starts the build process for Plasma projects % %-----------------------------------------------------------------------% :- module plzbuild. %-----------------------------------------------------------------------% :- interface. :- import_module io. :- pred main(io::di, io::uo) is det. %-----------------------------------------------------------------------% %-----------------------------------------------------------------------% :- implementation. :- import_module bool. :- import_module char. :- import_module getopt. :- import_module list. :- import_module maybe. :- import_module string. :- import_module build. :- import_module constant. :- import_module q_name. :- import_module util. :- import_module util.my_exception. :- import_module util.mercury. :- import_module util.path. :- import_module util.result. %-----------------------------------------------------------------------% main(!IO) :- io.command_line_arguments(Args0, !IO), process_options(Args0, OptionsResult, !IO), ( OptionsResult = ok(Mode), ( Mode = build(Options), build(Options, Errors, !IO), report_errors("", Errors, !IO), ( if has_fatal_errors(Errors) then set_exit_status(1, !IO) else true ) ; Mode = help, usage(!IO) ; Mode = version, version("Plasma Builder", !IO) ) ; OptionsResult = error(ErrMsg), exit_error(ErrMsg, !IO) ). %-----------------------------------------------------------------------% :- type plzbuild_mode ---> build(plzbuild_options) ; help ; version. :- pred process_options(list(string)::in, maybe_error(plzbuild_mode)::out, io::di, io::uo) is det. process_options(Args0, Result, !IO) :- OptionOpts = option_ops_multi(short_option, long_option, option_default), getopt.process_options(OptionOpts, Args0, Args, MaybeOptions), ( MaybeOptions = ok(OptionTable), lookup_bool_option(OptionTable, help, Help), lookup_bool_option(OptionTable, version, Version), ( if Help = yes then Result = ok(help) else if Version = yes then Result = ok(version) else Verbose = handle_bool_option(OptionTable, verbose, verbose, terse), Rebuild = handle_bool_option(OptionTable, rebuild, need_rebuild, dont_rebuild), lookup_string_option(OptionTable, build_file, BuildFile), lookup_string_option(OptionTable, build_dir, BuildDir), lookup_bool_option(OptionTable, report_timing, ReportTimingBool), ( ReportTimingBool = yes, ReportTiming = report_timing ; ReportTimingBool = no, ReportTiming = dont_report_timing ), discover_tools_path(MaybeToolsPath, !IO), ( MaybeToolsPath = yes(ToolsPath) ; MaybeToolsPath = no, my_exception.sorry($file, $pred, "We don't know how to determine plzbuild's path " ++ "(OS incompatibility?)") ), MaybeModuleNames = maybe_error_list(map( string_to_module_name, Args)), ( MaybeModuleNames = ok(ModuleNames), Result = ok(build(plzbuild_options(ModuleNames, Verbose, Rebuild, BuildFile, BuildDir, ReportTiming, ToolsPath, "../"))) ; MaybeModuleNames = error(Errors), Result = error(string_join("\n", Errors)) ) ) ; MaybeOptions = error(ErrMsg), Result = error("Error processing command line options: " ++ option_error_to_string(ErrMsg)) ). :- func string_to_module_name(string) = maybe_error(nq_name, string). string_to_module_name(String) = Result :- MaybeName = nq_name_from_string(String), ( MaybeName = ok(Name), Result = ok(Name) ; MaybeName = error(Error), Result = error(format("Plasma program name '%s' is invalid: %s.", [s(String), s(Error)])) ). :- pred discover_tools_path(maybe(string)::out, io::di, io::uo) is det. discover_tools_path(MaybePath, !IO) :- progname("", ProgramName, !IO), ( if ProgramName \= "" then ( if file_and_dir(ProgramName, Dir, _) then MaybePath = yes(Dir) else get_environment_var("PATH", MaybePathVar, !IO), ( MaybePathVar = yes(PathVar), Paths = words_separator(unify(':'), PathVar), search_path(Paths, ProgramName, MaybePath, !IO) ; MaybePathVar = no, MaybePath = no ) ) else MaybePath = no ). :- pred search_path(list(string)::in, string::in, maybe(string)::out, io::di, io::uo) is det. search_path([], _, no, !IO). search_path([Path | Paths], File, Result, !IO) :- file_and_dir(FullPath, Path, File), check_file_accessibility(FullPath, [execute], Res, !IO), ( Res = ok, Result = yes(Path) ; Res = error(_), search_path(Paths, File, Result, !IO) ). :- pred usage(io::di, io::uo) is det. usage(!IO) :- io.write_string("Plasma builder\n\n", !IO), io.write_string( " The Plasma builder is used to build Plasma programs and\n" ++ " libraries. It runs the other tools (compiler and linker)\n" ++ " to build an link the modules based on a `BUILD.plz` file.\n\n", !IO), io.write_string("Usage:\n\n", !IO), io.progname_base("plzbuild", ProgName, !IO), io.format(" %s [options] \n", [s(ProgName)], !IO), io.format(" %s -h | --help>\n", [s(ProgName)], !IO), io.format(" %s --version>\n", [s(ProgName)], !IO), io.nl(!IO), io.write_string("Options may include:\n\n", !IO), io.write_string(" -v | --verbose\n", !IO), io.write_string(" Write verbose output\n\n", !IO), io.write_string(" --rebuild\n", !IO), io.write_string(" Regenerate/rebuild everything regardless of timestamps\n\n", !IO), io.write_string("Developer options:\n\n", !IO), io.write_string(" --build-file FILE\n", !IO), io.write_string(" Use this build file.\n\n", !IO), io.write_string(" --build-dir DIR\n", !IO), io.write_string(" Perform the build in this directory.\n\n", !IO), io.write_string(" --report-timing\n", !IO), io.write_string(" Report the elapsed and CPU time for each sub-command.\n\n", !IO). :- type option ---> rebuild ; build_file ; build_dir ; report_timing ; help ; verbose ; version. :- pred short_option(char::in, option::out) is semidet. short_option('h', help). short_option('v', verbose). :- pred long_option(string::in, option::out) is semidet. long_option("rebuild", rebuild). long_option("build-file", build_file). long_option("build-dir", build_dir). long_option("report-timing", report_timing). long_option("help", help). long_option("verbose", verbose). long_option("version", version). :- pred option_default(option::out, option_data::out) is multi. option_default(rebuild, bool(no)). option_default(build_file, string(build_file)). option_default(build_dir, string(build_directory)). option_default(report_timing, bool(no)). option_default(help, bool(no)). option_default(verbose, bool(no)). option_default(version, bool(no)). %-----------------------------------------------------------------------% %-----------------------------------------------------------------------% ================================================ FILE: src/plzc.m ================================================ %-----------------------------------------------------------------------% % Plasma compiler % vim: ts=4 sw=4 et % % Copyright (C) Plasma Team % Distributed under the terms of the MIT License see ../LICENSE.code % % This program compiles plasma modules. % %-----------------------------------------------------------------------% :- module plzc. %-----------------------------------------------------------------------% :- interface. :- import_module io. :- pred main(io::di, io::uo) is det. %-----------------------------------------------------------------------% %-----------------------------------------------------------------------% :- implementation. :- import_module bool. :- import_module char. :- import_module cord. :- import_module getopt. :- import_module list. :- import_module maybe. :- import_module require. :- import_module string. :- import_module ast. :- import_module common_types. :- import_module compile. :- import_module compile_error. :- import_module constant. :- import_module context. :- import_module core. :- import_module core.arity_chk. :- import_module core.branch_chk. :- import_module core.pretty. :- import_module core.res_chk. :- import_module core.simplify. :- import_module core.type_chk. :- import_module core_to_pz. :- import_module dump_stage. :- import_module foreign. :- import_module options. :- import_module parse. :- import_module pre. :- import_module pre.import. :- import_module pz. :- import_module pz.pz_ds. :- import_module pz.write. :- import_module pz.pretty. :- import_module q_name. :- import_module util. :- import_module util.my_exception. :- import_module util.log. :- import_module util.mercury. :- import_module util.path. :- import_module util.result. :- import_module util.my_time. :- import_module write_interface. %-----------------------------------------------------------------------% main(!IO) :- now(StartTime, !IO), io.command_line_arguments(Args0, !IO), process_options(Args0, OptionsResult, !IO), ( OptionsResult = ok(PlasmaCOpts), ( PlasmaCOpts = plasmac_options(GeneralOpts, Mode), verbose_output(GeneralOpts ^ go_verbose, format("Parsing %s\n", [s(GeneralOpts ^ go_input_file)]), !IO), parse(GeneralOpts ^ go_input_file, MaybePlasmaAst, !IO), ( MaybePlasmaAst = ok(PlasmaAst), promise_equivalent_solutions [!:IO, HadErrors] ( ( Mode = compile(CompileOpts), run_and_catch(do_compile(GeneralOpts, CompileOpts, PlasmaAst), plzc, HadErrors, !IO) ; Mode = make_interface, run_and_catch(do_make_interface(GeneralOpts, PlasmaAst), plzc, HadErrors, !IO) ; Mode = make_typeres_exports, run_and_catch( do_make_typeres_exports(GeneralOpts, PlasmaAst), plzc, HadErrors, !IO) ; Mode = scan(TargetBytecode, TargetInterface), run_and_catch( do_make_dep_info(GeneralOpts, TargetBytecode, TargetInterface, PlasmaAst), plzc, HadErrors, !IO) ; Mode = make_foreign(OutputHeader), run_and_catch(do_make_foreign(GeneralOpts, OutputHeader, PlasmaAst), plzc, HadErrors, !IO) ), ReportTiming = GeneralOpts ^ go_report_timing, ( ReportTiming = report_command_times, now(EndTime, !IO), format("%s\n", [s(format_duration(diff_time(EndTime, StartTime)))], !IO) ; ReportTiming = no_timing ) ), ( HadErrors = had_errors, io.set_exit_status(2, !IO) ; HadErrors = did_not_have_errors ) ; MaybePlasmaAst = errors(Errors), report_errors(GeneralOpts ^ go_source_dir, Errors, !IO), set_exit_status(1, !IO) ) ; PlasmaCOpts = plasmac_help, usage(!IO) ; PlasmaCOpts = plasmac_version, version("Plasma Compiler", !IO) ) ; OptionsResult = error(ErrMsg), exit_error(ErrMsg, !IO) ). %-----------------------------------------------------------------------% :- pred do_compile(general_options::in, compile_options::in, ast::in, io::di, io::uo) is det. do_compile(GeneralOpts, CompileOpts, PlasmaAst, !IO) :- compile(GeneralOpts, CompileOpts, PlasmaAst, MaybePZ, !IO), ( MaybePZ = ok(PZ, Errors), report_errors(GeneralOpts ^ go_source_dir, Errors, !IO), ( if has_fatal_errors(Errors) then unexpected($file, $pred, "Fatal errors returned with result") else true ), ( if ( GeneralOpts ^ go_warn_as_error = no ; is_empty(Errors) ) then WriteOutput = GeneralOpts ^ go_write_output, ( WriteOutput = write_output, OutputFile = GeneralOpts ^ go_output_file, write_pz(OutputFile, PZ, Result, !IO), ( Result = ok ; Result = error(ErrMsg), exit_error(ErrMsg, !IO) ) ; WriteOutput = dont_write_output ) else set_exit_status(1, !IO) ) ; MaybePZ = errors(Errors), report_errors(GeneralOpts ^ go_source_dir, Errors, !IO), set_exit_status(1, !IO) ). %-----------------------------------------------------------------------% :- pred do_make_interface(general_options::in, ast::in, io::di, io::uo) is det. do_make_interface(GeneralOpts, PlasmaAst, !IO) :- process_declarations(GeneralOpts, PlasmaAst, MaybeCore, !IO), ( MaybeCore = ok(Core, Errors), report_errors(GeneralOpts ^ go_source_dir, Errors, !IO), ( if has_fatal_errors(Errors) then unexpected($file, $pred, "Fatal errors returned with result") else true ), ( if ( GeneralOpts ^ go_warn_as_error = no ; is_empty(Errors) ) then WriteOutput = GeneralOpts ^ go_write_output, ( WriteOutput = write_output, % The interface is within the core representation. We will % extract and pretty print the parts we need. OutputFile = GeneralOpts ^ go_output_file, write_interface(OutputFile, Core, Result, !IO), ( Result = ok ; Result = error(ErrMsg), exit_error(ErrMsg, !IO) ) ; WriteOutput = dont_write_output ) else set_exit_status(1, !IO) ) ; MaybeCore = errors(Errors), report_errors(GeneralOpts ^ go_source_dir, Errors, !IO), set_exit_status(1, !IO) ). %-----------------------------------------------------------------------% :- pred do_make_dep_info(general_options::in, string::in, string::in, ast::in, io::di, io::uo) is det. do_make_dep_info(GeneralOpts, TargetBytecode, TargetInterface, PlasmaAst, !IO) :- check_module_name(GeneralOpts, PlasmaAst ^ a_context, PlasmaAst ^ a_module_name, init, ModuleNameErrors), ( if has_fatal_errors(ModuleNameErrors) then report_errors(GeneralOpts ^ go_source_dir, ModuleNameErrors, !IO), set_exit_status(1, !IO) else filter_entries(PlasmaAst ^ a_entries, Imports0, _, _, _, _), % TODO: Include only dependencies required to build interface files, % that is those that are used by types and resources only. ast_to_import_list(PlasmaAst ^ a_module_name, "..", GeneralOpts ^ go_import_whitelist_file, Imports0, Imports, !IO), WriteOutput = GeneralOpts ^ go_write_output, ( WriteOutput = write_output, % The interface is within the core representation. We will % extract and pretty print the parts we need. OutputFile = GeneralOpts ^ go_output_file, write_dep_info(OutputFile, TargetBytecode, TargetInterface, Imports, Result, !IO), ( Result = ok ; Result = error(ErrMsg), exit_error(ErrMsg, !IO) ) ; WriteOutput = dont_write_output ) ). :- pred write_dep_info(string::in, string::in, string::in, list(import_info)::in, maybe_error::out, io::di, io::uo) is det. write_dep_info(Filename, TargetBytecode, TargetInterface, Info, Result, !IO) :- open_output(Filename, OpenRes, !IO), ( OpenRes = ok(File), Result = ok, write_string(File, "ninja_dyndep_version = 1\n\n", !IO), BytecodeDeps = string_join(" ", filter_map(ii_potential_interface_file(interface_import), Info)), InterfaceDeps = string_join(" ", filter_map(ii_potential_interface_file(typeres_import), Info)), format(File, "build %s : dyndep | %s\n\n", [s(TargetBytecode), s(BytecodeDeps)], !IO), format(File, "build %s : dyndep | %s\n\n", [s(TargetInterface), s(InterfaceDeps)], !IO), close_output(File, !IO) ; OpenRes = error(Error), Result = error(format("%s: %s", [s(Filename), s(error_message(Error))])) ). % Return the interface file for this module if it exists or we source % exists so it can be built. % :- func ii_potential_interface_file(import_type, import_info) = string is semidet. ii_potential_interface_file(ImportType, ImportInfo) = File :- ( ImportType = interface_import, File = ImportInfo ^ ii_interface_file ; ImportType = typeres_import, File = ImportInfo ^ ii_typeres_file ), ( file_exists = ImportInfo ^ ii_interface_exists ; yes(_) = ImportInfo ^ ii_source_file ). %-----------------------------------------------------------------------% :- pred do_make_typeres_exports(general_options::in, ast::in, io::di, io::uo) is det. do_make_typeres_exports(GeneralOpts, PlasmaAst, !IO) :- ExportsRes = find_typeres_exports(GeneralOpts, PlasmaAst), SourcePath = GeneralOpts ^ go_source_dir, ( ExportsRes = ok(Exports, Errors), WriteOutput = GeneralOpts ^ go_write_output, ( WriteOutput = write_output, OutputFile = GeneralOpts ^ go_output_file, write_typeres_exports(OutputFile, PlasmaAst ^ a_module_name, Exports, Result, !IO), ( Result = ok ; Result = error(ErrMsg), exit_error(ErrMsg, !IO) ) ; WriteOutput = dont_write_output ), report_errors(SourcePath, Errors, !IO) ; ExportsRes = errors(Errors), report_errors(SourcePath, Errors, !IO), exit_error("Failed", !IO) ). :- pred write_typeres_exports(string::in, q_name::in, typeres_exports::in, maybe_error::out, io::di, io::uo) is det. write_typeres_exports(Filename, ModuleName, Exports, Result, !IO) :- io.open_output(Filename, OpenRes, !IO), ( OpenRes = ok(File), format(File, "module %s\n\n", [s(q_name_to_string(ModuleName))], !IO), write_string(File, append_list( map(func(R) = format("resource %s\n", [s(q_name_to_string(R))]), Exports ^ te_resources)), !IO), nl(File, !IO), write_string(File, append_list( map(func({N, A}) = format("type %s/%d\n", [s(q_name_to_string(N)), i(A ^ a_num)]), Exports ^ te_types)), !IO), close_output(File, !IO), Result = ok ; OpenRes = error(Error), Result = error(format("%s: %s\n", [s(Filename), s(error_message(Error))])) ). %-----------------------------------------------------------------------% :- pred do_make_foreign(general_options::in, string::in, ast::in, io::di, io::uo) is det. do_make_foreign(GeneralOpts, OutputHeader, PlasmaAst, !IO) :- MaybeForeignInfo = make_foreign(PlasmaAst), ( MaybeForeignInfo = ok(ForeignInfo), write_foreign(GeneralOpts, OutputHeader, ForeignInfo, !IO) ; MaybeForeignInfo = errors(Errors), report_errors(GeneralOpts ^ go_source_dir, Errors, !IO), set_exit_status(1, !IO) ). %-----------------------------------------------------------------------% :- type plasmac_options ---> plasmac_options( pco_general :: general_options, pco_mode :: pco_mode_options ) ; plasmac_help ; plasmac_version. :- type pco_mode_options ---> compile( pmo_compile_opts :: compile_options ) ; make_interface ; make_typeres_exports ; scan( pmo_d_output :: string, pmo_d_interface :: string ) ; make_foreign( pmo_f_output_header :: string ). :- pred process_options(list(string)::in, maybe_error(plasmac_options)::out, io::di, io::uo) is det. process_options(Args0, Result, !IO) :- OptionOpts = option_ops_multi(short_option, long_option, option_default), getopt.process_options(OptionOpts, Args0, Args, MaybeOptions), ( MaybeOptions = ok(OptionTable), lookup_bool_option(OptionTable, help, Help), lookup_bool_option(OptionTable, version, Version), ( if Help = yes then Result = ok(plasmac_help) else if Version = yes then Result = ok(plasmac_version) else ( if Args = [InputPath] then process_options_mode(OptionTable, OutputExtension, ModeResult), GeneralOpts = process_options_general(OptionTable, InputPath, OutputExtension), ( ModeResult = ok(ModeOpts), Result = ok(plasmac_options(GeneralOpts, ModeOpts)) ; ModeResult = error(Error), Result = error(Error) ) else Result = error("Error processing command line options: " ++ "Expected exactly one input file") ) ) ; MaybeOptions = error(ErrMsg), Result = error("Error processing command line options: " ++ option_error_to_string(ErrMsg)) ). :- pred process_options_mode(option_table(option)::in, string::out, maybe_error(pco_mode_options)::out) is det. process_options_mode(OptionTable, OutputExtension, Result) :- lookup_string_option(OptionTable, mode_, Mode), ( if Mode = "compile" then DoSimplify = handle_bool_option(OptionTable, simplify, do_simplify_pass, skip_simplify_pass), EnableTailcalls = handle_bool_option(OptionTable, tailcalls, enable_tailcalls, dont_enable_tailcalls), Result = ok(compile( compile_options(DoSimplify, EnableTailcalls))), OutputExtension = constant.output_extension else if Mode = "make-interface" then Result = ok(make_interface), OutputExtension = constant.interface_extension else if Mode = "make-typeres-exports" then Result = ok(make_typeres_exports), OutputExtension = constant.typeres_extension else if Mode = "scan" then lookup_string_option(OptionTable, target_bytecode, TargetBytecode), lookup_string_option(OptionTable, target_interface, TargetInterface), Result = ok(scan(TargetBytecode, TargetInterface)), OutputExtension = constant.depends_extension else if Mode = "generate-foreign" then lookup_string_option(OptionTable, output_header, OutputHeader), Result = ok(make_foreign(OutputHeader)), OutputExtension = constant.cpp_extension else Result = error( format("Error processing command line options, " ++ "unknown mode `%s`.", [s(Mode)])), OutputExtension = ".error" % This is never seen ). :- func process_options_general(option_table(option), string, string) = general_options. process_options_general(OptionTable, InputPath, OutputExtension) = GeneralOpts :- lookup_string_option(OptionTable, source_path, SourcePath), file_and_dir_det(".", InputPath, InputDir, InputFile), ( if lookup_string_option(OptionTable, output_file, OutputFile0), OutputFile0 \= "" then OutputFile = OutputFile0 else file_change_extension_det(constant.source_extension, OutputExtension, InputFile, OutputFile) ), lookup_string_option(OptionTable, import_whitelist, ImportWhitelist), ( if ImportWhitelist = "" then MbImportWhitelist = no else MbImportWhitelist = yes(ImportWhitelist) ), lookup_string_option(OptionTable, module_name_check, ModuleNameCheck), ( if ModuleNameCheck = "" then MbModuleNameCheck = no else MbModuleNameCheck = yes(ModuleNameCheck) ), Verbose = handle_bool_option(OptionTable, verbose, verbose, silent), lookup_bool_option(OptionTable, warn_as_error, WError), DumpStages = handle_bool_option(OptionTable, dump_stages, dump_stages, dont_dump_stages), WriteOutput = handle_bool_option(OptionTable, write_output, write_output, dont_write_output), ReportTiming = handle_bool_option(OptionTable, report_timing, report_command_times, no_timing), GeneralOpts = general_options(InputDir, SourcePath, InputPath, OutputFile, MbImportWhitelist, MbModuleNameCheck, WError, Verbose, DumpStages, WriteOutput, ReportTiming). :- pred usage(io::di, io::uo) is det. usage(!IO) :- io.write_string("Plasma compiler\n\n", !IO), io.write_string( " The plasma compiler compiles plasma source code modules and\n" ++ " generates bytecode. It also has other modes to generate\n" ++ " interface files or dependency information.\n\n", !IO), io.write_string("Usage:\n\n", !IO), io.progname_base("plzc", ProgName, !IO), io.format(" %s -h | --help\n", [s(ProgName)], !IO), io.format(" %s --version\n\n", [s(ProgName)], !IO), io.format(" %s [-v] -o [compilation opts] \n", [s(ProgName)], !IO), io.write_string(" Compilation mode.\n\n", !IO), io.format(" %s [-v] --mode make-interface -o \n", [s(ProgName)], !IO), io.write_string(" Make interface mode.\n\n", !IO), io.format(" %s [-v] --mode make-typeres-exports -o \n", [s(ProgName)], !IO), io.write_string(" Make the typeres interface file.\n\n", !IO), io.format(" %s [-v] --mode scan \n", [s(ProgName)], !IO), io.write_string(" --target-bytecode $bytecode\n", !IO), io.write_string(" --target-interface $interface\n", !IO), io.write_string(" -o \n", !IO), io.write_string(" Scan source for dependencies.\n\n", !IO), io.format(" %s [-v] --mode generate-foreign -o \n", [s(ProgName)], !IO), io.write_string(" Generate runtime code required to register foeign functions.\n\n", !IO), io.write_string("General options:\n\n", !IO), io.write_string(" -h | --help\n" ++ " Help text (you're looking at it)\n\n", !IO), io.write_string(" -v | --verbose\n" ++ " Verbose output\n\n", !IO), io.write_string(" --version\n" ++ " Version information\n\n", !IO), io.write_string( " -o | --output-file \n" ++ " Specify output file (compiler will guess otherwise)\n\n", !IO), io.write_string(" --mode MODE\n" ++ " Specify what the compiler should do:\n" ++ " scan - " ++ "Scan code for dependency information,\n" ++ " make-interface - Generate the interface file,\n" ++ " make-typeres-exports - " ++ "Generate the typeres interface file.\n" ++ " compile (default) - Compile the module,\n" ++ " generate-foreign - " ++ "Generate foreign code registration.\n\n", !IO), io.write_string("Scan options:\n\n", !IO), io.write_string(" --target-bytecode \n" ++ " is the name of the bytecode file in the ninja\n" ++ " build file\n\n", !IO), io.write_string(" --target-interface \n" ++ " is the name of the interface file in the ninja\n" ++ " build file\n\n", !IO), io.write_string("Compilation options:\n\n", !IO), io.write_string(" --warnings-as-errors\n" ++ " All warnings are fatal\n\n", !IO), io.write_string(" --no-simplify\n" ++ " Disable the simplification optimisations\n\n", !IO), io.write_string("Developer options:\n\n", !IO), io.write_string(" --dump-stages\n" ++ " Dump the program representation at each stage of\n" ++ " compilation, each stage is saved to a seperate file in\n" ++ " the output directory\n\n", !IO), io.write_string(" --no-write-output\n" ++ " Skip writing the output file (for testing)\n\n", !IO), io.write_string(" --no-tailcalls\n" ++ " Do not generate tailcalls\n\n", !IO), io.write_string("Internal options:\n\n", !IO), io.write_string(" --import-whitelist \n" ++ " Imports are checked against the Mercury term in this file\n" ++ " generated by plzbuild.\n\n", !IO), io.write_string(" --module-name-check \n" ++ " Check that this is the module name in the source file.\n\n", !IO), io.write_string(" --source-path \n" ++ " Subtract this path from source filenames when printing\n" ++ " errors.\n\n", !IO), io.write_string(" --report-timing\n" ++ " Report the time taken to execute the compiler.\n\n", !IO). :- type option ---> help ; verbose ; version ; mode_ ; output_file ; output_header ; target_bytecode ; target_interface ; import_whitelist ; module_name_check ; source_path ; warn_as_error ; dump_stages ; write_output ; report_timing ; simplify ; tailcalls. :- pred short_option(char::in, option::out) is semidet. short_option('h', help). short_option('v', verbose). short_option('o', output_file). :- pred long_option(string::in, option::out) is semidet. long_option("help", help). long_option("verbose", verbose). long_option("version", version). long_option("mode", mode_). long_option("output-file", output_file). long_option("output-header", output_header). long_option("target-bytecode", target_bytecode). long_option("target-interface", target_interface). long_option("import-whitelist", import_whitelist). long_option("module-name-check", module_name_check). long_option("source-path", source_path). long_option("warnings-as-errors", warn_as_error). long_option("dump-stages", dump_stages). long_option("write-output", write_output). long_option("report-timing", report_timing). long_option("simplify", simplify). long_option("tailcalls", tailcalls). :- pred option_default(option::out, option_data::out) is multi. option_default(help, bool(no)). option_default(verbose, bool(no)). option_default(version, bool(no)). option_default(mode_, string("compile")). option_default(output_file, string("")). option_default(output_header, string("")). option_default(target_bytecode, string("")). option_default(target_interface, string("")). option_default(import_whitelist, string("")). option_default(module_name_check, string("")). option_default(source_path, string("")). option_default(warn_as_error, bool(no)). option_default(dump_stages, bool(no)). option_default(write_output, bool(yes)). option_default(report_timing, bool(no)). option_default(simplify, bool(yes)). option_default(tailcalls, bool(yes)). %-----------------------------------------------------------------------% %-----------------------------------------------------------------------% ================================================ FILE: src/plzdisasm.m ================================================ %-----------------------------------------------------------------------% % Plasma assembler % vim: ts=4 sw=4 et % % Copyright (C) Plasma Team % Distributed under the terms of the MIT License see ../LICENSE.code % % This program disassembles pz intermediate representation. % %-----------------------------------------------------------------------% :- module plzdisasm. %-----------------------------------------------------------------------% :- interface. :- import_module io. :- pred main(io::di, io::uo) is det. %-----------------------------------------------------------------------% %-----------------------------------------------------------------------% :- implementation. :- import_module bool. :- import_module char. :- import_module cord. :- import_module getopt. :- import_module list. :- import_module maybe. :- import_module string. :- import_module constant. :- import_module pz. :- import_module pz.pretty. :- import_module pz.read. :- import_module util. :- import_module util.my_exception. :- import_module util.mercury. %-----------------------------------------------------------------------% main(!IO) :- io.command_line_arguments(Args0, !IO), process_options(Args0, OptionsResult, !IO), ( OptionsResult = ok(PZDisOpts), Mode = PZDisOpts ^ pzo_mode, ( Mode = disasm(InputFile), promise_equivalent_solutions [!:IO] ( run_and_catch(do_dump(InputFile), plzasm, HadErrors, !IO), ( HadErrors = had_errors, io.set_exit_status(1, !IO) ; HadErrors = did_not_have_errors ) ) ; Mode = help, usage(!IO) ; Mode = version, version("Plasma Abstract Machine Disassembler", !IO) ) ; OptionsResult = error(ErrMsg), exit_error(ErrMsg, !IO) ). :- pred do_dump(string::in, io::di, io::uo) is det. do_dump(InputFile, !IO) :- read_pz(InputFile, Result, !IO), ( Result = ok(pz_read_result(Type, PZ)), Pretty = from_list(["// Plasma file type: ", string(Type), "\n\n"]) ++ pz_pretty(PZ), write_string(append_list(list(Pretty)), !IO) ; Result = error(Error), exit_error(Error, !IO) ). %-----------------------------------------------------------------------% :- type pzdis_options ---> pzdis_options( pzo_mode :: pzo_mode ). :- type pzo_mode ---> disasm( pzmd_input_file :: string ) ; help ; version. :- pred process_options(list(string)::in, maybe_error(pzdis_options)::out, io::di, io::uo) is det. process_options(Args0, Result, !IO) :- OptionOpts = option_ops_multi(short_option, long_option, option_default), getopt.process_options(OptionOpts, Args0, Args, MaybeOptions), ( MaybeOptions = ok(OptionTable), lookup_bool_option(OptionTable, help, Help), lookup_bool_option(OptionTable, version, Version), ( if Help = yes then Result = ok(pzdis_options(help)) else if Version = yes then Result = ok(pzdis_options(version)) else ( if Args = [InputFile] then Result = ok(pzdis_options(disasm(InputFile))) else Result = error("Error processing command line options: " ++ "Expected exactly one input file") ) ) ; MaybeOptions = error(ErrMsg), Result = error("Error processing command line options: " ++ option_error_to_string(ErrMsg)) ). :- pred usage(io::di, io::uo) is det. usage(!IO) :- io.write_string("Plasma disassembler\n\n", !IO), io.write_string( " The Plasma disassembler outputs a text representation of\n" ++ " Plasma bytecode files.\n\n", !IO), io.write_string("Usage:\n\n", !IO), io.progname_base("plzdisasm", ProgName, !IO), io.format(" %s \n", [s(ProgName)], !IO), io.format(" %s -h | --help\n", [s(ProgName)], !IO), io.format(" %s --version\n\n", [s(ProgName)], !IO). :- type option ---> help ; version. :- pred short_option(char::in, option::out) is semidet. short_option('h', help). :- pred long_option(string::in, option::out) is semidet. long_option("help", help). long_option("version", version). :- pred option_default(option::out, option_data::out) is multi. option_default(help, bool(no)). option_default(version, bool(no)). %-----------------------------------------------------------------------% %-----------------------------------------------------------------------% ================================================ FILE: src/plzgeninit.m ================================================ %-----------------------------------------------------------------------% % Plasma foreign initialisation generation % vim: ts=4 sw=4 et % % Copyright (C) Plasma Team % Distributed under the terms of the MIT License see ../LICENSE.code % % This program assembles and links the pz intermediate representation. % %-----------------------------------------------------------------------% :- module plzgeninit. %-----------------------------------------------------------------------% :- interface. :- import_module io. :- pred main(io::di, io::uo) is det. %-----------------------------------------------------------------------% %-----------------------------------------------------------------------% :- implementation. :- import_module bool. :- import_module char. :- import_module list. :- import_module getopt. :- import_module maybe. :- import_module string. :- import_module constant. :- import_module q_name. :- import_module util. :- import_module util.mercury. :- import_module util.my_exception. :- import_module util.my_io. %-----------------------------------------------------------------------% main(!IO) :- io.command_line_arguments(Args0, !IO), process_options(Args0, OptionsResult, !IO), ( OptionsResult = ok(PZGIOpts), Mode = PZGIOpts ^ pzo_mode, ( Mode = gen_init(OutputFile, Modules), promise_equivalent_solutions [!:IO] ( run_and_catch(do_gen_init(OutputFile, Modules), plzgeninit, HadErrors, !IO), ( HadErrors = had_errors, io.set_exit_status(1, !IO) ; HadErrors = did_not_have_errors ) ) ; Mode = help, usage(!IO) ; Mode = version, version("Plasma Foreign Interface Generator", !IO) ) ; OptionsResult = error(ErrMsg), exit_error(ErrMsg, !IO) ). :- pred do_gen_init(string::in, list(q_name)::in, io::di, io::uo) is det. do_gen_init(OutputFile, Modules, !IO) :- write_temp_and_move(open_output, close_output, pred(F::in, R::out, IO0::di, IO::uo) is det :- write_gen_init(F, Modules, R, IO0, IO), OutputFile, Result, !IO), ( Result = ok ; Result = error(ErrMsg), exit_error(ErrMsg, !IO) ). :- pred write_gen_init(output_stream::in, list(q_name)::in, maybe_error::out, io::di, io::uo) is det. write_gen_init(File, Modules, Result, !IO) :- write_string(File, "// Foreign initialisation\n\n", !IO), write_string(File, "extern \"C\" {\n", !IO), write_string(File, " bool pz_init_foreign_code(void *f, void *gc);\n", !IO), write_string(File, "}\n\n", !IO), % Forward declarations. foldl(write_declaration(File), Modules, !IO), write_string(File, "bool pz_init_foreign_code(void *f, void *gc) {\n", !IO), foldl(write_call(File), Modules, !IO), write_string(File, " return true;\n", !IO), write_string(File, "}\n", !IO), Result = ok. :- pred write_declaration(output_stream::in, q_name::in, io::di, io::uo) is det. write_declaration(File, Module, !IO) :- format(File, "bool pz_init_foreign_code_%s(void *f, void *gc);\n", [s(q_name_clobber(Module))], !IO). :- pred write_call(output_stream::in, q_name::in, io::di, io::uo) is det. write_call(File, Module, !IO) :- format(File, " if (!pz_init_foreign_code_%s(f, gc)) return false;\n", [s(q_name_clobber(Module))], !IO). %%-----------------------------------------------------------------------% :- type pzgi_options ---> pzgeninit_options( pzo_mode :: pzgi_mode, pzo_verbose :: bool ). :- type pzgi_mode ---> gen_init( pzgi_output_file :: string, pzgi_modules :: list(q_name) ) ; help ; version. :- pred process_options(list(string)::in, maybe_error(pzgi_options)::out, io::di, io::uo) is det. process_options(Args0, Result, !IO) :- OptionOpts = option_ops_multi(short_option, long_option, option_default), getopt.process_options(OptionOpts, Args0, Args, MaybeOptions), ( MaybeOptions = ok(OptionTable), lookup_bool_option(OptionTable, help, Help), lookup_bool_option(OptionTable, version, Version), lookup_bool_option(OptionTable, verbose, Verbose), ( if Help = yes then Result = ok(pzgeninit_options(help, Verbose)) else if Version = yes then Result = ok(pzgeninit_options(version, Verbose)) else ( if lookup_string_option(OptionTable, output, Output), Output \= "" then MaybeInputs = maybe_error_list(map(q_name_from_dotted_string, Args)), ( MaybeInputs = ok(Inputs), Result = ok(pzgeninit_options( gen_init(Output, Inputs), Verbose)) ; MaybeInputs = error(Errors), Result = error("Invalid module name: " ++ first_item(Errors)) ) else Result = error("No output file specified") ) ) ; MaybeOptions = error(ErrMsg), Result = error("Error processing command line options: " ++ option_error_to_string(ErrMsg)) ). :- pred usage(io::di, io::uo) is det. usage(!IO) :- io.write_string("Plasma foreign initialisation generator\n\n", !IO), io.write_string( " The Plasma foreign initialisation generator is used to\n" ++ " generate foreign code used to register foreign\n" ++ " implementations of Plasma functions.\n\n", !IO), io.write_string("Usage:\n\n", !IO), io.progname_base("plzgeninit", ProgName, !IO), io.format(" %s [-v] [-o | --output ]\n", [s(ProgName)], !IO), io.format(" %s -h\n\n", [s(ProgName)], !IO). :- type option ---> help ; verbose ; version ; output. :- pred short_option(char::in, option::out) is semidet. short_option('h', help). short_option('v', verbose). short_option('o', output). :- pred long_option(string::in, option::out) is semidet. long_option("help", help). long_option("verbose", verbose). long_option("version", version). long_option("output", output). :- pred option_default(option::out, option_data::out) is multi. option_default(help, bool(no)). option_default(verbose, bool(no)). option_default(version, bool(no)). option_default(output, string("")). %-----------------------------------------------------------------------% %-----------------------------------------------------------------------% ================================================ FILE: src/plzlnk.m ================================================ %-----------------------------------------------------------------------% % Plasma linker % vim: ts=4 sw=4 et % % Copyright (C) Plasma Team % Distributed under the terms of the MIT License see ../LICENSE.code % % This program links the pz intermediate representation. % %-----------------------------------------------------------------------% :- module plzlnk. %-----------------------------------------------------------------------% :- interface. :- import_module io. :- pred main(io::di, io::uo) is det. %-----------------------------------------------------------------------% %-----------------------------------------------------------------------% :- implementation. :- import_module bool. :- import_module char. :- import_module getopt. :- import_module list. :- import_module maybe. :- import_module require. :- import_module string. :- import_module constant. :- import_module pz. :- import_module pz.pz_ds. :- import_module pz.read. :- import_module pz.write. :- import_module pz.link. :- import_module q_name. :- import_module util. :- import_module util.my_exception. :- import_module util.mercury. :- import_module util.result. :- import_module util.my_time. %-----------------------------------------------------------------------% main(!IO) :- now(StartTime, !IO), io.command_line_arguments(Args0, !IO), process_options(Args0, OptionsResult, !IO), ( OptionsResult = ok(PZLnkOpts), Mode = PZLnkOpts ^ pzo_mode, ( Mode = link(LinkKind, InputFile, OutputFile), promise_equivalent_solutions [!:IO] ( run_and_catch( link(LinkKind, InputFile, OutputFile), plzlnk, HadErrors, !IO), ( HadErrors = had_errors, io.set_exit_status(2, !IO) ; HadErrors = did_not_have_errors ), ReportTiming = PZLnkOpts ^ pzo_report_timing, ( ReportTiming = report_timing, now(EndTime, !IO), format("%s\n", [s(format_duration(diff_time(EndTime, StartTime)))], !IO) ; ReportTiming = dont_report_timing ) ) ; Mode = help, usage(!IO) ; Mode = version, version("Plasma Abstract Machine Linker", !IO) ) ; OptionsResult = error(ErrMsg), exit_error(ErrMsg, !IO) ). :- pred link(pzo_link_kind::in, list(string)::in, string::in, io::di, io::uo) is det. link(LinkKind, InputFilenames, OutputFilename, !IO) :- read_inputs(InputFilenames, [], MaybeInputs, !IO), ( MaybeInputs = ok(Inputs), do_link(LinkKind, Inputs, PZResult), ( PZResult = ok(PZ), write_pz(OutputFilename, PZ, WriteResult, !IO), ( WriteResult = ok ; WriteResult = error(ErrMsg), exit_error(ErrMsg, !IO) ) ; PZResult = errors(Errors), report_errors("", Errors, !IO), set_exit_status(1, !IO) ) ; MaybeInputs = error(Error), exit_error(Error, !IO) ). :- pred read_inputs(list(string)::in, list(pz)::in, maybe_error(list(pz))::out, io::di, io::uo) is det. read_inputs([], PZs0, ok(PZs), !IO) :- reverse(PZs0, PZs). read_inputs([InputFilename | InputFilenames], PZs0, Result, !IO) :- read_pz(InputFilename, MaybeInput, !IO), ( MaybeInput = ok(pz_read_result(Type, PZ)), ( Type = pzft_object, read_inputs(InputFilenames, [PZ | PZs0], Result, !IO) ; Type = pzft_program, Result = error("Expected Plasma Object, not Plasma program") ; Type = pzft_library, Result = my_exception.sorry($file, $pred, "Maybe allow static-linking with libraries in the future?") ) ; MaybeInput = error(Error), Result = error(Error) ). %-----------------------------------------------------------------------% :- type pzlnk_options ---> pzlnk_options( pzo_mode :: pzo_mode, pzo_verbose :: verbose, pzo_report_timing :: report_timing ). :- type pzo_mode ---> link( pzml_link_kind :: pzo_link_kind, pzml_input_files :: list(string), pzml_output_file :: string ) ; help ; version. :- type verbose ---> verbose ; terse. :- type report_timing ---> report_timing ; dont_report_timing. :- pred process_options(list(string)::in, maybe_error(pzlnk_options)::out, io::di, io::uo) is det. process_options(Args0, Result, !IO) :- OptionOpts = option_ops_multi(short_option, long_option, option_default), getopt.process_options(OptionOpts, Args0, Args, MaybeOptions), ( MaybeOptions = ok(OptionTable), lookup_bool_option(OptionTable, help, Help), lookup_bool_option(OptionTable, version, Version), Verbose = handle_bool_option(OptionTable, verbose, verbose, terse), ReportTiming = handle_bool_option(OptionTable, report_timing, report_timing, dont_report_timing), ( if Help = yes then Result = ok(pzlnk_options(help, Verbose, ReportTiming)) else if Version = yes then Result = ok(pzlnk_options(version, Verbose, ReportTiming)) else lookup_string_option(OptionTable, output, OutputFile), MaybeNames = process_names_option(OptionTable), ( if Args \= [], OutputFile \= "", MaybeNames = ok(Names) then MaybeLinkKind = process_link_kind_option(OptionTable, Names), ( MaybeLinkKind = ok(LinkKind), Result = ok(pzlnk_options(link(LinkKind, Args, OutputFile), Verbose, ReportTiming)) ; MaybeLinkKind = error(Error), Result = error(Error) ) else if Args = [] then Result = error("Provide one or more input files") else if OutputFile = "" then Result = error( "Output file argument is missing or not understood") else if MaybeNames = error(Error) then Result = error(Error) else unexpected($file, $pred, "Unhandled error") ) ) ; MaybeOptions = error(ErrMsg), Result = error("Error processing command line options: " ++ option_error_to_string(ErrMsg)) ). :- func process_names_option(option_table(option)) = maybe_error(list(nq_name)). process_names_option(OptionTable) = MaybeNames :- lookup_accumulating_option(OptionTable, name, Names0), MaybeNames0 = maybe_error_list( map(string_to_module_name, Names0)), ( MaybeNames0 = error(Errors), ( Errors = [], unexpected($file, $pred, "This never happens") ; Errors = [Error] ; Errors = [_, _ | _], Error = "Multiple errors:\n" ++ append_list(list_join(["\n"], Errors)) ), MaybeNames = error(Error) ; MaybeNames0 = ok(Names), MaybeNames = ok(Names) ). :- func process_link_kind_option(option_table(option), list(nq_name)) = maybe_error(pzo_link_kind). process_link_kind_option(OptionTable, Names) = MaybeLinkKind :- lookup_bool_option(OptionTable, library, Library), lookup_string_option(OptionTable, entrypoint, EntryPointStr), ( Library = no, ( if Names = [Name] then ( if EntryPointStr \= "" then MaybeEntryPoint0 = q_name_from_dotted_string(EntryPointStr), ( MaybeEntryPoint0 = ok(EntryPoint), MaybeLinkKind = ok(pz_program(yes(EntryPoint), Name)) ; MaybeEntryPoint0 = error(Error), MaybeLinkKind = error( format("Invalid entry point name '%s': %s", [s(EntryPointStr), s(Error)])) ) else MaybeLinkKind = ok(pz_program(no, Name)) ) else MaybeLinkKind = error("Wrong number of names provided") ) ; Library = yes, ( if EntryPointStr \= "" then MaybeLinkKind = error("Libraries can't have entrypoints") else MaybeLinkKind = ok(pz_library(Names)) ) ). :- func string_to_module_name(string) = maybe_error(nq_name, string). string_to_module_name(String) = Result :- MaybeName = nq_name_from_string(String), ( MaybeName = ok(Name), Result = ok(Name) ; MaybeName = error(Error), Result = error(format( "Plasma program name (%s) is missing or invalid: %s", [s(String), s(Error)])) ). :- pred usage(io::di, io::uo) is det. usage(!IO) :- io.write_string("Plasma linker\n\n", !IO), io.write_string( " The linker is used by plzbuild to link Plasma objects\n" ++ " into programs and libraries\n\n", !IO), io.write_string("Usage:\n\n", !IO), io.progname_base("plzlnk", ProgName, !IO), io.format(" %s [-e ] \n", [s(ProgName)], !IO), io.format(" %s --library \n", [s(ProgName)], !IO), io.format(" %s -h | --help>\n", [s(ProgName)], !IO), io.format(" %s --version>\n", [s(ProgName)], !IO), io.write_string("\nOptions:\n\n", !IO), io.write_string(" -v | --verbose Verbose\n", !IO), io.write_string(" --report-timing Report linker timing\n", !IO), io.write_string(" -o | --output Output file\n", !IO), io.write_string(" -e | --entrypoint Name of program entrypoint\n", !IO), io.write_string(" --library Make a library\n", !IO), io.write_string(" -n | --name Program name or multiple module names to\n", !IO), io.write_string(" export (for libraries)\n", !IO), io.nl(!IO). :- type option ---> help ; verbose ; version ; output ; name ; entrypoint ; library ; report_timing. :- pred short_option(char::in, option::out) is semidet. short_option('h', help). short_option('v', verbose). short_option('o', output). short_option('n', name). short_option('e', entrypoint). :- pred long_option(string::in, option::out) is semidet. long_option("help", help). long_option("verbose", verbose). long_option("version", version). long_option("output", output). long_option("name", name). long_option("entrypoint", entrypoint). long_option("library", library). long_option("report-timing", report_timing). :- pred option_default(option::out, option_data::out) is multi. option_default(help, bool(no)). option_default(verbose, bool(no)). option_default(version, bool(no)). option_default(output, string("")). option_default(name, accumulating([])). option_default(entrypoint, string("")). option_default(library, bool(no)). option_default(report_timing, bool(no)). %-----------------------------------------------------------------------% %-----------------------------------------------------------------------% ================================================ FILE: src/pre.ast_to_core.m ================================================ %-----------------------------------------------------------------------% % vim: ts=4 sw=4 et %-----------------------------------------------------------------------% :- module pre.ast_to_core. % % Copyright (C) Plasma Team % Distributed under the terms of the MIT License see ../LICENSE.code % % Plasma parse tree to core representation conversion % %-----------------------------------------------------------------------% :- interface. :- import_module io. :- import_module list. :- import_module ast. :- import_module common_types. :- import_module compile_error. :- import_module core. :- import_module core.function. :- import_module core.types. :- import_module options. :- import_module pre.env. :- import_module q_name. :- import_module util. :- import_module util.result. %-----------------------------------------------------------------------% % The informationa bout a resource we need for ast_to_core (a2c). % :- type a2c_resource ---> a2c_resource( r_name :: nq_name, r_id :: resource_id, r_resource :: ast_resource ). :- type a2c_type ---> a2c_type( t_name :: nq_name, t_id :: type_id, t_type :: ast_type(nq_name) ). %-----------------------------------------------------------------------% :- pred ast_to_core_declarations(general_options::in, list(a2c_resource)::in, list(a2c_type)::in, list(nq_named(ast_function))::in, env::in, env::out, core::in, core::out, errors(compile_error)::in, errors(compile_error)::out, io::di, io::uo) is det. %-----------------------------------------------------------------------% % Exported for pre.import's use. % :- pred ast_to_func_decl(core::in, env::in, q_name::in, ast_function_decl::in, sharing::in, result(function, compile_error)::out) is det. % ast_to_core_type_i(GetCtorName, Env, TypeName, TypeId, Type, Result, % !Core) % % The constructors in an AST Type have a polymorphic name type. It % could be a q_name when reading from interfaces, or nq_name when % reading a local module. The caller provides GetCtorName which will % turn it into the actual q_name used within the core representation % (not the environment). % :- pred ast_to_core_type_i((func(Name) = q_name)::in, imported::in, env::in, q_name::in, type_id::in, ast_type(Name)::in, result({user_type, list(ctor_binding(Name))}, compile_error)::out, core::in, core::out) is det. % Map a constructor name to an ID, so that a caller can update the % environment. % :- type ctor_binding(Name) ---> cb( cb_name :: Name, cb_id :: ctor_id ). % After processing declarations, call this to process the bodies of % functions. % :- pred ast_to_core_funcs(general_options::in, q_name::in, list(nq_named(ast_function))::in, env::in, core::in, core::out, errors(compile_error)::in, errors(compile_error)::out, io::di, io::uo) is det. %-----------------------------------------------------------------------% %-----------------------------------------------------------------------% :- implementation. :- import_module char. :- import_module cord. :- import_module map. :- import_module maybe. :- import_module pair. :- import_module require. :- import_module set. :- import_module string. :- import_module builtins. :- import_module constant. :- import_module context. :- import_module core.resource. :- import_module dump_stage. :- import_module pre.bang. :- import_module pre.branches. :- import_module pre.closures. :- import_module pre.from_ast. :- import_module pre.import. :- import_module pre.pre_ds. :- import_module pre.pretty. :- import_module pre.to_core. :- import_module util.my_exception. :- import_module util.log. :- import_module util.path. :- import_module varmap. %-----------------------------------------------------------------------% ast_to_core_declarations(GOptions, Resources, Types, Funcs, !Env, !Core, !Errors, !IO) :- Verbose = GOptions ^ go_verbose, verbose_output(Verbose, "pre_to_core: Processing resources\n", !IO), ast_to_core_resources(Resources, !Env, !Core, !Errors), verbose_output(Verbose, "pre_to_core: Processing types\n", !IO), ast_to_core_types(Types, !Env, !Core, !Errors), verbose_output(Verbose, "pre_to_core: Processing function signatures\n", !IO), foldl3(gather_funcs, Funcs, !Core, !Env, !Errors), verbose_output(Verbose, "pre_to_core: Checking exports\n", !IO), add_errors(check_resource_exports(!.Core), !Errors), add_errors(check_type_exports(!.Core), !Errors), add_errors(check_function_exports(!.Core), !Errors). %-----------------------------------------------------------------------% :- pred ast_to_core_types(list(a2c_type)::in, env::in, env::out, core::in, core::out, errors(compile_error)::in, errors(compile_error)::out) is det. ast_to_core_types(Types, !Env, !Core, !Errors) :- foldl3(ast_to_core_type, Types, !Env, !Core, !Errors). :- pred ast_to_core_type(a2c_type::in, env::in, env::out, core::in, core::out, errors(compile_error)::in, errors(compile_error)::out) is det. ast_to_core_type(a2c_type(Name, TypeId, ASTType), !Env, !Core, !Errors) :- ModuleName = module_name(!.Core), ast_to_core_type_i(q_name_append(ModuleName), i_local, !.Env, q_name_append(ModuleName, Name), TypeId, ASTType, Result, !Core), ( Result = ok({Type, Ctors}), core_set_type(TypeId, Type, !Core), foldl((pred(C::in, E0::in, E::out) is det :- % TODO: Constructors in the environment may need to handle % their arity. env_add_constructor(q_name(C ^ cb_name), C ^ cb_id, E0, E) ), Ctors, !Env) ; Result = errors(Errors), add_errors(Errors, !Errors) ). ast_to_core_type_i(GetName, Imported, Env, Name, TypeId, ast_type(Params, Constrs0, Sharing, Context), Result, !Core) :- % Check that each parameter is unique. foldl(check_param, Params, init, ParamsSet), map_foldl2( ast_to_core_type_constructor(GetName, Env, TypeId, Params, ParamsSet), Constrs0, CtorResults, init, _, !Core), CtorsResult = result_list_to_result(CtorResults), ( CtorsResult = ok(Ctors), CtorIds = map(func(C) = C ^ cb_id, Ctors), Result = ok({ type_init(Name, Params, CtorIds, Sharing, Imported, Context), Ctors}) ; CtorsResult = errors(Errors), Result = errors(Errors) ). ast_to_core_type_i(_, _, _, Name, _, ast_type_abstract(Arity, Context), Result, !Core) :- Result = ok({type_init_abstract(Name, Arity, Context), []}). :- pred check_param(string::in, set(string)::in, set(string)::out) is det. check_param(Param, !Params) :- ( if insert_new(Param, !Params) then true else compile_error($file, $pred, "Non unique type parameters") ). :- pred ast_to_core_type_constructor((func(Name) = q_name)::in, env::in, type_id::in, list(string)::in, set(string)::in, at_constructor(Name)::in, result(ctor_binding(Name), compile_error)::out, set(q_name)::in, set(q_name)::out, core::in, core::out) is det. ast_to_core_type_constructor(GetName, Env, Type, Params, ParamsSet, at_constructor(EnvSymbol, Fields0, Context), Result, !CtorNameSet, !Core) :- Symbol = GetName(EnvSymbol), ( if insert_new(Symbol, !CtorNameSet) then core_allocate_ctor_id(CtorId, !Core), map(ast_to_core_field(!.Core, Env, ParamsSet), Fields0, FieldResults), FieldsResult = result_list_to_result(FieldResults), ( FieldsResult = ok(Fields), Constructor = constructor(Symbol, Params, Fields), core_set_constructor(CtorId, Symbol, Type, Constructor, !Core), Result = ok(cb(EnvSymbol, CtorId)) ; FieldsResult = errors(Errors), Result = errors(Errors) ) else Result = return_error(Context, ce_type_duplicate_constructor(Symbol)) ). :- pred ast_to_core_field(core::in, env::in, set(string)::in, at_field::in, result(type_field, compile_error)::out) is det. ast_to_core_field(Core, Env, ParamsSet, at_field(Name, Type0, _), Result) :- Symbol = q_name_single(Name), TypeResult = build_type_ref(Core, Env, s_private, check_type_vars(ParamsSet), Type0), ( TypeResult = ok(Type), Result = ok(type_field(Symbol, Type)) ; TypeResult = errors(Errors), Result = errors(Errors) ). %-----------------------------------------------------------------------% :- pred ast_to_core_resources(list(a2c_resource)::in, env::in, env::out, core::in, core::out, errors(compile_error)::in, errors(compile_error)::out) is det. ast_to_core_resources(Resources, !Env, !Core, !Errors) :- foldl2(ast_to_core_resource(!.Env), Resources, !Core, !Errors). :- pred ast_to_core_resource(env::in, a2c_resource::in, core::in, core::out, errors(compile_error)::in, errors(compile_error)::out) is det. ast_to_core_resource(Env, a2c_resource(Name, Res, ast_resource(FromName, Sharing, Context)), !Core, !Errors) :- ( if env_search_resource(Env, FromName, FromRes) then FullName = q_name_append(module_name(!.Core), Name), core_set_resource(Res, r_other(FullName, FromRes, Sharing, i_local, Context), !Core) else add_error(Context, ce_resource_unknown(FromName), !Errors) ). %-----------------------------------------------------------------------% ast_to_core_funcs(GOptions, ModuleName, Funcs, Env, !Core, !Errors, !IO) :- some [!Pre] ( % 1. the func_to_pre step resolves symbols, builds a varmap, % builds var-use and var-def sets. list.foldl(func_to_pre(Env), Funcs, map.init, !:Pre), maybe_dump_stage(GOptions, ModuleName, "pre1_initial", pre_pretty(!.Core), !.Pre, !IO), % 2. Annotate closures with captured variable information map.map_values_only(compute_closures, !Pre), maybe_dump_stage(GOptions, ModuleName, "pre2_closures", pre_pretty(!.Core), !.Pre, !IO), % 3. Fixup how variables are used in branching code, this pass: % * checks that used variables are always well defined (eg % along all execution paths) % * Updates the reachability information for branches. % Reachability information is incomplete until after % typechecking. % * Adds terminating "return" statements where needed. % process_procs(fix_branches, !Pre, !Errors), maybe_dump_stage(GOptions, ModuleName, "pre3_branches", pre_pretty(!.Core), !.Pre, !IO), % 4. Check bang placment is okay ResErrors = cord_list_to_cord( map(check_bangs(!.Core), map.values(!.Pre))), add_errors(ResErrors, !Errors), maybe_dump_stage(GOptions, ModuleName, "pre4_resources", pre_pretty(!.Core), !.Pre, !IO), % 5. Transform the pre structure into an expression tree. % TODO: Handle return statements in branches, where some % branches fall-through and others don't. ( if not has_fatal_errors(!.Errors) then map.foldl(pre_to_core, !.Pre, !Core) else true ) ). :- pred process_procs(func(V) = result(V, E), map(K, V), map(K, V), errors(E), errors(E)). :- mode process_procs(func(in) = (out) is det, in, out, in, out) is det. process_procs(Func, !Map, !Errors) :- map.map_values_foldl(process_proc(Func), !Map, !Errors). :- pred process_proc(func(V) = result(V, E), V, V, errors(E), errors(E)). :- mode process_proc(func(in) = (out) is det, in, out, in, out) is det. process_proc(Func, !Proc, !Errors) :- Result = Func(!.Proc), ( Result = ok(!:Proc) ; Result = errors(NewErrors), add_errors(NewErrors, !Errors) ). %-----------------------------------------------------------------------% :- pred gather_funcs(nq_named(ast_function)::in, core::in, core::out, env::in, env::out, errors(compile_error)::in, errors(compile_error)::out) is det. gather_funcs(nq_named(Name, Func), !Core, !Env, !Errors) :- Func = ast_function(Decl, Body, Sharing, IsEntrypoint), Context = Decl ^ afd_context, NameStr = nq_name_to_string(Name), ( if core_allocate_function(FuncId, !Core), % Add the function to the environment with it's local name, % since we're in the scope of the module already. env_add_func(q_name(Name), FuncId, !Env) then QName = q_name_append(module_name(!.Core), Name), ast_to_func_decl(!.Core, !.Env, QName, Decl, Sharing, MaybeFunction), ( MaybeFunction = ok(Function0), ( Body = ast_body_block(_), Function = Function0 ; Body = ast_body_foreign(_), func_set_foreign(Function0, Function) ), core_set_function(FuncId, Function, !Core), ( IsEntrypoint = is_entrypoint, func_get_type_signature(Function, Params, Returns, _), ListTypeId = env_operators(!.Env) ^ o_list_type, ( if Returns = [builtin_type(int)], ( Params = [], Entrypoint = entry_plain(FuncId) ; Params = [type_ref(ListTypeId, [builtin_type(string)])], Entrypoint = entry_argv(FuncId) ) then core_add_entry_function(Entrypoint, !Core) else add_error(Context, ce_entry_function_wrong_signature, !Errors) ) ; IsEntrypoint = not_entrypoint ) ; MaybeFunction = errors(Errors), add_errors(Errors, !Errors) ) else add_error(Context, ce_function_already_defined(NameStr), !Errors) ), ( Body = ast_body_block(Block), foldl3(gather_funcs_block, Block, !Core, !Env, !Errors) ; Body = ast_body_foreign(_) ). :- pred gather_nested_funcs(nq_name::in, ast_nested_function::in, core::in, core::out, env::in, env::out, errors(compile_error)::in, errors(compile_error)::out) is det. gather_nested_funcs(Name0, ast_nested_function(Decl, Body), !Core, !Env, !Errors) :- Context = Decl ^ afd_context, NameStr = mangle_lambda(nq_name_to_string(Name0), Context), Name = nq_name_det(NameStr), core_allocate_function(FuncId, !Core), env_add_lambda(NameStr, FuncId, !Env), QName = q_name_append(module_name(!.Core), Name), ast_to_func_decl(!.Core, !.Env, QName, Decl, s_private, MaybeFunction), ( MaybeFunction = ok(Function), core_set_function(FuncId, Function, !Core) ; MaybeFunction = errors(Errors), add_errors(Errors, !Errors) ), foldl3(gather_funcs_block, Body, !Core, !Env, !Errors). ast_to_func_decl(Core, Env, Name, Decl, Sharing, Result) :- Decl = ast_function_decl(Params, Returns, Uses0, Context), % Build basic information about the function. ParamTypesResult = result_list_to_result( map(build_param_type(Core, Env, Sharing), Params)), ReturnTypeResults = map( build_type_ref(Core, Env, Sharing, dont_check_type_vars), Returns), ReturnTypesResult = result_list_to_result(ReturnTypeResults), map_foldl2(build_uses(Context, Env), Uses0, ResourceErrorss, set.init, Uses, set.init, Observes), ResourceErrors = cord_list_to_cord(ResourceErrorss), IntersectUsesObserves = intersect(Uses, Observes), ( if ParamTypesResult = ok(ParamTypes), ReturnTypesResult = ok(ReturnTypes), is_empty(ResourceErrors), is_empty(IntersectUsesObserves) then Function = func_init_user(Name, Context, Sharing, ParamTypes, ReturnTypes, Uses, Observes), Result = ok(Function) else some [!Errors] ( !:Errors = init, add_errors_from_result(ParamTypesResult, !Errors), add_errors_from_result(ReturnTypesResult, !Errors), add_errors(ResourceErrors, !Errors), ( if not is_empty(IntersectUsesObserves) then Resources = list.map(core_get_resource(Core), set.to_sorted_list(IntersectUsesObserves)), add_error(Context, ce_uses_observes_not_distinct(Resources), !Errors) else true ), Result = errors(!.Errors) ) ). :- pred gather_funcs_block(ast_block_thing::in, core::in, core::out, env::in, env::out, errors(compile_error)::in, errors(compile_error)::out) is det. gather_funcs_block(astbt_statement(Stmt), !Core, !Env, !Errors) :- ast_statement(Type, _) = Stmt, gather_funcs_stmt(Type, !Core, !Env, !Errors). gather_funcs_block(astbt_function(Name, Defn), !Core, !Env, !Errors) :- gather_nested_funcs(Name, Defn, !Core, !Env, !Errors). :- pred gather_funcs_stmt(ast_stmt_type(context)::in, core::in, core::out, env::in, env::out, errors(compile_error)::in, errors(compile_error)::out) is det. gather_funcs_stmt(s_call(Call), !Core, !Env, !Errors) :- gather_funcs_call(Call, !Core, !Env, !Errors). gather_funcs_stmt(s_assign_statement(_, Exprs), !Core, !Env, !Errors) :- foldl3(gather_funcs_expr, Exprs, !Core, !Env, !Errors). gather_funcs_stmt(s_var_statement(_), !Core, !Env, !Errors). gather_funcs_stmt(s_array_set_statement(_, ExprA, ExprB), !Core, !Env, !Errors) :- gather_funcs_expr(ExprA, !Core, !Env, !Errors), gather_funcs_expr(ExprB, !Core, !Env, !Errors). gather_funcs_stmt(s_return_statement(Exprs), !Core, !Env, !Errors) :- foldl3(gather_funcs_expr, Exprs, !Core, !Env, !Errors). gather_funcs_stmt(s_match_statement(Expr, Cases), !Core, !Env, !Errors) :- gather_funcs_expr(Expr, !Core, !Env, !Errors), foldl3(gather_funcs_case, Cases, !Core, !Env, !Errors). gather_funcs_stmt(s_ite(Cond, Then, Else), !Core, !Env, !Errors) :- gather_funcs_expr(Cond, !Core, !Env, !Errors), foldl3(gather_funcs_block, Then, !Core, !Env, !Errors), foldl3(gather_funcs_block, Else, !Core, !Env, !Errors). :- pred gather_funcs_case(ast_match_case::in, core::in, core::out, env::in, env::out, errors(compile_error)::in, errors(compile_error)::out) is det. gather_funcs_case(ast_match_case(_, Block), !Core, !Env, !Errors) :- foldl3(gather_funcs_block, Block, !Core, !Env, !Errors). :- pred gather_funcs_call(ast_call_like::in, core::in, core::out, env::in, env::out, errors(compile_error)::in, errors(compile_error)::out) is det. gather_funcs_call(Call, !Core, !Env, !Errors) :- ( Call = ast_call_like(Callee, Args) ; Call = ast_bang_call(Callee, Args) ), gather_funcs_expr(Callee, !Core, !Env, !Errors), foldl3(gather_funcs_expr, Args, !Core, !Env, !Errors). :- pred gather_funcs_expr(ast_expression::in, core::in, core::out, env::in, env::out, errors(compile_error)::in, errors(compile_error)::out) is det. gather_funcs_expr(e_call_like(Call), !Core, !Env, !Errors) :- gather_funcs_call(Call, !Core, !Env, !Errors). gather_funcs_expr(e_u_op(_, Expr), !Core, !Env, !Errors) :- gather_funcs_expr(Expr, !Core, !Env, !Errors). gather_funcs_expr(e_b_op(Left, _, Right), !Core, !Env, !Errors) :- gather_funcs_expr(Left, !Core, !Env, !Errors), gather_funcs_expr(Right, !Core, !Env, !Errors). gather_funcs_expr(e_if(Cond, Then, Else), !Core, !Env, !Errors) :- gather_funcs_expr(Cond, !Core, !Env, !Errors), foldl3(gather_funcs_expr, Then, !Core, !Env, !Errors), foldl3(gather_funcs_expr, Else, !Core, !Env, !Errors). gather_funcs_expr(e_match(Expr, Cases), !Core, !Env, !Errors) :- gather_funcs_expr(Expr, !Core, !Env, !Errors), foldl3(gather_funcs_expr_case, Cases, !Core, !Env, !Errors). gather_funcs_expr(e_symbol(_), !Core, !Env, !Errors). gather_funcs_expr(e_const(_), !Core, !Env, !Errors). gather_funcs_expr(e_array(Exprs), !Core, !Env, !Errors) :- foldl3(gather_funcs_expr, Exprs, !Core, !Env, !Errors). :- pred gather_funcs_expr_case(ast_expr_match_case::in, core::in, core::out, env::in, env::out, errors(compile_error)::in, errors(compile_error)::out) is det. gather_funcs_expr_case(ast_emc(_, Exprs), !Core, !Env, !Errors) :- foldl3(gather_funcs_expr, Exprs, !Core, !Env, !Errors). %-----------------------------------------------------------------------% :- func build_param_type(core, env, sharing, ast_param) = result(type_, compile_error). build_param_type(Core, Env, Sharing, ast_param(_, Type)) = build_type_ref(Core, Env, Sharing, dont_check_type_vars, Type). :- type check_type_vars % Should check that each type variable is in the given set. ---> check_type_vars(set(string)) % Don't check, because this type expression is not part of a % type declaration. ; dont_check_type_vars. % build_type_ref(Core, Env, ParentSharing, Check, AstType) = Res, % % Build a type for this ast type expression. If the expression occurs % in an exported function declaration then ParentSharing should be % s_public. % :- func build_type_ref(core, env, sharing, check_type_vars, ast_type_expr) = result(type_, compile_error). build_type_ref(Core, Env, Sharing, CheckVars, ast_type(Name, Args0, Context)) = Result :- ArgsResult = result_list_to_result( map(build_type_ref(Core, Env, Sharing, CheckVars), Args0)), ( ArgsResult = ok(Args), ( if env_search_type(Env, Name, Type) then ( Type = te_builtin(BuiltinType), ( Args0 = [], Result = ok(builtin_type(BuiltinType)) ; Args0 = [_ | _], Result = return_error(Context, ce_builtin_type_with_args(Name)) ) ; Type = te_id(TypeId, TypeArity), ( if length(Args) = TypeArity ^ a_num then Result = ok(type_ref(TypeId, Args)) else Result = return_error(Context, ce_type_has_incorrect_num_of_args( Name, TypeArity ^ a_num, length(Args))) ) ) else Result = return_error(Context, ce_type_not_known(Name)) ) ; ArgsResult = errors(Error), Result = errors(Error) ). build_type_ref(Core, Env, Sharing, MaybeCheckVars, Func) = Result :- Func = ast_type_func(Args0, Returns0, Uses0, Context), ArgsResult = result_list_to_result( map(build_type_ref(Core, Env, Sharing, MaybeCheckVars), Args0)), ReturnsResult = result_list_to_result( map(build_type_ref(Core, Env, Sharing, MaybeCheckVars), Returns0)), map_foldl2(build_uses(Context, Env), Uses0, ResourceErrorss, set.init, UsesSet, set.init, ObservesSet), ResourceErrors = cord_list_to_cord(ResourceErrorss), ( if ArgsResult = ok(Args), ReturnsResult = ok(Returns), is_empty(ResourceErrors) then Result = ok(func_type(Args, Returns, UsesSet, ObservesSet)) else some [!Errors] ( !:Errors = init, add_errors_from_result(ArgsResult, !Errors), add_errors_from_result(ReturnsResult, !Errors), add_errors(ResourceErrors, !Errors), Result = errors(!.Errors) ) ). build_type_ref(_, _, _, MaybeCheckVars, ast_type_var(Name, Context)) = Result :- ( if MaybeCheckVars = check_type_vars(CheckVars) => member(Name, CheckVars) then Result = ok(type_variable(Name)) else Result = return_error(Context, ce_type_var_unknown(Name)) ). :- pred build_uses(context::in, env::in, ast_uses::in, errors(compile_error)::out, set(resource_id)::in, set(resource_id)::out, set(resource_id)::in, set(resource_id)::out) is det. build_uses(Context, Env, ast_uses(Type, ResourceName), !:Errors, !Uses, !Observes) :- !:Errors = init, ( if env_search_resource(Env, ResourceName, ResourceId) then ( Type = ut_uses, !:Uses = set.insert(!.Uses, ResourceId) ; Type = ut_observes, !:Observes = set.insert(!.Observes, ResourceId) ) else add_error(Context, ce_resource_unknown(ResourceName), !Errors) ). %-----------------------------------------------------------------------% :- pred func_to_pre(env::in, nq_named(ast_function)::in, map(func_id, pre_function)::in, map(func_id, pre_function)::out) is det. func_to_pre(Env0, nq_named(Name, Func), !Pre) :- Func = ast_function(ast_function_decl(Params, Returns, _, Context), Body, _, _), ( Body = ast_body_block(Block), % The name parameter is the name in the environment and doesn't need to % be qualified. func_to_pre_func(Env0, q_name(Name), Params, Returns, Block, Context, !Pre) ; Body = ast_body_foreign(_) % Foreign functions skip pre representation. ). %-----------------------------------------------------------------------% :- func check_resource_exports(core) = errors(compile_error). check_resource_exports(Core) = Errors :- Resources = core_all_exported_resources(Core), Errors = cord_list_to_cord( map(check_resource_exports_2(Core), Resources)). :- func check_resource_exports_2(core, pair(resource_id, resource)) = errors(compile_error). check_resource_exports_2(Core, _ - Res) = Errors :- ( Res = r_io, Errors = init ; Res = r_other(Name, FromId, _, _, Context), Errors = check_resource_exports_3(Name, Context, Core, FromId) ; Res = r_abstract(_), Errors = init ). :- func check_resource_exports_3(q_name, context, core, resource_id) = errors(compile_error). check_resource_exports_3(Name, Context, Core, Res) = Errors :- resource_is_private(Core, Res) = IsPrivate, ( IsPrivate = is_private(RName), Errors = error(Context, ce_resource_not_public_in_resource( q_name_unqual(Name), q_name_unqual(RName))) ; IsPrivate = is_not_private, Errors = init ). %-----------------------------------------------------------------------% :- type is_private ---> is_private(q_name) % could be public, abstract or imported. ; is_not_private. :- func resource_is_private(core, resource_id) = is_private. resource_is_private(Core, ResId) = resource_is_private_2(core_get_resource(Core, ResId)). :- func resource_is_private_2(resource) = is_private. resource_is_private_2(r_io) = is_not_private. resource_is_private_2(r_other(RName, _, Sharing, Imported, _)) = Private :- ( Sharing = so_public, Private = is_not_private ; Sharing = so_public_opaque, Private = is_not_private ; Sharing = so_private, ( Imported = i_imported, Private = is_not_private ; Imported = i_local, Private = is_private(RName) ) ). resource_is_private_2(r_abstract(_)) = is_not_private. :- func type_is_private(core, type_id) = is_private. type_is_private(Core, TypeId) = type_is_private_2(core_get_type(Core, TypeId)). :- func type_is_private_2(user_type) = is_private. type_is_private_2(Type) = Private :- Sharing = utype_get_sharing(Type), ( Sharing = so_private, Imported = utype_get_imported(Type), ( Imported = i_imported, Private = is_not_private ; Imported = i_local, Private = is_private(utype_get_name(Type)) ) ; Sharing = so_public, Private = is_not_private ; Sharing = so_public_opaque, Private = is_not_private ). %-----------------------------------------------------------------------% :- func check_type_exports(core) = errors(compile_error). check_type_exports(Core) = Errors :- Types = core_all_exported_types(Core), Errors = cord_list_to_cord( map(check_type_exports_2(Core), Types)). :- func check_type_exports_2(core, pair(type_id, user_type)) = errors(compile_error). check_type_exports_2(Core, _ - Type) = Errors :- Sharing = utype_get_sharing(Type), ( Sharing = so_public, ResourceErrors = cord_list_to_cord( map(check_type_resource(Core, Type), set.to_sorted_list(utype_get_resources(Core, Type)))), TypeErrors = cord_list_to_cord( map(check_type_type(Core, Type), set.to_sorted_list(utype_get_types(Core, Type)))), Errors = ResourceErrors ++ TypeErrors ; ( Sharing = so_public_opaque ; Sharing = so_private ), Errors = init ). :- func check_type_resource(core, user_type, resource_id) = errors(compile_error). check_type_resource(Core, Type, ResId) = Errors :- resource_is_private(Core, ResId) = Private, ( Private = is_private(RName), Name = utype_get_name(Type), Context = utype_get_context(Type), Errors = error(Context, ce_resource_not_public_in_type( q_name_unqual(Name), q_name_unqual(RName))) ; Private = is_not_private, Errors = init ). :- func check_type_type(core, user_type, type_id) = errors(compile_error). check_type_type(Core, Type, TypeId) = Errors :- type_is_private(Core, TypeId) = Private, ( Private = is_private(TName), Name = utype_get_name(Type), Context = utype_get_context(Type), Errors = error(Context, ce_type_not_public_in_type( q_name_unqual(Name), q_name_unqual(TName))) ; Private = is_not_private, Errors = init ). %-----------------------------------------------------------------------% :- func check_function_exports(core) = errors(compile_error). check_function_exports(Core) = Errors :- Functions = core_all_exported_functions(Core), Errors = cord_list_to_cord( map(check_function_exports_2(Core), Functions)). :- func check_function_exports_2(core, pair(func_id, function)) = errors(compile_error). check_function_exports_2(Core, _ - Func) = Errors :- func_get_resource_signature(Func, Uses, Observes), func_get_type_signature(Func, Params, Returns, _), ParamsRes = union_list(map(type_get_resources, Params)), ReturnsRes = union_list(map(type_get_resources, Returns)), ResIds = set.to_sorted_list(Uses `set.union` Observes `set.union` ParamsRes `set.union` ReturnsRes), ResErrors = cord_list_to_cord( map(check_function_resource(Core, Func), ResIds)), TypeIds = set.to_sorted_list( union_list(map(type_get_types, Params)) `set.union` union_list(map(type_get_types, Returns))), TypeErrors = cord_list_to_cord( map(check_function_type(Core, Func), TypeIds)), Errors = ResErrors ++ TypeErrors. :- func check_function_resource(core, function, resource_id) = errors(compile_error). check_function_resource(Core, Func, ResId) = Errors :- resource_is_private(Core, ResId) = Private, ( Private = is_private(RName), Name = func_get_name(Func), Context = func_get_context(Func), Errors = error(Context, ce_resource_not_public_in_function( q_name_unqual(Name), q_name_unqual(RName))) ; Private = is_not_private, Errors = init ). :- func check_function_type(core, function, type_id) = errors(compile_error). check_function_type(Core, Func, TypeId) = Errors :- Private = type_is_private(Core, TypeId), ( Private = is_private(TName), FName = func_get_name(Func), Context = func_get_context(Func), Errors = error(Context, ce_type_not_public_in_func( q_name_unqual(FName), q_name_unqual(TName))) ; Private = is_not_private, Errors = init ). %-----------------------------------------------------------------------% %-----------------------------------------------------------------------% ================================================ FILE: src/pre.bang.m ================================================ %-----------------------------------------------------------------------% % Plasma AST symbol resolution % vim: ts=4 sw=4 et % % Copyright (C) Plasma Team % Distributed under the terms of the MIT License see ../LICENSE.code % %-----------------------------------------------------------------------% :- module pre.bang. %-----------------------------------------------------------------------% :- interface. :- import_module compile_error. :- import_module core. :- import_module pre.pre_ds. :- import_module util. :- import_module util.result. %-----------------------------------------------------------------------% :- func check_bangs(core, pre_function) = errors(compile_error). %-----------------------------------------------------------------------% %-----------------------------------------------------------------------% :- implementation. :- import_module cord. :- import_module int. :- import_module list. :- import_module context. :- import_module common_types. %-----------------------------------------------------------------------% % Most of the resource checking is done in a stage after type checking, % (core.res_chk.m) so that type information is available for higher-order % values. The only check done here is whether there are multiple bangs in a % single statement. check_bangs(_Core, Func) = cord_list_to_cord(map(check_bangs_stmt, Stmts)) :- Stmts = Func ^ f_body. :- func check_bangs_stmt(pre_statement) = errors(compile_error). check_bangs_stmt(Stmt) = !:Errors :- !:Errors = init, StmtType = Stmt ^ s_type, Context = Stmt ^ s_info ^ si_context, ( StmtType = s_call(Call), check_bangs_call(Context, Call, ExprsWithBang, StmtErrors), add_errors(StmtErrors, !Errors) ; StmtType = s_decl_vars(_), ExprsWithBang = 0 ; StmtType = s_assign(_, Exprs), map2(check_bangs_expr(Context), Exprs, ExprsWithBangs, StmtErrors), ExprsWithBang = sum(ExprsWithBangs), add_errors(cord_list_to_cord(StmtErrors), !Errors) ; StmtType = s_return(_), ExprsWithBang = 0 ; StmtType = s_match(_, Cases), CasesErrors = map(check_bangs_case, Cases), ExprsWithBang = 0, add_errors(cord_list_to_cord(CasesErrors), !Errors) ), ( if ExprsWithBang > 1 then add_error(Context, ce_too_many_bangs_in_statement, !Errors) else true ). % This code has been removed because it cannot check higher order code % from this pass. And later pases do not carry statement information. % It should be re-implemented in the future. % ( if % all [U] ( member(U, UsedSet) => % ( % count_value(Used, U, 1), % \+ member(U, ObservedSet), % URes = core_get_resource(Info ^ cri_core, U), % all [P] ( member(P, UsedSet `union` ObservedSet) => % \+ (U \= P, resource_is_decendant(Info ^ cri_core, URes, P)) % ) % ) % ), % all [O] ( member(O, ObservedSet) => % ( % \+ member(O, UsedSet), % ORes = core_get_resource(Info ^ cri_core, O), % all [PP] ( member(PP, UsedSet) => % \+ resource_is_decendant(Info ^ cri_core, ORes, PP) % ) % ) % ) % then % true % else % add_error(Context, ce_resource_reused_in_stmt, !Errors) % ). :- func check_bangs_case(pre_case) = errors(compile_error). check_bangs_case(pre_case(_, Stmts)) = cord_list_to_cord(map(check_bangs_stmt, Stmts)). :- pred check_bangs_expr(context::in, pre_expr::in, int::out, errors(compile_error)::out) is det. check_bangs_expr(Context, e_call(Call), ExprsWithBang, Errors) :- check_bangs_call(Context, Call, ExprsWithBang, Errors). check_bangs_expr(Context, e_match(Expr, Cases), Bangs, Errors) :- check_bangs_expr(Context, Expr, BangsInExpr, ExprErrors), map2(check_bangs_expr_case(Context), Cases, BangsInCases, CasesErrors), Bangs = sum(BangsInCases) + BangsInExpr, Errors = ExprErrors ++ cord_list_to_cord(CasesErrors). check_bangs_expr(_, e_var(_), 0, init). check_bangs_expr(Context, e_construction(_, Exprs), Bangs, Errors) :- map2(check_bangs_expr(Context), Exprs, BangsInExprs, Errors0), Bangs = sum(BangsInExprs), Errors = cord_list_to_cord(Errors0). check_bangs_expr(_, e_lambda(Lambda), 0, Errors) :- Body = Lambda ^ pl_body, Errors = cord_list_to_cord(map(check_bangs_stmt, Body)). check_bangs_expr(_, e_constant(_), 0, init). :- pred check_bangs_call(context::in, pre_call::in, int::out, errors(compile_error)::out) is det. check_bangs_call(Context, Call, ExprsWithBang, !:Errors) :- !:Errors = init, ( Call = pre_call(_, Args, WithBang) ; Call = pre_ho_call(_, Args, WithBang) ), map2(check_bangs_expr(Context), Args, BangsInArgs0, ArgsErrors), BangsInArgs = sum(BangsInArgs0), add_errors(cord_list_to_cord(ArgsErrors), !Errors), ( WithBang = with_bang, ExprsWithBang = BangsInArgs + 1 ; WithBang = without_bang, ExprsWithBang = BangsInArgs ). :- pred check_bangs_expr_case(context::in, pre_expr_case::in, int::out, errors(compile_error)::out) is det. check_bangs_expr_case(Context, pre_e_case(_, Expr), Bangs, Errors) :- map2(check_bangs_expr(Context), Expr, Bangss, Errorss), Bangs = sum(Bangss), Errors = cord_list_to_cord(Errorss). %-----------------------------------------------------------------------% :- func sum(list(int)) = int. sum(Xs) = foldl(func(A, B) = A + B, Xs, 0). ================================================ FILE: src/pre.branches.m ================================================ %-----------------------------------------------------------------------% % Plasma AST symbol resolution % vim: ts=4 sw=4 et % % Copyright (C) Plasma Team % Distributed under the terms of the MIT License see ../LICENSE.code % % This module fixes variable usage in branching code. It: % * fixes var-def sets % * Determines some reachability information (WRT return statements). % * checks that used variables are always well defined (eg % along all execution paths) % * names-appart branch-local variables (from other % branches). % %-----------------------------------------------------------------------% :- module pre.branches. %-----------------------------------------------------------------------% :- interface. :- import_module compile_error. :- import_module pre.pre_ds. :- import_module util. :- import_module util.result. %-----------------------------------------------------------------------% :- func fix_branches(pre_function) = result(pre_function, compile_error). %-----------------------------------------------------------------------% %-----------------------------------------------------------------------% :- implementation. :- import_module cord. :- import_module list. :- import_module require. :- import_module set. :- import_module context. :- import_module common_types. :- import_module pre.util. :- import_module util.my_exception. :- import_module varmap. %-----------------------------------------------------------------------% fix_branches(!.Func) = Result :- Stmts0 = !.Func ^ f_body, Varmap0 = !.Func ^ f_varmap, Arity = !.Func ^ f_arity, Context = !.Func ^ f_context, map_foldl3(fix_branches_stmt, Stmts0, Stmts1, set.init, _, Varmap0, Varmap, init, BranchesErrors), ( if is_empty(BranchesErrors) then ResultStmts = fix_return_stmt(return_info(Context, Arity), Stmts1), ( ResultStmts = ok(Stmts), !Func ^ f_body := Stmts, !Func ^ f_varmap := Varmap, Result = ok(!.Func) ; ResultStmts = errors(Errors), Result = errors(Errors) ) else Result = errors(BranchesErrors) ). %-----------------------------------------------------------------------% :- pred fix_branches_stmt(pre_statement::in, pre_statement::out, set(var)::in, set(var)::out, varmap::in, varmap::out, errors(compile_error)::in, errors(compile_error)::out) is det. fix_branches_stmt(!Stmt, !DeclVars, !Varmap, !Errors) :- Context = !.Stmt ^ s_info ^ si_context, update_lambdas_this_stmt_2(fix_branches_lambda(Context), !Stmt, !Varmap, !Errors), Type = !.Stmt ^ s_type, % Only defined vars that are also non-local can be defined vars. ( ( Type = s_call(_) ; Type = s_assign(_, _) ; Type = s_return(_) ) ; Type = s_decl_vars(NewDeclVars), !:DeclVars = !.DeclVars `union` list_to_set(NewDeclVars) ; Type = s_match(Var, Cases0), Info = !.Stmt ^ s_info, DefVars = Info ^ si_def_vars, UsedDefVars = DefVars `intersect` !.DeclVars, map2_foldl3(fix_branches_case(!.DeclVars, UsedDefVars), Cases0, Cases, CasesReachable, set.init, _, !Varmap, !Errors), Reachable = reachable_branches(CasesReachable), !Stmt ^ s_type := s_match(Var, Cases), % Fixup variable sets. These sets are more strict but they also % allow us to avoid doing any renaming here, since renaming only % occurs for local variables. UseVars0 = Info ^ si_use_vars, UseVars = UseVars0 `intersect` !.DeclVars, !Stmt ^ s_info := ((Info ^ si_use_vars := UseVars) ^ si_reachable := Reachable) ). :- type binds_vars ---> binds_vars(set(var)) ; not_reached. :- pred fix_branches_case(set(var)::in, set(var)::in, pre_case::in, pre_case::out, stmt_reachable::out, set(var)::in, set(var)::out, varmap::in, varmap::out, errors(compile_error)::in, errors(compile_error)::out) is det. fix_branches_case(DeclVars, SwitchDefVars, pre_case(Pat, Stmts0), pre_case(Pat, Stmts), Reachable, !CasesVars, !Varmap, !Errors) :- map_foldl3(fix_branches_stmt, Stmts0, Stmts, DeclVars, _, !Varmap, !Errors), PatVars = pattern_all_vars(Pat), StmtsDefVars = union_list(map((func(S) = S ^ s_info ^ si_def_vars), Stmts)), Reachable = reachable_sequence( map((func(S) = S ^ s_info ^ si_reachable), Stmts)), ( Reachable = stmt_always_returns ; ( Reachable = stmt_always_fallsthrough ; Reachable = stmt_may_return ), DefVars = StmtsDefVars `union` PatVars, ( if not superset(DefVars, SwitchDefVars) then ( Stmts0 = [HeadStmt | _], Context = HeadStmt ^ s_info ^ si_context ; Stmts0 = [], unexpected($file, $pred, "Empty case") ), MissedVars = map(get_var_name_no_suffix(!.Varmap), to_sorted_list(difference(SwitchDefVars, DefVars))), add_error(Context, ce_case_does_not_define_all_variables(MissedVars), !Errors) else true ) ), AllVars = union_list(map(stmt_all_vars, Stmts)), !:CasesVars = !.CasesVars `union` AllVars. :- func reachable_branches(list(stmt_reachable)) = stmt_reachable. reachable_branches([]) = stmt_always_fallsthrough. reachable_branches([R | Rs]) = foldl(reachable_branches_2, Rs, R). :- func reachable_branches_2(stmt_reachable, stmt_reachable) = stmt_reachable. reachable_branches_2(stmt_may_return, _) = stmt_may_return. reachable_branches_2(stmt_always_fallsthrough, stmt_always_fallsthrough) = stmt_always_fallsthrough. reachable_branches_2(stmt_always_fallsthrough, stmt_always_returns) = stmt_may_return. reachable_branches_2(stmt_always_fallsthrough, stmt_may_return) = stmt_may_return. reachable_branches_2(stmt_always_returns, stmt_always_returns) = stmt_always_returns. reachable_branches_2(stmt_always_returns, stmt_always_fallsthrough) = stmt_may_return. reachable_branches_2(stmt_always_returns, stmt_may_return) = stmt_may_return. :- func reachable_sequence(list(stmt_reachable)) = stmt_reachable. reachable_sequence(Branches) = foldl(reachable_sequence_2, Branches, stmt_always_fallsthrough). :- func reachable_sequence_2(stmt_reachable, stmt_reachable) = stmt_reachable. reachable_sequence_2(stmt_always_fallsthrough, R) = R. reachable_sequence_2(stmt_always_returns, _) = stmt_always_returns. reachable_sequence_2(stmt_may_return, stmt_always_fallsthrough) = stmt_may_return. reachable_sequence_2(stmt_may_return, stmt_always_returns) = stmt_always_returns. reachable_sequence_2(stmt_may_return, stmt_may_return) = stmt_may_return. %-----------------------------------------------------------------------% :- pred fix_branches_lambda(context::in, pre_lambda::in, pre_lambda::out, varmap::in, varmap::out, errors(compile_error)::in, errors(compile_error)::out) is det. fix_branches_lambda(Context, !Lambda, !Varmap, !Errors) :- some [!Body] ( !.Lambda = pre_lambda(Func, Params, Captured, Arity, !:Body), map_foldl3(fix_branches_stmt, !Body, set.init, _, !Varmap, !Errors), ResultStmts = fix_return_stmt(return_info(Context, Arity), !.Body), ( ResultStmts = ok(!:Body), !:Lambda = pre_lambda(Func, Params, Captured, Arity, !.Body) ; ResultStmts = errors(Errors), add_errors(Errors, !Errors) ) ). %-----------------------------------------------------------------------% :- type return_info ---> return_info( ri_context :: context, ri_arity :: arity ). :- func fix_return_stmt(return_info, pre_statements) = result(pre_statements, compile_error). fix_return_stmt(Info, Stmts0) = result_map(reverse, fix_return_stmt_rev(Info, reverse(Stmts0))). :- func fix_return_stmt_rev(return_info, pre_statements) = result(pre_statements, compile_error). fix_return_stmt_rev(Info, []) = check_arity_and_return(Context, Arity) :- return_info(Context, Arity) = Info. fix_return_stmt_rev(Info, [Stmt0 | Stmts0]) = Result :- Reachable = Stmt0 ^ s_info ^ si_reachable, ( Reachable = stmt_always_returns, Result = ok([Stmt0 | Stmts0]) ; Reachable = stmt_always_fallsthrough, Context = Stmt0 ^ s_info ^ si_context, Arity = Info ^ ri_arity, Result0 = check_arity_and_return(Context, Arity), Result = result_map((func(R) = R ++ [Stmt0 | Stmts0]), Result0) ; Reachable = stmt_may_return, Type = Stmt0 ^ s_type, ( Type = s_match(Var, Cases0), CasesResult = result_list_to_result( map(fix_return_stmt_case(Info), Cases0)), Result = result_map( (func(Cases) = [Stmt | Stmts0] :- Stmt = Stmt0 ^ s_type := s_match(Var, Cases) ), CasesResult) ; ( Type = s_call(_) ; Type = s_decl_vars(_) ; Type = s_assign(_, _) ; Type = s_return(_) ), unexpected($file, $pred, "Impercise reachablity") ) ). :- func fix_return_stmt_case(return_info, pre_case) = result(pre_case, compile_error). fix_return_stmt_case(Info, pre_case(Pat, Stmts0)) = Result :- ResultStmts = fix_return_stmt(Info, Stmts0), Result = result_map( (func(Stmts) = pre_case(Pat, Stmts) ), ResultStmts). :- func check_arity_and_return(context, arity) = result(pre_statements, compile_error). check_arity_and_return(Context, Arity) = Result :- ( if Arity = arity(0) then Result = ok([new_return_statement]) else Result = return_error(Context, ce_no_return_statement(Arity)) ). :- func new_return_statement = pre_statement. new_return_statement = pre_statement(s_return([]), Info) :- Info = stmt_info(nil_context, init, init, stmt_always_returns). %-----------------------------------------------------------------------% %-----------------------------------------------------------------------% ================================================ FILE: src/pre.closures.m ================================================ %-----------------------------------------------------------------------% % Plasma AST symbol resolution % vim: ts=4 sw=4 et % % Copyright (C) Plasma Team % Distributed under the terms of the MIT License see ../LICENSE.code % % This module computes nonlocals within the pre-core representation. % %-----------------------------------------------------------------------% :- module pre.closures. %-----------------------------------------------------------------------% :- interface. :- import_module pre.pre_ds. %-----------------------------------------------------------------------% :- pred compute_closures(pre_function::in, pre_function::out) is det. %-----------------------------------------------------------------------% %-----------------------------------------------------------------------% :- implementation. :- import_module maybe. :- import_module list. :- import_module require. :- import_module set. :- import_module varmap. %-----------------------------------------------------------------------% compute_closures(!Func) :- Stmts0 = !.Func ^ f_body, filter_map(vow_is_var, !.Func ^ f_param_vars, Params), map_foldl(compute_closures_stmt, Stmts0, Stmts, list_to_set(Params), _), !Func ^ f_body := Stmts. :- pred compute_closures_stmt(pre_statement::in, pre_statement::out, set(var)::in, set(var)::out) is det. compute_closures_stmt(!Stmt, !DeclVars) :- !.Stmt = pre_statement(Type, Info), ( Type = s_call(Call0), compute_closures_call(!.DeclVars, Call0, Call), !:Stmt = pre_statement(s_call(Call), Info) ; Type = s_decl_vars(Vars), !:DeclVars = !.DeclVars `union` list_to_set(Vars) ; Type = s_assign(Vars, Exprs0), map(compute_closures_expr(!.DeclVars), Exprs0, Exprs), !:Stmt = pre_statement(s_assign(Vars, Exprs), Info) ; Type = s_return(_) ; Type = s_match(Var, Cases0), map(compute_closures_case(!.DeclVars), Cases0, Cases), !:Stmt = pre_statement(s_match(Var, Cases), Info) ). :- pred compute_closures_case(set(var)::in, pre_case::in, pre_case::out) is det. compute_closures_case(DeclVars, pre_case(Pat, Stmts0), pre_case(Pat, Stmts)) :- map_foldl(compute_closures_stmt, Stmts0, Stmts, DeclVars `union` pattern_all_vars(Pat), _). :- pred compute_closures_call(set(var)::in, pre_call::in, pre_call::out) is det. compute_closures_call(DeclVars, pre_call(Func, Args0, Bang), pre_call(Func, Args, Bang)) :- map(compute_closures_expr(DeclVars), Args0, Args). compute_closures_call(DeclVars, pre_ho_call(Callee0, Args0, Bang), pre_ho_call(Callee, Args, Bang)) :- compute_closures_expr(DeclVars, Callee0, Callee), map(compute_closures_expr(DeclVars), Args0, Args). :- pred compute_closures_expr(set(var)::in, pre_expr::in, pre_expr::out) is det. compute_closures_expr(DeclVars, e_call(Call0), e_call(Call)) :- compute_closures_call(DeclVars, Call0, Call). compute_closures_expr(DeclVars, e_match(Expr0, Cases0), e_match(Expr, Cases)) :- compute_closures_expr(DeclVars, Expr0, Expr), map(compute_closures_e_case(DeclVars), Cases0, Cases). compute_closures_expr(_, e_var(V), e_var(V)). compute_closures_expr(DeclVars, e_construction(Ctors, Args0), e_construction(Ctors, Args)) :- map(compute_closures_expr(DeclVars), Args0, Args). compute_closures_expr(DeclVars, e_lambda(Lambda0), e_lambda(Lambda)) :- compute_closures_lambda(DeclVars, Lambda0, Lambda). compute_closures_expr(_, e_constant(C), e_constant(C)). :- pred compute_closures_e_case(set(var)::in, pre_expr_case::in, pre_expr_case::out) is det. compute_closures_e_case(DeclVars, pre_e_case(Pat, Exprs0), pre_e_case(Pat, Exprs)) :- map(compute_closures_expr(DeclVars `union` pattern_all_vars(Pat)), Exprs0, Exprs). :- pred compute_closures_lambda(set(var)::in, pre_lambda::in, pre_lambda::out) is det. compute_closures_lambda(DeclVars, !Lambda) :- MaybeCaptured = !.Lambda ^ pl_captured, ( MaybeCaptured = no ; MaybeCaptured = yes(_), unexpected($file, $pred, "Expect MaybeCaptured = no") ), map_foldl(compute_closures_stmt, !.Lambda ^ pl_body, Body, DeclVars `union` list_to_set(ParamVars), _), % We have to capture this information from within the lambda, if we got % it from outside it could be confused with other expressions within the % same statement. DefVars = union_list(map(func(S) = S ^ s_info ^ si_def_vars, Body)), UseVars = union_list(map(func(S) = S ^ s_info ^ si_use_vars, Body)), filter_map(vow_is_var, !.Lambda ^ pl_params, ParamVars), Captured = (UseVars `intersect` DeclVars) `difference` DefVars `difference` list_to_set(ParamVars), !Lambda ^ pl_captured := yes(Captured), !Lambda ^ pl_body := Body. %-----------------------------------------------------------------------% %-----------------------------------------------------------------------% ================================================ FILE: src/pre.env.m ================================================ %-----------------------------------------------------------------------% % Plasma AST Environment manipulation routines % vim: ts=4 sw=4 et % % Copyright (C) Plasma Team % Distributed under the terms of the MIT License see ../LICENSE.code % % This module contains code to track the environment of a statement in the % Plasma AST. % %-----------------------------------------------------------------------% :- module pre.env. %-----------------------------------------------------------------------% :- interface. :- import_module set. :- import_module string. :- import_module ast. :- import_module context. :- import_module common_types. :- import_module core. :- import_module core.types. :- import_module q_name. :- import_module varmap. %-----------------------------------------------------------------------% :- type env. % init(Operators) = Env. % :- func init(operators) = env. % Sometimes we need to look up particular operators and constructors, % when we do this we know exactly which constroctor and don't need to % use the normal name resolution. % :- type operators ---> operators( o_int_add :: func_id, o_int_sub :: func_id, o_int_mul :: func_id, o_int_div :: func_id, o_int_mod :: func_id, o_int_gt :: func_id, o_int_lt :: func_id, o_int_gteq :: func_id, o_int_lteq :: func_id, o_int_eq :: func_id, o_int_neq :: func_id, % Unary minus o_int_minus :: func_id, % We need to lookup bool constructors for generating ITE % code. o_bool_true :: ctor_id, o_bool_false :: ctor_id, o_bool_and :: func_id, o_bool_or :: func_id, o_bool_not :: func_id, % We need to lookup list constructors to handle built in % list syntax. o_list_type :: type_id, o_list_nil :: ctor_id, o_list_cons :: ctor_id, o_string_concat :: func_id ). :- func env_operators(env) = operators. %-----------------------------------------------------------------------% % % Code to add variables and maniuplate their visibility in the environment. % % Add but leave a variable uninitialised. % % The variable must not already exist. % :- pred env_add_uninitialised_var(string::in, var::out, env::in, env::out, varmap::in, varmap::out) is semidet. % Add and initialise a variable. % % The variable must not already exist. % :- pred env_add_and_initlalise_var(string::in, var::out, env::in, env::out, varmap::in, varmap::out) is semidet. :- type initialise_result(T) ---> ok(T) ; does_not_exist ; already_initialised ; inaccessible. % Initialise an existing variable. % % The variable must already exist. % :- pred env_initialise_var(string::in, initialise_result(var)::out, env::in, env::out, varmap::in, varmap::out) is det. % All the vars that are defined but not initialised. % :- func env_uninitialised_vars(env) = set(var). % Mark all these uninitialised vars as initialised. % :- pred env_mark_initialised(set(var)::in, env::in, env::out) is det. % Within a closure scope the currently-uninitialised variables cannot be % accessed from the closure. % % We leave closures (like any scope) by discarding the environment and % using a "higher" one. % :- pred env_enter_closure(env::in, env::out) is det. % Add a letrec variable. % % These are added to help resolve names within nested functions. % They're cleared when the real variable bindings become available. % Discarding is performed by discarding the environment. % :- pred env_add_for_letrec(string::in, var::out, env::in, env::out, varmap::in, varmap::out) is semidet. % Within a letrec temporally set a self-recursive reference to a direct % function call. This is how we handle self-recursion, which works % because its the same environment. % :- pred env_letrec_self_recursive(string::in, func_id::in, env::in, env::out) is det. % Mark the formerly-letrec variable as a fully defined variable, because % it has now been defined while processing the letrec. % :- pred env_letrec_defined(string::in, env::in, env::out) is det. % Make all letrec variables initalised (we've finished building the % letrec). % :- pred env_leave_letrec(env::in, env::out) is det. %-----------------------------------------------------------------------% % % Code to add other symbols to the environment. % :- pred env_add_func(q_name::in, func_id::in, env::in, env::out) is semidet. % Used to add builtins, which always have unique names. % :- pred env_add_func_det(q_name::in, func_id::in, env::in, env::out) is det. :- pred env_add_type(q_name::in, arity::in, type_id::in, env::in, env::out) is semidet. :- pred env_add_type_det(q_name::in, arity::in, type_id::in, env::in, env::out) is det. :- pred env_add_builtin_type_det(q_name::in, builtin_type::in, env::in, env::out) is det. % Constructors may be overloaded, unlike other symbols, this predicate % will add this constructor ID to the set of constructor IDs that this % name may be referring to. If the name is already bound to something % else, it throws an exception. % :- pred env_add_constructor(q_name::in, ctor_id::in, env::in, env::out) is det. :- pred env_add_resource(q_name::in, resource_id::in, env::in, env::out) is semidet. :- pred env_add_resource_det(q_name::in, resource_id::in, env::in, env::out) is det. %-----------------------------------------------------------------------% % % Code to query the environment. % :- type env_entry ---> ee_var(var) ; ee_func(func_id) ; ee_constructor(set(ctor_id)). :- inst env_entry_func_or_ctor for env_entry/0 ---> ee_func(ground) ; ee_constructor(ground). :- type env_search_result(T) ---> ok(T) ; not_found ; not_initaliased ; inaccessible ; maybe_cyclic_retlec. :- pred env_search(env::in, q_name::in, env_search_result(env_entry)::out) is det. % Throws an exception if the entry doesn't exist or isn't a function. % :- pred env_lookup_function(env::in, q_name::in, func_id::out) is det. :- type type_entry ---> te_builtin( te_builtin :: builtin_type ) ; te_id( te_id :: type_id, te_arity :: arity ). :- pred env_search_type(env::in, q_name::in, type_entry::out) is semidet. :- pred env_lookup_type(env::in, q_name::in, type_entry::out) is det. :- pred env_search_constructor(env::in, q_name::in, set(ctor_id)::out) is semidet. % NOTE: This is currently only implemented for one data type per % operator. % :- pred env_operator_entry(env, ast_bop, env_entry). :- mode env_operator_entry(in, in, out(env_entry_func_or_ctor)) is det. :- func env_unary_operator_func(env, ast_uop) = func_id. :- pred env_search_resource(env::in, q_name::in, resource_id::out) is semidet. :- pred env_lookup_resource(env::in, q_name::in, resource_id::out) is det. %-----------------------------------------------------------------------% % % Misc. % % Make a mangled name for a lambda. % :- func mangle_lambda(string, context) = string. % A name->func_id mapping is tracked in the environment. These aren't % actual name bindings in the Plasma language, and env_search won't find % them. It's just convenient to put them in this data structure since % they're added at the top level and not needed after the pre-core % compilation stage. % % This is different from the letrec entries added above. % :- pred env_add_lambda(string::in, func_id::in, env::in, env::out) is det. :- pred env_lookup_lambda(env::in, string::in, func_id::out) is det. %-----------------------------------------------------------------------% :- pred do_var_or_wildcard(pred(X, Y, A, A, B, B), var_or_wildcard(X), var_or_wildcard(Y), A, A, B, B). :- mode do_var_or_wildcard(pred(in, out, in, out, in, out) is det, in, out, in, out, in, out) is det. :- mode do_var_or_wildcard(pred(in, out, in, out, in, out) is semidet, in, out, in, out, in, out) is semidet. %-----------------------------------------------------------------------% %-----------------------------------------------------------------------% :- implementation. :- import_module list. :- import_module map. :- import_module maybe. :- import_module require. :- import_module util. :- import_module util.my_exception. :- import_module builtins. %-----------------------------------------------------------------------% % TODO, use a radix structure. Lookup errors can be more informative. % :- type env ---> env( e_map :: map(q_name, env_entry), e_typemap :: map(q_name, type_entry), e_resmap :: map(q_name, resource_id), e_lambdas :: map(string, func_id), % The set of uninitialised variables e_uninitialised :: set(var), % The set of letrec variables, they're also uninitialised but % their definition may be recursive and so we don't generate % an error as we do for uninitialised ones. e_letrec_vars :: set(var), % Uninitalised variables outside this closure. e_inaccessible :: set(var), e_operators :: operators ). %-----------------------------------------------------------------------% init(Operators) = env(init, init, init, init, init, init, init, Operators). env_operators(Env) = Env ^ e_operators. %-----------------------------------------------------------------------% %-----------------------------------------------------------------------% env_add_uninitialised_var(Name, Var, !Env, !Varmap) :- env_add_var(Name, Var, !Env, !Varmap), !Env ^ e_uninitialised := insert(!.Env ^ e_uninitialised, Var). env_add_and_initlalise_var(Name, Var, !Env, !Varmap) :- env_add_var(Name, Var, !Env, !Varmap). :- pred env_add_var(string::in, var::out, env::in, env::out, varmap::in, varmap::out) is semidet. env_add_var(Name, Var, !Env, !Varmap) :- ( if Name = "_" then unexpected($file, $pred, "Wildcard string as varname") else add_fresh_var(Name, Var, !Varmap), insert(q_name_single(Name), ee_var(Var), !.Env ^ e_map, Map), !Env ^ e_map := Map ). env_initialise_var(Name, Result, !Env, !Varmap) :- ( if Name = "_" then unexpected($file, $pred, "Windcard string as varname") else ( if search(!.Env ^ e_map, q_name_single(Name), ee_var(Var)) then ( if remove(Var, !.Env ^ e_uninitialised, Uninitialised) then !Env ^ e_uninitialised := Uninitialised, Result = ok(Var) else if member(Var, !.Env ^ e_inaccessible) then Result = inaccessible else if member(Var, !.Env ^ e_letrec_vars) then unexpected($file, $pred, "Cannot set letrec variables this way") else Result = already_initialised ) else Result = does_not_exist ) ). %-----------------------------------------------------------------------% env_uninitialised_vars(Env) = Env ^ e_uninitialised. env_mark_initialised(Vars, !Env) :- !Env ^ e_uninitialised := !.Env ^ e_uninitialised `difference` Vars. env_enter_closure(!Env) :- !Env ^ e_inaccessible := !.Env ^ e_uninitialised, !Env ^ e_uninitialised := set.init. %-----------------------------------------------------------------------% env_add_for_letrec(Name, Var, !Env, !Varmap) :- env_add_var(Name, Var, !Env, !Varmap), !Env ^ e_letrec_vars := insert(!.Env ^ e_letrec_vars, Var). env_letrec_self_recursive(Name, FuncId, !Env) :- lookup(!.Env ^ e_map, q_name_single(Name), Entry), ( Entry = ee_var(Var), det_update(q_name_single(Name), ee_func(FuncId), !.Env ^ e_map, Map), !Env ^ e_map := Map, det_remove(Var, !.Env ^ e_letrec_vars, LetrecVars), !Env ^ e_letrec_vars := LetrecVars ; ( Entry = ee_func(_) ; Entry = ee_constructor(_) ), unexpected($file, $pred, "Entry is not a variable") ). env_letrec_defined(Name, !Env) :- lookup(!.Env ^ e_map, q_name_single(Name), Entry), ( Entry = ee_var(Var), det_remove(Var, !.Env ^ e_letrec_vars, LetrecVars), !Env ^ e_letrec_vars := LetrecVars ; ( Entry = ee_func(_) ; Entry = ee_constructor(_) ), unexpected($file, $pred, "Not a variable") ). env_leave_letrec(!Env) :- ( if not is_empty(!.Env ^ e_letrec_vars) then !Env ^ e_letrec_vars := set.init else unexpected($file, $pred, "Letrec had no variables") ). %-----------------------------------------------------------------------% %-----------------------------------------------------------------------% env_add_func(Name, Func, !Env) :- insert(Name, ee_func(Func), !.Env ^ e_map, Map), !Env ^ e_map := Map. env_add_func_det(Name, Func, !Env) :- ( if env_add_func(Name, Func, !Env) then true else unexpected($file, $pred, "Function already exists") ). %-----------------------------------------------------------------------% env_add_type(Name, Arity, Type, !Env) :- insert(Name, te_id(Type, Arity), !.Env ^ e_typemap, Map), !Env ^ e_typemap := Map. env_add_type_det(Name, Arity, Type, !Env) :- ( if env_add_type(Name, Arity, Type, !Env) then true else unexpected($file, $pred, "Type already defined") ). env_add_builtin_type_det(Name, Builtin, !Env) :- map.det_insert(Name, te_builtin(Builtin), !.Env ^ e_typemap, Map), !Env ^ e_typemap := Map. %-----------------------------------------------------------------------% env_add_constructor(Name, Cons, !Env) :- some [!Map] ( !:Map = !.Env ^ e_map, ( if search(!.Env ^ e_map, Name, Entry) then ( Entry = ee_constructor(ConsSet0), ConsSet = insert(ConsSet0, Cons), det_update(Name, ee_constructor(ConsSet), !Map) ; ( Entry = ee_var(_) ; Entry = ee_func(_) ), unexpected($file, $pred, "name already exists as non-constructor") ) else det_insert(Name, ee_constructor(make_singleton_set(Cons)), !Map) ), !Env ^ e_map := !.Map ). %-----------------------------------------------------------------------% env_add_resource(Name, ResId, !Env) :- insert(Name, ResId, !.Env ^ e_resmap, Map), !Env ^ e_resmap := Map. env_add_resource_det(Name, ResId, !Env) :- det_insert(Name, ResId, !.Env ^ e_resmap, Map), !Env ^ e_resmap := Map. %-----------------------------------------------------------------------% %-----------------------------------------------------------------------% env_search(Env, QName, Result) :- ( if search(Env ^ e_map, QName, Entry) then ( Entry = ee_var(Var), ( if member(Var, Env ^ e_inaccessible) then Result = inaccessible else if member(Var, Env ^ e_uninitialised) then Result = not_initaliased else if member(Var, Env ^ e_letrec_vars) then Result = maybe_cyclic_retlec else Result = ok(Entry) ) ; ( Entry = ee_func(_) ; Entry = ee_constructor(_) ), Result = ok(Entry) ) else Result = not_found ). env_lookup_function(Env, QName, FuncId) :- ( if env_search(Env, QName, ok(ee_func(FuncIdPrime))) then FuncId = FuncIdPrime else unexpected($file, $pred, "Entry not found or not a function") ). env_search_type(Env, QName, Type) :- search(Env ^ e_typemap, QName, Type). env_lookup_type(Env, QName, Type) :- ( if env_search_type(Env, QName, TypePrime) then Type = TypePrime else unexpected($file, $pred, "Type not found") ). env_search_constructor(Env, QName, CtorId) :- env_search(Env, QName, ok(ee_constructor(CtorId))). %-----------------------------------------------------------------------% env_operator_entry(Env, Op, Entry) :- Ops = env_operators(Env), ( ( Op = b_add, Func = Ops ^ o_int_add ; Op = b_sub, Func = Ops ^ o_int_sub ; Op = b_mul, Func = Ops ^ o_int_mul ; Op = b_div, Func = Ops ^ o_int_div ; Op = b_mod, Func = Ops ^ o_int_mod ; Op = b_gt, Func = Ops ^ o_int_gt ; Op = b_lt, Func = Ops ^ o_int_lt ; Op = b_gteq, Func = Ops ^ o_int_gteq ; Op = b_lteq, Func = Ops ^ o_int_lteq ; Op = b_eq, Func = Ops ^ o_int_eq ; Op = b_neq, Func = Ops ^ o_int_neq ; Op = b_logical_and, Func = Ops ^ o_bool_and ; Op = b_logical_or, Func = Ops ^ o_bool_or ; Op = b_concat, Func = Ops ^ o_string_concat ), Entry = ee_func(Func) ; Op = b_list_cons, Entry = ee_constructor(make_singleton_set(Ops ^ o_list_cons)) ; Op = b_array_subscript, my_exception.sorry($file, $pred, "Array subscript") ). env_unary_operator_func(Env, UOp) = FuncId :- Ops = env_operators(Env), ( UOp = u_minus, FuncId = Ops ^ o_int_minus ; UOp = u_not, FuncId = Ops ^ o_bool_not ). %-----------------------------------------------------------------------% env_search_resource(Env, QName, ResId) :- search(Env ^ e_resmap, QName, ResId). env_lookup_resource(Env, QName, ResId) :- lookup(Env ^ e_resmap, QName, ResId). %-----------------------------------------------------------------------% %-----------------------------------------------------------------------% mangle_lambda(Name, context(_, Line, Col)) = string.format("lambda_l%d_%s_c%d", [i(Line), s(Name), i(Col)]). env_add_lambda(Name, FuncId, !Env) :- det_insert(Name, FuncId, !.Env ^ e_lambdas, Lambdas), !Env ^ e_lambdas := Lambdas. env_lookup_lambda(Env, Name, FuncId) :- lookup(Env ^ e_lambdas, Name, FuncId). %-----------------------------------------------------------------------% do_var_or_wildcard(Pred, var(Name), var(Var), !Env, !Varmap) :- Pred(Name, Var, !Env, !Varmap). do_var_or_wildcard(_, wildcard, wildcard, !Env, !Varmap). %-----------------------------------------------------------------------% %-----------------------------------------------------------------------% ================================================ FILE: src/pre.from_ast.m ================================================ %-----------------------------------------------------------------------% % Plasma AST symbol resolution % vim: ts=4 sw=4 et % % Copyright (C) Plasma Team % Distributed under the terms of the MIT License see ../LICENSE.code % % This module resolves symbols within the Plasma AST returning the pre-core % representation. % %-----------------------------------------------------------------------% :- module pre.from_ast. %-----------------------------------------------------------------------% :- interface. :- import_module list. :- import_module map. :- import_module ast. :- import_module context. :- import_module common_types. :- import_module pre.env. :- import_module pre.pre_ds. :- import_module q_name. %-----------------------------------------------------------------------% :- pred func_to_pre_func(env::in, q_name::in, list(ast_param)::in, list(ast_type_expr)::in, list(ast_block_thing)::in, context::in, map(func_id, pre_function)::in, map(func_id, pre_function)::out) is det. %-----------------------------------------------------------------------% %-----------------------------------------------------------------------% :- implementation. :- import_module maybe. :- import_module pair. :- import_module require. :- import_module set. :- import_module string. :- import_module util. :- import_module util.my_exception. :- import_module util.mercury. :- import_module varmap. %-----------------------------------------------------------------------% func_to_pre_func(Env, Name, Params, Returns, Body0, Context, !Pre) :- % Build body. some [!Varmap] ( !:Varmap = varmap.init, env_lookup_function(Env, Name, FuncId), Arity = arity(length(Returns)), ast_to_pre_body(Env, Context, Arity, Params, ParamVarsOrWildcards, Body0, Body, _, !Varmap), Func = pre_function(FuncId, !.Varmap, ParamVarsOrWildcards, Arity, Body, Context), map.det_insert(FuncId, Func, !Pre) ). :- pred ast_to_pre_body(env::in, context::in, arity::in, list(ast_param)::in, list(var_or_wildcard(var))::out, list(ast_block_thing(context))::in, pre_statements::out, set(var)::out, varmap::in, varmap::out) is det. ast_to_pre_body(Env0, Context, Arity, Params, ParamVarsOrWildcards, Body0, Body, UseVars, !Varmap) :- ParamNames = map((func(ast_param(N, _)) = N), Params), ( if map_foldl2(do_var_or_wildcard(env_add_and_initlalise_var), ParamNames, ParamVarsOrWildcardsPrime, Env0, EnvPrime, !Varmap) then ParamVarsOrWildcards = ParamVarsOrWildcardsPrime, Env = EnvPrime else compile_error($file, $pred, Context, "Two or more parameters have the same name") ), Info = ast_pre_info(Arity), ast_to_pre(Info, Env, Body0, Body, UseVars, !Varmap). %-----------------------------------------------------------------------% :- pred ast_to_pre(ast_pre_info::in, env::in, list(ast_block_thing)::in, pre_statements::out, set(var)::out, varmap::in, varmap::out) is det. ast_to_pre(Info, Env, Block0, Block, UseVars, !Varmap) :- ast_to_pre_block(Info, Block0, Block, UseVars, _, Env, _, !Varmap). %-----------------------------------------------------------------------% :- pred ast_to_pre_block(ast_pre_info::in, list(ast_block_thing)::in, list(pre_statement)::out, set(var)::out, set(var)::out, env::in, env::out, varmap::in, varmap::out) is det. ast_to_pre_block(Info, Block0, Block, union_list(UseVars), union_list(DefVars), !Env, !Varmap) :- ast_to_pre_block_2(Info, Block0, StmtsList, UseVars, DefVars, !Env, !Varmap), Block = condense(StmtsList). % It seems silly to use both Env and !Varmap. They are used differently by % branches, with varmap tracking all variables and Env being rewound to the % state before the branch. Secondly Env will also capture symbols that % aren't variables, such as modules and instances. :- pred ast_to_pre_block_2(ast_pre_info::in, list(ast_block_thing)::in, list(list(pre_statement))::out, list(set(var))::out, list(set(var))::out, env::in, env::out, varmap::in, varmap::out) is det. ast_to_pre_block_2(_, [], [], [], [], !Env, !Varmap). ast_to_pre_block_2(Info, [BlockThing | Block0], [Stmts0 | Stmts], [UseVarsHead | UseVarsTail], [DefVarsHead | DefVarsTail], !Env, !Varmap) :- ( BlockThing = astbt_statement(Stmt), ast_to_pre_stmt(Info, Stmt, Stmts0, UseVarsHead, DefVarsHead, !Env, !Varmap), Block = Block0 ; BlockThing = astbt_function(_, _), take_while(pred(astbt_function(_, _)::in) is semidet, [BlockThing | Block0], Defns, Block), ast_to_pre_block_defns(Defns, Stmts0, UseVarsHead, DefVarsHead, !Env, !Varmap) ), ast_to_pre_block_2(Info, Block, Stmts, UseVarsTail, DefVarsTail, !Env, !Varmap). :- pred ast_to_pre_block_defns(list(ast_block_thing)::in, list(pre_statement)::out, set(var)::out, set(var)::out, env::in, env::out, varmap::in, varmap::out) is det. ast_to_pre_block_defns(Defns0, Stmts, UseVars, DefVars, !Env, !Varmap) :- Defns = map((func(BT) = {N, F} :- ( BT = astbt_function(N, F) ; BT = astbt_statement(_), unexpected($file, $pred, "Statement") ) ), Defns0), % 1. Pre-process definitions into a letrec so that mutual recursion is % supported. map_foldl2(defn_make_letrec, Defns, Vars, !Env, !Varmap), % 2. Create the bodies. env_enter_closure(!.Env, EnvInClosure), map2_foldl2(defn_make_pre_body, Defns, Exprs, UseVarsList, EnvInClosure, _, !Varmap), env_leave_letrec(!Env), % 3. Create the expressions and statements. map4_corresponding2(defn_make_stmt, Defns, Vars, Exprs, UseVarsList, StmtsList, DefVarsList), Stmts = condense(StmtsList), UseVars = union_list(UseVarsList), DefVars = union_list(DefVarsList). :- pred defn_make_letrec({nq_name, ast_nested_function}::in, var::out, env::in, env::out, varmap::in, varmap::out) is det. defn_make_letrec({Name, ast_nested_function(Decl, _)}, Var, !Env, !Varmap) :- Context = Decl ^ afd_context, NameStr = nq_name_to_string(Name), ( if env_add_for_letrec(NameStr, VarPrime, !Env, !Varmap) then Var = VarPrime else compile_error($file, $pred, Context, format("Name already defined for nested function: %s", [s(NameStr)])) ). :- pred defn_make_pre_body({nq_name, ast_nested_function}::in, pre_expr::out, set(var)::out, env::in, env::out, varmap::in, varmap::out) is det. defn_make_pre_body({Name, ast_nested_function(Decl, Body0)}, Expr, UseVars, !Env, !Varmap) :- Decl = ast_function_decl(Params0, Returns, _, Context), NameStr = nq_name_to_string(Name), MangledName = mangle_lambda(NameStr, Context), env_lookup_lambda(!.Env, MangledName, FuncId), env_letrec_self_recursive(NameStr, FuncId, !.Env, EnvSelfRec), Arity = arity(length(Returns)), ast_to_pre_body(EnvSelfRec, Context, Arity, Params0, Params, Body0, Body, UseVars, !Varmap), % Until we properly implement letrecs we mark each variable as defined % immediately after its definition. We'll need this to properly support % optimisation of mutually-recursive closures. env_letrec_defined(NameStr, !Env), Expr = e_lambda(pre_lambda(FuncId, Params, no, Arity, Body)). :- pred defn_make_stmt({nq_name, ast_nested_function}::in, var::in, pre_expr::in, set(var)::in, pre_statements::out, set(var)::out) is det. defn_make_stmt({_, ast_nested_function(Decl, _)}, Var, Expr, UseVars, Stmts, DefVars) :- Context = Decl ^ afd_context, DefVars = make_singleton_set(Var), Stmts = [ pre_statement(s_decl_vars([Var]), stmt_info(Context, set.init, set.init, stmt_always_fallsthrough)), pre_statement(s_assign([var(Var)], [Expr]), stmt_info(Context, UseVars, DefVars, stmt_always_fallsthrough)) ]. %-----------------------------------------------------------------------% % Info for the current function during the ast-to-pre transformation. % :- type ast_pre_info ---> ast_pre_info( % The arity of the function. api_arity :: arity ). :- pred ast_to_pre_stmt(ast_pre_info::in, ast_statement::in, pre_statements::out, set(var)::out, set(var)::out, env::in, env::out, varmap::in, varmap::out) is det. ast_to_pre_stmt(Info, ast_statement(StmtType0, Context), Stmts, UseVars, DefVars, !Env, !Varmap) :- ( StmtType0 = s_call(Call), ast_to_pre_stmt_call(!.Env, Context, Call, Stmts, UseVars, DefVars, !Varmap) ; StmtType0 = s_assign_statement(Patterns, Exprs), ast_to_pre_stmt_assign(Context, Patterns, Exprs, Stmts, UseVars, DefVars, !Env, !Varmap) ; StmtType0 = s_array_set_statement(_, _, _), my_exception.sorry($file, $pred, Context, "Arrays") ; StmtType0 = s_return_statement(Exprs), ast_to_pre_stmt_return(Info, !.Env, Context, Exprs, Stmts, UseVars, DefVars, !Varmap) ; StmtType0 = s_var_statement(VarName), ast_to_pre_stmt_var(Context, VarName, Stmts, UseVars, DefVars, !Env, !Varmap) ; StmtType0 = s_match_statement(Expr, Cases), ast_to_pre_stmt_match(Info, Context, Expr, Cases, Stmts, UseVars, DefVars, !Env, !Varmap) ; StmtType0 = s_ite(Cond, Then, Else), ast_to_pre_stmt_ite(Info, Context, Cond, Then, Else, Stmts, UseVars, DefVars, !Env, !Varmap) ). :- pred ast_to_pre_stmt_call(env::in, context::in, ast_call_like::in, pre_statements::out, set(var)::out, set(var)::out, varmap::in, varmap::out) is det. ast_to_pre_stmt_call(Env, Context, Call0, Stmts, UseVars, DefVars, !Varmap) :- ast_to_pre_call_like(Context, Env, Call0, CallLike, UseVars, !Varmap), ( CallLike = pcl_call(Call) ; CallLike = pcl_constr(_), compile_error($file, $pred, "A construction is not a statement") ), DefVars = set.init, StmtType = s_call(Call), Stmts = [pre_statement(StmtType, stmt_info(Context, UseVars, DefVars, stmt_always_fallsthrough))]. :- pred ast_to_pre_stmt_assign(context::in, list(ast_pattern)::in, list(ast_expression)::in, pre_statements::out, set(var)::out, set(var)::out, env::in, env::out, varmap::in, varmap::out) is det. ast_to_pre_stmt_assign(Context, Patterns, Exprs0, Stmts, UseVars, DefVars, !Env, !Varmap) :- % Process the expressions before adding the variables, this may % create confusing errors (without column numbers) but at least % it'll be correct. map2_foldl(ast_to_pre_expr(Context, !.Env), Exprs0, Exprs, ExprsUseVarss, !Varmap), ExprsUseVars = union_list(ExprsUseVarss), ( if map_foldl3(pattern_simple_vars_or_wildcards(Context), Patterns, VarOrWildcards, [], DeclVars, !Env, !Varmap) then filter_map(vow_is_var, VarOrWildcards, Vars), DefVars = list_to_set(Vars), UseVars = ExprsUseVars, Stmts = [ pre_statement(s_decl_vars(DeclVars), stmt_info(Context, init, init, stmt_always_fallsthrough)), pre_statement(s_assign(VarOrWildcards, Exprs), stmt_info(Context, UseVars, DefVars, stmt_always_fallsthrough))] else if Patterns = [Pattern], Exprs = [Expr] then ast_to_pre_stmt_unpack(Context, Pattern, Expr, Stmts, UsedVars0, DefVars, !Env, !Varmap), UseVars = ExprsUseVars `union` UsedVars0 else my_exception.sorry($file, $pred, Context, "Can't unpack more than one pattern") ). :- pred pattern_simple_vars_or_wildcards(context::in, ast_pattern::in, var_or_wildcard(var)::out, list(var)::in, list(var)::out, env::in, env::out, varmap::in, varmap::out) is semidet. pattern_simple_vars_or_wildcards(Context, p_var(Name), VOW, !DeclVars, !Env, !Varmap) :- ( if env_add_and_initlalise_var(Name, Var, !Env, !Varmap) then VOW = var(Var), !:DeclVars = [Var | !.DeclVars] else compile_error($file, $pred, Context, format("The variable '%s' is already declared", [s(Name)])) ). pattern_simple_vars_or_wildcards(Context, p_symbol(Symbol), VOW, !DeclVars, !Env, !Varmap) :- q_name_is_single(Symbol, Name), env_initialise_var(Name, Result, !Env, !Varmap), require_complete_switch [Result] ( Result = ok(Var), VOW = var(Var) ; Result = does_not_exist, false ; Result = already_initialised, compile_error($file, $pred, Context, format("The variable '%s' is already initialised", [s(Name)])) ; Result = inaccessible, compile_error($file, $pred, Context, format("The variable '%s' is defined in an outer scope and " ++ "cannot be initialised from within this closure", [s(Name)])) ). pattern_simple_vars_or_wildcards(_, p_wildcard, wildcard, !DeclVars, !Env, !Varmap). :- pred ast_to_pre_stmt_return(ast_pre_info::in, env::in, context::in, list(ast_expression)::in, pre_statements::out, set(var)::out, set(var)::out, varmap::in, varmap::out) is det. ast_to_pre_stmt_return(Info, Env, Context, Exprs0, Stmts, UseVars, DefVars, !Varmap) :- map2_foldl(ast_to_pre_expr(Context, Env), Exprs0, Exprs, ExprsUseVars, !Varmap), UseVars = union_list(ExprsUseVars), Arity = Info ^ api_arity, varmap.add_n_anon_vars(Arity ^ a_num, Vars, !Varmap), RetVars = list_to_set(Vars), DefVars = RetVars, Stmts = [ pre_statement(s_decl_vars(Vars), stmt_info(Context, set.init, set.init, stmt_always_fallsthrough)), pre_statement(s_assign(map(func(V) = var(V), Vars), Exprs), stmt_info(Context, UseVars, DefVars, stmt_always_fallsthrough)), pre_statement(s_return(Vars), stmt_info(Context, RetVars, set.init, stmt_always_returns)) ]. :- pred ast_to_pre_stmt_var(context::in, string::in, pre_statements::out, set(var)::out, set(var)::out, env::in, env::out, varmap::in, varmap::out) is det. ast_to_pre_stmt_var(Context, VarName, Stmts, UseVars, DefVars, !Env, !Varmap) :- ( if env_add_uninitialised_var(VarName, Var, !Env, !Varmap) then UseVars = init, DefVars = init, Stmts = [pre_statement(s_decl_vars([Var]), stmt_info(Context, set.init, set.init, stmt_always_fallsthrough))] else compile_error($file, $pred, Context, format("The variable '%s' is already defined", [s(VarName)])) ). :- pred ast_to_pre_stmt_match(ast_pre_info::in, context::in, ast_expression::in, list(ast_match_case)::in, pre_statements::out, set(var)::out, set(var)::out, env::in, env::out, varmap::in, varmap::out) is det. ast_to_pre_stmt_match(Info, Context, Expr0, Cases0, Stmts, UseVars, DefVars, !Env, !Varmap) :- ast_to_pre_expr(Context, !.Env, Expr0, Expr, UseVarsExpr, !Varmap), varmap.add_anon_var(Var, !Varmap), StmtsAssign = [ pre_statement(s_decl_vars([Var]), stmt_info(Context, set.init, set.init, stmt_always_fallsthrough)), pre_statement(s_assign([var(Var)], [Expr]), stmt_info(Context, UseVarsExpr, make_singleton_set(Var), stmt_always_fallsthrough)) ], map3_foldl(ast_to_pre_case(Info, Context, !.Env), Cases0, Cases, UseVarsCases, DefVars0, !Varmap), UseVars = union_list(UseVarsCases) `union` make_singleton_set(Var), DefVars = union_list(DefVars0) `intersect` env_uninitialised_vars(!.Env), env_mark_initialised(DefVars, !Env), % The reachability information will be updated later in % pre.branches StmtMatch = pre_statement(s_match(Var, Cases), stmt_info(Context, UseVars, DefVars, stmt_may_return)), Stmts = StmtsAssign ++ [StmtMatch]. :- pred ast_to_pre_stmt_unpack(context::in, ast_pattern::in, pre_expr::in, pre_statements::out, set(var)::out, set(var)::out, env::in, env::out, varmap::in, varmap::out) is det. ast_to_pre_stmt_unpack(Context, Pattern0, Expr, Stmts, UsedVars, DefVars, !Env, !Varmap) :- % Transform the pattern then rename all the variables in the pattern to % new fresh variables. ast_to_pre_pattern(Context, Pattern0, Pattern1, PatVarsSet, !Env, !Varmap), pat_rename(PatVarsSet, Pattern1, Pattern, map.init, Renaming, !Varmap), PatternVarPairs = to_assoc_list(Renaming), % The list of variables form the original pattern. PatternVars = map(fst, PatternVarPairs), % The list of new variables, they have the same positions in their list % as the original set. PrimeVars = map(snd, PatternVarPairs), PrimeVarsSet = list_to_set(PrimeVars), % The new pattern with the renamed variables is used with an expression % to copy those variables out. TODO: For now we can only handle % patterns that extract a single variable. ( PrimeVars = [], unexpected($file, $pred, "Zero variables bound by unpack") ; PrimeVars = [_ | _], CopyVarsOutExprs = map(func(V) = e_var(V), PrimeVars) ), MatchExpr = e_match(Expr, [pre_e_case(Pattern, CopyVarsOutExprs)]), % The assignment must assign variables in the same order that % CopyVarsOutExpr returns them as. DefVars = list_to_set(PatternVars), PatternVarsVars = map(func(V) = var(V), PatternVars), AssignStmt = pre_statement(s_assign(PatternVarsVars, [MatchExpr]), stmt_info(Context, UsedVars, DefVars, stmt_always_fallsthrough)), Stmts = [ pre_statement(s_decl_vars(PatternVars), stmt_info(Context, set.init, set.init, stmt_always_fallsthrough)), AssignStmt], UsedVars = PatVarsSet `union` PrimeVarsSet. :- pred ast_to_pre_stmt_ite(ast_pre_info::in, context::in, ast_expression::in, list(ast_block_thing)::in, list(ast_block_thing)::in, pre_statements::out, set(var)::out, set(var)::out, env::in, env::out, varmap::in, varmap::out) is det. ast_to_pre_stmt_ite(Info, Context, Cond0, Then0, Else0, Stmts, UseVars, DefVars, !Env, !Varmap) :- % ITEs are syntas sugar for a match expression using booleans. ast_to_pre_expr(Context, !.Env, Cond0, Cond, UseVarsCond, !Varmap), varmap.add_anon_var(Var, !Varmap), % TODO: To avoid amberguities, we may need a way to force this % variable to be bool at this point in the compiler when we know that % it's a bool. StmtsAssign = [ pre_statement(s_decl_vars([Var]), stmt_info(Context, set.init, set.init, stmt_always_fallsthrough)), pre_statement(s_assign([var(Var)], [Cond]), stmt_info(Context, UseVarsCond, make_singleton_set(Var), stmt_always_fallsthrough)) ], ast_to_pre_block(Info, Then0, Then, UseVarsThen, DefVarsThen, !.Env, _, !Varmap), Operators = env_operators(!.Env), TrueId = Operators ^ o_bool_true, TrueCase = pre_case(p_constr(make_singleton_set(TrueId), []), Then), ast_to_pre_block(Info, Else0, Else, UseVarsElse, DefVarsElse, !.Env, _, !Varmap), FalseId = Operators ^ o_bool_false, FalseCase = pre_case(p_constr(make_singleton_set(FalseId), []), Else), UseVars = UseVarsCond `union` UseVarsThen `union` UseVarsElse `union` make_singleton_set(Var), DefVars = union(DefVarsThen, DefVarsElse) `intersect` env_uninitialised_vars(!.Env), env_mark_initialised(DefVars, !Env), StmtMatch = pre_statement(s_match(Var, [TrueCase, FalseCase]), stmt_info(Context, UseVars, DefVars, stmt_may_return)), Stmts = StmtsAssign ++ [StmtMatch]. %-----------------------------------------------------------------------% :- pred ast_to_pre_case(ast_pre_info::in, context::in, env::in, ast_match_case::in, pre_case::out, set(var)::out, set(var)::out, varmap::in, varmap::out) is det. ast_to_pre_case(Info, Context, !.Env, ast_match_case(Pattern0, Stmts0), pre_case(Pattern, Stmts), UseVars, DefVars, !Varmap) :- ast_to_pre_pattern(Context, Pattern0, Pattern, DefVarsPattern, !Env, !Varmap), ast_to_pre_block(Info, Stmts0, Stmts, UseVars, DefVarsStmts, !Env, !Varmap), DefVars = DefVarsPattern `union` DefVarsStmts, _ = !.Env. :- pred ast_to_pre_pattern(context::in, ast_pattern::in, pre_pattern::out, set(var)::out, env::in, env::out, varmap::in, varmap::out) is det. ast_to_pre_pattern(_, p_number(Num), p_number(Num), set.init, !Env, !Varmap). ast_to_pre_pattern(Context, p_constr(Name, Args0), Pattern, Vars, !Env, !Varmap) :- ( if env_search_constructor(!.Env, Name, CtorIds) then map2_foldl2(ast_to_pre_pattern(Context), Args0, Args, ArgsVars, !Env, !Varmap), Vars = union_list(ArgsVars), Pattern = p_constr(CtorIds, Args) else ( if Args0 = [], q_name_is_single(Name, _) then Kind = "variable or constructor" else Kind = "constructor" ), compile_error($file, $pred, Context, format("Unknown %s '%s'", [s(Kind), s(q_name_to_string(Name))])) ). ast_to_pre_pattern(_, p_list_nil, Pattern, set.init, !Env, !Varmap) :- Pattern = p_constr( make_singleton_set(env_operators(!.Env) ^ o_list_nil), []). ast_to_pre_pattern(Context, p_list_cons(Head0, Tail0), Pattern, Vars, !Env, !Varmap) :- ast_to_pre_pattern(Context, Head0, Head, HeadVars, !Env, !Varmap), ast_to_pre_pattern(Context, Tail0, Tail, TailVars, !Env, !Varmap), Vars = HeadVars `union` TailVars, Pattern = p_constr(make_singleton_set(env_operators(!.Env) ^ o_list_cons), [Head, Tail]). ast_to_pre_pattern(_, p_wildcard, p_wildcard, set.init, !Env, !Varmap). ast_to_pre_pattern(Context, p_var(Name), Pattern, DefVars, !Env, !Varmap) :- ( if env_add_and_initlalise_var(Name, Var, !Env, !Varmap) then Pattern = p_var(Var), DefVars = make_singleton_set(Var) else compile_error($file, $pred, Context, format("Variable '%s' already defined", [s(Name)])) ). ast_to_pre_pattern(Context, p_symbol(Symbol), Pattern, DefVars, !Env, !Varmap) :- ( if q_name_is_single(Symbol, Name) then env_initialise_var(Name, Result, !Env, !Varmap), ( Result = ok(Var), Pattern = p_var(Var), DefVars = make_singleton_set(Var) ; Result = does_not_exist, ast_to_pre_pattern(Context, p_constr(Symbol, []), Pattern, DefVars, !Env, !Varmap) ; Result = already_initialised, compile_error($file, $pred, Context, "Variable already initialised") ; Result = inaccessible, unexpected($file, $pred, "Inaccessible?") ) else ast_to_pre_pattern(Context, p_constr(Symbol, []), Pattern, DefVars, !Env, !Varmap) ). :- pred ast_to_pre_expr(context::in, env::in, ast_expression::in, pre_expr::out, set(var)::out, varmap::in, varmap::out) is det. ast_to_pre_expr(Context, Env, Expr0, Expr, Vars, !Varmap) :- ast_to_pre_expr_2(Context, Env, Expr0, Expr1, Vars, !Varmap), ( if Expr1 = e_constant(c_ctor(ConsIds)) then Expr = e_construction(ConsIds, []) else Expr = Expr1 ). :- pred ast_to_pre_expr_2(context::in, env::in, ast_expression::in, pre_expr::out, set(var)::out, varmap::in, varmap::out) is det. ast_to_pre_expr_2(Context, Env, e_call_like(Call0), Expr, Vars, !Varmap) :- ast_to_pre_call_like(Context, Env, Call0, CallLike, Vars, !Varmap), ( CallLike = pcl_call(Call), Expr = e_call(Call) ; CallLike = pcl_constr(Expr) ). ast_to_pre_expr_2(Context, Env, e_u_op(Op, SubExpr0), Expr, Vars, !Varmap) :- ast_to_pre_expr(Context, Env, SubExpr0, SubExpr, Vars, !Varmap), Expr = e_call(pre_call(env_unary_operator_func(Env, Op), [SubExpr], without_bang)). ast_to_pre_expr_2(Context, Env, e_b_op(ExprL0, Op, ExprR0), Expr, Vars, !Varmap) :- ast_to_pre_expr(Context, Env, ExprL0, ExprL, VarsL, !Varmap), ast_to_pre_expr(Context, Env, ExprR0, ExprR, VarsR, !Varmap), Vars = union(VarsL, VarsR), % NOTE: When introducing interfaces for primative types this will need % to change env_operator_entry(Env, Op, OpEntry), ( OpEntry = ee_func(OpFunc), Expr = e_call(pre_call(OpFunc, [ExprL, ExprR], without_bang)) ; OpEntry = ee_constructor(OpCtors), Expr = e_construction(OpCtors, [ExprL, ExprR]) ). ast_to_pre_expr_2(Context, Env, e_match(MatchExpr0, Cases0), Expr, Vars, !Varmap) :- ast_to_pre_expr(Context, Env, MatchExpr0, MatchExpr, MatchVars, !Varmap), map2_foldl(ast_to_pre_expr_case(Context, Env), Cases0, Cases, CasesVars, !Varmap), Expr = e_match(MatchExpr, Cases), Vars = MatchVars `union` union_list(CasesVars). ast_to_pre_expr_2(Context, Env, e_if(Cond0, Then0, Else0), Expr, Vars, !Varmap) :- ast_to_pre_expr(Context, Env, Cond0, Cond, CondVars, !Varmap), map2_foldl(ast_to_pre_expr(Context, Env), Then0, Then, ThenVars, !Varmap), map2_foldl(ast_to_pre_expr(Context, Env), Else0, Else, ElseVars, !Varmap), Operators = env_operators(Env), PatTrue = p_constr(make_singleton_set(Operators ^ o_bool_true), []), PatFalse = p_constr(make_singleton_set(Operators ^ o_bool_false), []), Expr = e_match(Cond, [pre_e_case(PatTrue, Then), pre_e_case(PatFalse, Else)]), Vars = CondVars `union` union_list(ThenVars) `union` union_list(ElseVars). ast_to_pre_expr_2(Context, Env, e_symbol(Symbol), Expr, Vars, !Varmap) :- env_search(Env, Symbol, Result), ( Result = ok(Entry), ( Entry = ee_var(Var), Expr = e_var(Var), Vars = make_singleton_set(Var) ; Entry = ee_constructor(Constrs), Expr = e_constant(c_ctor(Constrs)), Vars = set.init ; Entry = ee_func(Func), Expr = e_constant(c_func(Func)), Vars = set.init ) ; Result = not_found, compile_error($file, $pred, Context, format("Unknown symbol: %s", [s(q_name_to_string(Symbol))])) ; ( Result = not_initaliased % Varibles may be inaccessible because they're not initalised. ; Result = inaccessible ), compile_error($file, $pred, Context, format("Variable not initalised: %s", [s(q_name_to_string(Symbol))])) ; Result = maybe_cyclic_retlec, my_exception.sorry($file, $pred, Context, format("%s is possibly involved in a mutual recursion of " ++ "closures. If they're not mutually recursive try " ++ "re-ordering them.", [s(q_name_to_string(Symbol))])) ). ast_to_pre_expr_2(_, Env, e_const(Const0), e_constant((Const)), init, !Varmap) :- ( Const0 = c_string(String), Const = c_string(String) ; Const0 = c_number(Number), Const = c_number(Number) ; Const0 = c_list_nil, Const = c_ctor(make_singleton_set(env_operators(Env) ^ o_list_nil)) ). ast_to_pre_expr_2(Context, _, e_array(_), _, _, !Varmap) :- my_exception.sorry($file, $pred, Context, "Arrays"). :- type pre_call_like ---> pcl_call(pre_call) ; pcl_constr(pre_expr). :- pred ast_to_pre_call_like(context::in, env::in, ast_call_like::in, pre_call_like::out, set(var)::out, varmap::in, varmap::out) is det. ast_to_pre_call_like(Context, Env, CallLike0, CallLike, Vars, !Varmap) :- ( CallLike0 = ast_call_like(CalleeExpr0, Args0), WithBang = without_bang ; CallLike0 = ast_bang_call(CalleeExpr0, Args0), WithBang = with_bang ), % For the callee we call the _2 version, which does not convert % constructors with no args into constructions. ast_to_pre_expr_2(Context, Env, CalleeExpr0, CalleeExpr, CalleeVars, !Varmap), map2_foldl(ast_to_pre_expr(Context, Env), Args0, Args, Varss, !Varmap), Vars = union_list(Varss) `union` CalleeVars, ( if CalleeExpr = e_constant(c_func(Callee)) then CallLike = pcl_call(pre_call(Callee, Args, WithBang)) else if CalleeExpr = e_constant(c_ctor(CtorIds)) then ( WithBang = with_bang, compile_error($file, $pred, "Construction must not have bang") ; WithBang = without_bang, CallLike = pcl_constr(e_construction(CtorIds, Args)) ) else CallLike = pcl_call(pre_ho_call(CalleeExpr, Args, WithBang)) ). :- pred ast_to_pre_expr_case(context::in, env::in, ast_expr_match_case::in, pre_expr_case::out, set(var)::out, varmap::in, varmap::out) is det. ast_to_pre_expr_case(Context, Env0, ast_emc(Pat0, Exprs0), pre_e_case(Pat, Exprs), Vars, !Varmap) :- % Pretty sure we don't need to capture the new variable here as we do in % the match statements. ast_to_pre_pattern(Context, Pat0, Pat, _, Env0, Env, !Varmap), map2_foldl(ast_to_pre_expr(Context, Env), Exprs0, Exprs, Varss, !Varmap), Vars = union_list(Varss). %-----------------------------------------------------------------------% %-----------------------------------------------------------------------% ================================================ FILE: src/pre.import.m ================================================ %-----------------------------------------------------------------------% % vim: ts=4 sw=4 et %-----------------------------------------------------------------------% :- module pre.import. % % Copyright (C) Plasma Team % Distributed under the terms of the MIT License see ../LICENSE.code % % Process imports by reading interface files. % %-----------------------------------------------------------------------% :- interface. :- import_module io. :- import_module list. :- import_module maybe. :- import_module ast. :- import_module compile_error. :- import_module core. :- import_module pre.env. :- import_module q_name. :- import_module util. :- import_module util.log. :- import_module util.result. %-----------------------------------------------------------------------% :- type import_type ---> interface_import ; typeres_import. %-----------------------------------------------------------------------% :- type import_info ---> import_info( ii_module :: q_name, ii_whitelisted :: whitelisted, ii_source_file :: maybe(string), ii_interface_file :: string, ii_interface_exists :: file_exists, ii_typeres_file :: string, ii_typeres_exists :: file_exists ). :- type whitelisted ---> w_is_whitelisted ; w_not_whitelisted ; w_no_whitelist. :- type file_exists ---> file_exists ; file_does_not_exist. %-----------------------------------------------------------------------% % ast_to_import_list(ThisModule, Directory, WhitelistFile, % Imports, ImportInfo, !IO) % % Find the list of modules and their files we need to import. % :- pred ast_to_import_list(q_name::in, string::in, maybe(string)::in, list(ast_import)::in, list(import_info)::out, io::di, io::uo) is det. % ast_to_core_imports(Verbose, ModuleName, ImportType, ImportEnv, % MaybeWhitelistFile, Imports, !Env, !Core, !Errors, !IO). % % The ImportEnv is the Env that should be used to read interface files, % while !Env is a different environment to be updated with the results. % :- pred ast_to_core_imports(log_config::in, q_name::in, import_type::in, env::in, maybe(string)::in, list(ast_import)::in, env::in, env::out, core::in, core::out, errors(compile_error)::in, errors(compile_error)::out, io::di, io::uo) is det. %-----------------------------------------------------------------------% %-----------------------------------------------------------------------% :- implementation. :- import_module assoc_list. :- import_module cord. :- import_module map. :- import_module pair. :- import_module require. :- import_module set. :- import_module string. :- import_module unit. :- import_module common_types. :- import_module constant. :- import_module context. :- import_module core.function. :- import_module core.resource. :- import_module core.types. :- import_module file_utils. :- import_module parse. :- import_module parse_util. :- import_module pre.ast_to_core. :- import_module util.my_exception. :- import_module util.my_io. :- import_module util.mercury. :- import_module util.path. %-----------------------------------------------------------------------% ast_to_import_list(ThisModule, Dir, MaybeWhitelistFile, Imports, Result, !IO) :- ( MaybeWhitelistFile = yes(WhitelistFile), read_whitelist(ThisModule, WhitelistFile, MaybeWhitelist, !IO) ; MaybeWhitelistFile = no, MaybeWhitelist = no ), ModuleNames = sort_and_remove_dups(map(func(I) = I ^ ai_name, Imports)), map_foldl2(make_import_info(Dir, MaybeWhitelist), ModuleNames, Result, init, _, !IO). :- pred make_import_info(string::in, maybe(import_whitelist)::in, q_name::in, import_info::out, dir_info::in, dir_info::out, io::di, io::uo) is det. make_import_info(Path, MaybeWhitelist, Module, Result, !DirInfo, !IO) :- ( MaybeWhitelist = no, Whitelisted = w_no_whitelist ; MaybeWhitelist = yes(Whitelist), ( if member(Module, Whitelist) then Whitelisted = w_is_whitelisted else Whitelisted = w_not_whitelisted ) ), find_module_file(Path, source_extension, Module, ResultSource, !DirInfo, !IO), ( ResultSource = yes(SourceFile), MbSourceFile = yes(SourceFile) ; ResultSource = no, MbSourceFile = no ; ResultSource = error(ErrPath, Error), compile_error($file, $pred, "IO error while searching for modules: " ++ ErrPath ++ ": " ++ Error) ), find_module_file(Path, interface_extension, Module, ResultInterface, !DirInfo, !IO), CanonBaseName = canonical_base_name(Module), ( ResultInterface = yes(InterfaceFile), InterfaceExists = file_exists ; ResultInterface = no, InterfaceFile = CanonBaseName ++ interface_extension, InterfaceExists = file_does_not_exist ; ResultInterface = error(ErrPath, Error), compile_error($file, $pred, "IO error while searching for modules: " ++ ErrPath ++ ": " ++ Error) ), find_module_file(Path, typeres_extension, Module, ResultTypeRes, !DirInfo, !IO), ( ResultTypeRes = yes(TyperesFile), TyperesExists = file_exists ; ResultTypeRes = no, TyperesFile = CanonBaseName ++ typeres_extension, TyperesExists = file_does_not_exist ; ResultTypeRes = error(ErrPath, Error), compile_error($file, $pred, "IO error while searching for modules: " ++ ErrPath ++ ": " ++ Error) ), Result = import_info(Module, Whitelisted, MbSourceFile, InterfaceFile, InterfaceExists, TyperesFile, TyperesExists). %-----------------------------------------------------------------------% :- type import_whitelist == set(q_name). :- pred read_whitelist(q_name::in, string::in, maybe(import_whitelist)::out, io::di, io::uo) is det. read_whitelist(ThisModule, Filename, MaybeWhitelist, !IO) :- io.open_input(Filename, OpenRes, !IO), ( OpenRes = ok(File), read(File, WhitelistRes, !IO), ( WhitelistRes = ok(WhitelistList `with_type` list(list(q_name))), % The whitelist is stored as the list of lists of modules groups % from the build file, we need to find the relevant sets and % compute their intersection. ModulesSets = filter( pred(M::in) is semidet :- member(ThisModule, M), map(set.from_list, WhitelistList)), ( ModulesSets = [], % We can't compute the intersection of zero sets, so ignore % the whitelist. This can happen if the module name in the % build file doesn't match the actual name. MaybeWhitelist = no ; ModulesSets = [_ | _], MaybeWhitelist = yes(delete(power_intersect_list(ModulesSets), ThisModule)) ) ; WhitelistRes = eof, compile_error($file, $pred, format("%s: premature end of file", [s(Filename)])) ; WhitelistRes = error(Error, Line), compile_error($file, $pred, format("%s:%d: %s", [s(Filename), i(Line), s(Error)])) ), close_input(File, !IO) ; OpenRes = error(Error), compile_error($file, $pred, format("%s: %s", [s(Filename), s(error_message(Error))])) ). %-----------------------------------------------------------------------% ast_to_core_imports(Verbose, ThisModule, ImportType, !.ReadEnv, MbImportWhitelist, Imports, !Env, !Core, !Errors, !IO) :- ast_to_import_list(ThisModule, ".", MbImportWhitelist, Imports, ImportInfos, !IO), % Read the imports and convert it to AST. map_foldl(read_import(Verbose, !.Core, ImportType), ImportInfos, ImportAsts0, !IO), % Process the imports to add them to the core representation. ( ImportType = interface_import, % We update this environment with resources and types so that we can % process types and functions correctly. Then throw away that % environment as different bindings will be made depending on the import % statement used. import_map_foldl2(gather_declarations, ImportAsts0, ImportAsts, !ReadEnv, !Core), % Process transitively imported things. These things are declared % by .typeres files we didn't read, but must exist or we wouldn't % have been able to generate the .pi files we're now reading. This % has to be done after regular declarations so those can be checked % more rigidly and it's simplier to do them before processing % definitions below. import_foldl2(gather_implicit_declarations, ImportAsts, !ReadEnv, !Core), import_map_foldl(process_interface_import(!.ReadEnv), ImportAsts, ImportItems, !Core) ; ImportType = typeres_import, import_map_foldl(process_typeres_import, ImportAsts0, ImportItems, !Core) ), ImportMap = map.from_assoc_list(ImportItems), % Enrol the imports in the environment. foldl5(enroll_import(Verbose, ImportMap), Imports, set.init, _, set.init, _, !Env, !Errors, !IO). %-----------------------------------------------------------------------% :- type import_map(T) == map(q_name, import_result(T)). :- type import_list(T) == assoc_list(q_name, import_result(T)). :- type import_result(T) ---> ok(T) ; read_error(compile_error) ; compile_errors(errors(compile_error)). :- pred import_map_foldl(pred(q_name, X, import_result(Y), A, A), import_list(X), import_list(Y), A, A). :- mode import_map_foldl(pred(in, in, out, in, out) is det, in, out, in, out) is det. import_map_foldl(_, [], [], !A). import_map_foldl(Pred, [N - XRes | Xs], [N - YRes | Ys], !A) :- ( XRes = ok(X), Pred(N, X, YRes, !A) ; XRes = read_error(E), YRes = read_error(E) ; XRes = compile_errors(Es), YRes = compile_errors(Es) ), import_map_foldl(Pred, Xs, Ys, !A). :- pred import_map_foldl2(pred(q_name, X, import_result(Y), A, A, B, B), import_list(X), import_list(Y), A, A, B, B). :- mode import_map_foldl2(pred(in, in, out, in, out, in, out) is det, in, out, in, out, in, out) is det. import_map_foldl2(_, [], [], !A, !B). import_map_foldl2(Pred, [N - XRes | Xs], [N - YRes | Ys], !A, !B) :- ( XRes = ok(X), Pred(N, X, YRes, !A, !B) ; XRes = read_error(E), YRes = read_error(E) ; XRes = compile_errors(Es), YRes = compile_errors(Es) ), import_map_foldl2(Pred, Xs, Ys, !A, !B). % Only processes ok(_) entries. % :- pred import_foldl2(pred(q_name, X, A, A, B, B), import_list(X), A, A, B, B). :- mode import_foldl2(pred(in, in, in, out, in, out) is det, in, in, out, in, out) is det. import_foldl2(_, [], !A, !B). import_foldl2(Pred, [N - XRes | Xs], !A, !B) :- ( XRes = ok(X), Pred(N, X, !A, !B) ; XRes = read_error(_) ; XRes = compile_errors(_) ), import_foldl2(Pred, Xs, !A, !B). %-----------------------------------------------------------------------% % The AST in the ast.m file stores entries in the order they occur in % the file. This AST stores them by type. We should consider % re-writing ast.m to be like this then drop this type definition. In % the future we may want something that reconstructs things in file % order but that's solveable, and not what we need today anyway. % :- type import_ast(R, T) ---> import_ast( ia_module_name :: q_name, ia_context :: context, ia_entries :: entry_types(R, T) ). :- type entry_types(R, T) ---> et_typeres( ett_resources :: list(q_name), ett_types :: list({q_name, arity}) ) ; et_interface( eti_resources :: list({q_name, maybe(ast_resource), R}), eti_types :: list({q_name, ast_type(q_name), T}), eti_functions :: list(q_named(ast_function_decl)) ). % Read an import and convert it to core representation, store references % to it in the import map. % :- pred read_import(log_config::in, core::in, import_type::in, import_info::in, pair(q_name, import_result(import_ast(unit, unit)))::out, io::di, io::uo) is det. read_import(Verbose, Core, ImportType, ImportInfo, ModuleName - Result, !IO) :- ModuleName = ImportInfo ^ ii_module, Whitelisted = ImportInfo ^ ii_whitelisted, ( Whitelisted = w_not_whitelisted, Result = read_error(ce_module_unavailable(ModuleName, module_name(Core))) ; ( Whitelisted = w_is_whitelisted ; Whitelisted = w_no_whitelist ), ( ImportType = interface_import, FileExists = ImportInfo ^ ii_interface_exists, Filename = ImportInfo ^ ii_interface_file ; ImportType = typeres_import, FileExists = ImportInfo ^ ii_typeres_exists, Filename = ImportInfo ^ ii_typeres_file ), ( FileExists = file_exists, verbose_output(Verbose, format("Reading %s from %s\n", [s(q_name_to_string(ModuleName)), s(Filename)]), !IO), ( ImportType = interface_import, parse_interface(Filename, MaybeAST, !IO), ( MaybeAST = ok(AST), foldl3(filter_entries, AST ^ a_entries, [], Resources0, [], Types0, [], Funcs), Resources = map( func(q_named(Name, Res)) = {Name, Res, unit}, Resources0), Types = map( func(q_named(Name, Type)) = {Name, Type, unit}, Types0), Result = ok(import_ast(AST ^ a_module_name, AST ^ a_context, et_interface(Resources, Types, Funcs))) ; MaybeAST = errors(Errors), Result = compile_errors( map(func(error(C, E)) = error(C, ce_read_source_error(E)), Errors)) ) ; ImportType = typeres_import, parse_typeres(Filename, MaybeAST, !IO), ( MaybeAST = ok(AST), filter_map( pred(asti_resource_abs(N)::in, N::out) is semidet, AST ^ a_entries, Resources), filter_map( pred(asti_type_abs(N, A)::in, {N, A}::out) is semidet, AST ^ a_entries, Types), Result = ok(import_ast(AST ^ a_module_name, AST ^ a_context, et_typeres(Resources, Types))) ; MaybeAST = errors(Errors), Result = compile_errors( map(func(error(C, E)) = error(C, ce_read_source_error(E)), Errors)) ) ) ; FileExists = file_does_not_exist, Result = read_error(ce_module_not_found(ModuleName)) ) ). :- pred filter_entries(ast_interface_entry::in, list(q_named(maybe(ast_resource)))::in, list(q_named(maybe(ast_resource)))::out, list(q_named(ast_type(q_name)))::in, list(q_named(ast_type(q_name)))::out, list(q_named(ast_function_decl))::in, list(q_named(ast_function_decl))::out) is det. filter_entries(asti_resource(N, R), !Resources, !Types, !Funcs) :- !:Resources = [q_named(N, R) | !.Resources]. filter_entries(asti_type(N, T), !Resources, !Types, !Funcs) :- !:Types = [q_named(N, T) | !.Types]. filter_entries(asti_function(N, F), !Resources, !Types, !Funcs) :- !:Funcs = [q_named(N, F) | !.Funcs]. %-----------------------------------------------------------------------% :- pred process_typeres_import(q_name::in, import_ast(_, _)::in, import_result(import_entries)::out, core::in, core::out) is det. process_typeres_import(ModuleName, ImportAST, Result, !Core) :- ImportAST = import_ast(ModuleNameAST, Context, Entries), ( if ModuleNameAST = ModuleName then ( Entries = et_interface(_, _, _), unexpected($file, $pred, "Interface") ; Entries = et_typeres(Resources, Types), map_foldl((pred(Name::in, NQName - ie_resource(Res)::out, C0::in, C::out) is det :- ( if q_name_append(ModuleName, NQName0, Name) then NQName = NQName0 else unexpected($file, $pred, "Imported module exports symbols of other module") ), core_allocate_resource_id(Res, C0, C1), core_set_resource(Res, r_abstract(Name), C1, C) ), Resources, NamePairsA, !Core), map_foldl((pred({Name, Arity}::in, NQName - ie_type(Arity, Type)::out, C0::in, C::out) is det :- ( if q_name_append(ModuleName, NQName0, Name) then NQName = NQName0 else unexpected($file, $pred, "Imported module exports symbols of other module") ), core_allocate_type_id(Type, C0, C1), core_set_type(Type, type_init_abstract(Name, Arity, nil_context), C1, C) ), Types, NamePairsB, !Core), Result = ok(NamePairsA ++ NamePairsB) ) else Result = compile_errors(error(Context, ce_interface_contains_wrong_module( filename(Context ^ c_file), ModuleName, ModuleNameAST))) ). %-----------------------------------------------------------------------% :- pred gather_declarations(q_name::in, import_ast(_, _)::in, import_result(import_ast(resource_id, type_id))::out, env::in, env::out, core::in, core::out) is det. gather_declarations(_, ImportAST0, ok(ImportAST), !Env, !Core) :- Entries0 = ImportAST0 ^ ia_entries, ( Entries0 = et_typeres(_, _), unexpected($file, $pred, "Typeres") ; Entries0 = et_interface(Resources0, Types0, Funcs), map_foldl2(gather_resource, Resources0, Resources, !Env, !Core), map_foldl2(gather_types, Types0, Types, !Env, !Core), Entries = et_interface(Resources, Types, Funcs) ), ImportAST = ImportAST0 ^ ia_entries := Entries. :- pred gather_implicit_declarations(q_name::in, import_ast(_, _)::in, env::in, env::out, core::in, core::out) is det. gather_implicit_declarations(ImportModule, ImportAST, !Env, !Core) :- ThisModule = module_name(!.Core), Entries = ImportAST ^ ia_entries, ( Entries = et_typeres(_, _), unexpected($file, $pred, "Typeres") ; Entries = et_interface(Resources, Types, Funcs), % Gather resources and types that this module uses that my be % declared by transitively-imported modules. ResNames0 = union_list(map(resource_get_resources, Resources)) `union` union_list(map(func_get_resources, Funcs)), ResNames = filter(module_name_filter(ThisModule, ImportModule), ResNames0), foldl2(maybe_add_implicit_resource, ResNames, !Env, !Core), TypeNames0 = union_list(map(type_get_types, Types)) `union` union_list(map(func_get_types, Funcs)), TypeNames = filter((pred({N, _}::in) is semidet :- module_name_filter(ThisModule, ImportModule, N) ), TypeNames0), foldl2(maybe_add_implicit_type, TypeNames, !Env, !Core) ). :- pred module_name_filter(q_name::in, q_name::in, q_name::in) is semidet. module_name_filter(ThisModule, ImportModule, Name) :- q_name_parts(Name, MbModule, _), ( MbModule = no, unexpected($file, $pred, "No module part in name") ; MbModule = yes(Module) ), % Exclude resources in the module we're compiling \+ ThisModule = Module, % Exclude resources in the module being imported \+ ImportModule = Module. :- pred maybe_add_implicit_resource(q_name::in, env::in, env::out, core::in, core::out) is det. maybe_add_implicit_resource(Name, !Env, !Core) :- ( if env_search_resource(!.Env, Name, _) then true else core_allocate_resource_id(ResId, !Core), core_set_resource(ResId, r_abstract(Name), !Core), env_add_resource_det(Name, ResId, !Env) ). :- pred maybe_add_implicit_type({q_name, arity}::in, env::in, env::out, core::in, core::out) is det. maybe_add_implicit_type({Name, Arity}, !Env, !Core) :- ( if env_search_type(!.Env, Name, _) then true else core_allocate_type_id(TypeId, !Core), env_add_type_det(Name, Arity, TypeId, !Env), core_set_type(TypeId, type_init_abstract(Name, Arity, nil_context), !Core) ). %-----------------------------------------------------------------------% :- type import_entries == assoc_list(nq_name, import_entry). :- type import_entry ---> ie_resource(resource_id) ; ie_type(arity, type_id) ; ie_ctor(ctor_id) ; ie_func(func_id). :- pred process_interface_import(env::in, q_name::in, import_ast(resource_id, type_id)::in, import_result(import_entries)::out, core::in, core::out) is det. process_interface_import(Env, ModuleName, ImportAST, Result, !Core) :- ImportAST = import_ast(ModuleNameAST, Context, Entries), ( if ModuleNameAST = ModuleName then ( Entries = et_interface(Resources, Types, Funcs), read_import_import(ModuleName, Env, Resources, Types, Funcs, NamePairs, Errors, !Core), ( if is_empty(Errors) then Result = ok(NamePairs) else Result = compile_errors(Errors) ) ; Entries = et_typeres(_, _), unexpected($file, $pred, "Typeres") ) else Result = compile_errors(error(Context, ce_interface_contains_wrong_module( filename(Context ^ c_file), ModuleName, ModuleNameAST))) ). :- pred read_import_import(q_name::in, env::in, list({q_name, maybe(ast_resource), resource_id})::in, list({q_name, ast_type(q_name), type_id})::in, list(q_named(ast_function_decl))::in, assoc_list(nq_name, import_entry)::out, errors(compile_error)::out, core::in, core::out) is det. read_import_import(ModuleName, Env, Resources, Types, Funcs, NamePairs, Errors, !Core) :- map2_foldl(do_import_resource(ModuleName, Env), Resources, ResourcePairs, ResourceErrors, !Core), map2_foldl(do_import_type(ModuleName, Env), Types, TypePairs, TypeErrors, !Core), map2_foldl(do_import_function(ModuleName, Env), Funcs, FuncPairs, FunctionErrors, !Core), NamePairs = ResourcePairs ++ condense(TypePairs) ++ FuncPairs, Errors = cord_list_to_cord(ResourceErrors ++ TypeErrors ++ FunctionErrors). %-----------------------------------------------------------------------% :- pred gather_resource({q_name, T, _}::in, {q_name, T, resource_id}::out, env::in, env::out, core::in, core::out) is det. gather_resource({Name, Res, _}, {Name, Res, ResId}, !Env, !Core) :- core_allocate_resource_id(ResId, !Core), ( if env_add_resource(Name, ResId, !Env) then true else compile_error($file, $pred, "Resource already defined") ). :- func resource_get_resources({_, maybe(ast_resource), _}) = set(q_name). resource_get_resources({_, yes(ast_resource(Name, _, _)), _}) = make_singleton_set(Name). resource_get_resources({_, no, _}) = set.init. :- pred do_import_resource(q_name::in, env::in, {q_name, maybe(ast_resource), resource_id}::in, pair(nq_name, import_entry)::out, errors(compile_error)::out, core::in, core::out) is det. do_import_resource(ModuleName, Env, {Name, Res0, ResId}, NamePair, !:Errors, !Core) :- !:Errors = init, ( if q_name_append(ModuleName, NQName0, Name) then NQName = NQName0 else unexpected($file, $pred, "Imported module exports symbols of other module") ), NamePair = NQName - ie_resource(ResId), ( Res0 = yes(ast_resource(FromName, _, Context)), ( if env_search_resource(Env, FromName, FromRes) then core_set_resource(ResId, r_other(Name, FromRes, so_private, i_imported, Context), !Core) else add_error(Context, ce_resource_unknown(FromName), !Errors) ) ; Res0 = no, core_set_resource(ResId, r_abstract(Name), !Core) ). %-----------------------------------------------------------------------% :- pred gather_types({q_name, ast_type(q_name), _}::in, {q_name, ast_type(q_name), type_id}::out, env::in, env::out, core::in, core::out) is det. gather_types({Name, Type, _}, {Name, Type, TypeId}, !Env, !Core) :- core_allocate_type_id(TypeId, !Core), Arity = type_arity(Type), env_add_type_det(Name, Arity, TypeId, !Env). :- func type_get_types({_, ast_type(_), _}) = set({q_name, arity}). type_get_types({_, Type, _}) = Types :- ( Type = ast_type(_, Ctors, _, _), Types = union_list(map(ctor_get_types, Ctors)) ; Type = ast_type_abstract(_, _), Types = init ). :- func ctor_get_types(at_constructor(_)) = set({q_name, arity}). ctor_get_types(Ctor) = union_list(map(field_get_types, Ctor ^ atc_args)). :- func field_get_types(at_field) = set({q_name, arity}). field_get_types(at_field(_, TypeExpr, _)) = type_expr_get_types(TypeExpr). :- func type_expr_get_types(ast_type_expr) = set({q_name, arity}). type_expr_get_types(ast_type(Name, Args, _)) = make_singleton_set({Name, arity(length(Args))}) `union` union_list(map(type_expr_get_types, Args)). type_expr_get_types(ast_type_func(Args, Returns, _, _)) = union_list(map(type_expr_get_types, Args)) `union` union_list(map(type_expr_get_types, Returns)). type_expr_get_types(ast_type_var(_, _)) = init. :- pred do_import_type(q_name::in, env::in, {q_name, ast_type(q_name), type_id}::in, assoc_list(nq_name, import_entry)::out, errors(compile_error)::out, core::in, core::out) is det. do_import_type(ModuleName, Env, {Name, ASTType, TypeId}, NamePairs, Errors, !Core) :- ( if q_name_append(ModuleName, NQName0, Name) then NQName = NQName0 else unexpected($file, $pred, "Imported module exports symbols of other module") ), NamePair = NQName - ie_type(type_arity(ASTType), TypeId), ast_to_core_type_i(func(N) = N, i_imported, Env, Name, TypeId, ASTType, Result, !Core), ( Result = ok({Type, Ctors}), core_set_type(TypeId, Type, !Core), CtorNamePairs = map( func(C) = q_name_unqual(C ^ cb_name) - ie_ctor(C ^ cb_id), Ctors), NamePairs = [NamePair | CtorNamePairs], Errors = init ; Result = errors(Errors), NamePairs = [] ). %-----------------------------------------------------------------------% :- func func_get_resources(q_named(ast_function_decl)) = set(q_name). func_get_resources(q_named(_, Func)) = list_to_set(map(func(U) = U ^ au_name, Func ^ afd_uses)). :- func func_get_types(q_named(ast_function_decl)) = set({q_name, arity}). func_get_types(q_named(_, Func)) = union_list(map(func(ast_param(_, T)) = type_expr_get_types(T), Func ^ afd_params)) `union` union_list(map(type_expr_get_types, Func ^ afd_return)). %-----------------------------------------------------------------------% :- pred do_import_function(q_name::in, env::in, q_named(ast_function_decl)::in, pair(nq_name, import_entry)::out, errors(compile_error)::out, core::in, core::out) is det. do_import_function(ModuleName, Env, q_named(Name, Decl), NamePair, Errors, !Core) :- core_allocate_function(FuncId, !Core), ( if q_name_append(ModuleName, NQName0, Name) then NQName = NQName0 else unexpected($file, $pred, "Imported module exports symbols of other module") ), NamePair = NQName - ie_func(FuncId), % Imported functions aren't re-exported, so we annotate it with % s_private. ast_to_func_decl(!.Core, Env, Name, Decl, s_private, Result), ( Result = ok(Function0), func_set_imported(Function0, Function), core_set_function(FuncId, Function, !Core), Errors = init ; Result = errors(Errors) ). %-----------------------------------------------------------------------% % Enrol an import in the import_map into the environment. % % IO is used only for logging. % :- pred enroll_import(log_config::in, import_map(import_entries)::in, ast_import::in, set(q_name)::in, set(q_name)::out, set(q_name)::in, set(q_name)::out, env::in, env::out, errors(compile_error)::in, errors(compile_error)::out, io::di, io::uo) is det. enroll_import(Verbose, ImportMap, ast_import(ModuleName, MaybeAsName, Context), !AsSet, !DupImportsSet, !Env, !Errors, !IO) :- ( MaybeAsName = no, AsName = ModuleName ; MaybeAsName = yes(AsNameStr), AsName = q_name_from_dotted_string_det(AsNameStr) ), verbose_output(Verbose, format("Importing %s as %s\n", [s(q_name_to_string(ModuleName)), s(q_name_to_string(AsName))]), !IO), ( if insert_new(AsName, !AsSet) then true else add_error(Context, ce_import_would_clobber(ModuleName, map_maybe(q_name_from_dotted_string_det, MaybeAsName)), !Errors) ), ( if insert_new(ModuleName, !DupImportsSet) then true else add_error(Context, ce_import_duplicate(ModuleName), !Errors) ), map.lookup(ImportMap, ModuleName, ReadResult), ( ReadResult = ok(NamePairs), foldl(import_add_to_env(AsName), NamePairs, !Env) ; ReadResult = read_error(Error), add_error(Context, Error, !Errors) ; ReadResult = compile_errors(Errors), add_errors(Errors, !Errors) ). :- pred import_add_to_env(q_name::in, pair(nq_name, import_entry)::in, env::in, env::out) is det. import_add_to_env(IntoName, Name0 - Entry, !Env) :- Name = q_name_append(IntoName, Name0), ( if require_complete_switch [Entry] ( Entry = ie_resource(ResId), env_add_resource(Name, ResId, !Env) ; Entry = ie_type(Arity, TypeId), env_add_type(Name, Arity, TypeId, !Env) ; Entry = ie_ctor(CtorId), env_add_constructor(Name, CtorId, !Env) ; Entry = ie_func(FuncId), env_add_func(Name, FuncId, !Env) ) then true else % XXX Needs to be context of import directive, we'll do a proper % error later. compile_error($file, $pred, "Name collision caused by import") ). %-----------------------------------------------------------------------% %-----------------------------------------------------------------------% ================================================ FILE: src/pre.m ================================================ %-----------------------------------------------------------------------% % Plasma pre-core representation % vim: ts=4 sw=4 et % % Copyright (C) Plasma Team % Distributed under the terms of the MIT License see ../LICENSE.code % % This module represents the pre-core representation. % %-----------------------------------------------------------------------% :- module pre. %-----------------------------------------------------------------------% :- interface. :- include_module pre.ast_to_core. :- include_module pre.env. :- include_module pre.import. %-----------------------------------------------------------------------% %-----------------------------------------------------------------------% :- implementation. :- include_module pre.bang. :- include_module pre.branches. :- include_module pre.closures. :- include_module pre.from_ast. :- include_module pre.pre_ds. :- include_module pre.pretty. :- include_module pre.to_core. :- include_module pre.util. %-----------------------------------------------------------------------% ================================================ FILE: src/pre.pre_ds.m ================================================ %-----------------------------------------------------------------------% % Plasma pre-core representation % vim: ts=4 sw=4 et % % Copyright (C) Plasma Team % Distributed under the terms of the MIT License see ../LICENSE.code % % This module represents the pre-core representation. % %-----------------------------------------------------------------------% :- module pre.pre_ds. %-----------------------------------------------------------------------% :- interface. :- import_module list. :- import_module map. :- import_module maybe. :- import_module set. :- import_module context. :- import_module common_types. :- import_module varmap. %-----------------------------------------------------------------------% % Compared with the AST representation, the pre representation has % variables resolved, and restricts where expressions can appear % (they're not allowed as the switched-on variable in switches or return % expressions). % :- type pre_function ---> pre_function( f_func_id :: func_id, f_varmap :: varmap, f_param_vars :: list(var_or_wildcard(var)), f_arity :: arity, f_body :: pre_statements, f_context :: context ). %-----------------------------------------------------------------------% :- type pre_statements == list(pre_statement). :- type pre_statement ---> pre_statement( s_type :: pre_stmt_type, s_info :: pre_stmt_info ). :- type pre_stmt_type ---> s_call(pre_call) ; s_decl_vars(list(var)) ; s_assign(list(var_or_wildcard(var)), list(pre_expr)) ; s_return(list(var)) ; s_match(var, list(pre_case)). :- type pre_stmt_info ---> stmt_info( si_context :: context, % Use vars the set of variables whose values are needed % by this computation. They appear on the LHS of % assignments or anywhere within other statement types. si_use_vars :: set(var), % Def vars is the set of variables that are computed by % this computation. They appear on the RHS of % assignments. They may intersect with use vars, for % example if this is a compound statement containing an % assignment of a variable followed by the use of the % same variable. si_def_vars :: set(var), % Whether the end of this statment is reachable. si_reachable :: stmt_reachable ). :- type stmt_reachable ---> stmt_always_fallsthrough % NOTE: All visible cases are covered, uncovered cases cannot be % detected until after typechecking. ; stmt_always_returns ; stmt_may_return. :- type pre_call % XXX: Maybe use only variables as call arguments? ---> pre_call(func_id, list(pre_expr), with_bang) ; pre_ho_call(pre_expr, list(pre_expr), with_bang). :- type with_bang ---> with_bang ; without_bang. :- type pre_case ---> pre_case(pre_pattern, pre_statements). :- type pre_pattern ---> p_number(int) ; p_var(var) % The pattern is for one of the possible constructors ; p_constr(set(ctor_id), list(pre_pattern)) ; p_wildcard. :- type pre_expr ---> e_call(pre_call) ; e_match(pre_expr, list(pre_expr_case)) ; e_var(var) ; e_construction( set(ctor_id), list(pre_expr) ) ; e_lambda(pre_lambda) ; e_constant(const_type). :- type pre_expr_case ---> pre_e_case(pre_pattern, list(pre_expr)). :- type pre_lambda ---> pre_lambda( pl_id :: func_id, pl_params :: list(var_or_wildcard(var)), % Filled in during nonlocals processing. pl_captured :: maybe(set(var)), pl_arity :: arity, pl_body :: pre_statements ). %-----------------------------------------------------------------------% :- func stmt_all_vars(pre_statement) = set(var). :- func pattern_all_vars(pre_pattern) = set(var). :- pred stmt_rename(set(var)::in, pre_statement::in, pre_statement::out, map(var, var)::in, map(var, var)::out, varmap::in, varmap::out) is det. :- pred pat_rename(set(var)::in, pre_pattern::in, pre_pattern::out, map(var, var)::in, map(var, var)::out, varmap::in, varmap::out) is det. %-----------------------------------------------------------------------% %-----------------------------------------------------------------------% :- implementation. :- import_module require. :- import_module util. :- import_module util.mercury. %-----------------------------------------------------------------------% stmt_all_vars(pre_statement(Type, _)) = Vars :- ( Type = s_call(Call), Vars = call_all_vars(Call) ; Type = s_decl_vars(VarsList), Vars = list_to_set(VarsList) ; Type = s_assign(LVarsOrWildcards, Exprs), filter_map(vow_is_var, LVarsOrWildcards, LVars), Vars = list_to_set(LVars) `union` union_list(map(expr_all_vars, Exprs)) ; Type = s_return(RVars), Vars = list_to_set(RVars) ; Type = s_match(Var, Cases), Vars = make_singleton_set(Var) `union` union_list(map(case_all_vars, Cases)) ). :- func case_all_vars(pre_case) = set(var). case_all_vars(pre_case(Pat, Stmts)) = pattern_all_vars(Pat) `union` union_list(map(stmt_all_vars, Stmts)). pattern_all_vars(p_number(_)) = set.init. pattern_all_vars(p_var(Var)) = make_singleton_set(Var). pattern_all_vars(p_wildcard) = set.init. pattern_all_vars(p_constr(_, Args)) = union_list(map(pattern_all_vars, Args)). :- func expr_all_vars(pre_expr) = set(var). expr_all_vars(e_call(Call)) = call_all_vars(Call). expr_all_vars(e_match(MatchExpr, Cases)) = expr_all_vars(MatchExpr) `union` union_list(map(func(pre_e_case(Pat, Expr)) = pattern_all_vars(Pat) `union` union_list(map(expr_all_vars, Expr)), Cases)). expr_all_vars(e_var(Var)) = make_singleton_set(Var). expr_all_vars(e_construction(_, Args)) = union_list(map(expr_all_vars, Args)). expr_all_vars(e_lambda(Lambda)) = union_list(map(stmt_all_vars, Body)) `union` list_to_set(ParamVars) :- Body = Lambda ^ pl_body, filter_map(vow_is_var, Lambda ^ pl_params, ParamVars). expr_all_vars(e_constant(_)) = set.init. :- func call_all_vars(pre_call) = set(var). call_all_vars(pre_call(_, Exprs, _)) = union_list(map(expr_all_vars, Exprs)). call_all_vars(pre_ho_call(CalleeExpr, ArgsExprs, _)) = union_list(map(expr_all_vars, ArgsExprs)) `union` expr_all_vars(CalleeExpr). %-----------------------------------------------------------------------% stmt_rename(Vars, pre_statement(Type0, Info0), pre_statement(Type, Info), !Renaming, !Varmap) :- ( Type0 = s_call(Call0), call_rename(Vars, Call0, Call, !Renaming, !Varmap), Type = s_call(Call) ; Type0 = s_decl_vars(DVars0), map_foldl2(var_rename(Vars), DVars0, DVars, !Renaming, !Varmap), Type = s_decl_vars(DVars) ; Type0 = s_assign(LVars0, Exprs0), map_foldl2(var_or_wild_rename(Vars), LVars0, LVars, !Renaming, !Varmap), map_foldl2(expr_rename(Vars), Exprs0, Exprs, !Renaming, !Varmap), Type = s_assign(LVars, Exprs) ; Type0 = s_return(RVars0), map_foldl2(var_rename(Vars), RVars0, RVars, !Renaming, !Varmap), Type = s_return(RVars) ; Type0 = s_match(Var0, Cases0), var_rename(Vars, Var0, Var, !Renaming, !Varmap), map_foldl2(case_rename(Vars), Cases0, Cases, !Renaming, !Varmap), Type = s_match(Var, Cases) ), Info0 = stmt_info(Context, UseVars0, DefVars0, StmtReturns), set_map_foldl2(var_rename(Vars), UseVars0, UseVars, !Renaming, !Varmap), set_map_foldl2(var_rename(Vars), DefVars0, DefVars, !Renaming, !Varmap), Info = stmt_info(Context, UseVars, DefVars, StmtReturns). :- pred case_rename(set(var)::in, pre_case::in, pre_case::out, map(var, var)::in, map(var, var)::out, varmap::in, varmap::out) is det. case_rename(Vars, pre_case(Pat0, Stmts0), pre_case(Pat, Stmts), !Renaming, !Varmap) :- pat_rename(Vars, Pat0, Pat, !Renaming, !Varmap), map_foldl2(stmt_rename(Vars), Stmts0, Stmts, !Renaming, !Varmap). pat_rename(_, p_number(N), p_number(N), !Renaming, !Varmap). pat_rename(Vars, p_var(Var0), p_var(Var), !Renaming, !Varmap) :- var_rename(Vars, Var0, Var, !Renaming, !Varmap). pat_rename(_, p_wildcard, p_wildcard, !Renaming, !Varmap). pat_rename(Vars, p_constr(Cs, Args0), p_constr(Cs, Args), !Renaming, !Varmap) :- map_foldl2(pat_rename(Vars), Args0, Args, !Renaming, !Varmap). :- pred expr_rename(set(var)::in, pre_expr::in, pre_expr::out, map(var, var)::in, map(var, var)::out, varmap::in, varmap::out) is det. expr_rename(Vars, e_call(Call0), e_call(Call), !Renaming, !Varmap) :- call_rename(Vars, Call0, Call, !Renaming, !Varmap). expr_rename(Vars, e_match(Expr0, Cases0), e_match(Expr, Cases), !Renaming, !Varmap) :- expr_rename(Vars, Expr0, Expr, !Renaming, !Varmap), map_foldl2(expr_case_rename(Vars), Cases0, Cases, !Renaming, !Varmap). expr_rename(Vars, e_var(Var0), e_var(Var), !Renaming, !Varmap) :- var_rename(Vars, Var0, Var, !Renaming, !Varmap). expr_rename(Vars, e_construction(Cs, Args0), e_construction(Cs, Args), !Renaming, !Varmap) :- map_foldl2(expr_rename(Vars), Args0, Args, !Renaming, !Varmap). expr_rename(Vars, e_lambda(!.Lambda), e_lambda(!:Lambda), !Renaming, !Varmap) :- map_foldl2(var_or_wild_rename(Vars), !.Lambda ^ pl_params, Params, !Renaming, !Varmap), MaybeCaptured0 = !.Lambda ^ pl_captured, ( MaybeCaptured0 = yes(Captured0), set_rename(Vars, Captured0, Captured, !Renaming, !Varmap), !Lambda ^ pl_captured := yes(Captured) ; MaybeCaptured0 = no ), map_foldl2(stmt_rename(Vars), !.Lambda ^ pl_body, Body, !Renaming, !Varmap), !Lambda ^ pl_params := Params, !Lambda ^ pl_body := Body. expr_rename(_, e_constant(C), e_constant(C), !Renaming, !Varmap). :- pred call_rename(set(var)::in, pre_call::in, pre_call::out, map(var, var)::in, map(var, var)::out, varmap::in, varmap::out) is det. call_rename(Vars, pre_call(Func, Exprs0, Bang), pre_call(Func, Exprs, Bang), !Renaming, !Varmap) :- map_foldl2(expr_rename(Vars), Exprs0, Exprs, !Renaming, !Varmap). call_rename(Vars, pre_ho_call(CalleeExpr0, ArgExprs0, Bang), pre_ho_call(CalleeExpr, ArgExprs, Bang), !Renaming, !Varmap) :- expr_rename(Vars, CalleeExpr0, CalleeExpr, !Renaming, !Varmap), map_foldl2(expr_rename(Vars), ArgExprs0, ArgExprs, !Renaming, !Varmap). :- pred expr_case_rename(set(var)::in, pre_expr_case::in, pre_expr_case::out, map(var, var)::in, map(var, var)::out, varmap::in, varmap::out) is det. expr_case_rename(Vars, pre_e_case(Pat0, Exprs0), pre_e_case(Pat, Exprs), !Renaming, !Varmap) :- pat_rename(Vars, Pat0, Pat, !Renaming, !Varmap), map_foldl2(expr_rename(Vars), Exprs0, Exprs, !Renaming, !Varmap). :- pred set_rename(set(var)::in, set(var)::in, set(var)::out, map(var, var)::in, map(var, var)::out, varmap::in, varmap::out) is det. set_rename(Vars, !Set, !Renaming, !Varmap) :- fold3(set_rename_2(Vars), !.Set, set.init, !:Set, !Renaming, !Varmap). :- pred set_rename_2(set(var)::in, var::in, set(var)::in, set(var)::out, map(var, var)::in, map(var, var)::out, varmap::in, varmap::out) is det. set_rename_2(Vars, Var0, !Set, !Renaming, !Varmap) :- var_rename(Vars, Var0, Var, !Renaming, !Varmap), ( if insert_new(Var, !Set) then true else unexpected($file, $pred, "Renaming vars in a set is broken") ). :- pred var_or_wild_rename(set(var)::in, var_or_wildcard(var)::in, var_or_wildcard(var)::out, map(var, var)::in, map(var, var)::out, varmap::in, varmap::out) is det. var_or_wild_rename(Vars, var(Var0), var(Var), !Renaming, !Varmap) :- var_rename(Vars, Var0, Var, !Renaming, !Varmap). var_or_wild_rename(_, wildcard, wildcard, !Renaming, !Varmap). :- pred var_rename(set(var)::in, var::in, var::out, map(var, var)::in, map(var, var)::out, varmap::in, varmap::out) is det. var_rename(Vars, Var0, Var, !Renaming, !Varmap) :- ( if member(Var0, Vars) then ( if search(!.Renaming, Var0, VarPrime) then Var = VarPrime else add_fresh_var(get_var_name_no_suffix(!.Varmap, Var0), Var, !Varmap), det_insert(Var0, Var, !Renaming) ) else Var = Var0 ). %-----------------------------------------------------------------------% %-----------------------------------------------------------------------% ================================================ FILE: src/pre.pretty.m ================================================ %-----------------------------------------------------------------------% % Plasma pre-core pretty printer % vim: ts=4 sw=4 et % % Copyright (C) Plasma Team % Distributed under the terms of the MIT License see ../LICENSE.code % % This module defines a pretty printer for the pre-core representation. % %-----------------------------------------------------------------------% :- module pre.pretty. %-----------------------------------------------------------------------% :- interface. :- import_module cord. :- import_module map. % Used to lookup function names, we could decouple this better. :- import_module core. :- import_module common_types. :- import_module pre.pre_ds. :- func pre_pretty(core, map(func_id, pre_function)) = cord(string). %-----------------------------------------------------------------------% %-----------------------------------------------------------------------% :- implementation. :- import_module list. :- import_module maybe. :- import_module pair. :- import_module set. :- import_module string. :- import_module context. :- import_module q_name. :- import_module core.pretty. :- import_module util. :- import_module util.mercury. :- import_module util.pretty. :- import_module varmap. %-----------------------------------------------------------------------% pre_pretty(Core, Map) = pretty(default_options, 0, Pretty) :- Pretty = [p_list(list_join([p_nl_hard], map(func_pretty(Core), to_assoc_list(Map))))]. :- type pretty_info ---> pretty_info( pi_varmap :: varmap, pi_core :: core ). :- func func_pretty(core, pair(func_id, pre_function)) = pretty. func_pretty(Core, FuncId - Func) = procish_pretty(Info, FuncId, ParamVars, yes(init), Body) :- ParamVars = Func ^ f_param_vars, Body = Func ^ f_body, Varmap = Func ^ f_varmap, Info = pretty_info(Varmap, Core). :- func procish_pretty(pretty_info, func_id, list(var_or_wildcard(var)), maybe(set(var)), pre_statements) = pretty. procish_pretty(Info, FuncId, ParamVars, MaybeCaptured, Body) = p_group_curly( [q_name_pretty(core_lookup_function_name(Core, FuncId)), p_str("(")] ++ pretty_comma_seperated( map(var_or_wild_pretty(Varmap), ParamVars)) ++ [p_str(")")] ++ CapturedPretty, singleton("{"), stmts_pretty(Info, Body), singleton("}")) :- pretty_info(Varmap, Core) = Info, ( if MaybeCaptured = yes(Captured), not is_empty(Captured) then CapturedPretty = [p_nl_hard, p_str("// Captured: "), vars_set_pretty(Varmap, Captured)] else CapturedPretty = [] ). :- func stmts_pretty(pretty_info, pre_statements) = list(pretty). stmts_pretty(Info, Stmts) = condense(list_join([[p_nl_double]], map(stmt_pretty(Info), Stmts))). :- func stmt_pretty(pretty_info, pre_statement) = list(pretty). stmt_pretty(Info, pre_statement(Type, StmtInfo)) = PrettyInfo1 ++ [p_nl_hard, PrettyStmt] ++ PrettyInfo2 :- Varmap = Info ^ pi_varmap, StmtInfo = stmt_info(Context, UseVars, DefVars, StmtReturns), PrettyInfo1 = [p_comment(singleton("// "), [p_str(context_string(Context)), p_nl_hard, p_str("Use vars: "), vars_set_pretty(Varmap, UseVars)])], PrettyInfo2 = [p_comment(singleton("// "), [p_str("Def vars: "), vars_set_pretty(Varmap, DefVars), p_nl_hard, p_str("Reachable: "), p_str(string(StmtReturns))])], ( Type = s_call(Call), PrettyStmt = call_pretty(Info, Call) ; Type = s_decl_vars(Vars), PrettyStmt = p_expr([p_str("var "), vars_pretty(Varmap, Vars)]) ; Type = s_assign(Vars, Exprs), PrettyStmt = p_expr(pretty_comma_seperated( map(var_or_wild_pretty(Varmap), Vars)) ++ [p_spc, p_nl_soft, p_str("= "), p_expr(pretty_comma_seperated( map(expr_pretty(Info), Exprs)))]) ; Type = s_return(Vars), PrettyStmt = p_expr([p_str("return "), vars_pretty(Varmap, Vars)]) ; Type = s_match(Var, Cases), PrettyStmt = p_group_curly( [p_str("match ("), var_pretty(Varmap, Var), p_str(")")], singleton("{"), list_join([p_nl_hard], map(case_pretty(Info), Cases)), singleton("}")) ). :- func case_pretty(pretty_info, pre_case) = pretty. case_pretty(Info, pre_case(Pattern, Stmts)) = p_group_curly( [p_str("case "), pattern_pretty(Info, Pattern), p_str(" ->")], singleton("{"), stmts_pretty(Info, Stmts), singleton("}")). :- func pattern_pretty(pretty_info, pre_pattern) = pretty. pattern_pretty(_, p_number(Num)) = p_str(string(Num)). pattern_pretty(Info, p_var(Var)) = var_pretty(Info ^ pi_varmap, Var). pattern_pretty(_, p_wildcard) = p_str("_"). pattern_pretty(Info, p_constr(CtorIds, Args)) = pretty_optional_args(IdPretty, ArgsPretty) :- IdPretty = constructor_name_pretty(Info ^ pi_core, CtorIds), ArgsPretty = map(pattern_pretty(Info), Args). :- func expr_pretty(pretty_info, pre_expr) = pretty. expr_pretty(Info, e_call(Call)) = call_pretty(Info, Call). expr_pretty(Info, e_match(Expr, Cases)) = p_expr([p_str("match ("), expr_pretty(Info, Expr), p_str(")"), p_nl_hard] ++ list_join([p_nl_hard], map(case_expr_pretty(Info), Cases))). expr_pretty(Info, e_var(Var)) = var_pretty(Info ^ pi_varmap, Var). expr_pretty(Info, e_construction(CtorIds, Args)) = pretty_optional_args(IdPretty, ArgsPretty) :- IdPretty = constructor_name_pretty(Info ^ pi_core, CtorIds), ArgsPretty = map(expr_pretty(Info), Args). expr_pretty(Info, e_lambda(pre_lambda(FuncId, Params, MaybeCaptured, _, Body))) = procish_pretty(Info, FuncId, Params, MaybeCaptured, Body). expr_pretty(Info, e_constant(Const)) = const_pretty( func(F) = q_name_pretty(core_lookup_function_name(Info ^ pi_core, F)), constructor_name_pretty(Info ^ pi_core), Const). :- func call_pretty(pretty_info, pre_call) = pretty. call_pretty(Info, Call) = Pretty :- ( Call = pre_call(FuncId, Args, WithBang), CalleePretty = q_name_pretty( core_lookup_function_name(Info ^ pi_core, FuncId)) ; Call = pre_ho_call(Callee, Args, WithBang), CalleePretty = expr_pretty(Info, Callee) ), ( WithBang = with_bang, BangPretty = [p_str("!")] ; WithBang = without_bang, BangPretty = [] ), Pretty = pretty_callish(p_expr([CalleePretty] ++ BangPretty), map(expr_pretty(Info), Args)). :- func case_expr_pretty(pretty_info, pre_expr_case) = pretty. case_expr_pretty(Info, pre_e_case(Pat, Expr)) = p_expr([pattern_pretty(Info, Pat), p_spc, p_nl_soft, p_str("-> "), p_list(pretty_comma_seperated(map(expr_pretty(Info), Expr)))]). %-----------------------------------------------------------------------% %-----------------------------------------------------------------------% ================================================ FILE: src/pre.to_core.m ================================================ %-----------------------------------------------------------------------% % vim: ts=4 sw=4 et %-----------------------------------------------------------------------% :- module pre.to_core. % % Copyright (C) Plasma Team % Distributed under the terms of the MIT License see ../LICENSE.code % % Plasma parse tree to core representation conversion % %-----------------------------------------------------------------------% :- interface. :- import_module core. :- import_module common_types. :- import_module pre.pre_ds. %-----------------------------------------------------------------------% :- pred pre_to_core(func_id::in, pre_function::in, core::in, core::out) is det. %-----------------------------------------------------------------------% %-----------------------------------------------------------------------% :- implementation. :- import_module int. :- import_module list. :- import_module maybe. :- import_module require. :- import_module set. :- import_module string. :- import_module context. :- import_module core.code. :- import_module core.function. :- import_module pre.util. :- import_module varmap. :- import_module util. :- import_module util.my_exception. %-----------------------------------------------------------------------% pre_to_core(FuncId, Func, !Core) :- Func = pre_function(_, Varmap, Params, _, Body, _), pre_to_core_func(FuncId, Params, [], Body, Varmap, !Core). :- pred pre_to_core_func(func_id::in, list(var_or_wildcard(var))::in, list(var)::in, pre_statements::in, varmap::in, core::in, core::out) is det. pre_to_core_func(FuncId, Params, Captured, Body0, !.Varmap, !Core) :- map_foldl(var_or_make_var, Params, ParamVars, !Varmap), foldl(pre_to_core_lambda(!.Varmap), get_all_lambdas_stmts(Body0), !Core), ParamVarsSet = list_to_set(ParamVars), pre_to_core_stmts(ParamVarsSet, Body0, Body1, !Varmap), expr_make_vars_unique(Body1, Body, set.init, _, !Varmap), core_get_function_det(!.Core, FuncId, Function0), func_set_body(!.Varmap, ParamVars, Captured, Body, Function0, Function), core_set_function(FuncId, Function, !Core). :- pred pre_to_core_stmts(set(var)::in, pre_statements::in, expr::out, varmap::in, varmap::out) is det. pre_to_core_stmts(_, [], empty_tuple, !Varmap). pre_to_core_stmts(DeclVars0, Stmts0@[_ | _], Expr, !Varmap) :- det_split_last(Stmts0, Stmts, LastStmt), ( Stmts = [], pre_to_core_stmt(LastStmt, LastExpr, Vars, DeclVars0, _, !Varmap), terminate_let(Vars, [], LastExpr, Expr) ; Stmts = [_ | _], map_foldl2( (pred(S::in, e_let(V, E)::out, Dv0::in, Dv::out, Vm0::in, Vm::out) is det :- pre_to_core_stmt(S, E, V, Dv0, Dv, Vm0, Vm) ), Stmts, Lets, DeclVars0, DeclVars, !Varmap), pre_to_core_stmt(LastStmt, LastExpr, Vars, DeclVars, _, !Varmap), terminate_let(Vars, Lets, LastExpr, Expr) ). :- pred terminate_let(list(var)::in, list(expr_let)::in, expr::in, expr::out) is det. terminate_let([], [], Expr, Expr). terminate_let([], Lets@[_ | _], LastExpr, Expr) :- Expr = expr(e_lets(Lets, LastExpr), LastExpr ^ e_info). terminate_let(Vars@[_ | _], Lets0, LastExpr, Expr) :- Lets = Lets0 ++ [e_let(Vars, LastExpr)], Expr = expr(e_lets(Lets, empty_tuple), LastExpr ^ e_info). % pre_to_core_stmt(Statement, !Stmts, Expr, !DeclVars, !Varmap). % % Build Expr from Statement and maybe some of !Stmts. % :- pred pre_to_core_stmt(pre_statement::in, expr::out, list(var)::out, set(var)::in, set(var)::out, varmap::in, varmap::out) is det. pre_to_core_stmt(Stmt, Expr, DefnVars, !DeclVars, !Varmap) :- Stmt = pre_statement(StmtType, Info), Context = Info ^ si_context, ( StmtType = s_call(Call), pre_to_core_call(Context, Call, Expr, !Varmap), DefnVars = [] ; StmtType = s_decl_vars(NewDeclVars), !:DeclVars = !.DeclVars `union` list_to_set(NewDeclVars), Expr = empty_tuple, DefnVars = [] ; StmtType = s_assign(Vars0, PreExprs), map_foldl(var_or_make_var, Vars0, Vars, !Varmap), map_foldl(pre_to_core_expr(Context), PreExprs, Exprs, !Varmap), Expr = expr(e_tuple(Exprs), code_info_init(o_user_body(Context))), DefnVars = Vars ; StmtType = s_return(Vars), CodeInfo = code_info_init(o_user_return(Context)), Expr = expr( e_tuple(map((func(V) = expr(e_var(V), CodeInfo)), Vars)), CodeInfo), DefnVars = [] ; StmtType = s_match(Var, Cases0), % For the initial version we require that all cases fall through, or % tha all will execute a return statement. Reachable = Info ^ si_reachable, ( Reachable = stmt_always_fallsthrough ; Reachable = stmt_always_returns ; Reachable = stmt_may_return, my_exception.sorry($file, $pred, Context, "Cannot handle some branches returning and others " ++ "falling-through") ), % This statement will become a let expression, binding the % variables produced on all branches that are declared outside % of the statement. ProdVarsSet = Info ^ si_def_vars `intersect` !.DeclVars, % Within each case we have to rename these variables. then we % can create an expression at the end that returns their values. map_foldl(pre_to_core_case_rename(!.DeclVars, ProdVarsSet), Cases0, Cases, !Varmap), MatchInfo = code_info_init(o_user_body(Context)), DefnVars = to_sorted_list(ProdVarsSet), Expr = expr(e_match(Var, Cases), MatchInfo) ). :- pred pre_to_core_case_rename(set(var)::in, set(var)::in, pre_case::in, expr_case::out, varmap::in, varmap::out) is det. pre_to_core_case_rename(!.DeclVars, VarsSet, pre_case(Pattern0, Stmts), e_case(Pattern, Expr), !Varmap) :- pre_to_core_pattern(Pattern0, Pattern1, !DeclVars, !Varmap), pre_to_core_stmts(!.DeclVars, Stmts, Expr0, !Varmap), ( if not is_empty(VarsSet) then make_renaming(VarsSet, Renaming, !Varmap), rename_pattern(Renaming, Pattern1, Pattern), Info = code_info_init(o_introduced), ReturnExpr = expr(e_tuple(map(func(V) = expr(e_var(V), Info), to_sorted_list(VarsSet))), Info), insert_result_expr(ReturnExpr, Expr0, Expr1), rename_expr(Renaming, Expr1, Expr) else Pattern = Pattern1, Expr = Expr0 ). :- pred pre_to_core_pattern(pre_pattern::in, expr_pattern::out, set(var)::in, set(var)::out, varmap::in, varmap::out) is det. pre_to_core_pattern(p_number(Num), p_num(Num), !DeclVars, !Varmap). pre_to_core_pattern(p_var(Var), p_variable(Var), !DeclVars, !Varmap) :- set.insert(Var, !DeclVars). pre_to_core_pattern(p_wildcard, p_wildcard, !DeclVars, !Varmap). pre_to_core_pattern(p_constr(Constrs, Args0), p_ctor(Constrs, Args), !DeclVars, !Varmap) :- map_foldl(make_pattern_arg_var, Args0, Args, !Varmap), !:DeclVars = !.DeclVars `union` list_to_set(Args). :- pred make_pattern_arg_var(pre_pattern::in, var::out, varmap::in, varmap::out) is det. make_pattern_arg_var(p_number(_), _, !Varmap) :- my_exception.sorry($file, $pred, "Nested pattern matching (number within other pattern)"). make_pattern_arg_var(p_constr(_, _), _, !Varmap) :- my_exception.sorry($file, $pred, "Nested pattern matching (constructor within other pattern)"). make_pattern_arg_var(p_var(Var), Var, !Varmap). make_pattern_arg_var(p_wildcard, Var, !Varmap) :- add_anon_var(Var, !Varmap). :- pred pre_to_core_expr(context::in, pre_expr::in, expr::out, varmap::in, varmap::out) is det. pre_to_core_expr(Context, e_call(Call), Expr, !Varmap) :- pre_to_core_call(Context, Call, Expr, !Varmap). pre_to_core_expr(Context, e_match(MatchExpr0, Cases), Expr, !Varmap) :- pre_to_core_expr(Context, MatchExpr0, MatchExpr, !Varmap), map_foldl(pre_to_core_expr_case(Context), Cases, CasesExprs, !Varmap), add_anon_var(Var, !Varmap), CodeInfo = code_info_init(o_user_body(Context)), Expr = expr(e_lets([e_let([Var], MatchExpr)], CasesExpr), CodeInfo), CasesExpr = expr(e_match(Var, CasesExprs), CodeInfo). pre_to_core_expr(Context, e_var(Var), expr(e_var(Var), code_info_init(o_user_body(Context))), !Varmap). pre_to_core_expr(Context, e_construction(CtorIds, Args0), Expr, !Varmap) :- make_arg_exprs(Context, Args0, Args, LetExpr, !Varmap), Expr = expr(e_lets([e_let(Args, LetExpr)], expr(e_construction(CtorIds, Args), code_info_init(o_user_body(Context)))), code_info_init(o_user_body(Context))). pre_to_core_expr(Context, e_lambda(Lambda), Expr, !Varmap) :- pre_lambda(FuncId, _, MaybeCaptured, _, _) = Lambda, ( MaybeCaptured = yes(Captured), ( if is_empty(Captured) then % This isn't a closure so we can generate a function reference % instead. ExprType = e_constant(c_func(FuncId)) else CapturedList = to_sorted_list(Captured), ExprType = e_closure(FuncId, CapturedList) ) ; MaybeCaptured = no, unexpected($file, $pred, "e_lambda with no captured set") ), Expr = expr(ExprType, code_info_init(o_user_body(Context))). pre_to_core_expr(Context, e_constant(Const), expr(e_constant(Const), code_info_init(o_user_body(Context))), !Varmap). :- pred pre_to_core_call(context::in, pre_call::in, expr::out, varmap::in, varmap::out) is det. pre_to_core_call(Context, Call, Expr, !Varmap) :- CodeInfo0 = code_info_init(o_user_body(Context)), ( Call = pre_call(_, Args0, WithBang) ; Call = pre_ho_call(_, Args0, WithBang) ), ( WithBang = without_bang, CodeInfo = CodeInfo0 ; WithBang = with_bang, code_info_set_bang_marker(has_bang_marker, CodeInfo0, CodeInfo) ), make_arg_exprs(Context, Args0, Args, ArgsLetExpr, !Varmap), ( Call = pre_call(Callee, _, _), % We could fill in resources here but we do that after type-checking % anyway and re-check it then. CallExpr = expr(e_call(c_plain(Callee), Args, unknown_resources), CodeInfo) ; Call = pre_ho_call(CalleeExpr0, _, _), add_anon_var(CalleeVar, !Varmap), pre_to_core_expr(Context, CalleeExpr0, CalleeExpr, !Varmap), CallExpr = expr(e_lets([e_let([CalleeVar], CalleeExpr)], expr(e_call(c_ho(CalleeVar), Args, unknown_resources), CodeInfo)), code_info_init(o_user_body(Context))) ), ( Args = [], Expr = CallExpr ; Args = [_ | _], Expr = expr(e_lets([e_let(Args, ArgsLetExpr)], CallExpr), code_info_init(o_user_body(Context))) ). :- pred make_arg_exprs(context::in, list(pre_expr)::in, list(var)::out, expr::out, varmap::in, varmap::out) is det. make_arg_exprs(Context, Args0, Args, LetExpr, !Varmap) :- map_foldl(pre_to_core_expr(Context), Args0, ArgExprs, !Varmap), LetExpr = expr(e_tuple(ArgExprs), code_info_init(o_introduced)), make_arg_vars(length(Args0), Args, !Varmap). :- pred pre_to_core_expr_case(context::in, pre_expr_case::in, expr_case::out, varmap::in, varmap::out) is det. pre_to_core_expr_case(Context, pre_e_case(Pat0, Exprs0), e_case(Pat, Expr), !Varmap) :- % DeclVars is used when the inside of the match is a series of % statements. pre_to_core_pattern(Pat0, Pat, init, _DeclVars, !Varmap), map_foldl(pre_to_core_expr(Context), Exprs0, Exprs, !Varmap), ( Exprs = [], unexpected($file, $pred, "Empty expressions in case") ; Exprs = [Expr] ; Exprs = [_, _ | _], Expr = expr(e_tuple(Exprs), code_info_init(o_user_body(Context))) ). %-----------------------------------------------------------------------% :- pred pre_to_core_lambda(varmap, pre_lambda, core, core). :- mode pre_to_core_lambda(in, in, in, out) is det. pre_to_core_lambda(Varmap, pre_lambda(FuncId, Params, MaybeCaptured, _, Body), !Core) :- ( MaybeCaptured = yes(Captured), CapturedList = set.to_sorted_list(Captured), pre_to_core_func(FuncId, Params, CapturedList, Body, Varmap, !Core) ; MaybeCaptured = no, unexpected($file, $pred, "Unfilled capture set") ). %-----------------------------------------------------------------------% :- pred make_arg_vars(int::in, list(var)::out, varmap::in, varmap::out) is det. make_arg_vars(Num, Vars, !Varmap) :- ( if Num = 0 then Vars = [] else make_arg_vars(Num - 1, Vars0, !Varmap), add_anon_var(Var, !Varmap), Vars = [Var | Vars0] ). :- func empty_tuple = expr. empty_tuple = expr(e_tuple([]), code_info_init(o_introduced)). %-----------------------------------------------------------------------% %-----------------------------------------------------------------------% ================================================ FILE: src/pre.util.m ================================================ %-----------------------------------------------------------------------% % Plasma AST symbol resolution % vim: ts=4 sw=4 et % % Copyright (C) Plasma Team % Distributed under the terms of the MIT License see ../LICENSE.code % % This module computes nonlocals within the pre-core representation. % %-----------------------------------------------------------------------% :- module pre.util. %-----------------------------------------------------------------------% :- interface. :- import_module list. :- import_module pre.pre_ds. %-----------------------------------------------------------------------% :- pred update_lambdas_this_stmt(pred(pre_lambda, pre_lambda, T, T), pre_statement, pre_statement, T, T). :- mode update_lambdas_this_stmt(pred(in, out, in, out) is det, in, out, in, out) is det. :- pred update_lambdas_this_stmt_2(pred(pre_lambda, pre_lambda, T, T, U, U), pre_statement, pre_statement, T, T, U, U). :- mode update_lambdas_this_stmt_2(pred(in, out, in, out, in, out) is det, in, out, in, out, in, out) is det. % This returns only the lambdas found directly. it won't recurse into % lambdas and return any inside them. % :- func get_all_lambdas_stmts(pre_statements) = list(pre_lambda). %-----------------------------------------------------------------------% %-----------------------------------------------------------------------% :- implementation. %-----------------------------------------------------------------------% update_lambdas_this_stmt(Update, pre_statement(Type0, Info), pre_statement(Type, Info), !Acc) :- ( Type0 = s_call(Call0), update_lambdas_call(Update, Call0, Call, !Acc), Type = s_call(Call) ; Type0 = s_decl_vars(_), Type = Type0 ; Type0 = s_assign(Var, Exprs0), map_foldl(update_lambdas_expr(Update), Exprs0, Exprs, !Acc), Type = s_assign(Var, Exprs) ; Type0 = s_return(_), Type = Type0 ; Type0 = s_match(_, _), % We expect our caller to recurse into nested statements. Type = Type0 ). update_lambdas_this_stmt_2(Update, pre_statement(Type0, Info), pre_statement(Type, Info), !Acc1, !Acc2) :- ( Type0 = s_call(Call0), update_lambdas_call_2(Update, Call0, Call, !Acc1, !Acc2), Type = s_call(Call) ; Type0 = s_decl_vars(_), Type = Type0 ; Type0 = s_assign(Var, Exprs0), map_foldl2(update_lambdas_expr_2(Update), Exprs0, Exprs, !Acc1, !Acc2), Type = s_assign(Var, Exprs) ; Type0 = s_return(_), Type = Type0 ; Type0 = s_match(_, _), % We expect our caller to recurse into nested statements. Type = Type0 ). :- pred update_lambdas_call(pred(pre_lambda, pre_lambda, T, T), pre_call, pre_call, T, T). :- mode update_lambdas_call(pred(in, out, in, out) is det, in, out, in, out) is det. update_lambdas_call(Update, pre_call(Func, Args0, Bang), pre_call(Func, Args, Bang), !Acc) :- map_foldl(update_lambdas_expr(Update), Args0, Args, !Acc). update_lambdas_call(Update, pre_ho_call(Ho0, Args0, Bang), pre_ho_call(Ho, Args, Bang), !Acc) :- update_lambdas_expr(Update, Ho0, Ho, !Acc), map_foldl(update_lambdas_expr(Update), Args0, Args, !Acc). :- pred update_lambdas_call_2(pred(pre_lambda, pre_lambda, T, T, U, U), pre_call, pre_call, T, T, U, U). :- mode update_lambdas_call_2(pred(in, out, in, out, in, out) is det, in, out, in, out, in, out) is det. update_lambdas_call_2(Update, pre_call(Func, Args0, Bang), pre_call(Func, Args, Bang), !Acc1, !Acc2) :- map_foldl2(update_lambdas_expr_2(Update), Args0, Args, !Acc1, !Acc2). update_lambdas_call_2(Update, pre_ho_call(Ho0, Args0, Bang), pre_ho_call(Ho, Args, Bang), !Acc1, !Acc2) :- update_lambdas_expr_2(Update, Ho0, Ho, !Acc1, !Acc2), map_foldl2(update_lambdas_expr_2(Update), Args0, Args, !Acc1, !Acc2). :- pred update_lambdas_expr(pred(pre_lambda, pre_lambda, T, T), pre_expr, pre_expr, T, T). :- mode update_lambdas_expr(pred(in, out, in, out) is det, in, out, in, out) is det. update_lambdas_expr(Update, e_call(Call0), e_call(Call), !Acc) :- update_lambdas_call(Update, Call0, Call, !Acc). update_lambdas_expr(Update, e_match(Expr0, Cases0), e_match(Expr, Cases), !Acc) :- update_lambdas_expr(Update, Expr0, Expr, !Acc), map_foldl(update_lambdas_case(Update), Cases0, Cases, !Acc). update_lambdas_expr(_, e_var(Var), e_var(Var), !Acc). update_lambdas_expr(Update, e_construction(Ctors, Args0), e_construction(Ctors, Args), !Acc) :- map_foldl(update_lambdas_expr(Update), Args0, Args, !Acc). update_lambdas_expr(Update, e_lambda(Lambda0), e_lambda(Lambda), !Acc) :- Update(Lambda0, Lambda, !Acc). update_lambdas_expr(_, e_constant(Const), e_constant(Const), !Acc). :- pred update_lambdas_expr_2(pred(pre_lambda, pre_lambda, T, T, U, U), pre_expr, pre_expr, T, T, U, U). :- mode update_lambdas_expr_2(pred(in, out, in, out, in, out) is det, in, out, in, out, in, out) is det. update_lambdas_expr_2(Update, e_call(Call0), e_call(Call), !Acc1, !Acc2) :- update_lambdas_call_2(Update, Call0, Call, !Acc1, !Acc2). update_lambdas_expr_2(Update, e_match(Expr0, Cases0), e_match(Expr, Cases), !Acc1, !Acc2) :- update_lambdas_expr_2(Update, Expr0, Expr, !Acc1, !Acc2), map_foldl2(update_lambdas_case_2(Update), Cases0, Cases, !Acc1, !Acc2). update_lambdas_expr_2(_, e_var(Var), e_var(Var), !Acc1, !Acc2). update_lambdas_expr_2(Update, e_construction(Ctors, Args0), e_construction(Ctors, Args), !Acc1, !Acc2) :- map_foldl2(update_lambdas_expr_2(Update), Args0, Args, !Acc1, !Acc2). update_lambdas_expr_2(Update, e_lambda(Lambda0), e_lambda(Lambda), !Acc1, !Acc2) :- Update(Lambda0, Lambda, !Acc1, !Acc2). update_lambdas_expr_2(_, e_constant(Const), e_constant(Const), !Acc1, !Acc2). :- pred update_lambdas_case(pred(pre_lambda, pre_lambda, T, T), pre_expr_case, pre_expr_case, T, T). :- mode update_lambdas_case(pred(in, out, in, out) is det, in, out, in, out) is det. update_lambdas_case(Update, pre_e_case(Pat, Expr0), pre_e_case(Pat, Expr), !Acc) :- map_foldl(update_lambdas_expr(Update), Expr0, Expr, !Acc). :- pred update_lambdas_case_2(pred(pre_lambda, pre_lambda, T, T, U, U), pre_expr_case, pre_expr_case, T, T, U, U). :- mode update_lambdas_case_2(pred(in, out, in, out, in, out) is det, in, out, in, out, in, out) is det. update_lambdas_case_2(Update, pre_e_case(Pat, Expr0), pre_e_case(Pat, Expr), !Acc1, !Acc2) :- map_foldl2(update_lambdas_expr_2(Update), Expr0, Expr, !Acc1, !Acc2). %-----------------------------------------------------------------------% get_all_lambdas_stmts(Stmts) = condense(map(get_all_lambdas_stmt, Stmts)). :- func get_all_lambdas_stmt(pre_statement) = list(pre_lambda). get_all_lambdas_stmt(pre_statement(Type, _)) = Lambdas :- ( Type = s_call(Call), Lambdas = get_all_lambdas_call(Call) ; Type = s_decl_vars(_), Lambdas = [] ; Type = s_assign(_, Exprs), Lambdas = condense(map(get_all_lambdas_expr, Exprs)) ; Type = s_return(_), Lambdas = [] ; Type = s_match(_, Cases), Lambdas = condense(map(get_all_lambdas_case, Cases)) ). :- func get_all_lambdas_call(pre_call) = list(pre_lambda). get_all_lambdas_call(Call) = condense(map(get_all_lambdas_expr, Args)) :- ( Call = pre_call(_, Args, _) ; Call = pre_ho_call(_, Args, _) ). :- func get_all_lambdas_expr(pre_expr) = list(pre_lambda). get_all_lambdas_expr(Expr) = Lambdas :- ( Expr = e_call(Call), Lambdas = get_all_lambdas_call(Call) ; Expr = e_match(MatchExpr, Cases), Lambdas = get_all_lambdas_expr(MatchExpr) ++ condense(map( func(pre_e_case(_, Es)) = condense(map(get_all_lambdas_expr, Es)), Cases)) ; ( Expr = e_var(_) ; Expr = e_constant(_) ), Lambdas = [] ; Expr = e_construction(_, Args), Lambdas = condense(map(get_all_lambdas_expr, Args)) ; Expr = e_lambda(Lambda), Lambdas = [Lambda] ). :- func get_all_lambdas_case(pre_case) = list(pre_lambda). get_all_lambdas_case(pre_case(_, Stmts)) = get_all_lambdas_stmts(Stmts). %-----------------------------------------------------------------------% %-----------------------------------------------------------------------% ================================================ FILE: src/pz.bytecode.m ================================================ %-----------------------------------------------------------------------% % vim: ts=4 sw=4 et %-----------------------------------------------------------------------% :- module pz.bytecode. % % Common code for reading or writing PZ bytecode. % % Copyright (C) Plasma Team % Distributed under the terms of the MIT License see ../LICENSE.code % %-----------------------------------------------------------------------% :- interface. :- import_module maybe. :- import_module common_types. :- import_module pz.code. %-----------------------------------------------------------------------% :- type code_entry_type ---> code_instr ; code_meta_context ; code_meta_context_short ; code_meta_context_nil. :- inst code_entry_type_context for code_entry_type/0 ---> code_meta_context ; code_meta_context_short ; code_meta_context_nil. %-----------------------------------------------------------------------% % Instruction encoding %-----------------------------------------------------------------------% :- type pz_opcode ---> pzo_load_immediate_num ; pzo_ze ; pzo_se ; pzo_trunc ; pzo_add ; pzo_sub ; pzo_mul ; pzo_div ; pzo_mod ; pzo_lshift ; pzo_rshift ; pzo_and ; pzo_or ; pzo_xor ; pzo_lt_u ; pzo_lt_s ; pzo_gt_u ; pzo_gt_s ; pzo_eq ; pzo_not ; pzo_drop ; pzo_roll ; pzo_pick ; pzo_call ; pzo_call_import ; pzo_call_ind ; pzo_call_proc ; pzo_tcall ; pzo_tcall_import ; pzo_tcall_ind ; pzo_tcall_proc ; pzo_cjmp ; pzo_jmp ; pzo_ret ; pzo_alloc ; pzo_make_closure ; pzo_load ; pzo_store ; pzo_get_env. :- type maybe_operand_width ---> one_width(pz_width) ; two_widths(pz_width, pz_width) ; no_width. :- pred instruction(pz_instr, pz_opcode, maybe_operand_width, maybe(pz_immediate_value)). :- mode instruction(in, out, out, out) is det. :- mode instruction(out, in, in, in) is semidet. :- type num_needed_widths ---> one_width ; two_widths ; no_width. % This type represents intermediate values within the instruction % stream, such as labels and stack depths. The related immediate_value % type, represents only the types of immediate values that can be loaded % with the pzi_load_immediate instruction. % :- type immediate_needed ---> im_none ; im_num ; im_closure ; im_proc ; im_import ; im_struct ; im_struct_field ; im_label ; im_depth. % A stack depth % Instruction encoding information. :- pred instruction_encoding(pz_opcode, num_needed_widths, immediate_needed). :- mode instruction_encoding(in, out, out) is det. %-----------------------------------------------------------------------% % This type represents intermediate values within the instruction % stream, such as labels and stack depths. The related immediate_value % type, represents only the types of immediate values that can be loaded % with the pzi_load_immediate instruction. % :- type pz_immediate_value ---> pz_im_i8(int8) ; pz_im_u8(uint8) ; pz_im_i16(int16) ; pz_im_u16(uint16) ; pz_im_i32(int32) ; pz_im_u32(uint32) ; pz_im_i64(int64) ; pz_im_u64(uint64) ; pz_im_closure(pzc_id) ; pz_im_proc(pzp_id) ; pz_im_import(pzi_id) ; pz_im_struct(pzs_id) ; pz_im_struct_field(pzs_id, field_num) ; pz_im_label(pzb_id) ; pz_im_depth(int). % A stack depth %-----------------------------------------------------------------------% %-----------------------------------------------------------------------% :- implementation. :- import_module list. :- pragma foreign_decl("C", include_file("../runtime/pz_common.h")). :- pragma foreign_decl("C", include_file("../runtime/pz_instructions.h")). %-----------------------------------------------------------------------% :- pragma foreign_enum("C", code_entry_type/0, [ code_instr - "PZ_CODE_INSTR", code_meta_context - "PZ_CODE_META_CONTEXT", code_meta_context_short - "PZ_CODE_META_CONTEXT_SHORT", code_meta_context_nil - "PZ_CODE_META_CONTEXT_NIL" ]). %-----------------------------------------------------------------------% % Instruction encoding %-----------------------------------------------------------------------% :- pragma foreign_enum("C", pz_opcode/0, [ pzo_load_immediate_num - "PZI_LOAD_IMMEDIATE_NUM", pzo_ze - "PZI_ZE", pzo_se - "PZI_SE", pzo_trunc - "PZI_TRUNC", pzo_add - "PZI_ADD", pzo_sub - "PZI_SUB", pzo_mul - "PZI_MUL", pzo_div - "PZI_DIV", pzo_mod - "PZI_MOD", pzo_lshift - "PZI_LSHIFT", pzo_rshift - "PZI_RSHIFT", pzo_and - "PZI_AND", pzo_or - "PZI_OR", pzo_xor - "PZI_XOR", pzo_lt_u - "PZI_LT_U", pzo_lt_s - "PZI_LT_S", pzo_gt_u - "PZI_GT_U", pzo_gt_s - "PZI_GT_S", pzo_eq - "PZI_EQ", pzo_not - "PZI_NOT", pzo_drop - "PZI_DROP", pzo_roll - "PZI_ROLL", pzo_pick - "PZI_PICK", pzo_call - "PZI_CALL", pzo_call_import - "PZI_CALL_IMPORT", pzo_call_ind - "PZI_CALL_IND", pzo_call_proc - "PZI_CALL_PROC", pzo_tcall - "PZI_TCALL", pzo_tcall_import - "PZI_TCALL_IMPORT", pzo_tcall_ind - "PZI_TCALL_IND", pzo_tcall_proc - "PZI_TCALL_PROC", pzo_cjmp - "PZI_CJMP", pzo_jmp - "PZI_JMP", pzo_ret - "PZI_RET", pzo_alloc - "PZI_ALLOC", pzo_make_closure - "PZI_MAKE_CLOSURE", pzo_load - "PZI_LOAD", pzo_store - "PZI_STORE", pzo_get_env - "PZI_GET_ENV" ]). instruction(pzi_load_immediate(W, NI), pzo_load_immediate_num, one_width(W), yes(I)) :- immediate_num(NI, I). instruction(pzi_ze(W1, W2), pzo_ze, two_widths(W1, W2), no). instruction(pzi_se(W1, W2), pzo_se, two_widths(W1, W2), no). instruction(pzi_trunc(W1, W2), pzo_trunc, two_widths(W1, W2), no). instruction(pzi_add(W), pzo_add, one_width(W), no). instruction(pzi_sub(W), pzo_sub, one_width(W), no). instruction(pzi_mul(W), pzo_mul, one_width(W), no). instruction(pzi_div(W), pzo_div, one_width(W), no). instruction(pzi_mod(W), pzo_mod, one_width(W), no). instruction(pzi_lshift(W), pzo_lshift, one_width(W), no). instruction(pzi_rshift(W), pzo_rshift, one_width(W), no). instruction(pzi_and(W), pzo_and, one_width(W), no). instruction(pzi_or(W), pzo_or, one_width(W), no). instruction(pzi_xor(W), pzo_xor, one_width(W), no). instruction(pzi_lt_u(W), pzo_lt_u, one_width(W), no). instruction(pzi_lt_s(W), pzo_lt_s, one_width(W), no). instruction(pzi_gt_u(W), pzo_gt_u, one_width(W), no). instruction(pzi_gt_s(W), pzo_gt_s, one_width(W), no). instruction(pzi_eq(W), pzo_eq, one_width(W), no). instruction(pzi_not(W), pzo_not, one_width(W), no). instruction(pzi_drop, pzo_drop, no_width, no). instruction(pzi_roll(D), pzo_roll, no_width, yes(pz_im_depth(D))). instruction(pzi_pick(D), pzo_pick, no_width, yes(pz_im_depth(D))). instruction(pzi_call(pzc_closure(C)), pzo_call, no_width, yes(pz_im_closure(C))). instruction(pzi_call(pzc_import(I)), pzo_call_import, no_width, yes(pz_im_import(I))). instruction(pzi_call(pzc_proc_opt(P)), pzo_call_proc, no_width, yes(pz_im_proc(P))). instruction(pzi_call_ind, pzo_call_ind, no_width, no). instruction(pzi_tcall(pzc_closure(C)), pzo_tcall, no_width, yes(pz_im_closure(C))). instruction(pzi_tcall(pzc_import(I)), pzo_tcall_import, no_width, yes(pz_im_import(I))). instruction(pzi_tcall(pzc_proc_opt(P)), pzo_tcall_proc, no_width, yes(pz_im_proc(P))). instruction(pzi_tcall_ind, pzo_tcall_ind, no_width, no). instruction(pzi_cjmp(L, W), pzo_cjmp, one_width(W), yes(pz_im_label(L))). instruction(pzi_jmp(L), pzo_jmp, no_width, yes(pz_im_label(L))). instruction(pzi_ret, pzo_ret, no_width, no). instruction(pzi_alloc(S), pzo_alloc, no_width, yes(pz_im_struct(S))). instruction(pzi_make_closure(P), pzo_make_closure, no_width, yes(pz_im_proc(P))). instruction(pzi_load(S, F, W), pzo_load, one_width(W), yes(pz_im_struct_field(S, F))). instruction(pzi_store(S, F, W), pzo_store, one_width(W), yes(pz_im_struct_field(S, F))). instruction(pzi_get_env, pzo_get_env, no_width, no). :- pred immediate_num(immediate_value, pz_immediate_value). :- mode immediate_num(in, out) is det. :- mode immediate_num(out, in) is semidet. immediate_num(im_i8(N), pz_im_i8(N)). immediate_num(im_u8(N), pz_im_u8(N)). immediate_num(im_i16(N), pz_im_i16(N)). immediate_num(im_u16(N), pz_im_u16(N)). immediate_num(im_i32(N), pz_im_i32(N)). immediate_num(im_u32(N), pz_im_u32(N)). immediate_num(im_i64(N), pz_im_i64(N)). immediate_num(im_u64(N), pz_im_u64(N)). instruction_encoding(pzo_load_immediate_num, one_width, im_num). instruction_encoding(pzo_ze, two_widths, im_none). instruction_encoding(pzo_se, two_widths, im_none). instruction_encoding(pzo_trunc, two_widths, im_none). instruction_encoding(pzo_add, one_width, im_none). instruction_encoding(pzo_sub, one_width, im_none). instruction_encoding(pzo_mul, one_width, im_none). instruction_encoding(pzo_div, one_width, im_none). instruction_encoding(pzo_mod, one_width, im_none). instruction_encoding(pzo_lshift, one_width, im_none). instruction_encoding(pzo_rshift, one_width, im_none). instruction_encoding(pzo_and, one_width, im_none). instruction_encoding(pzo_or, one_width, im_none). instruction_encoding(pzo_xor, one_width, im_none). instruction_encoding(pzo_lt_u, one_width, im_none). instruction_encoding(pzo_lt_s, one_width, im_none). instruction_encoding(pzo_gt_u, one_width, im_none). instruction_encoding(pzo_gt_s, one_width, im_none). instruction_encoding(pzo_eq, one_width, im_none). instruction_encoding(pzo_not, one_width, im_none). instruction_encoding(pzo_drop, no_width, im_none). instruction_encoding(pzo_roll, no_width, im_depth). instruction_encoding(pzo_pick, no_width, im_depth). instruction_encoding(pzo_call, no_width, im_closure). instruction_encoding(pzo_call_import, no_width, im_import). instruction_encoding(pzo_call_proc, no_width, im_proc). instruction_encoding(pzo_call_ind, no_width, im_none). instruction_encoding(pzo_tcall, no_width, im_closure). instruction_encoding(pzo_tcall_import, no_width, im_import). instruction_encoding(pzo_tcall_proc, no_width, im_proc). instruction_encoding(pzo_tcall_ind, no_width, im_none). instruction_encoding(pzo_cjmp, one_width, im_label). instruction_encoding(pzo_jmp, no_width, im_label). instruction_encoding(pzo_ret, no_width, im_none). instruction_encoding(pzo_alloc, no_width, im_struct). instruction_encoding(pzo_make_closure, no_width, im_proc). instruction_encoding(pzo_load, one_width, im_struct_field). instruction_encoding(pzo_store, one_width, im_struct_field). instruction_encoding(pzo_get_env, no_width, im_none). %-----------------------------------------------------------------------% %-----------------------------------------------------------------------% ================================================ FILE: src/pz.code.m ================================================ %-----------------------------------------------------------------------% % vim: ts=4 sw=4 et %-----------------------------------------------------------------------% :- module pz.code. % % PZ representation of code. % % Copyright (C) Plasma Team % Distributed under the terms of the MIT License see ../LICENSE.code % %-----------------------------------------------------------------------% :- interface. :- import_module list. :- import_module common_types. :- import_module context. :- import_module maybe. :- import_module q_name. :- type pz_proc ---> pz_proc( pzp_name :: q_name, pzp_signature :: pz_signature, % Procedures imported from other modules will not have a % body. pzp_blocks :: maybe(list(pz_block)) ). % A procedure's signature describes how it behaves with respect to the % parameter stack. % % ( before - after ) % % before is the list of items (left = lower) on the stack before the % call, after is the list of items (left = lower) on the stack after the % call. Of course other things may be on the stack, but this call % promises no to affect them. % % When functions are translated to procedures, parameters are pushed % onto the stack in the order they appear - leftmost parameters are % deeper on the stack, this is the same for return parameters. % % The bytecode interpreter/code generator isn't required to check this, % but it may use this information to generate code - so it must be % correct. % % XXX: varargs % :- type pz_signature ---> pz_signature( pzs_before :: list(pz_width), pzs_after :: list(pz_width) ). :- type pz_block ---> pz_block( pzb_instrs :: list(pz_instr_obj) ). % An instruction object. Is anything that can appear within an % instruction stream including a comment. % :- type pz_instr_obj ---> pzio_instr( pzio_instr :: pz_instr ) ; pzio_context( pzio_context :: pz_context ) ; pzio_comment( pzio_comment :: string ). :- type pz_instr ---> pzi_load_immediate(pz_width, immediate_value) ; pzi_ze(pz_width, pz_width) ; pzi_se(pz_width, pz_width) ; pzi_trunc(pz_width, pz_width) ; pzi_add(pz_width) ; pzi_sub(pz_width) ; pzi_mul(pz_width) ; pzi_div(pz_width) ; pzi_mod(pz_width) ; pzi_lshift(pz_width) ; pzi_rshift(pz_width) ; pzi_and(pz_width) ; pzi_or(pz_width) ; pzi_xor(pz_width) ; pzi_lt_u(pz_width) ; pzi_lt_s(pz_width) ; pzi_gt_u(pz_width) ; pzi_gt_s(pz_width) ; pzi_eq(pz_width) ; pzi_not(pz_width) ; pzi_drop % Roll the top N items on the stack shifting them toward the % left, the deepest item becomes the TOS and all % other items shift along one space deeper (to the left). % roll 1 is a no-op, roll 2 is "swap". ; pzi_roll(int) ; pzi_pick(int) ; pzi_call(pz_callee) ; pzi_tcall(pz_callee) ; pzi_call_ind ; pzi_tcall_ind ; pzi_cjmp(pzb_id, pz_width) ; pzi_jmp(pzb_id) ; pzi_ret ; pzi_alloc(pzs_id) ; pzi_make_closure(pzp_id) ; pzi_load(pzs_id, field_num, pz_width) ; pzi_store(pzs_id, field_num, pz_width) ; pzi_get_env. :- type pz_callee ---> pzc_closure(pzc_id) ; pzc_import(pzi_id) % Being able to refer to a proc directly is an optimisation. ; pzc_proc_opt(pzp_id). % This type represents the kinds of immediate value that can be loaded % onto the stack via the pzi_load_immediate instruction. The related % type pz_immediate_value is more comprehensive and covers intermediate % values within the instruction stream, such as labels and stack depths. % :- type immediate_value ---> im_i8(int8) ; im_u8(uint8) ; im_i16(int16) ; im_u16(uint16) ; im_i32(int32) ; im_u32(uint32) ; im_i64(int64) ; im_u64(uint64). :- type pz_context ---> pz_context( pzic_context :: context, pzic_file_data :: pzd_id ) ; pz_context_short( pzics_line :: int ) ; pz_nil_context. % Block ID % :- type pzb_id == uint32. % % Some aliases for commonly used instructions. % :- func pzi_dup = pz_instr. :- func pzi_swap = pz_instr. %-----------------------------------------------------------------------% :- type pz_entry_signature ---> pz_es_plain ; pz_es_args. %-----------------------------------------------------------------------% %-----------------------------------------------------------------------% :- implementation. %-----------------------------------------------------------------------% pzi_dup = pzi_pick(1). pzi_swap = pzi_roll(2). %-----------------------------------------------------------------------% :- pragma foreign_enum("C", pz_entry_signature/0, [ pz_es_plain - "PZ_OPT_ENTRY_SIG_PLAIN", pz_es_args - "PZ_OPT_ENTRY_SIG_ARGS" ]). %-----------------------------------------------------------------------% %-----------------------------------------------------------------------% ================================================ FILE: src/pz.format.m ================================================ %-----------------------------------------------------------------------% % vim: ts=4 sw=4 et %-----------------------------------------------------------------------% :- module pz.format. % % Common code for the PZ file format. % % Copyright (C) Plasma Team % Distributed under the terms of the MIT License see ../LICENSE.code % %-----------------------------------------------------------------------% :- interface. :- import_module pz.bytecode. :- import_module pz.code. %-----------------------------------------------------------------------% :- func pz_object_magic = uint32. :- func pz_program_magic = uint32. :- func pz_library_magic = uint32. :- func pz_object_id_string = string. :- func pz_object_id_string_part = string. :- func pz_program_id_string = string. :- func pz_program_id_string_part = string. :- func pz_library_id_string = string. :- func pz_library_id_string_part = string. :- func pz_version = uint16. %-----------------------------------------------------------------------% % Constants for encoding option types. :- func pzf_opt_entry_closure = uint16. :- func pzf_opt_entry_candidate = uint16. :- pred pz_signature_byte(pz_entry_signature, uint8). :- mode pz_signature_byte(in, out) is det. :- mode pz_signature_byte(out, in) is semidet. %-----------------------------------------------------------------------% % Constants for encoding data types. :- func pzf_data_array = uint8. :- func pzf_data_struct = uint8. :- func pzf_data_string = uint8. % Encoding type is used for data items, it is used by the code that % reads/writes this static data so that it knows how to interpret each % value. % :- type enc_type ---> t_normal ; t_wfast ; t_wptr ; t_data ; t_import ; t_closure. :- pred pz_enc_byte(enc_type, int, uint8). :- mode pz_enc_byte(in, in, out) is det. :- mode pz_enc_byte(out, out, in) is semidet. %-----------------------------------------------------------------------% :- pred code_entry_byte(code_entry_type, uint8). :- mode code_entry_byte(in, out) is det. :- mode code_entry_byte(out, in) is semidet. %-----------------------------------------------------------------------% :- pred opcode_byte(pz_opcode, uint8). :- mode opcode_byte(in, out) is det. :- mode opcode_byte(out, in) is semidet. :- pred pz_width_byte(pz_width, uint8). :- mode pz_width_byte(in, out) is det. :- mode pz_width_byte(out, in) is semidet. %-----------------------------------------------------------------------% :- pred pz_import_type_byte(pz_import_type, uint8). :- mode pz_import_type_byte(in, out) is det. :- mode pz_import_type_byte(out, in) is semidet. %-----------------------------------------------------------------------% %-----------------------------------------------------------------------% :- implementation. :- import_module uint16. :- pragma foreign_decl("C", include_file("../runtime/pz_common.h")). :- pragma foreign_decl("C", include_file("../runtime/pz_format.h")). %-----------------------------------------------------------------------% :- pragma foreign_proc("C", pz_object_magic = (Magic::out), [will_not_call_mercury, thread_safe, promise_pure], " Magic = PZ_OBJECT_MAGIC_NUMBER; "). :- pragma foreign_proc("C", pz_program_magic = (Magic::out), [will_not_call_mercury, thread_safe, promise_pure], " Magic = PZ_PROGRAM_MAGIC_NUMBER; "). :- pragma foreign_proc("C", pz_library_magic = (Magic::out), [will_not_call_mercury, thread_safe, promise_pure], " Magic = PZ_LIBRARY_MAGIC_NUMBER; "). %-----------------------------------------------------------------------% pz_object_id_string = make_id_string(pz_object_id_string_part). :- pragma foreign_proc("C", pz_object_id_string_part = (X::out), [will_not_call_mercury, thread_safe, promise_pure], " /* * Cast away the const qualifier, Mercury won't modify this string * because it does not have a unique mode. */ X = (char*)PZ_OBJECT_MAGIC_STRING; "). pz_program_id_string = make_id_string(pz_program_id_string_part). :- pragma foreign_proc("C", pz_program_id_string_part = (X::out), [will_not_call_mercury, thread_safe, promise_pure], " /* * Cast away the const qualifier, Mercury won't modify this string * because it does not have a unique mode. */ X = (char*)PZ_PROGRAM_MAGIC_STRING; "). pz_library_id_string = make_id_string(pz_library_id_string_part). :- pragma foreign_proc("C", pz_library_id_string_part = (X::out), [will_not_call_mercury, thread_safe, promise_pure], " /* * Cast away the const qualifier, Mercury won't modify this string * because it does not have a unique mode. */ X = (char*)PZ_LIBRARY_MAGIC_STRING; "). :- func make_id_string(string) = string. make_id_string(Part) = format("%s version %d", [s(Part), i(to_int(pz_version))]). %-----------------------------------------------------------------------% :- pragma foreign_proc("C", pz_version = (X::out), [will_not_call_mercury, thread_safe, promise_pure], "X = PZ_FORMAT_VERSION;"). %-----------------------------------------------------------------------% :- pragma foreign_proc("C", pz_signature_byte(Val::in, Byte::out), [promise_pure, thread_safe, will_not_call_mercury, will_not_throw_exception], " Byte = Val; "). :- pragma foreign_proc("C", pz_signature_byte(Val::out, Byte::in), [promise_pure, thread_safe, will_not_call_mercury, will_not_throw_exception], " SUCCESS_INDICATOR = Byte <= PZ_OPT_ENTRY_SIG_LAST; Val = Byte; "). %-----------------------------------------------------------------------% :- pragma foreign_proc("C", pzf_opt_entry_closure = (X::out), [will_not_call_mercury, thread_safe, promise_pure], "X = PZ_OPT_ENTRY_CLOSURE;"). :- pragma foreign_proc("C", pzf_opt_entry_candidate = (X::out), [will_not_call_mercury, thread_safe, promise_pure], "X = PZ_OPT_ENTRY_CANDIDATE;"). %-----------------------------------------------------------------------% % These are used directly as integers when writing out PZ files, % otherwise this would be a good candidate for a foreign_enum. :- pragma foreign_proc("C", pzf_data_array = (X::out), [will_not_call_mercury, thread_safe, promise_pure], "X = PZ_DATA_ARRAY;"). :- pragma foreign_proc("C", pzf_data_struct = (X::out), [will_not_call_mercury, thread_safe, promise_pure], "X = PZ_DATA_STRUCT;"). :- pragma foreign_proc("C", pzf_data_string = (X::out), [will_not_call_mercury, thread_safe, promise_pure], "X = PZ_DATA_STRING;"). %-----------------------------------------------------------------------% :- pragma foreign_enum("C", enc_type/0, [ t_normal - "pz_data_enc_type_normal", t_wfast - "pz_data_enc_type_fast", t_wptr - "pz_data_enc_type_wptr", t_data - "pz_data_enc_type_data", t_import - "pz_data_enc_type_import", t_closure - "pz_data_enc_type_closure" ]). :- pragma foreign_proc("C", pz_enc_byte(EncType::in, NumBytes::in, EncInt::out), [will_not_call_mercury, promise_pure, thread_safe], " EncInt = PZ_MAKE_ENC(EncType, NumBytes); "). :- pragma foreign_proc("C", pz_enc_byte(EncType::out, NumBytes::out, EncInt::in), [will_not_call_mercury, promise_pure, thread_safe], " EncType = PZ_DATA_ENC_TYPE(EncInt); NumBytes = PZ_DATA_ENC_BYTES(EncInt); SUCCESS_INDICATOR = EncType <= PZ_LAST_DATA_ENC_TYPE; "). %-----------------------------------------------------------------------% :- pragma foreign_proc("C", code_entry_byte(CodeEntry::in, Byte::out), [will_not_call_mercury, promise_pure, thread_safe], "Byte = CodeEntry"). :- pragma foreign_proc("C", code_entry_byte(CodeEntry::out, Byte::in), [will_not_call_mercury, promise_pure, thread_safe], " CodeEntry = Byte; SUCCESS_INDICATOR = CodeEntry < PZ_NUM_CODE_ITEMS; "). %-----------------------------------------------------------------------% :- pragma foreign_proc("C", opcode_byte(OpcodeValue::in, Byte::out), [will_not_call_mercury, promise_pure, thread_safe], "Byte = OpcodeValue"). :- pragma foreign_proc("C", opcode_byte(OpcodeValue::out, Byte::in), [will_not_call_mercury, promise_pure, thread_safe], " OpcodeValue = Byte; SUCCESS_INDICATOR = Byte < PZ_NUM_OPCODES; "). %-----------------------------------------------------------------------% :- pragma foreign_proc("C", pz_width_byte(WidthValue::in, Byte::out), [will_not_call_mercury, promise_pure, thread_safe], "Byte = WidthValue;"). :- pragma foreign_proc("C", pz_width_byte(WidthValue::out, Byte::in), [will_not_call_mercury, promise_pure, thread_safe], " WidthValue = Byte; SUCCESS_INDICATOR = Byte < PZ_NUM_WIDTHS; "). %-----------------------------------------------------------------------% :- pragma foreign_proc("C", pz_import_type_byte(ImportType::in, Byte::out), [will_not_call_mercury, promise_pure, thread_safe], "Byte = ImportType;"). :- pragma foreign_proc("C", pz_import_type_byte(ImportType::out, Byte::in), [will_not_call_mercury, promise_pure, thread_safe], " ImportType = Byte; SUCCESS_INDICATOR = Byte <= PZ_IMPORT_LAST; "). %-----------------------------------------------------------------------% %-----------------------------------------------------------------------% ================================================ FILE: src/pz.link.m ================================================ %-----------------------------------------------------------------------% % Plasma linking code % vim: ts=4 sw=4 et % % Copyright (C) Plasma Team % Distributed under the terms of the MIT License see ../LICENSE.code % % This program links the pz intermediate representation. % %-----------------------------------------------------------------------% :- module pz.link. %-----------------------------------------------------------------------% :- interface. :- import_module maybe. :- import_module q_name. :- import_module util. :- import_module util.result. :- type link_error == string. :- type pzo_link_kind ---> pz_program( pzlkp_entry_point :: maybe(q_name), pzlkp_name :: nq_name ) ; pz_library( pzlkp_export_mods :: list(nq_name) ). :- pred do_link(pzo_link_kind::in, list(pz)::in, result(pz, link_error)::out) is det. %-----------------------------------------------------------------------% %-----------------------------------------------------------------------% :- implementation. :- import_module array. :- import_module assoc_list. :- import_module cord. :- import_module int. :- import_module map. :- import_module pair. :- import_module require. :- import_module set. :- import_module uint32. :- import_module context. :- import_module pz.code. :- import_module pz.bytecode. :- import_module pz.pz_ds. :- import_module util.my_exception. :- import_module util.mercury. %-----------------------------------------------------------------------% do_link(LinkKind, Inputs, Result) :- some [!PZ, !Errors] ( !:Errors = init, ( LinkKind = pz_program(_, Name), FileType = pzft_program, Names = [Name] ; LinkKind = pz_library(Names), FileType = pzft_library ), % Calculate the IDs of all the entries in the new PZ file. Also % build a map from module names to modules and count the various % entries. build_input_maps(Inputs, IdMap, ModNameMap, NumStructs, NumDatas, NumProcs, NumClosures), !:PZ = init_pz(map(q_name, Names), FileType, 0u32, NumStructs, NumDatas, NumProcs, NumClosures), % Build a map of exports. This will be used to determine what can be % linked too. foldl2(build_export_map(!.PZ, IdMap), Inputs, 0, _, init, ExportMap), % Link the files by each entry type at a time, eg: all the structs for % all the inputs, then all the datas for all the inputs. foldl2(link_structs(IdMap), Inputs, 0, _, !PZ), % Process imports, those found in ExportMap will be linked and the % others will become imports in !PZ. foldl3(link_imports(ExportMap), Inputs, 0, _, !PZ, init, CloLinkMap), foldl2(link_datas(IdMap, CloLinkMap), Inputs, 0, _, !PZ), foldl2(link_procs(IdMap, CloLinkMap), Inputs, 0, _, !PZ), foldl2(link_closures(IdMap), Inputs, 0, _, !PZ), % Entrypoints and exports don't need to be polarised for programs % and libraries like this. It'd be possible to have libraries with % entrypoints or programs with exports. But for now we keep things % simple until we work on the tooling. ( LinkKind = pz_program(MaybeEntry, _), link_set_entrypoints(IdMap, ModNameMap, Inputs, MaybeEntry, !PZ, !Errors) ; LinkKind = pz_library(_), foldl2((pred(N::in, PZ0::in, PZ::out, Es0::in, Es::out) is det :- link_set_exports(N, IdMap, ModNameMap, PZ0, PZ, Es0, Es) ), Names, !PZ, !Errors) ), ( if is_empty(!.Errors) then Result = ok(!.PZ) else Result = errors(!.Errors) ) ). :- pred link_set_entrypoints(id_map::in, map(q_name, {int, pz})::in, list(pz)::in, maybe(q_name)::in, pz::in, pz::out, errors(link_error)::in, errors(link_error)::out) is det. link_set_entrypoints(IdMap, ModNameMap, Inputs, MaybeEntry, !PZ, !Errors) :- map_foldl(get_translate_entrypoints(!.PZ, IdMap), Inputs, AllEntrypoints, 0, _), MaybeEntryRes = find_entrypoint(!.PZ, IdMap, Inputs, ModNameMap, MaybeEntry), ( MaybeEntryRes = ok(no) ; MaybeEntryRes = ok(yes(Entry)), pz_entrypoint(Clo, Sig, EntryName) = Entry, pz_export_closure(Clo, EntryName, !PZ), pz_set_entry_closure(Clo, Sig, !PZ), ( if list.delete_first(condense(AllEntrypoints), Entry, CandidateEntrypoints) then foldl(add_entry_candidate, CandidateEntrypoints, !PZ) else unexpected($file, $pred, "Entrypoint not in all entrypoints") ) ; MaybeEntryRes = errors(Errors), add_errors(Errors, !Errors) ). :- pred link_set_exports(nq_name::in, id_map::in, map(q_name, {int, pz})::in, pz::in, pz::out, errors(link_error)::in, errors(link_error)::out) is det. link_set_exports(Name, IdMap, ModNameMap, !PZ, !Errors) :- % If a module has the same name as the library we're building, % then re-export all its exports. ( if search(ModNameMap, q_name(Name), {ModNum, Mod}) then Exports = pz_get_exports(Mod), foldl((pred((N - Cid0)::in, PZ0::in, PZ::out) is det :- Cid = transform_closure_id(PZ0, IdMap, ModNum, Cid0), pz_export_closure(Cid, N, PZ0, PZ) ), Exports, !PZ) else add_error(command_line_context, format("Module '%s' isn't being linked, can't export anything", [s(nq_name_to_string(Name))]), !Errors) ). :- pred add_entry_candidate(pz_entrypoint::in, pz::in, pz::out) is det. add_entry_candidate(pz_entrypoint(Clo, Sig, Name), !PZ) :- pz_export_closure(Clo, Name, !PZ), pz_add_entry_candidate(Clo, Sig, !PZ). %-----------------------------------------------------------------------% :- pred build_export_map(pz::in, id_map::in, pz::in, int::in, int::out, export_map::in, export_map::out) is det. build_export_map(PZ, IdMap, Input, InputNum, InputNum+1, !Exports) :- Exports = from_assoc_list(map((func(Name - Id0) = Name - Id :- Id = transform_closure_id(PZ, IdMap, InputNum, Id0) ), pz_get_exports(Input))), ( if [ModuleName] = pz_get_module_names(Input) then det_insert(ModuleName, Exports, !Exports) else util.my_exception.sorry($file, $pred, "Multiple module names") ). :- pred link_imports(export_map::in, pz::in, int::in, int::out, pz::in, pz::out, link_map::in, link_map::out) is det. link_imports(ModuleMap, Input, InputNum, InputNum+1, !PZ, !LinkMap) :- Imports = pz_get_imports(Input), foldl2(link_imports_2(ModuleMap, InputNum), Imports, !PZ, !LinkMap). :- pred link_imports_2(export_map::in, int::in, pair(pzi_id, pz_import)::in, pz::in, pz::out, link_map::in, link_map::out) is det. link_imports_2(ExportMap0, InputNum, ImportId - Import, !PZ, !LinkMap) :- Import = pz_import(Name, ImportType), ( ImportType = pzit_import, ( if q_name_parts(Name, yes(Module), _), search(ExportMap0, Module, ExportMap), ( if search(ExportMap, Name, ClosureId0) then ClosureId = ClosureId0 else % This could almost be a compilation error, it shouldn't be % possible though but we could reconsider it. unexpected($file, $pred, format("Unknown symbol `%s`\n", [s(q_name_to_string(Name))])) ) then det_insert({InputNum, ImportId}, link_to(ClosureId), !LinkMap) else pz_new_import(NewImportId, Import, !PZ), det_insert({InputNum, ImportId}, link_external(NewImportId), !LinkMap) ) ; ImportType = pzit_foreign, pz_new_import(NewImportId, Import, !PZ), det_insert({InputNum, ImportId}, link_external(NewImportId), !LinkMap) ). :- pred link_structs(id_map::in, pz::in, int::in, int::out, pz::in, pz::out) is det. link_structs(IdMap, Input, InputNum, InputNum+1, !PZ) :- Structs = pz_get_structs(Input), foldl(link_structs_2(IdMap, InputNum), Structs, !PZ). :- pred link_structs_2(id_map::in, int::in, pair(pzs_id, pz_named_struct)::in, pz::in, pz::out) is det. link_structs_2(IdMap, InputNum, SId0 - pz_named_struct(Name, Struct), !PZ) :- SId = transform_struct_id(!.PZ, IdMap, InputNum, SId0), pz_add_struct(SId, Name, Struct, !PZ). :- pred link_datas(id_map::in, link_map::in, pz::in, int::in, int::out, pz::in, pz::out) is det. link_datas(IdMap, LinkMap, Input, InputNum, InputNum+1, !PZ) :- Datas = pz_get_data_items(Input), foldl(link_datas_2(IdMap, LinkMap, InputNum), Datas, !PZ). :- pred link_datas_2(id_map::in, link_map::in, int::in, pair(pzd_id, pz_data)::in, pz::in, pz::out) is det. link_datas_2(IdMap, LinkMap, InputNum, DataId0 - Data0, !PZ) :- Data0 = pz_data(Type0, Values0), ( Type0 = type_array(_, _), Type = Type0 ; Type0 = type_struct(OldId), NewId = transform_struct_id(!.PZ, IdMap, InputNum, OldId), Type = type_struct(NewId) ; Type0 = type_string(_), Type = Type0 ), Values = map(transform_value(!.PZ, IdMap, LinkMap, InputNum), Values0), Data = pz_data(Type, Values), DataId = transform_data_id(!.PZ, IdMap, InputNum, DataId0), pz_add_data(DataId, Data, !PZ). :- pred link_procs(id_map::in, link_map::in, pz::in, int::in, int::out, pz::in, pz::out) is det. link_procs(IdMap, LinkMap, Input, InputNum, InputNum+1, !PZ) :- Procs = pz_get_procs(Input), foldl(link_proc(IdMap, LinkMap, InputNum), Procs, !PZ). :- pred link_proc(id_map::in, link_map::in, int::in, pair(pzp_id, pz_proc)::in, pz::in, pz::out) is det. link_proc(IdMap, LinkMap, Input, ProcId0 - Proc0, !PZ) :- pz_proc(Name, Signature, MaybeBlocks0) = Proc0, ( MaybeBlocks0 = no, MaybeBlocks = no ; MaybeBlocks0 = yes(Blocks0), Blocks = map(link_block(!.PZ, IdMap, LinkMap, Input), Blocks0), MaybeBlocks = yes(Blocks) ), Proc = pz_proc(Name, Signature, MaybeBlocks), ProcId = transform_proc_id(!.PZ, IdMap, Input, ProcId0), pz_add_proc(ProcId, Proc, !PZ). :- func link_block(pz, id_map, link_map, int, pz_block) = pz_block. link_block(PZ, IdMap, LinkMap, Input, pz_block(Instrs)) = pz_block(map(link_instr_obj(PZ, IdMap, LinkMap, Input), Instrs)). :- func link_instr_obj(pz, id_map, link_map, int, pz_instr_obj) = pz_instr_obj. link_instr_obj(PZ, IdMap, LinkMap, Input, pzio_instr(Instr)) = pzio_instr(link_instr(PZ, IdMap, LinkMap, Input, Instr)). link_instr_obj(PZ, IdMap, _, Input, pzio_context(Context)) = pzio_context(link_context(PZ, IdMap, Input, Context)). link_instr_obj(_, _, _, _, pzio_comment(Comment)) = pzio_comment(Comment). :- func link_instr(pz, id_map, link_map, int, pz_instr) = pz_instr. link_instr(PZ, IdMap, LinkMap, Input, Instr0) = Instr :- instruction(Instr0, Opcode, Width, MaybeImm0), ( MaybeImm0 = no, MaybeImm = no ; MaybeImm0 = yes(Imm0), ( ( Imm0 = pz_im_i8(_) ; Imm0 = pz_im_u8(_) ; Imm0 = pz_im_i16(_) ; Imm0 = pz_im_u16(_) ; Imm0 = pz_im_i32(_) ; Imm0 = pz_im_u32(_) ; Imm0 = pz_im_i64(_) ; Imm0 = pz_im_u64(_) ; Imm0 = pz_im_label(_) ; Imm0 = pz_im_depth(_) ), Imm = Imm0 ; Imm0 = pz_im_closure(CloId), Imm = pz_im_closure(transform_closure_id(PZ, IdMap, Input, CloId)) ; Imm0 = pz_im_proc(ProcId), Imm = pz_im_proc(transform_proc_id(PZ, IdMap, Input, ProcId)) ; Imm0 = pz_im_import(ImportId), LinkDest = transform_import_id(LinkMap, Input, ImportId), ( LinkDest = link_to(ClosureId), Imm = pz_im_closure(ClosureId) ; LinkDest = link_external(NewImportId), Imm = pz_im_import(NewImportId) ) ; Imm0 = pz_im_struct(StructId), Imm = pz_im_struct(transform_struct_id(PZ, IdMap, Input, StructId)) ; Imm0 = pz_im_struct_field(StructId, FieldNo), Imm = pz_im_struct_field( transform_struct_id(PZ, IdMap, Input, StructId), FieldNo) ), MaybeImm = yes(Imm) ), ( if instruction(InstrPrime, Opcode, Width, MaybeImm) then Instr = InstrPrime else unexpected($file, $pred, "Instruction encoding bug") ). :- func link_context(pz, id_map, int, pz_context) = pz_context. link_context(PZ, IdMap, InputNum, pz_context(OrigContext, FileData)) = pz_context(OrigContext, transform_data_id(PZ, IdMap, InputNum, FileData)). link_context(_, _, _, pz_context_short(Line)) = pz_context_short(Line). link_context(_, _, _, pz_nil_context) = pz_nil_context. :- pred link_closures(id_map::in, pz::in, int::in, int::out, pz::in, pz::out) is det. link_closures(IdMap, Input, InputNum, InputNum+1, !PZ) :- Closures = pz_get_closures(Input), foldl(link_closure(IdMap, InputNum), Closures, !PZ). :- pred link_closure(id_map::in, int::in, pair(pzc_id, pz_closure)::in, pz::in, pz::out) is det. link_closure(IdMap, InputNum, CID0 - pz_closure(Proc, Data), !PZ) :- Closure = pz_closure( transform_proc_id(!.PZ, IdMap, InputNum, Proc), transform_data_id(!.PZ, IdMap, InputNum, Data)), CID = transform_closure_id(!.PZ, IdMap, InputNum, CID0), pz_add_closure(CID, Closure, !PZ). :- func find_entrypoint(pz, id_map, list(pz), map(q_name, {int, pz}), maybe(q_name)) = result(maybe(pz_entrypoint), link_error). find_entrypoint(PZ, IdMap, _, ModNameMap, yes(EntryName)) = Result :- q_name_parts(EntryName, MbEntryModName, EntryFuncPart), ( MbEntryModName = yes(EntryModName), ( if map.search(ModNameMap, EntryModName, {ModuleNum, Module}) then ( if promise_equivalent_solutions [Entry0] ( search(pz_get_exports(Module), EntryName, EntryClo), member(Entry0, get_entrypoints(Module)), pz_entrypoint(EntryClo, _, _) = Entry0 ) then Result = ok(yes( translate_entrypoint(PZ, IdMap, ModuleNum, Entry0))) else Result = return_error(command_line_context, format( "Module `%s` does not contain an entrypoint named '%s'", [s(q_name_to_string(EntryModName)), s(nq_name_to_string(EntryFuncPart))])) ) else Result = return_error(command_line_context, format("Cannot find entry module `%s`", [s(q_name_to_string(EntryModName))])) ) ; MbEntryModName = no, Result = return_error(command_line_context, format("Entrypoint '%s' is not fully qualified", [s(q_name_to_string(EntryName))])) ). find_entrypoint(PZ, IdMap, Inputs, _, no) = Result :- map_foldl(get_translate_entrypoints(PZ, IdMap), Inputs, Entrypoints0, 0, _), Entrypoints = condense(Entrypoints0), ( if Entrypoints = [Entry] then Result = ok(yes(Entry)) else % We assume we're building a program, libraries will be an explicit % option, so that makes this an error. Result = return_error(nil_context, format("No unique entrypoint found, found %d entrypoints", [i(length(Entrypoints))])) ). :- func get_entrypoints(pz) = list(pz_entrypoint). get_entrypoints(Module) = maybe_list(pz_get_maybe_entry_closure(Module)) ++ to_sorted_list(pz_get_entry_candidates(Module)). :- func translate_entrypoint(pz, id_map, int, pz_entrypoint) = pz_entrypoint. translate_entrypoint(PZ, IdMap, ModuleNum, Entry0) = Entry :- pz_entrypoint(CloId0, Signature, Name) = Entry0, CloId = transform_closure_id(PZ, IdMap, ModuleNum, CloId0), pz_entrypoint(CloId, Signature, Name) = Entry. :- pred get_translate_entrypoints(pz::in, id_map::in, pz::in, list(pz_entrypoint)::out, int::in, int::out) is det. get_translate_entrypoints(PZ, IdMap, Module, Entries, Num, Num + 1) :- Entries = map(translate_entrypoint(PZ, IdMap, Num), get_entrypoints(Module)). %-----------------------------------------------------------------------% :- func transform_value(pz, id_map, link_map, int, pz_data_value) = pz_data_value. transform_value(_, _, _, _, pzv_num(Num)) = pzv_num(Num). transform_value(PZ, IdMap, _, Input, pzv_data(OldId)) = pzv_data(NewId) :- NewId = transform_data_id(PZ, IdMap, Input, OldId). transform_value(_, _, LinkMap, Input, pzv_import(OldId)) = Value :- LinkDest = transform_import_id(LinkMap, Input, OldId), ( LinkDest = link_to(ClosureId), Value = pzv_closure(ClosureId) ; LinkDest = link_external(NewImportId), Value = pzv_import(NewImportId) ). transform_value(PZ, IdMap, _, Input, pzv_closure(OldId)) = pzv_closure(NewId) :- NewId = transform_closure_id(PZ, IdMap, Input, OldId). %-----------------------------------------------------------------------% :- type link_map == map({int, pzi_id}, link_dest). :- type link_dest ---> link_to(pzc_id) ; link_external(pzi_id). :- type id_map ---> id_map( idm_struct_offsets :: array(uint32), idm_data_offsets :: array(uint32), idm_proc_offsets :: array(uint32), idm_closure_offsets :: array(uint32) ). :- type export_map == map(q_name, map(q_name, pzc_id)). :- pred build_input_maps(list(pz)::in, id_map::out, map(q_name, {int, pz})::out, uint32::out, uint32::out, uint32::out, uint32::out) is det. build_input_maps(Inputs, IdMap, NameMap, NumStructs, NumDatas, NumProcs, NumClosures) :- calculate_offsets_and_build_maps(Inputs, 0, 0u32, NumStructs, [], StructOffsetsList, 0u32, NumDatas, [], DataOffsetsList, 0u32, NumProcs, [], ProcOffsetsList, 0u32, NumClosures, [], ClosureOffsetsList, init, NameMap), StructOffsets = array(StructOffsetsList), DataOffsets = array(DataOffsetsList), ProcOffsets = array(ProcOffsetsList), ClosureOffsets = array(ClosureOffsetsList), IdMap = id_map(StructOffsets, DataOffsets, ProcOffsets, ClosureOffsets). :- pred calculate_offsets_and_build_maps(list(pz)::in, int::in, uint32::in, uint32::out, list(uint32)::in, list(uint32)::out, uint32::in, uint32::out, list(uint32)::in, list(uint32)::out, uint32::in, uint32::out, list(uint32)::in, list(uint32)::out, uint32::in, uint32::out, list(uint32)::in, list(uint32)::out, map(q_name, {int, pz})::in, map(q_name, {int, pz})::out) is det. calculate_offsets_and_build_maps([], _, !NumStructs, !StructOffsets, !NumDatas, !DataOffsets, !NumProcs, !ProcOffsets, !NumClosures, !ClosureOffsets, !NameMap) :- reverse(!StructOffsets), reverse(!DataOffsets), reverse(!ProcOffsets), reverse(!ClosureOffsets). calculate_offsets_and_build_maps([Input | Inputs], ModuleNum, !StructOffset, !StructOffsets, !DataOffset, !DataOffsets, !ProcOffset, !ProcOffsets, !ClosureOffset, !ClosureOffsets, !NameMap) :- !:StructOffset = !.StructOffset + pz_get_num_structs(Input), !:StructOffsets = [!.StructOffset | !.StructOffsets], !:DataOffset = !.DataOffset + pz_get_num_datas(Input), !:DataOffsets = [!.DataOffset | !.DataOffsets], !:ProcOffset = !.ProcOffset + pz_get_num_procs(Input), !:ProcOffsets = [!.ProcOffset | !.ProcOffsets], !:ClosureOffset = !.ClosureOffset + pz_get_num_closures(Input), !:ClosureOffsets = [!.ClosureOffset | !.ClosureOffsets], foldl((pred(N::in, NM0::in, NM::out) is det :- ( if insert(N, {ModuleNum, Input}, NM0, NM1) then NM = NM1 else compile_error($file, $pred, "Cannot link two modules containing the same module") ) ), pz_get_module_names(Input), !NameMap), calculate_offsets_and_build_maps(Inputs, ModuleNum + 1, !StructOffset, !StructOffsets, !DataOffset, !DataOffsets, !ProcOffset, !ProcOffsets, !ClosureOffset, !ClosureOffsets, !NameMap). %-----------------------------------------------------------------------% :- func transform_import_id(link_map, int, pzi_id) = link_dest. transform_import_id(LinkMap, InputNum, OldId) = LinkDest :- lookup(LinkMap, {InputNum, OldId}, LinkDest). :- func transform_struct_id(pz, id_map, int, pzs_id) = pzs_id. transform_struct_id(PZ, IdMap, InputNum, OldId) = transform_id(pzs_id_get_num, pzs_id_from_num(PZ), IdMap ^ idm_struct_offsets, InputNum, OldId). :- func transform_data_id(pz, id_map, int, pzd_id) = pzd_id. transform_data_id(PZ, IdMap, InputNum, OldId) = transform_id(pzd_id_get_num, pzd_id_from_num(PZ), IdMap ^ idm_data_offsets, InputNum, OldId). :- func transform_proc_id(pz, id_map, int, pzp_id) = pzp_id. transform_proc_id(PZ, IdMap, InputNum, ProcId) = transform_id(pzp_id_get_num, pzp_id_from_num(PZ), IdMap ^ idm_proc_offsets, InputNum, ProcId). :- func transform_closure_id(pz, id_map, int, pzc_id) = pzc_id. transform_closure_id(PZ, IdMap, InputNum, ClosureId) = transform_id(pzc_id_get_num, pzc_id_from_num(PZ), IdMap ^ idm_closure_offsets, InputNum, ClosureId). :- func transform_id(func(Id) = uint32, pred(uint32, Id), array(uint32), int, Id) = Id. :- mode transform_id(in, pred(in, out) is semidet, in, in, in) = (out) is det. transform_id(GetNum, FromNum, Offsets, InputNum, OldId) = NewId :- ( if InputNum > 0 then OldIdNum = GetNum(OldId), NewIdNum = OldIdNum + Offsets ^ elem(InputNum - 1), ( if FromNum(NewIdNum, NewIdPrime) then NewId = NewIdPrime else unexpected($file, $pred, "Bad id") ) else NewId = OldId ). %-----------------------------------------------------------------------% %-----------------------------------------------------------------------% ================================================ FILE: src/pz.m ================================================ %-----------------------------------------------------------------------% % vim: ts=4 sw=4 et %-----------------------------------------------------------------------% :- module pz. % % Low level plasma data structure. % % Copyright (C) Plasma Team % Distributed under the terms of the MIT License see ../LICENSE.code % %-----------------------------------------------------------------------% :- interface. :- import_module list. :- import_module q_name. :- import_module pz.pz_ds. :- include_module pz.code. :- include_module pz.pretty. :- include_module pz.pz_ds. :- include_module pz.link. :- include_module pz.read. :- include_module pz.write. %-----------------------------------------------------------------------% % % Common definitions % :- type pz_file_type ---> pzft_program ; pzft_library ; pzft_object. % TODO: Separate structs into new entries. Allow arrays of structs. % TODO: Allow data to reference code. % TODO: Re-arrange data and value types to better match the on-disk format. :- type pz_struct ---> pz_struct(list(pz_width)). % A data type. % % Note that types aren't defined recursively. All PZ cares about is the % width and padding of data, so we don't need recursive definitions. % There is one place where recursive definitions would be useful but the % costs outweigh the benefit, and the workaround is simple. % :- type pz_data_type ---> type_array( pza_width :: pz_width, pza_num_items :: int ) ; type_struct( pzs_id :: pzs_id ) ; type_string( pzs_c_units :: int ). % A static data entry % :- type pz_data ---> pz_data(pz_data_type, list(pz_data_value)). :- type pz_closure ---> pz_closure(pzp_id, pzd_id). :- type pz_import_type % Import from another module. ---> pzit_import % Import from foreign code, the imported thing probably has the % same module name as this module. ; pzit_foreign. :- type pz_import ---> pz_import( pzi_name :: q_name, pzi_type :: pz_import_type ). % % PZ isn't typed like a high level language. The only things PZ needs to % know are data widths (for alignment and padding). % :- type pz_width ---> pzw_8 ; pzw_16 ; pzw_32 ; pzw_64 ; pzw_fast ; pzw_ptr. :- type pz_data_value ---> pzv_num(int) ; pzv_data(pzd_id) ; pzv_import(pzi_id) ; pzv_closure(pzc_id). %-----------------------------------------------------------------------% :- type pz_named_struct ---> pz_named_struct( pzs_name :: string, pzs_struct :: pz_struct ). %-----------------------------------------------------------------------% :- func pz_encode_string(string) = pz_data. %-----------------------------------------------------------------------% %-----------------------------------------------------------------------% :- implementation. :- import_module char. :- import_module string. :- include_module pz.bytecode. :- include_module pz.format. %-----------------------------------------------------------------------% :- pragma foreign_decl("C", include_file("../runtime/pz_common.h")). :- pragma foreign_decl("C", include_file("../runtime/pz_format.h")). :- pragma foreign_enum("C", pz_import_type/0, [ pzit_import - "PZ_IMPORT_IMPORT", pzit_foreign - "PZ_IMPORT_FOREIGN" ]). :- pragma foreign_enum("C", pz_width/0, [ pzw_8 - "PZW_8", pzw_16 - "PZW_16", pzw_32 - "PZW_32", pzw_64 - "PZW_64", pzw_fast - "PZW_FAST", pzw_ptr - "PZW_PTR" ]). %-----------------------------------------------------------------------% pz_encode_string(String) = Data :- Values = map(func(C) = pzv_num(to_int(C)), to_char_list(String)), Data = pz_data(type_string(length(Values)), Values). %-----------------------------------------------------------------------% %-----------------------------------------------------------------------% ================================================ FILE: src/pz.pretty.m ================================================ %-----------------------------------------------------------------------% % vim: ts=4 sw=4 et %-----------------------------------------------------------------------% :- module pz.pretty. % % PZ pretty printer % % Copyright (C) Plasma Team % Distributed under the terms of the MIT License see ../LICENSE.code % %-----------------------------------------------------------------------% :- interface. :- import_module cord. :- import_module string. :- func pz_pretty(pz) = cord(string). %-----------------------------------------------------------------------% %-----------------------------------------------------------------------% :- implementation. :- import_module int. :- import_module maybe. :- import_module pair. :- import_module require. :- import_module set. :- import_module uint32. :- import_module context. :- import_module pz.code. :- import_module util. :- import_module util.pretty_old. :- import_module q_name. %-----------------------------------------------------------------------% pz_pretty(PZ) = condense(ModuleDeclsPretty) ++ nl ++ condense(ImportsPretty) ++ nl ++ condense(StructsPretty) ++ nl ++ condense(DataPretty) ++ nl ++ condense(ProcsPretty) ++ nl ++ condense(ClosuresPretty) ++ nl :- ModuleDeclsPretty = from_list(map(module_decl_pretty, pz_get_module_names(PZ))), ImportsPretty = from_list(map(import_pretty, pz_get_imports(PZ))), StructsPretty = from_list(map(struct_pretty, pz_get_structs(PZ))), DataPretty = from_list(map(data_pretty, pz_get_data_items(PZ))), ProcsPretty = from_list(map(proc_pretty(PZ), pz_get_procs(PZ))), ClosuresPretty = from_list(map(closure_pretty(PZ), pz_get_closures(PZ))). :- func module_decl_pretty(q_name) = cord(string). module_decl_pretty(Name) = cord.from_list(["module ", q_name_to_string(Name)]) ++ nl. %-----------------------------------------------------------------------% :- func import_pretty(pair(pzi_id, pz_import)) = cord(string). import_pretty(IID - pz_import(Name, Type)) = from_list([Label, string(pzi_id_get_num(IID)), " ", q_name_to_string(Name), ";\n"]) :- ( Type = pzit_import, Label = "import " ; Type = pzit_foreign, Label = "foreign " ). %-----------------------------------------------------------------------% :- func struct_pretty(pair(pzs_id, pz_named_struct)) = cord(string). struct_pretty(SID - pz_named_struct(Name, pz_struct(Fields))) = String :- SIDNum = pzs_id_get_num(SID), String = from_list(["struct ", Name, "_", string(SIDNum), " = { "]) ++ join(comma ++ spc, map(width_pretty, Fields)) ++ singleton(" }\n"). %-----------------------------------------------------------------------% :- func data_pretty(pair(pzd_id, pz_data)) = cord(string). data_pretty(DID - pz_data(Type, Values)) = String :- DIDNum = pzd_id_get_num(DID), DeclStr = format("data d%d = ", [i(cast_to_int(DIDNum))]), TypeStr = data_type_pretty(Type), DataStr = singleton("{ ") ++ join(spc, map(data_value_pretty, Values)) ++ singleton(" }"), String = singleton(DeclStr) ++ TypeStr ++ spc ++ DataStr ++ semicolon ++ nl. :- func data_type_pretty(pz_data_type) = cord(string). data_type_pretty(type_array(Width, _)) = cons("array(", snoc(width_pretty(Width), ")")). data_type_pretty(type_struct(StructId)) = singleton(StructName) :- StructName = format("struct_%d", [i(cast_to_int(pzs_id_get_num(StructId)))]). data_type_pretty(type_string(_)) = singleton("string"). :- func data_value_pretty(pz_data_value) = cord(string). data_value_pretty(pzv_num(Num)) = singleton(string(Num)). data_value_pretty(Value) = singleton(format("%s%i", [s(Label), i(cast_to_int(IdNum))])) :- ( Value = pzv_data(DID), Label = "d", IdNum = pzd_id_get_num(DID) ; Value = pzv_import(IID), Label = "i", IdNum = pzi_id_get_num(IID) ; Value = pzv_closure(CID), Label = "c", IdNum = pzc_id_get_num(CID) ). %-----------------------------------------------------------------------% :- func proc_pretty(pz, pair(pzp_id, pz_proc)) = cord(string). proc_pretty(PZ, PID - Proc) = String :- Name = pretty_proc_name(PID, Proc), Inputs = Proc ^ pzp_signature ^ pzs_before, Outputs = Proc ^ pzp_signature ^ pzs_after, ParamsStr = join(spc, map(width_pretty, Inputs)) ++ singleton(" - ") ++ join(spc, map(width_pretty, Outputs)), DeclStr = singleton("proc ") ++ singleton(Name) ++ singleton(" (") ++ ParamsStr ++ singleton(")"), MaybeBlocks = Proc ^ pzp_blocks, ( MaybeBlocks = yes(Blocks), ( Blocks = [], unexpected($file, $pred, "no blocks") ; Blocks = [Block], BlocksStr = pretty_block(PZ, Block) ; Blocks = [_, _ | _], map_foldl(pretty_block_with_name(PZ), Blocks, BlocksStr0, 0, _), BlocksStr = cord_list_to_cord(BlocksStr0) ), BodyStr = singleton(" {\n") ++ BlocksStr ++ singleton("}") ; MaybeBlocks = no, BodyStr = init ), String = DeclStr ++ BodyStr ++ semicolon ++ nl ++ nl. :- func pretty_proc_name(pzp_id, pz_proc) = string. pretty_proc_name(PID, Proc) = format("%s_%d", [s(q_name_to_string(Proc ^ pzp_name)), i(cast_to_int(pzp_id_get_num(PID)))]). :- pred pretty_block_with_name(pz::in, pz_block::in, cord(string)::out, int::in, int::out) is det. pretty_block_with_name(PZ, pz_block(Instrs), String, !Num) :- String = indent(2) ++ singleton(format("block b%d {\n", [i(!.Num)])) ++ pretty_instrs(PZ, 4, Instrs) ++ indent(2) ++ singleton("}\n"), !:Num = !.Num + 1. :- func pretty_block(pz, pz_block) = cord(string). pretty_block(PZ, pz_block(Instrs)) = pretty_instrs(PZ, 2, Instrs). :- func pretty_instrs(pz, int, list(pz_instr_obj)) = cord(string). pretty_instrs(_, _, []) = init. pretty_instrs(PZ, Indent, [Instr | Instrs]) = indent(Indent) ++ pretty_instr_obj(PZ, Instr) ++ nl ++ pretty_instrs(PZ, Indent, Instrs). :- func pretty_instr_obj(pz, pz_instr_obj) = cord(string). pretty_instr_obj(PZ, pzio_instr(Instr)) = pretty_instr(PZ, Instr). pretty_instr_obj(_, pzio_context(PZContext)) = Pretty :- ( PZContext = pz_context(Context, _), Pretty = comment ++ singleton(context_string(Context)) ; PZContext = pz_context_short(Line), Pretty = comment ++ singleton(":" ++ string(Line)) ; PZContext = pz_nil_context, Pretty = empty ). pretty_instr_obj(_, pzio_comment(Comment)) = comment ++ singleton(Comment). :- func pretty_instr(pz, pz_instr) = cord(string). pretty_instr(PZ, Instr) = String :- ( Instr = pzi_load_immediate(Width, Value), ( ( Value = im_i8(Num), NumStr = string(Num) ; Value = im_u8(Num), NumStr = string(Num) ; Value = im_i16(Num), NumStr = string(Num) ; Value = im_u16(Num), NumStr = string(Num) ; Value = im_i32(Num), NumStr = string(Num) ; Value = im_u32(Num), NumStr = string(Num) ; Value = im_i64(Num), NumStr = string(Num) ; Value = im_u64(Num), NumStr = string(Num) ), String = singleton(NumStr) ++ colon ++ width_pretty(Width) ) ; ( Instr = pzi_ze(Width1, Width2), Name = "ze" ; Instr = pzi_se(Width1, Width2), Name = "se" ; Instr = pzi_trunc(Width1, Width2), Name = "trunc" ), String = singleton(Name) ++ colon ++ width_pretty(Width1) ++ comma ++ width_pretty(Width2) ; ( Instr = pzi_add(Width), Name = "add" ; Instr = pzi_sub(Width), Name = "sub" ; Instr = pzi_mul(Width), Name = "mul" ; Instr = pzi_div(Width), Name = "div" ; Instr = pzi_mod(Width), Name = "mod" ; Instr = pzi_lshift(Width), Name = "lshift" ; Instr = pzi_rshift(Width), Name = "rshift" ; Instr = pzi_and(Width), Name = "and" ; Instr = pzi_or(Width), Name = "or" ; Instr = pzi_xor(Width), Name = "xor" ; Instr = pzi_lt_u(Width), Name = "lt_u" ; Instr = pzi_lt_s(Width), Name = "lt_s" ; Instr = pzi_gt_u(Width), Name = "gt_u" ; Instr = pzi_gt_s(Width), Name = "gt_s" ; Instr = pzi_eq(Width), Name = "eq" ; Instr = pzi_not(Width), Name = "not" ; Instr = pzi_cjmp(Dest, Width), Name = format("cjmp b%d", [i(cast_to_int(Dest))]) ), String = singleton(Name) ++ colon ++ width_pretty(Width) ; ( Instr = pzi_call(Callee), InstrName = "call" ; Instr = pzi_tcall(Callee), InstrName = "tcall" ), ( Callee = pzc_closure(CID), CalleeName = format("closure_%d", [i( cast_to_int(pzc_id_get_num(CID)))]) ; ( Callee = pzc_import(IID), CalleeSym = pz_lookup_import(PZ, IID) ^ pzi_name ; Callee = pzc_proc_opt(PID), CalleeSym = pz_lookup_proc(PZ, PID) ^ pzp_name ), CalleeName = q_name_to_string(CalleeSym) ), String = singleton(InstrName) ++ spc ++ singleton(CalleeName) ; ( Instr = pzi_drop, Name = "drop" ; Instr = pzi_call_ind, Name = "call_ind" ; Instr = pzi_tcall_ind, Name = "tcall_ind" ; Instr = pzi_jmp(Dest), Name = format("jmp %d", [i(cast_to_int(Dest))]) ; Instr = pzi_ret, Name = "ret" ; Instr = pzi_get_env, Name = "get_env" ), String = singleton(Name) ; ( Instr = pzi_roll(N), Name = "roll " ; Instr = pzi_pick(N), Name = "pick " ), String = singleton(Name) ++ singleton(string(N)) ; Instr = pzi_alloc(Struct), String = singleton(format("alloc struct_%d", [i(cast_to_int(pzs_id_get_num(Struct)))])) ; Instr = pzi_make_closure(Proc), String = singleton(format("make_closure_%d", [i(cast_to_int(pzp_id_get_num(Proc)))])) ; ( Instr = pzi_load(Struct, Field, Width), Name = "load" ; Instr = pzi_store(Struct, Field, Width), Name = "store" ), String = singleton(Name) ++ colon ++ width_pretty(Width) ++ spc ++ singleton(string(pzs_id_get_num(Struct))) ++ spc ++ singleton(string(Field)) ). %-----------------------------------------------------------------------% :- func closure_pretty(pz, pair(pzc_id, pz_closure)) = cord(string). closure_pretty(PZ, Id - pz_closure(ProcId, DataId)) = CloPretty ++ EntryPretty :- Proc = pz_lookup_proc(PZ, ProcId), ProcName = pretty_proc_name(ProcId, Proc), DataName = format("d%d", [i(cast_to_int(pzd_id_get_num(DataId)))]), CloPretty = ExportPretty ++ from_list( ["closure ", Name, " = ", ProcName, " ", DataName, ";\n"]), ( if find_first_match((pred((_ - EId)::in) is semidet :- Id = EId ), pz_get_exports(PZ), Export), Export = ExportName0 - Id then ExportPretty = singleton("export "), Name = q_name_to_string(ExportName0) else ExportPretty = init, Name = format("clo_%d", [i(cast_to_int(pzc_id_get_num(Id)))]) ), ( if ( if pz_get_maybe_entry_closure(PZ) = yes(Entry), Id = Entry ^ pz_ep_closure then Type = "default " else if member(Entry, pz_get_entry_candidates(PZ)), Id = Entry ^ pz_ep_closure then Type = "candidate " else false ) then EntryPretty = from_list(["entry ", Type, Name, ";\n"]) else EntryPretty = init ). %-----------------------------------------------------------------------% :- func width_pretty(pz_width) = cord(string). width_pretty(Width) = singleton(width_pretty_str(Width)). :- func width_pretty_str(pz_width) = string. width_pretty_str(pzw_8) = "w8". width_pretty_str(pzw_16) = "w16". width_pretty_str(pzw_32) = "w32". width_pretty_str(pzw_64) = "w64". % TODO: check that these match what the parser expects, standardize on some % names for these throughout the system. width_pretty_str(pzw_fast) = "w". width_pretty_str(pzw_ptr) = "ptr". :- func comment = cord(string). comment = singleton("// "). %-----------------------------------------------------------------------% %-----------------------------------------------------------------------% ================================================ FILE: src/pz.pz_ds.m ================================================ %-----------------------------------------------------------------------% % vim: ts=4 sw=4 et %-----------------------------------------------------------------------% :- module pz.pz_ds. % % Low level plasma data structure. % % Copyright (C) Plasma Team % Distributed under the terms of the MIT License see ../LICENSE.code % %-----------------------------------------------------------------------% :- interface. :- import_module assoc_list. :- import_module map. :- import_module maybe. :- import_module set. :- import_module pz.code. :- import_module q_name. %-----------------------------------------------------------------------% % Structure ID % :- type pzs_id. :- func pzs_id_get_num(pzs_id) = uint32. :- pred pzs_id_from_num(pz::in, uint32::in, pzs_id::out) is semidet. % Imported procedure ID % :- type pzi_id. :- func pzi_id_get_num(pzi_id) = uint32. :- pred pzi_id_from_num(pz::in, uint32::in, pzi_id::out) is semidet. % Procedure ID % :- type pzp_id. :- func pzp_id_get_num(pzp_id) = uint32. :- pred pzp_id_from_num(pz::in, uint32::in, pzp_id::out) is semidet. % Data ID % :- type pzd_id. :- func pzd_id_get_num(pzd_id) = uint32. :- pred pzd_id_from_num(pz::in, uint32::in, pzd_id::out) is semidet. % Closure ID % :- type pzc_id. :- func pzc_id_get_num(pzc_id) = uint32. :- pred pzc_id_from_num(pz::in, uint32::in, pzc_id::out) is semidet. %-----------------------------------------------------------------------% :- type pz. %-----------------------------------------------------------------------% % init_pz(ModuleNames, FileType) % init_pz(ModuleNames, FileType, NumImports, NumStructs, NumProcs, NumDatas, % NumClosures). % :- func init_pz(list(q_name), pz_file_type) = pz. :- func init_pz(list(q_name), pz_file_type, uint32, uint32, uint32, uint32, uint32) = pz. %-----------------------------------------------------------------------% :- func pz_get_module_names(pz) = list(q_name). :- func pz_get_file_type(pz) = pz_file_type. %-----------------------------------------------------------------------% :- type pz_entrypoint ---> pz_entrypoint( pz_ep_closure :: pzc_id, pz_ep_signature :: pz_entry_signature, pz_ep_name :: q_name ). :- pred pz_set_entry_closure(pzc_id::in, pz_entry_signature::in, pz::in, pz::out) is det. :- func pz_get_maybe_entry_closure(pz) = maybe(pz_entrypoint). :- pred pz_add_entry_candidate(pzc_id::in, pz_entry_signature::in, pz::in, pz::out) is det. :- func pz_get_entry_candidates(pz) = set(pz_entrypoint). %-----------------------------------------------------------------------% :- func pz_get_structs(pz) = assoc_list(pzs_id, pz_named_struct). :- func pz_get_num_structs(pz) = uint32. :- func pz_get_struct_names_map(pz) = map(pzs_id, string). :- func pz_lookup_struct(pz, pzs_id) = pz_struct. :- pred pz_new_struct_id(pzs_id::out, string::in, pz::in, pz::out) is det. :- pred pz_add_struct(pzs_id::in, pz_struct::in, pz::in, pz::out) is det. :- pred pz_add_struct(pzs_id::in, string::in, pz_struct::in, pz::in, pz::out) is det. %-----------------------------------------------------------------------% :- func pz_get_imports(pz) = assoc_list(pzi_id, pz_import). :- func pz_get_num_imports(pz) = uint32. :- func pz_lookup_import(pz, pzi_id) = pz_import. :- pred pz_new_import(pzi_id::out, pz_import::in, pz::in, pz::out) is det. :- pred pz_add_import(pzi_id::in, pz_import::in, pz::in, pz::out) is det. %-----------------------------------------------------------------------% :- pred pz_new_proc_id(pzp_id::out, pz::in, pz::out) is det. :- pred pz_add_proc(pzp_id::in, pz_proc::in, pz::in, pz::out) is det. :- func pz_get_procs(pz) = assoc_list(pzp_id, pz_proc). :- func pz_lookup_proc(pz, pzp_id) = pz_proc. :- func pz_get_num_procs(pz) = uint32. %-----------------------------------------------------------------------% :- pred pz_new_data_id(pzd_id::out, pz::in, pz::out) is det. :- pred pz_add_data(pzd_id::in, pz_data::in, pz::in, pz::out) is det. :- func pz_lookup_data(pz, pzd_id) = pz_data. :- func pz_get_data_items(pz) = assoc_list(pzd_id, pz_data). :- func pz_get_num_datas(pz) = uint32. %-----------------------------------------------------------------------% :- pred pz_new_closure_id(pzc_id::out, pz::in, pz::out) is det. :- pred pz_add_closure(pzc_id::in, pz_closure::in, pz::in, pz::out) is det. :- func pz_get_closures(pz) = assoc_list(pzc_id, pz_closure). :- func pz_get_num_closures(pz) = uint32. %-----------------------------------------------------------------------% :- func pz_get_exports(pz) = assoc_list(q_name, pzc_id) is det. :- pred pz_export_closure(pzc_id::in, q_name::in, pz::in, pz::out) is det. %-----------------------------------------------------------------------% %-----------------------------------------------------------------------% :- implementation. :- import_module pair. :- import_module require. :- import_module uint32. %-----------------------------------------------------------------------% :- type pzs_id ---> pzs_id(pzs_id_num :: uint32). pzs_id_get_num(pzs_id(Num)) = Num. pzs_id_from_num(PZ, Num, pzs_id(Num)) :- Num < PZ ^ pz_next_struct_id ^ pzs_id_num. %-----------------------------------------------------------------------% :- type pzi_id ---> pzi_id(pzi_id_num :: uint32). pzi_id_get_num(pzi_id(Num)) = Num. pzi_id_from_num(PZ, Num, pzi_id(Num)) :- Num < PZ ^ pz_next_import_id ^ pzi_id_num. %-----------------------------------------------------------------------% :- type pzp_id ---> pzp_id(pzp_id_num :: uint32). pzp_id_get_num(pzp_id(Num)) = Num. pzp_id_from_num(PZ, Num, pzp_id(Num)) :- Num < PZ ^ pz_next_proc_id ^ pzp_id_num. %-----------------------------------------------------------------------% :- type pzd_id ---> pzd_id(pzd_id_num :: uint32). pzd_id_get_num(pzd_id(Num)) = Num. pzd_id_from_num(PZ, Num, pzd_id(Num)) :- Num < PZ ^ pz_next_data_id ^ pzd_id_num. %-----------------------------------------------------------------------% :- type pzc_id ---> pzc_id(pzc_id_num :: uint32). pzc_id_get_num(pzc_id(Num)) = Num. pzc_id_from_num(PZ, Num, pzc_id(Num)) :- Num < PZ ^ pz_next_closure_id ^ pzc_id_num. %-----------------------------------------------------------------------% :- type pz ---> pz( pz_module_names :: list(q_name), pz_file_type :: pz_file_type, pz_structs :: map(pzs_id, {string, maybe(pz_struct)}), pz_next_struct_id :: pzs_id, pz_imports :: map(pzi_id, pz_import), pz_next_import_id :: pzi_id, pz_procs :: map(pzp_id, pz_proc), pz_next_proc_id :: pzp_id, pz_data :: map(pzd_id, pz_data), pz_next_data_id :: pzd_id, pz_closures :: map(pzc_id, pz_closure_maybe_export), pz_next_closure_id :: pzc_id, pz_maybe_entry :: maybe(pz_entrypoint_internal), pz_entry_candidates :: set(pz_entrypoint_internal) ). :- type pz_closure_maybe_export ---> pz_closure(pz_closure) ; pz_exported_closure(q_name, pz_closure). :- type pz_entrypoint_internal ---> pz_entrypoint_internal( pz_epi_closure :: pzc_id, pz_epi_signature :: pz_entry_signature ). %-----------------------------------------------------------------------% init_pz(ModuleNames, FileType) = pz(ModuleNames, FileType, init, pzs_id(0u32), init, pzi_id(0u32), init, pzp_id(0u32), init, pzd_id(0u32), init, pzc_id(0u32), no, init). init_pz(ModuleNames, FileType, NumImports, NumStructs, NumDatas, NumProcs, NumClosures) = pz( ModuleNames, FileType, init, pzs_id(NumStructs), init, pzi_id(NumImports), init, pzp_id(NumProcs), init, pzd_id(NumDatas), init, pzc_id(NumClosures), no, init). %-----------------------------------------------------------------------% pz_get_module_names(PZ) = PZ ^ pz_module_names. pz_get_file_type(PZ) = PZ ^ pz_file_type. %-----------------------------------------------------------------------% pz_set_entry_closure(Clo, Sig, !PZ) :- Entry = pz_entrypoint_internal(Clo, Sig), expect(unify(no, !.PZ ^ pz_maybe_entry), $file, $pred, "Entry must be unset"), expect(entry_is_exported(!.PZ, Entry), $file, $pred, "Entry must be exported"), !PZ ^ pz_maybe_entry := yes(Entry). pz_get_maybe_entry_closure(PZ) = map_maybe(entrypoint_add_name(PZ), PZ ^ pz_maybe_entry). pz_add_entry_candidate(Closure, Signature, !PZ) :- Entry = pz_entrypoint_internal(Closure, Signature), expect(entry_is_exported(!.PZ, Entry), $file, $pred, "Entry must be exported"), !PZ ^ pz_entry_candidates := insert(!.PZ ^ pz_entry_candidates, Entry). pz_get_entry_candidates(PZ) = map(entrypoint_add_name(PZ), PZ ^ pz_entry_candidates). :- func get_name_of_export(pz, pzc_id) = q_name. get_name_of_export(PZ, Clo) = Name :- Exports = reverse_members(pz_get_exports(PZ)), lookup(Exports, Clo, Name). :- func entrypoint_add_name(pz, pz_entrypoint_internal) = pz_entrypoint. entrypoint_add_name(PZ, pz_entrypoint_internal(Clo, Sig)) = pz_entrypoint(Clo, Sig, get_name_of_export(PZ, Clo)). :- pred entry_is_exported(pz::in, pz_entrypoint_internal::in) is semidet. entry_is_exported(PZ, Entry) :- Closures = map(snd, pz_get_exports(PZ)), member(Entry ^ pz_epi_closure, Closures). %-----------------------------------------------------------------------% pz_get_structs(PZ) = Structs :- filter_map(pred((K - {N, yes(S)})::in, (K - pz_named_struct(N, S))::out) is semidet, to_assoc_list(PZ ^ pz_structs), Structs). pz_get_num_structs(PZ) = pzs_id_get_num(PZ ^ pz_next_struct_id). pz_get_struct_names_map(PZ) = map_values(func(_, {N, _}) = N, PZ ^ pz_structs). pz_lookup_struct(PZ, PZSId) = Struct :- {_, MaybeStruct} = map.lookup(PZ ^ pz_structs, PZSId), ( MaybeStruct = no, unexpected($file, $pred, "Struct not found") ; MaybeStruct = yes(Struct) ). pz_new_struct_id(StructId, Name, !PZ) :- StructId = !.PZ ^ pz_next_struct_id, !PZ ^ pz_next_struct_id := pzs_id(StructId ^ pzs_id_num + 1u32), !PZ ^ pz_structs := det_insert(!.PZ ^ pz_structs, StructId, {Name, no}). pz_add_struct(StructId, Struct, !PZ) :- Structs0 = !.PZ ^ pz_structs, ( if search(Structs0, StructId, {N, _}) then det_update(StructId, {N, yes(Struct)}, Structs0, Structs) else det_insert(StructId, {string(StructId), yes(Struct)}, Structs0, Structs) ), !PZ ^ pz_structs := Structs. pz_add_struct(StructId, Name, Struct, !PZ) :- Structs0 = !.PZ ^ pz_structs, map.set(StructId, {Name, yes(Struct)}, Structs0, Structs), !PZ ^ pz_structs := Structs. %-----------------------------------------------------------------------% pz_get_imports(PZ) = to_assoc_list(PZ ^ pz_imports). pz_get_num_imports(PZ) = pzi_id_get_num(PZ ^ pz_next_import_id). pz_lookup_import(PZ, ImportId) = lookup(PZ ^ pz_imports, ImportId). pz_new_import(ImportId, Import, !PZ) :- ImportId = !.PZ ^ pz_next_import_id, !PZ ^ pz_next_import_id := pzi_id(ImportId ^ pzi_id_num + 1u32), pz_add_import(ImportId, Import, !PZ). pz_add_import(ImportId, Import, !PZ) :- Imports0 = !.PZ ^ pz_imports, map.det_insert(ImportId, Import, Imports0, Imports), !PZ ^ pz_imports := Imports. %-----------------------------------------------------------------------% pz_new_proc_id(ProcId, !PZ) :- ProcId = !.PZ ^ pz_next_proc_id, !PZ ^ pz_next_proc_id := pzp_id(ProcId ^ pzp_id_num + 1u32). pz_add_proc(ProcID, Proc, !PZ) :- Procs0 = !.PZ ^ pz_procs, map.det_insert(ProcID, Proc, Procs0, Procs), !PZ ^ pz_procs := Procs. pz_get_procs(PZ) = to_assoc_list(PZ ^ pz_procs). pz_lookup_proc(PZ, PID) = map.lookup(PZ ^ pz_procs, PID). pz_get_num_procs(PZ) = pzp_id_num(PZ ^ pz_next_proc_id). %-----------------------------------------------------------------------% pz_new_data_id(NewID, !PZ) :- NewID = !.PZ ^ pz_next_data_id, !PZ ^ pz_next_data_id := pzd_id(NewID ^ pzd_id_num + 1u32). pz_add_data(DataID, Data, !PZ) :- Datas0 = !.PZ ^ pz_data, map.det_insert(DataID, Data, Datas0, Datas), !PZ ^ pz_data := Datas. pz_lookup_data(PZ, DataId) = Data :- lookup(PZ ^ pz_data, DataId, Data). pz_get_data_items(PZ) = to_assoc_list(PZ ^ pz_data). pz_get_num_datas(PZ) = pzd_id_num(PZ ^ pz_next_data_id). %-----------------------------------------------------------------------% pz_new_closure_id(NewID, !PZ) :- NewID = !.PZ ^ pz_next_closure_id, !PZ ^ pz_next_closure_id := pzc_id(NewID ^ pzc_id_num + 1u32). pz_add_closure(ClosureID, Closure, !PZ) :- Closures0 = !.PZ ^ pz_closures, map.det_insert(ClosureID, pz_closure(Closure), Closures0, Closures), !PZ ^ pz_closures := Closures. pz_get_closures(PZ) = map((func(Id - CloEx) = Id - Clo :- ( CloEx = pz_closure(Clo) ; CloEx = pz_exported_closure(_, Clo) ) ), to_assoc_list(PZ ^ pz_closures)). pz_get_num_closures(PZ) = pzc_id_num(PZ ^ pz_next_closure_id). %-----------------------------------------------------------------------% pz_get_exports(PZ) = Exports :- filter_map(is_export_closure, to_assoc_list(PZ ^ pz_closures), Exports). pz_export_closure(Id, Name, !PZ) :- lookup(!.PZ ^ pz_closures, Id, ClosureExport0), ( ClosureExport0 = pz_closure(Closure), ClosureExport = pz_exported_closure(Name, Closure) ; ClosureExport0 = pz_exported_closure(_, _), unexpected($file, $pred, "This closure is already exported") ), set(Id, ClosureExport, !.PZ ^ pz_closures, Closures), !PZ ^ pz_closures := Closures. :- pred is_export_closure(pair(pzc_id, pz_closure_maybe_export)::in, pair(q_name, pzc_id)::out) is semidet. is_export_closure(Id - pz_exported_closure(Name, _), Name - Id). %-----------------------------------------------------------------------% %-----------------------------------------------------------------------% ================================================ FILE: src/pz.read.m ================================================ %-----------------------------------------------------------------------% % vim: ts=4 sw=4 et %-----------------------------------------------------------------------% :- module pz.read. % % Read the PZ bytecode. % % Copyright (C) Plasma Team % Distributed under the terms of the MIT License see ../LICENSE.code % %-----------------------------------------------------------------------% :- interface. :- import_module io. :- import_module maybe. :- import_module string. %-----------------------------------------------------------------------% :- type pz_read_result ---> pz_read_result(pz_file_type, pz). :- pred read_pz(string::in, maybe_error(pz_read_result)::out, io::di, io::uo) is det. %-----------------------------------------------------------------------% %-----------------------------------------------------------------------% :- implementation. :- import_module require. :- import_module uint16. :- import_module uint32. :- import_module uint8. :- import_module common_types. :- import_module constant. :- import_module context. :- import_module int. :- import_module pz.bytecode. :- import_module pz.code. :- import_module pz.format. :- import_module pz.pz_ds. :- import_module q_name. :- import_module util. :- import_module util.my_io. :- import_module util.mercury. :- import_module util.path. %-----------------------------------------------------------------------% read_pz(Filename, Result, !IO) :- open_binary_input(Filename, MaybeInput, !IO), ( MaybeInput = ok(Input), read_pz_2(Input, ResultPZ, !IO), ( ResultPZ = ok(ReadRes), Result = ok(ReadRes) ; ResultPZ = error(Error), Result = error(format("%s: %s", [s(Filename), s(Error)])) ), close_binary_input(Input, !IO) ; MaybeInput = error(Error), Result = error(format("%s: %s", [s(Filename), s(error_message(Error))])) ). :- pred read_pz_2(binary_input_stream::in, maybe_error(pz_read_result)::out, io::di, io::uo) is det. read_pz_2(Input, Result, !IO) :- my_io.read_uint32(Input, MaybeMagic, !IO), read_len_string(Input, MaybeObjectIdString, !IO), my_io.read_uint16(Input, MaybeVersion, !IO), MaybeHeader = combine_read_3(MaybeMagic, MaybeObjectIdString, MaybeVersion), ( MaybeHeader = ok({Magic, ObjectIdString, Version}), check_file_type(Magic, ObjectIdString, Version, ResultCheck), ( ResultCheck = ok(Type), read_options(Input, MaybeOptions, !IO), read_pz_3(Input, Type, MaybePZ0, !IO), MaybePZ1 = combine_read_2(MaybeOptions, MaybePZ0), ( MaybePZ1 = ok({Options, PZ1}), % An error during options processing cannot be detected % until here, after we read the rest of the module then % process the options. process_options(Options, PZ1, OptionsResult), ( OptionsResult = ok(PZ), Result = ok(pz_read_result(Type, PZ)) ; OptionsResult = error(Error), Result = error(Error) ) ; MaybePZ1 = error(Error), Result = error(Error) ) ; ResultCheck = error(Error), Result = error(Error) ) ; MaybeHeader = error(Error), Result = error(Error) ). :- pred check_file_type(uint32::in, string::in, uint16::in, maybe_error(pz_file_type)::out) is det. check_file_type(Magic, String, Version, Result) :- ( if % This has only one solution but Mercury can't figure it out. promise_equivalent_solutions [Type] ( Magic = pz_object_magic, prefix(String, pz_object_id_string_part), Type = pzft_object ; Magic = pz_program_magic, prefix(String, pz_program_id_string_part), Type = pzft_program ; Magic = pz_library_magic, prefix(String, pz_library_id_string_part), Type = pzft_library ) then ( if Version = pz_version then Result = ok(Type) else Result = error(format("Incorrect file verison, need %d got %d", [i(to_int(pz_version)), i(to_int(Version))])) ) else Result = error("Unrecognised file type") ). :- type pz_options_entry ---> poe_entrypoint(uint32, pz_entry_signature, pz_entry_type). :- type pz_entry_type ---> entry_default ; entry_candidate. :- pred read_options(binary_input_stream::in, maybe_error(list(pz_options_entry))::out, io::di, io::uo) is det. read_options(Input, Result, !IO) :- my_io.read_uint16(Input, MaybeNumOptions, !IO), ( MaybeNumOptions = ok(NumOptions), % The file format currently only has one possible option, so just % read it if it's there. read_options_2(Input, to_int(NumOptions), [], Result, !IO) ; MaybeNumOptions = error(Error), Result = error(Error) ). :- pred read_options_2(binary_input_stream::in, int::in, list(pz_options_entry)::in, maybe_error(list(pz_options_entry))::out, io::di, io::uo) is det. read_options_2(Input, Num, RevList0, Result, !IO) :- ( if Num > 0 then read_option_entry(Input, Result0, !IO), ( Result0 = ok(Entry), RevList = [Entry | RevList0], read_options_2(Input, Num - 1, RevList, Result, !IO) ; Result0 = error(Error), Result = error(Error) ) else Result = ok(reverse(RevList0)) ). :- pred read_option_entry(binary_input_stream::in, maybe_error(pz_options_entry)::out, io::di, io::uo) is det. read_option_entry(Input, Result, !IO) :- my_io.read_uint16(Input, MaybeType, !IO), my_io.read_uint16(Input, MaybeLen, !IO), MaybeTypeLen = combine_read_2(MaybeType, MaybeLen), ( MaybeTypeLen = ok({Type, Len}), ( if Type = pzf_opt_entry_closure, Len = 5u16 then read_opt_entrypoint(Input, entry_default, Result, !IO) else if Type = pzf_opt_entry_candidate, Len = 5u16 then read_opt_entrypoint(Input, entry_candidate, Result, !IO) else Result = error("Currupt option") ) ; MaybeTypeLen = error(Error), error(Error) ). :- pred read_opt_entrypoint(io.binary_input_stream::in, pz_entry_type::in, maybe_error(pz_options_entry)::out, io::di, io::uo) is det. read_opt_entrypoint(Input, Type, Result, !IO) :- my_io.read_uint8(Input, MaybeSignatureByte, !IO), my_io.read_uint32(Input, MaybeClosure, !IO), ReadRes = combine_read_2(MaybeSignatureByte, MaybeClosure), ( ReadRes = ok({SignatureByte, Closure}), ( if pz_signature_byte(Signature, SignatureByte) then Result = ok(poe_entrypoint(Closure, Signature, Type)) else Result = error("Unrecognised entry signature byte") ) ; ReadRes = error(Error), Result = error(Error) ). :- pred process_options(list(pz_options_entry)::in, pz::in, maybe_error(pz)::out) is det. process_options([], PZ, ok(PZ)). process_options([Option | Options], !.PZ, Result) :- poe_entrypoint(EntryClo0, Signature, Type) = Option, ( if pzc_id_from_num(!.PZ, EntryClo0, EntryClo) then ( Type = entry_default, pz_set_entry_closure(EntryClo, Signature, !PZ) ; Type = entry_candidate, pz_add_entry_candidate(EntryClo, Signature, !PZ) ), process_options(Options, !.PZ, Result) else Result = error("Invalid closure ID for entry") ). %-----------------------------------------------------------------------% :- pred read_pz_3(binary_input_stream::in, pz_file_type::in, maybe_error(pz)::out, io::di, io::uo) is det. read_pz_3(Input, FileType, Result, !IO) :- my_io.read_uint32(Input, MaybeNumModuleNames, !IO), ( MaybeNumModuleNames = ok(NumModuleNames), read_module_names(Input, NumModuleNames, [], MaybeModuleNames, !IO), my_io.read_uint32(Input, MaybeNumImports, !IO), my_io.read_uint32(Input, MaybeNumStructs, !IO), my_io.read_uint32(Input, MaybeNumDatas, !IO), my_io.read_uint32(Input, MaybeNumProcs, !IO), my_io.read_uint32(Input, MaybeNumClosures, !IO), my_io.read_uint32(Input, MaybeNumExports, !IO), MaybeNums = combine_read_7(MaybeModuleNames, MaybeNumImports, MaybeNumStructs, MaybeNumDatas, MaybeNumProcs, MaybeNumClosures, MaybeNumExports), ( MaybeNums = ok({ModuleNames, NumImports, NumStructs, NumDatas, NumProcs, NumClosures, NumExports}), PZ = init_pz(ModuleNames, FileType, NumImports, NumStructs, NumDatas, NumProcs, NumClosures), read_pz_sections([read_imports(Input, NumImports), read_structs(Input, NumStructs), read_datas(Input, NumDatas), read_procs(Input, NumProcs), read_closures(Input, NumClosures), read_exports(Input, NumExports)], PZ, Result, !IO) ; MaybeNums = error(Error), Result = error(Error) ) ; MaybeNumModuleNames = error(Error), Result = error(Error) ). :- pred read_module_names(binary_input_stream::in, uint32::in, list(q_name)::in, maybe_error(list(q_name))::out, io::di, io::uo) is det. read_module_names(Input, Num, RevModuleNames, MaybeModuleNames, !IO) :- ( if Num > 0u32 then read_dotted_name(Input, MaybeName, !IO), ( MaybeName = ok(Name), read_module_names(Input, Num - 1u32, [Name | RevModuleNames], MaybeModuleNames, !IO) ; MaybeName = error(Error), MaybeModuleNames = error(Error) ) else MaybeModuleNames = ok(reverse(RevModuleNames)) ). :- pred read_pz_sections( list(pred(pz, maybe_error(pz), io, io)), pz, maybe_error(pz), io, io). :- mode read_pz_sections( in(list(pred(in, out, di, uo) is det)), in, out, di, uo) is det. read_pz_sections([], PZ, ok(PZ), !IO). read_pz_sections([Section | Sections], PZ0, Result, !IO) :- Section(PZ0, Result0, !IO), ( Result0 = ok(PZ), read_pz_sections(Sections, PZ, Result, !IO) ; Result0 = error(Error), Result = error(Error) ). %-----------------------------------------------------------------------% :- pred read_imports(binary_input_stream::in, uint32::in, pz::in, maybe_error(pz)::out, io::di, io::uo) is det. read_imports(Input, Num, PZ0, Result, !IO) :- read_items(read_import(Input), (pred(N::in, I::in, PZI0::in, PZI::out) is det :- ( if pzi_id_from_num(PZI0, N, ImportId) then pz_add_import(ImportId, I, PZI0, PZI) else unexpected($file, $pred, "Bad Import Id") ) ), Num, 0u32, PZ0, Result, !IO). :- pred read_import(binary_input_stream::in, T::in, maybe_error(pz_import)::out, io::di, io::uo) is det. read_import(Input, _, Result, !IO) :- read_uint8(Input, MaybeTypeByte, !IO), read_len_string(Input, MaybeModuleName, !IO), read_len_string(Input, MaybeSymbolName, !IO), MaybeReads = combine_read_3(MaybeTypeByte, MaybeModuleName, MaybeSymbolName), ( MaybeReads = ok({TypeByte, ModuleName, SymbolName}), ( if pz_import_type_byte(TypeP, TypeByte) then Type = TypeP else unexpected($file, $pred, "Invalid import type") ), Name = q_name_append_str(q_name_from_dotted_string_det(ModuleName), SymbolName), Result = ok(pz_import(Name, Type)) ; MaybeReads = error(Error), Result = error(Error) ). %-----------------------------------------------------------------------% :- pred read_structs(binary_input_stream::in, uint32::in, pz::in, maybe_error(pz)::out, io::di, io::uo) is det. read_structs(Input, Num, PZ0, Result, !IO) :- read_items(read_struct(Input), (pred(N::in, I::in, PZI0::in, PZI::out) is det :- ( if pzs_id_from_num(PZI0, N, StructId) then pz_add_struct(StructId, I, PZI0, PZI) else unexpected($file, $pred, "Bad Struct Id") ) ), Num, 0u32, PZ0, Result, !IO). :- pred read_struct(binary_input_stream::in, T::in, maybe_error(pz_struct)::out, io::di, io::uo) is det. read_struct(Input, _, Result, !IO) :- read_uint32(Input, MaybeNumFields, !IO), ( MaybeNumFields = ok(NumFields0), NumFields = det_uint32_to_int(NumFields0), read_n(read_width(Input), NumFields, MaybeWidths, !IO), ( MaybeWidths = ok(Widths), Result = ok(pz_struct(Widths)) ; MaybeWidths = error(Error), Result = error(Error) ) ; MaybeNumFields = error(Error), Result = error(Error) ). %-----------------------------------------------------------------------% :- pred read_datas(binary_input_stream::in, uint32::in, pz::in, maybe_error(pz)::out, io::di, io::uo) is det. read_datas(Input, Num, PZ0, Result, !IO) :- read_items(read_data(Input), (pred(N::in, I::in, PZI0::in, PZI::out) is det :- ( if pzd_id_from_num(PZI0, N, DataId) then pz_add_data(DataId, I, PZI0, PZI) else unexpected($file, $pred, "Bad data id") ) ), Num, 0u32, PZ0, Result, !IO). :- pred read_data(binary_input_stream::in, pz::in, maybe_error(pz_data)::out, io::di, io::uo) is det. read_data(Input, PZ, Result, !IO) :- read_data_type(PZ, Input, TypeResult, !IO), ( TypeResult = ok(Type), ( % XXX: Width is unused (#391). ( Type = type_array(_Width, Num) ; Type = type_string(Num), _Width = pzw_8 ), read_data_enc(Input, EncResult, !IO), ( EncResult = ok({EncType, NumBytes}), read_n(read_data_value(PZ, Input, EncType, NumBytes), Num, ValuesResult, !IO) ; EncResult = error(Error0), ValuesResult = error(Error0) ) ; Type = type_struct(StructId), pz_struct(Widths) = pz_lookup_struct(PZ, StructId), read_map(read_data_enc_value(PZ, Input), Widths, ValuesResult, !IO) ), ( ValuesResult = ok(Values), Result = ok(pz_data(Type, Values)) ; ValuesResult = error(Error), Result = error(Error) ) ; TypeResult = error(Error), Result = error(Error) ). :- pred read_data_type(pz::in, binary_input_stream::in, maybe_error(pz_data_type)::out, io::di, io::uo) is det. read_data_type(PZ, Input, Result, !IO) :- read_uint8(Input, MaybeType, !IO), ( MaybeType = ok(Type), ( if Type = pzf_data_array then read_uint16(Input, MaybeNumItems, !IO), read_width(Input, MaybeWidth, !IO), Result0 = combine_read_2(MaybeNumItems, MaybeWidth), ( Result0 = ok({NumItems, Width}), Result = ok(type_array(Width, to_int(NumItems))) ; Result0 = error(Error), Result = error(Error) ) else if Type = pzf_data_struct then read_struct_id(PZ, Input, MaybeStructId, !IO), Result = maybe_error_map(func(Id) = type_struct(Id), MaybeStructId) else if Type = pzf_data_string then read_uint16(Input, MaybeNumUnits, !IO), Result = maybe_error_map(func(NumUnits) = type_string(to_int(NumUnits)), MaybeNumUnits) else Result = error("Unknown data type") ) ; MaybeType = error(Error), Result = error(Error) ). :- pred read_data_enc(binary_input_stream::in, maybe_error({enc_type, int})::out, io::di, io::uo) is det. read_data_enc(Input, Result, !IO) :- read_uint8(Input, MaybeEncByte, !IO), ( MaybeEncByte = ok(EncByte), ( if pz_enc_byte(EncType, NumBytes, EncByte) then Result = ok({EncType, NumBytes}) else Result = error("Unknown encoding type/byte") ) ; MaybeEncByte = error(Error), Result = error(Error) ). :- pred read_data_enc_value(pz::in, binary_input_stream::in, pz_width::in, maybe_error(pz_data_value)::out, io::di, io::uo) is det. read_data_enc_value(PZ, Input, _Width, Result, !IO) :- read_data_enc(Input, EncResult, !IO), ( EncResult = ok({EncType, NumBytes}), % TODO: We don't actually use the Width for how to read values. % That means this is another encoding inefficency (or unused % feature). (Bug #391) read_data_value(PZ, Input, EncType, NumBytes, Result, !IO) ; EncResult = error(Error), Result = error(Error) ). :- pred read_data_value(pz::in, binary_input_stream::in, enc_type::in, int::in, maybe_error(pz_data_value)::out, io::di, io::uo) is det. read_data_value(_, Input, t_normal, NumBytes, Result, !IO) :- ( if NumBytes = 1 then read_uint8(Input, MaybeNum, !IO), Result = maybe_error_map( (func(N) = pzv_num(to_int(N))), MaybeNum) else if NumBytes = 2 then read_uint16(Input, MaybeNum, !IO), Result = maybe_error_map( (func(N) = pzv_num(to_int(N))), MaybeNum) else if NumBytes = 4 then read_uint32(Input, MaybeNum, !IO), Result = maybe_error_map( (func(N) = pzv_num(det_uint32_to_int(N))), MaybeNum) else if NumBytes = 8 then read_uint64(Input, MaybeNum, !IO), Result = maybe_error_map( (func(N) = pzv_num(det_uint64_to_int(N))), MaybeNum) else unexpected($file, $pred, "Unknown encoding") ). read_data_value(_, Input, t_wfast, NumBytes, Result, !IO) :- read_uint32(Input, MaybeNum, !IO), Result = maybe_error_map( (func(N) = pzv_num(det_uint32_to_int(N))), MaybeNum), expect(unify(NumBytes, 4), $file, $pred, "Expected a 32bit value"). read_data_value(_, Input, t_wptr, NumBytes, Result, !IO) :- read_uint32(Input, MaybeNum, !IO), Result = maybe_error_map( (func(N) = pzv_num(det_uint32_to_int(N))), MaybeNum), expect(unify(NumBytes, 4), $file, $pred, "Expected a 32bit value"). read_data_value(PZ, Input, t_data, NumBytes, Result, !IO) :- read_data_id(PZ, Input, MaybeDataId, !IO), Result = maybe_error_map(func(Id) = pzv_data(Id), MaybeDataId), expect(unify(NumBytes, 4), $file, $pred, "Expected a 32bit value"). read_data_value(PZ, Input, t_closure, NumBytes, Result, !IO) :- read_closure_id(PZ, Input, MaybeClosureId, !IO), Result = maybe_error_map(func(Id) = pzv_closure(Id), MaybeClosureId), expect(unify(NumBytes, 4), $file, $pred, "Expected a 32bit value"). read_data_value(PZ, Input, t_import, NumBytes, Result, !IO) :- read_import_id(PZ, Input, MaybeImportId, !IO), Result = maybe_error_map(func(Id) = pzv_import(Id), MaybeImportId), expect(unify(NumBytes, 4), $file, $pred, "Expected a 32bit value"). %-----------------------------------------------------------------------% :- pred read_procs(binary_input_stream::in, uint32::in, pz::in, maybe_error(pz)::out, io::di, io::uo) is det. read_procs(Input, Num, PZ0, Result, !IO) :- read_items(read_proc(Input), (pred(N::in, I::in, PZI0::in, PZI::out) is det :- ( if pzp_id_from_num(PZI0, N, ProcId) then pz_add_proc(ProcId, I, PZI0, PZI) else unexpected($file, $pred, "Bad Proc Id") ) ), Num, 0u32, PZ0, Result, !IO). :- pred read_proc(binary_input_stream::in, pz::in, maybe_error(pz_proc)::out, io::di, io::uo) is det. read_proc(Input, PZ, Result, !IO) :- read_dotted_name(Input, MaybeName, !IO), read_uint32(Input, MaybeNumBlocks, !IO), HeadResult = combine_read_2(MaybeName, MaybeNumBlocks), ( HeadResult = ok({Name, NumBlocks0}), NumBlocks = det_uint32_to_int(NumBlocks0), read_n(read_block(PZ, Input), NumBlocks, MaybeBlocks, !IO), ( MaybeBlocks = ok(Blocks), % XXX: This signature is fake. Signature = pz_signature([], []), Result = ok(pz_proc(Name, Signature, yes(Blocks))) ; MaybeBlocks = error(Error), Result = error(Error) ) ; HeadResult = error(Error), Result = error(Error) ). :- pred read_block(pz::in, binary_input_stream::in, maybe_error(pz_block)::out, io::di, io::uo) is det. read_block(PZ, Input, Result, !IO) :- read_uint32(Input, MaybeNumInstrObjs, !IO), ( MaybeNumInstrObjs = ok(NumInstrObjs0), NumInstrObjs = det_uint32_to_int(NumInstrObjs0), read_n(read_code_item(PZ, Input), NumInstrObjs, MaybeInstrObjs, !IO), Result = maybe_error_map((func(Is) = pz_block(Is)), MaybeInstrObjs) ; MaybeNumInstrObjs = error(Error), Result = error(Error) ). :- pred read_code_item(pz::in, binary_input_stream::in, maybe_error(pz_instr_obj)::out, io::di, io::uo) is det. read_code_item(PZ, Input, Result, !IO) :- read_uint8(Input, TypeByteResult, !IO), ( TypeByteResult = ok(TypeByte), ( if code_entry_byte(Type, TypeByte) then ( Type = code_instr, read_instr(PZ, Input, Result, !IO) ; ( Type = code_meta_context ; Type = code_meta_context_short ; Type = code_meta_context_nil ), read_context(PZ, Input, Type, Result, !IO) ) else Result = error("Invalid code entry type") ) ; TypeByteResult = error(Error), Result = error(Error) ). :- pred read_instr(pz::in, binary_input_stream::in, maybe_error(pz_instr_obj)::out, io::di, io::uo) is det. read_instr(PZ, Input, Result, !IO) :- read_uint8(Input, OpcodeByteResult, !IO), ( OpcodeByteResult = ok(OpcodeByte), ( if opcode_byte(Opcode, OpcodeByte) then instruction_encoding(Opcode, WidthsNeeded, ImmediateNeeded), ( WidthsNeeded = no_width, MaybeWidths = ok(no_width) ; WidthsNeeded = one_width, read_width(Input, MaybeWidth, !IO), MaybeWidths = maybe_error_map(func(W) = one_width(W), MaybeWidth) ; WidthsNeeded = two_widths, read_width(Input, MaybeWidthA, !IO), read_width(Input, MaybeWidthB, !IO), MaybeWidths = maybe_error_map( func({A, B}) = two_widths(A, B), combine_read_2(MaybeWidthA, MaybeWidthB)) ), read_immediate(PZ, Input, ImmediateNeeded, MaybeMaybeImmediate, !IO), MaybeWidthsImmediate = combine_read_2(MaybeWidths, MaybeMaybeImmediate), ( MaybeWidthsImmediate = ok({Widths, MaybeImmediate}), ( if instruction(Instr, Opcode, Widths, MaybeImmediate) then Result = ok(pzio_instr(Instr)) else unexpected($file, $pred, "Error in instruction encoding data for " ++ string(Opcode)) ) ; MaybeWidthsImmediate = error(Error), Result = error(Error) ) else Result = error("Unknown opcode") ) ; OpcodeByteResult = error(Error), Result = error(Error) ). :- pred read_immediate(pz::in, binary_input_stream::in, immediate_needed::in, maybe_error(maybe(pz_immediate_value))::out, io::di, io::uo) is det. read_immediate(_, _, im_none, ok(no), !IO). read_immediate(_, Input, im_num, Result, !IO) :- % XXX: The immediate value is always encoded as a 32 bit number but % this restriction should be lifted. read_int32(Input, MaybeInt, !IO), Result = maybe_error_map(func(N) = yes(pz_im_i32(N)), MaybeInt). read_immediate(PZ, Input, im_closure, Result, !IO) :- read_closure_id(PZ, Input, MaybeClosureId, !IO), Result = maybe_error_map(func(C) = yes(pz_im_closure(C)), MaybeClosureId). read_immediate(PZ, Input, im_proc, Result, !IO) :- read_proc_id(PZ, Input, MaybeProcId, !IO), Result = maybe_error_map(func(P) = yes(pz_im_proc(P)), MaybeProcId). read_immediate(PZ, Input, im_import, Result, !IO) :- read_import_id(PZ, Input, MaybeImportId, !IO), Result = maybe_error_map(func(I) = yes(pz_im_import(I)), MaybeImportId). read_immediate(PZ, Input, im_struct, Result, !IO) :- read_struct_id(PZ, Input, MaybeStructId, !IO), Result = maybe_error_map(func(S) = yes(pz_im_struct(S)), MaybeStructId). read_immediate(PZ, Input, im_struct_field, Result, !IO) :- read_struct_id(PZ, Input, MaybeStructId, !IO), read_uint8(Input, MaybeFieldNo, !IO), MaybeStructField = combine_read_2(MaybeStructId, MaybeFieldNo), Result = maybe_error_map( func({S, F}) = yes(pz_im_struct_field(S, field_num(to_int(F) + 1))), MaybeStructField). read_immediate(_, Input, im_label, Result, !IO) :- read_uint32(Input, MaybeInt, !IO), Result = maybe_error_map(func(L) = yes(pz_im_label(L)), MaybeInt). read_immediate(_, Input, im_depth, Result, !IO) :- read_uint8(Input, MaybeInt, !IO), Result = maybe_error_map(func(D) = yes(pz_im_depth(to_int(D))), MaybeInt). :- pred read_context(pz::in, binary_input_stream::in, code_entry_type::in(code_entry_type_context), maybe_error(pz_instr_obj)::out, io::di, io::uo) is det. read_context(PZ, Input, code_meta_context, Result, !IO) :- read_data_id(PZ, Input, MaybeDataId, !IO), read_uint32(Input, MaybeLine, !IO), MaybeContext = combine_read_2(MaybeDataId, MaybeLine), ( MaybeContext = ok({DataId, Line}), ( if data_get_filename(PZ, DataId, Filename0) then Filename = Filename0 else unexpected($file, $pred, "Bad filename in context information") ), Context = context(Filename, det_uint32_to_int(Line)), Result = ok(pzio_context(pz_context(Context, DataId))) ; MaybeContext = error(Error), Result = error(Error) ). read_context(_, Input, code_meta_context_short, Result, !IO) :- read_uint32(Input, MaybeLine, !IO), Result = maybe_error_map( (func(I) = pzio_context(pz_context_short(det_uint32_to_int(I)))), MaybeLine). read_context(_, _Input, code_meta_context_nil, Result, !IO) :- Result = ok(pzio_context(pz_nil_context)). %-----------------------------------------------------------------------% :- pred read_closures(binary_input_stream::in, uint32::in, pz::in, maybe_error(pz)::out, io::di, io::uo) is det. read_closures(Input, Num, PZ0, Result, !IO) :- read_items(read_closure(Input), (pred(N::in, I::in, PZI0::in, PZI::out) is det :- ( if pzc_id_from_num(PZI0, N, ClosureId) then pz_add_closure(ClosureId, I, PZI0, PZI) else unexpected($file, $pred, "Bad Closure Id") ) ), Num, 0u32, PZ0, Result, !IO). :- pred read_closure(binary_input_stream::in, pz::in, maybe_error(pz_closure)::out, io::di, io::uo) is det. read_closure(Input, PZ, Result, !IO) :- read_proc_id(PZ, Input, MaybeProc, !IO), read_data_id(PZ, Input, MaybeData, !IO), MaybePair = combine_read_2(MaybeProc, MaybeData), Result = maybe_error_map( func({Proc, Data}) = pz_closure(Proc, Data), MaybePair). %-----------------------------------------------------------------------% :- pred read_exports(binary_input_stream::in, uint32::in, pz::in, maybe_error(pz)::out, io::di, io::uo) is det. read_exports(Input, Num, PZ0, Result, !IO) :- read_items(read_export(Input), (pred(_::in, {Name, CloId}::in, PZI0::in, PZI::out) is det :- pz_export_closure(CloId, Name, PZI0, PZI) ), Num, 0u32, PZ0, Result, !IO). :- pred read_export(binary_input_stream::in, pz::in, maybe_error({q_name, pzc_id})::out, io::di, io::uo) is det. read_export(Input, PZ, Result, !IO) :- read_dotted_name(Input, MaybeName, !IO), read_uint32(Input, MaybeId, !IO), MaybePair = combine_read_2(MaybeName, MaybeId), Result = maybe_error_map( (func({Name, Num}) = {Name, Id} :- ( if pzc_id_from_num(PZ, Num, Id0) then Id = Id0 else unexpected($file, $pred, "Invalid closure id") ) ), MaybePair). %-----------------------------------------------------------------------% :- pred read_width(binary_input_stream::in, maybe_error(pz_width)::out, io::di, io::uo) is det. read_width(Input, Result, !IO) :- read_uint8(Input, MaybeByte, !IO), ( MaybeByte = ok(Byte), ( if pz_width_byte(Width, Byte) then Result = ok(Width) else Result = error("Invalid width") ) ; MaybeByte = error(Error), Result = error(Error) ). :- pred read_struct_id(pz::in, binary_input_stream::in, maybe_error(pzs_id)::out, io::di, io::uo) is det. read_struct_id(PZ, Input, Result, !IO) :- read_uint32(Input, MaybeStructNum, !IO), ( MaybeStructNum = ok(StructNum), ( if pzs_id_from_num(PZ, StructNum, StructId) then Result = ok(StructId) else Result = error("Unknown struct") ) ; MaybeStructNum = error(Error), Result = error(Error) ). :- pred read_data_id(pz::in, binary_input_stream::in, maybe_error(pzd_id)::out, io::di, io::uo) is det. read_data_id(PZ, Input, Result, !IO) :- read_uint32(Input, MaybeNum, !IO), ( MaybeNum = ok(Num), ( if pzd_id_from_num(PZ, Num, DataId) then Result = ok(DataId) else Result = error("Unknown data item") ) ; MaybeNum = error(Error), Result = error(Error) ). :- pred read_proc_id(pz::in, binary_input_stream::in, maybe_error(pzp_id)::out, io::di, io::uo) is det. read_proc_id(PZ, Input, Result, !IO) :- read_uint32(Input, MaybeNum, !IO), ( MaybeNum = ok(Num), ( if pzp_id_from_num(PZ, Num, ProcId) then Result = ok(ProcId) else Result = error("Unknown procedure") ) ; MaybeNum = error(Error), Result = error(Error) ). :- pred read_closure_id(pz::in, binary_input_stream::in, maybe_error(pzc_id)::out, io::di, io::uo) is det. read_closure_id(PZ, Input, Result, !IO) :- read_uint32(Input, MaybeNum, !IO), ( MaybeNum = ok(Num), ( if pzc_id_from_num(PZ, Num, ClosureId) then Result = ok(ClosureId) else Result = error("Unknown closure") ) ; MaybeNum = error(Error), Result = error(Error) ). :- pred read_import_id(pz::in, binary_input_stream::in, maybe_error(pzi_id)::out, io::di, io::uo) is det. read_import_id(PZ, Input, Result, !IO) :- read_uint32(Input, MaybeNum, !IO), ( MaybeNum = ok(Num), ( if pzi_id_from_num(PZ, Num, ImportId) then Result = ok(ImportId) else Result = error("Unknown import") ) ; MaybeNum = error(Error), Result = error(Error) ). %-----------------------------------------------------------------------% :- pred read_items(pred(pz, maybe_error(T), io, io), pred(uint32, T, pz, pz), uint32, uint32, pz, maybe_error(pz), io, io). :- mode read_items(pred(in, out, di, uo) is det, pred(in, in, in, out) is det, in, in, in, out, di, uo) is det. read_items(Read, Add, Num, Cur, PZ0, Result, !IO) :- ( if Cur < Num then Read(PZ0, Result0, !IO), ( Result0 = ok(Item), Add(Cur, Item, PZ0, PZ), read_items(Read, Add, Num, Cur + 1u32, PZ, Result, !IO) ; Result0 = error(Error), Result = error(Error) ) else Result = ok(PZ0) ). :- pred read_n(pred(maybe_error(T), io, io), int, maybe_error(list(T)), io, io). :- mode read_n(pred(out, di, uo) is det, in, out, di, uo) is det. read_n(Pred, N, Result, !IO) :- ( if N > 0 then Pred(HeadResult, !IO), ( HeadResult = ok(Head), read_n(Pred, N - 1, Result0, !IO), ( Result0 = ok(Tail), Result = ok([Head | Tail]) ; Result0 = error(Error), Result = error(Error) ) ; HeadResult = error(Error), Result = error(Error) ) else Result = ok([]) ). :- pred read_map(pred(T, maybe_error(U), io, io), list(T), maybe_error(list(U)), io, io). :- mode read_map(pred(in, out, di, uo) is det, in, out, di, uo) is det. read_map(_, [], ok([]), !IO). read_map(Read, [X | Xs], Result, !IO) :- Read(X, ResultY, !IO), ( ResultY = ok(Y), read_map(Read, Xs, ResultYs, !IO), ( ResultYs = ok(Ys), Result = ok([Y | Ys]) ; ResultYs = error(Error), Result = error(Error) ) ; ResultY = error(Error), Result = error(Error) ). :- pred read_dotted_name(io.binary_input_stream::in, maybe_error(q_name)::out, io::di, io::uo) is det. read_dotted_name(Input, Result, !IO) :- read_len_string(Input, StringResult, !IO), ( StringResult = ok(String), Result = q_name_from_dotted_string(String) ; StringResult = error(Error), Result = error(Error) ). %-----------------------------------------------------------------------% :- pred data_get_filename(pz::in, pzd_id::in, string::out) is semidet. data_get_filename(PZ, DataId, String) :- Data = pz_lookup_data(PZ, DataId), pz_data(DataType, Items0) = Data, type_string(_NumItems) = DataType, % Drop the null byte at the end of the list. det_take(length(Items0) - 1, Items0, Items), map((pred(pzv_num(I)::in, C::out) is semidet :- from_int(I, C) ), Items, Chars), String = string.from_char_list(Chars). %-----------------------------------------------------------------------% %-----------------------------------------------------------------------% ================================================ FILE: src/pz.write.m ================================================ %-----------------------------------------------------------------------% % vim: ts=4 sw=4 et %-----------------------------------------------------------------------% :- module pz.write. % % Write the PZ bytecode. % % Copyright (C) Plasma Team % Distributed under the terms of the MIT License see ../LICENSE.code % %-----------------------------------------------------------------------% :- interface. :- import_module io. :- import_module maybe. :- import_module string. %-----------------------------------------------------------------------% :- pred write_pz(string::in, pz::in, maybe_error::out, io::di, io::uo) is det. %-----------------------------------------------------------------------% %-----------------------------------------------------------------------% :- implementation. :- import_module int. :- import_module int16. :- import_module int32. :- import_module int64. :- import_module int8. :- import_module list. :- import_module pair. :- import_module require. :- import_module set. :- import_module uint16. :- import_module uint32. :- import_module uint8. :- import_module common_types. :- import_module context. :- import_module pz.code. :- import_module pz.bytecode. :- import_module pz.format. :- import_module q_name. :- import_module util. :- import_module util.my_io. %-----------------------------------------------------------------------% write_pz(Filename, PZ, Result, !IO) :- write_temp_and_move(open_binary_output, close_binary_output, write_pz_2(PZ), Filename, Result, !IO). :- pred write_pz_2(pz::in, binary_output_stream::in, maybe_error::out, io::di, io::uo) is det. write_pz_2(PZ, File, Result, !IO) :- FileType = pz_get_file_type(PZ), ( FileType = pzft_object, Magic = pz_object_magic, IdString = pz_object_id_string ; FileType = pzft_program, Magic = pz_program_magic, IdString = pz_program_id_string ; FileType = pzft_library, Magic = pz_library_magic, IdString = pz_library_id_string ), write_binary_uint32_le(File, Magic, !IO), write_len_string(File, IdString, !IO), write_binary_uint16_le(File, pz_version, !IO), write_pz_options(File, PZ, !IO), ModuleNames = pz_get_module_names(PZ), write_binary_uint32_le(File, det_from_int(length(ModuleNames)), !IO), foldl(write_module_name(File), ModuleNames, !IO), write_pz_entries(File, PZ, !IO), Result = ok. :- pred write_module_name(binary_output_stream::in, q_name::in, io::di, io::uo) is det. write_module_name(File, ModuleName, !IO) :- write_len_string(File, q_name_to_string(ModuleName), !IO). %-----------------------------------------------------------------------% :- pred write_pz_options(io.binary_output_stream::in, pz::in, io::di, io::uo) is det. write_pz_options(File, PZ, !IO) :- MaybeEntryClosure = pz_get_maybe_entry_closure(PZ), EntryCandidates = set.to_sorted_list(pz_get_entry_candidates(PZ)), NumOptions = length(EntryCandidates) + ( if MaybeEntryClosure = yes(_) then 1 else 0 ), write_binary_uint16_le(File, det_from_int(NumOptions), !IO), ( MaybeEntryClosure = yes(Entry), write_binary_uint16_le(File, pzf_opt_entry_closure, !IO), write_entrypoint(File, Entry, !IO) ; MaybeEntryClosure = no ), foldl(write_entry_candidate(File), EntryCandidates, !IO). :- pred write_entry_candidate(io.binary_output_stream::in, pz_entrypoint::in, io::di, io::uo) is det. write_entry_candidate(File, Entry, !IO) :- write_binary_uint16_le(File, pzf_opt_entry_candidate, !IO), write_entrypoint(File, Entry, !IO). :- pred write_entrypoint(io.binary_output_stream::in, pz_entrypoint::in, io::di, io::uo) is det. write_entrypoint(File, Entry, !IO) :- write_binary_uint16_le(File, 5u16, !IO), pz_entrypoint(EntryCID, Signature, _) = Entry, pz_signature_byte(Signature, SignatureByte), write_binary_uint8(File, SignatureByte, !IO), write_binary_uint32_le(File, pzc_id_get_num(EntryCID), !IO). :- pred write_pz_entries(io.binary_output_stream::in, pz::in, io::di, io::uo) is det. write_pz_entries(File, PZ, !IO) :- % Write counts of each entry type ImportedProcs = sort(pz_get_imports(PZ)), write_binary_uint32_le(File, det_from_int(length(ImportedProcs)), !IO), Structs = sort(pz_get_structs(PZ)), write_binary_uint32_le(File, det_from_int(length(Structs)), !IO), Datas = sort(pz_get_data_items(PZ)), write_binary_uint32_le(File, det_from_int(length(Datas)), !IO), Procs = sort(pz_get_procs(PZ)), write_binary_uint32_le(File, det_from_int(length(Procs)), !IO), Closures = sort(pz_get_closures(PZ)), write_binary_uint32_le(File, det_from_int(length(Closures)), !IO), Exports = pz_get_exports(PZ), write_binary_uint32_le(File, det_from_int(length(Exports)), !IO), % Write the actual entries. foldl(write_imported_proc(File), ImportedProcs, !IO), foldl(write_struct(File), Structs, !IO), foldl(write_data(File, PZ), Datas, !IO), foldl(write_proc(File), Procs, !IO), foldl(write_closure(File), Closures, !IO), foldl(write_export(File), Exports, !IO). %-----------------------------------------------------------------------% :- pred write_imported_proc(io.binary_output_stream::in, pair(T, pz_import)::in, io::di, io::uo) is det. write_imported_proc(File, _ - pz_import(QName, Type), !IO) :- q_name_parts(QName, MaybeModule, Proc), ( MaybeModule = yes(Module), pz_import_type_byte(Type, TypeByte), write_binary_uint8(File, TypeByte, !IO), ModuleName = q_name_to_string(Module), ProcName = nq_name_to_string(Proc), write_len_string(File, ModuleName, !IO), write_len_string(File, ProcName, !IO) ; MaybeModule = no, unexpected($file, $pred, "Unqualified procedure name") ). %-----------------------------------------------------------------------% :- pred write_struct(io.binary_output_stream::in, pair(T, pz_named_struct)::in, io::di, io::uo) is det. write_struct(File, _ - pz_named_struct(_, pz_struct(Widths)), !IO) :- write_binary_uint32_le(File, det_from_int(length(Widths)), !IO), foldl(write_width(File), Widths, !IO). :- pred write_width(io.binary_output_stream::in, pz_width::in, io::di, io::uo) is det. write_width(File, Width, !IO) :- pz_width_byte(Width, Int), write_binary_uint8(File, Int, !IO). %-----------------------------------------------------------------------% :- pred write_data(io.binary_output_stream::in, pz::in, pair(T, pz_data)::in, io::di, io::uo) is det. write_data(File, PZ, _ - pz_data(Type, Values), !IO) :- write_data_type(File, Type, !IO), write_data_values(File, PZ, Type, Values, !IO). :- pred write_data_type(io.binary_output_stream::in, pz_data_type::in, io::di, io::uo) is det. write_data_type(File, type_array(Width, Length), !IO) :- write_binary_uint8(File, pzf_data_array, !IO), write_binary_uint16_le(File, det_from_int(Length), !IO), write_width(File, Width, !IO). write_data_type(File, type_struct(PZSId), !IO) :- write_binary_uint8(File, pzf_data_struct, !IO), write_binary_uint32_le(File, pzs_id_get_num(PZSId), !IO). write_data_type(File, type_string(Length), !IO) :- write_binary_uint8(File, pzf_data_string, !IO), write_binary_uint16_le(File, det_from_int(Length), !IO). :- pred write_data_values(io.binary_output_stream::in, pz::in, pz_data_type::in, list(pz_data_value)::in, io::di, io::uo) is det. write_data_values(File, PZ, Type, Values, !IO) :- ( Type = type_array(Width, NumValues), ( if length(Values, NumValues) then true else unexpected($file, $pred, "Incorrect array length") ), write_enc_for_values(File, Width, Values, !IO), foldl(write_value(File, Width), Values, !IO) ; Type = type_struct(PZSId), pz_lookup_struct(PZ, PZSId) = pz_struct(Widths), foldl_corresponding(write_enc_value(File), Widths, Values, !IO) ; Type = type_string(NumUnits), ( if length(Values, NumUnits) then true else unexpected($file, $pred, "Incorrect string length") ), write_enc_for_values(File, pzw_8, Values, !IO), foldl(write_value(File, pzw_8), Values, !IO) ). :- pred write_enc_for_values(binary_output_stream::in, pz_width::in, list(pz_data_value)::in, io::di, io::uo) is det. write_enc_for_values(File, Width, Values, !IO) :- Encs = map(get_enc(Width), Values), ( Encs = [], EncType = t_normal, NumBytes = 1 ; Encs = [Enc | _], expect(all_true(unify(Enc), Encs), $file, $pred, "All elements must encode the same"), Enc = {EncType, NumBytes} ), pz_enc_byte(EncType, NumBytes, EncByte), write_binary_uint8(File, EncByte, !IO). :- func get_enc(pz_width, pz_data_value) = {enc_type, int}. get_enc(Width, Value) = {EncType, NumBytes} :- value_enc(Value, Width, EncType, NumBytes). :- pred write_enc_value(io.binary_output_stream::in, pz_width::in, pz_data_value::in, io::di, io::uo) is det. write_enc_value(File, Width, Value, !IO) :- value_enc(Value, Width, EncType, NumBytes), pz_enc_byte(EncType, NumBytes, EncByte), write_binary_uint8(File, EncByte, !IO), write_value(File, Width, Value, !IO). :- pred value_enc(pz_data_value::in, pz_width::in, enc_type::out, int::out) is det. value_enc(pzv_num(_), pzw_8, t_normal, 1). value_enc(pzv_num(_), pzw_16, t_normal, 2). value_enc(pzv_num(_), pzw_32, t_normal, 4). value_enc(pzv_num(_), pzw_64, t_normal, 8). value_enc(pzv_num(_), pzw_fast, t_wfast, 4). value_enc(pzv_num(_), pzw_ptr, _, _) :- % This could be used by tag values in the future, currently I % think 32bit values are used. unexpected($file, $pred, "Unused"). value_enc(Value, Width, Type, 4) :- ( Value = pzv_data(_), Type = t_data ; Value = pzv_import(_), Type = t_import ; Value = pzv_closure(_), Type = t_closure ), expect(unify(Width, pzw_ptr), $file, $pred, "Must be pointer width"). :- pred write_value(io.binary_output_stream::in, pz_width::in, pz_data_value::in, io::di, io::uo) is det. write_value(File, pzw_8, pzv_num(Num), !IO) :- write_binary_int8(File, det_from_int(Num), !IO). write_value(File, pzw_16, pzv_num(Num), !IO) :- write_binary_int16_le(File, det_from_int(Num), !IO). write_value(File, pzw_32, pzv_num(Num), !IO) :- write_binary_int32_le(File, det_from_int(Num), !IO). write_value(File, pzw_64, pzv_num(Num), !IO) :- write_binary_int64_le(File, from_int(Num), !IO). write_value(File, pzw_fast, pzv_num(Num), !IO) :- write_binary_int32_le(File, det_from_int(Num), !IO). write_value(_, pzw_ptr, pzv_num(_), !IO) :- % This could be used by tag values in the future, currently I % think 32bit values are used. unexpected($file, $pred, "Unused"). write_value(File, Width, Value, !IO) :- ( Value = pzv_data(DID), IdNum = pzd_id_get_num(DID) ; Value = pzv_import(IID), IdNum = pzi_id_get_num(IID) ; Value = pzv_closure(CID), IdNum = pzc_id_get_num(CID) ), write_binary_uint32_le(File, IdNum, !IO), expect(unify(Width, pzw_ptr), $file, $pred, "Must be pointer width"). %-----------------------------------------------------------------------% :- pred write_proc(binary_output_stream::in, pair(T, pz_proc)::in, io::di, io::uo) is det. write_proc(File, _ - Proc, !IO) :- write_len_string(File, q_name_to_string(Proc ^ pzp_name), !IO), MaybeBlocks = Proc ^ pzp_blocks, ( MaybeBlocks = yes(Blocks), write_binary_uint32_le(File, det_from_int(length(Blocks)), !IO), foldl(write_block(File), Blocks, !IO) ; MaybeBlocks = no, unexpected($file, $pred, "Missing definition") ). :- pred write_block(binary_output_stream::in, pz_block::in, io::di, io::uo) is det. write_block(File, pz_block(Instr0), !IO) :- % Filter out the comments but leave everything else. filter_instrs(Instr0, pz_nil_context, [], Instrs), write_binary_uint32_le(File, det_from_int(length(Instrs)), !IO), foldl(write_instr(File), Instrs, !IO). :- pred filter_instrs(list(pz_instr_obj)::in, pz_context::in, list(pz_instr_obj)::in, list(pz_instr_obj)::out) is det. filter_instrs([], _, !Instrs) :- reverse(!Instrs). filter_instrs([I | Is0], PrevContext, !Instrs) :- ( I = pzio_instr(_), !:Instrs = [I | !.Instrs], NextContext = PrevContext ; I = pzio_comment(_), NextContext = PrevContext ; I = pzio_context(Context), ( if Context = PrevContext then true else if % If the filename is the same then we only need to store the % line number. Context = pz_context(context(File, Line, _), _), PrevContext = pz_context(context(File, _, _), _) then !:Instrs = [pzio_context(pz_context_short(Line)) | !.Instrs] else !:Instrs = [I | !.Instrs] ), NextContext = Context ), filter_instrs(Is0, NextContext, !Instrs). :- pred write_instr(binary_output_stream::in, pz_instr_obj::in, io::di, io::uo) is det. write_instr(File, pzio_instr(Instr), !IO) :- code_entry_byte(code_instr, CodeInstrByte), write_binary_uint8(File, CodeInstrByte, !IO), instruction(Instr, Opcode, Widths, MaybeImmediate), opcode_byte(Opcode, OpcodeByte), write_binary_uint8(File, OpcodeByte, !IO), ( Widths = no_width ; Widths = one_width(Width), write_width(File, Width, !IO) ; Widths = two_widths(WidthA, WidthB), write_width(File, WidthA, !IO), write_width(File, WidthB, !IO) ), ( MaybeImmediate = yes(Immediate), write_immediate(File, Immediate, !IO) ; MaybeImmediate = no ). write_instr(File, pzio_context(PZContext), !IO) :- ( PZContext = pz_context(Context, DataId), code_entry_byte(code_meta_context, CodeMetaByte), write_binary_uint8(File, CodeMetaByte, !IO), write_binary_uint32_le(File, pzd_id_get_num(DataId), !IO), write_binary_uint32_le(File, det_from_int(Context ^ c_line), !IO) ; PZContext = pz_context_short(Line), code_entry_byte(code_meta_context_short, CodeMetaByte), write_binary_uint8(File, CodeMetaByte, !IO), write_binary_uint32_le(File, det_from_int(Line), !IO) ; PZContext = pz_nil_context, code_entry_byte(code_meta_context_nil, CodeMetaByte), write_binary_uint8(File, CodeMetaByte, !IO) ). write_instr(_, pzio_comment(_), !IO) :- unexpected($file, $pred, "pzio_comment"). :- pred write_immediate(binary_output_stream::in, pz_immediate_value::in, io::di, io::uo) is det. write_immediate(File, Immediate, !IO) :- ( Immediate = pz_im_i8(Int), write_binary_int8(File, Int, !IO) ; Immediate = pz_im_u8(Int), write_binary_uint8(File, Int, !IO) ; Immediate = pz_im_i16(Int), write_binary_int16_le(File, Int, !IO) ; Immediate = pz_im_u16(Int), write_binary_uint16_le(File, Int, !IO) ; Immediate = pz_im_i32(Int), write_binary_int32_le(File, Int, !IO) ; Immediate = pz_im_u32(Int), write_binary_uint32_le(File, Int, !IO) ; Immediate = pz_im_i64(Int), write_binary_int64_le(File, Int, !IO) ; Immediate = pz_im_u64(Int), write_binary_uint64_le(File, Int, !IO) ; Immediate = pz_im_label(Int), write_binary_uint32_le(File, Int, !IO) ; Immediate = pz_im_closure(ClosureId), write_binary_uint32_le(File, pzc_id_get_num(ClosureId), !IO) ; Immediate = pz_im_proc(ProcId), write_binary_uint32_le(File, pzp_id_get_num(ProcId), !IO) ; Immediate = pz_im_import(ImportId), write_binary_uint32_le(File, pzi_id_get_num(ImportId), !IO) ; Immediate = pz_im_struct(SID), write_binary_uint32_le(File, pzs_id_get_num(SID), !IO) ; Immediate = pz_im_struct_field(SID, field_num(FieldNumInt)), write_binary_uint32_le(File, pzs_id_get_num(SID), !IO), % Subtract 1 for the zero-based encoding format. write_binary_uint8(File, det_from_int(FieldNumInt - 1), !IO) ; Immediate = pz_im_depth(Int), write_binary_uint8(File, det_from_int(Int), !IO) ). %-----------------------------------------------------------------------% :- pred write_closure(binary_output_stream::in, pair(T, pz_closure)::in, io::di, io::uo) is det. write_closure(File, _ - pz_closure(Proc, Data), !IO) :- write_binary_uint32_le(File, pzp_id_get_num(Proc), !IO), write_binary_uint32_le(File, pzd_id_get_num(Data), !IO). %-----------------------------------------------------------------------% :- pred write_export(binary_output_stream::in, pair(q_name, pzc_id)::in, io::di, io::uo) is det. write_export(File, Name - Id, !IO) :- write_len_string(File, q_name_to_string(Name), !IO), write_binary_uint32_le(File, pzc_id_get_num(Id), !IO). %-----------------------------------------------------------------------% %-----------------------------------------------------------------------% ================================================ FILE: src/pzt_parse.m ================================================ %-----------------------------------------------------------------------% % vim: ts=4 sw=4 et %-----------------------------------------------------------------------% :- module pzt_parse. % % Parse the PZ textual representation. % % Copyright (C) Plasma Team % Distributed under the terms of the MIT License see ../LICENSE.code % %-----------------------------------------------------------------------% :- interface. %-----------------------------------------------------------------------% :- import_module io. :- import_module asm_ast. :- import_module asm_error. :- import_module util. :- import_module util.result. :- pred parse(string::in, result(asm, asm_error)::out, io::di, io::uo) is det. %-----------------------------------------------------------------------% %-----------------------------------------------------------------------% :- implementation. :- import_module cord. :- import_module list. :- import_module maybe. :- import_module require. :- import_module string. :- import_module unit. :- import_module common_types. :- import_module context. :- import_module lex. :- import_module parse_util. :- import_module parsing. :- import_module pz. :- import_module pz.code. :- import_module q_name. %-----------------------------------------------------------------------% parse(Filename, Result, !IO) :- parse_file(Filename, lexemes, ignore_tokens, parse_pzt, Result0, !IO), ( Result0 = ok(AST), Result = ok(AST) ; Result0 = errors(Errors), Result = errors(map( (func(error(C, E)) = error(C, e_read_src_error(E))), Errors)) ). %-----------------------------------------------------------------------% :- type pzt_token == token(token_basic). :- type pzt_tokens == list(pzt_token). :- type token_basic ---> module_ ; import ; export ; proc ; block ; struct ; data ; array ; string ; closure ; global_env ; entry ; jmp ; cjmp ; call ; tcall ; roll ; pick ; alloc ; make_closure ; load ; load_named ; store % TODO: we can probably remove the w_ptr token. ; w ; w8 ; w16 ; w32 ; w64 ; w_ptr ; ptr ; open_curly ; close_curly ; open_paren ; close_paren ; dash ; equals ; semicolon ; colon ; comma ; period ; identifier ; number ; comment ; whitespace ; eof. :- instance ident_parsing(token_basic) where [ ident_ = identifier, period_ = period ]. :- func lexemes = list(lexeme(lex_token(token_basic))). lexemes = [ ("module" -> return(module_)), ("import" -> return(import)), ("export" -> return(export)), ("proc" -> return(proc)), ("block" -> return(block)), ("struct" -> return(struct)), ("data" -> return(data)), ("array" -> return(array)), ("string" -> return(string)), ("closure" -> return(closure)), ("global_env" -> return(global_env)), ("entry" -> return(entry)), ("jmp" -> return(jmp)), ("cjmp" -> return(cjmp)), ("call" -> return(call)), ("tcall" -> return(tcall)), ("roll" -> return(roll)), ("pick" -> return(pick)), ("alloc" -> return(alloc)), ("make_closure" -> return(make_closure)), ("load" -> return(load)), ("load_named" -> return(load_named)), ("store" -> return(store)), ("w" -> return(w)), ("w8" -> return(w8)), ("w16" -> return(w16)), ("w32" -> return(w32)), ("w64" -> return(w64)), ("w_ptr" -> return(w_ptr)), ("ptr" -> return(ptr)), ("{" -> return(open_curly)), ("}" -> return(close_curly)), ("(" -> return(open_paren)), (")" -> return(close_paren)), ("-" -> return(dash)), ("=" -> return(equals)), ("," -> return(comma)), ("." -> return(period)), (";" -> return(semicolon)), (":" -> return(colon)), (lex.identifier -> return(identifier)), (?("-") ++ lex.nat -> return(number)), ("//" ++ (*(anybut("\n"))) -> return(comment)), (lex.whitespace -> return(whitespace)) ]. :- pred ignore_tokens(token_basic::in) is semidet. ignore_tokens(whitespace). ignore_tokens(comment). %-----------------------------------------------------------------------% %-----------------------------------------------------------------------% :- pred parse_pzt(pzt_tokens::in, result(asm, read_src_error)::out) is det. parse_pzt(Tokens, Result) :- parse_pzt_2(Tokens, Result0), ( Result0 = ok(Asm), Result = ok(Asm) ; Result0 = error(Ctxt, Got, Expect), Result = return_error(Ctxt, rse_parse_error(Got, Expect)) ). :- pred parse_pzt_2(pzt_tokens::in, parse_res(asm)::out) is det. parse_pzt_2(!.Tokens, Result) :- parse_module_decl(ModuleDeclResult, !Tokens), ( ModuleDeclResult = ok(ModuleName), TokensBeforeItems = !.Tokens, zero_or_more_last_error(or([parse_import, parse_proc, parse_struct, parse_data, parse_closure, parse_entry]), ok(Items), LastError, !Tokens), ( !.Tokens = [], ( TokensBeforeItems = [FirstToken | _], Filename = FirstToken ^ t_context ^ c_file ; TokensBeforeItems = [], Filename = "unknown.pzt" ), Result = ok(asm(ModuleName, Filename, Items)) ; !.Tokens = [token(_, Str, TokCtxt) | _], LastError = error(LECtxt, Got, Expect), ( if compare((<), LECtxt, TokCtxt) then Result = error(TokCtxt, Str, "end of file") else Result = error(LECtxt, Got, Expect) ) ) ; ModuleDeclResult = error(C, G, E), Result = error(C, G, E) ). :- pred parse_module_decl(parse_res(q_name)::out, pzt_tokens::in, pzt_tokens::out) is det. parse_module_decl(Result, !Tokens) :- match_token(module_, MatchModule, !Tokens), parse_q_name(NameResult, !Tokens), match_token(semicolon, MatchSemicolon, !Tokens), ( if MatchModule = ok(_), NameResult = ok(Name), MatchSemicolon = ok(_) then Result = ok(Name) else Result = combine_errors_3(MatchModule, NameResult, MatchSemicolon) ). %-----------------------------------------------------------------------% :- pred parse_struct(parse_res(asm_item)::out, pzt_tokens::in, pzt_tokens::out) is det. parse_struct(Result, !Tokens) :- get_context(!.Tokens, Context), match_token(struct, MatchStruct, !Tokens), ( MatchStruct = ok(_), parse_ident(IdentResult, !Tokens), within(open_curly, one_or_more(parse_width), close_curly, FieldsResult, !Tokens), match_token(semicolon, MatchSemi, !Tokens), ( if IdentResult = ok(Ident), FieldsResult = ok(Fields), MatchSemi = ok(_) then Result = ok(asm_item(q_name_single(Ident), Context, asm_struct(Fields))) else Result = combine_errors_3(IdentResult, FieldsResult, MatchSemi) ) ; MatchStruct = error(C, G, E), Result = error(C, G, E) ). %-----------------------------------------------------------------------% :- pred parse_data(parse_res(asm_item)::out, pzt_tokens::in, pzt_tokens::out) is det. parse_data(Result, !Tokens) :- get_context(!.Tokens, Context), match_token(data, MatchData, !Tokens), parse_ident(IdentResult, !Tokens), match_token(equals, MatchEquals, !Tokens), parse_data_type(TypeResult, !Tokens), parse_data_values(ValuesResult, !Tokens), match_token(semicolon, MatchSemi, !Tokens), ( if MatchData = ok(_), IdentResult = ok(Ident), MatchEquals = ok(_), TypeResult = ok(Type), ValuesResult = ok(Values), MatchSemi = ok(_) then Result = ok(asm_item(q_name_single(Ident), Context, asm_data(Type, Values))) else Result = combine_errors_6(MatchData, IdentResult, MatchEquals, TypeResult, ValuesResult, MatchSemi) ). :- pred parse_data_type(parse_res(asm_data_type)::out, pzt_tokens::in, pzt_tokens::out) is det. parse_data_type(Result, !Tokens) :- % Only arrays are implemented. or([parse_data_type_array, parse_data_type_struct, parse_data_type_string], Result, !Tokens). :- pred parse_data_type_array(parse_res(asm_data_type)::out, pzt_tokens::in, pzt_tokens::out) is det. parse_data_type_array(Result, !Tokens) :- match_tokens([array, open_paren], StartMatch, !Tokens), parse_width(WidthResult, !Tokens), match_token(close_paren, CloseMatch, !Tokens), ( if StartMatch = ok(_), WidthResult = ok(Width), CloseMatch = ok(_) then Result = ok(asm_dtype_array(Width)) else Result = combine_errors_3(StartMatch, WidthResult, CloseMatch) ). :- pred parse_data_type_struct(parse_res(asm_data_type)::out, pzt_tokens::in, pzt_tokens::out) is det. parse_data_type_struct(Result, !Tokens) :- parse_ident(IdentResult, !Tokens), ( IdentResult = ok(Ident), Result = ok(asm_dtype_struct(Ident)) ; IdentResult = error(C, G, E), Result = error(C, G, E) ). :- pred parse_data_type_string(parse_res(asm_data_type)::out, pzt_tokens::in, pzt_tokens::out) is det. parse_data_type_string(Result, !Tokens) :- match_token(string, Result0, !Tokens), ( Result0 = ok(_), Result = ok(asm_dtype_string) ; Result0 = error(C, G, E), Result = error(C, G, E) ). :- pred parse_data_values(parse_res(list(asm_data_value))::out, pzt_tokens::in, pzt_tokens::out) is det. parse_data_values(Result, !Tokens) :- within(open_curly, zero_or_more(or([ parse_data_value_num, parse_data_value_name])), close_curly, Result, !Tokens). :- pred parse_data_value_num(parse_res(asm_data_value)::out, pzt_tokens::in, pzt_tokens::out) is det. parse_data_value_num(Result, !Tokens) :- parse_number(NumResult, !Tokens), Result = map((func(Num) = asm_dvalue_num(Num)), NumResult). :- pred parse_data_value_name(parse_res(asm_data_value)::out, pzt_tokens::in, pzt_tokens::out) is det. parse_data_value_name(Result, !Tokens) :- parse_q_name(NameResult, !Tokens), Result = map((func(Name) = asm_dvalue_name(Name)), NameResult). %-----------------------------------------------------------------------% :- pred parse_closure(parse_res(asm_item)::out, pzt_tokens::in, pzt_tokens::out) is det. parse_closure(Result, !Tokens) :- get_context(!.Tokens, Context), optional(match_token(export), ok(MaybeExport), !Tokens), match_token(closure, ClosureMatch, !Tokens), parse_q_name(IdentResult, !Tokens), match_token(equals, EqualsMatch, !Tokens), parse_ident(ProcResult, !Tokens), parse_ident(DataResult, !Tokens), match_token(semicolon, SemicolonMatch, !Tokens), ( if ClosureMatch = ok(_), IdentResult = ok(Ident), EqualsMatch = ok(_), ProcResult = ok(Proc), DataResult = ok(Data), SemicolonMatch = ok(_) then ( MaybeExport = yes(_), Sharing = s_public ; MaybeExport = no, Sharing = s_private ), Closure = asm_closure(Proc, Data, Sharing), Result = ok(asm_item(Ident, Context, Closure)) else Result = combine_errors_6(ClosureMatch, IdentResult, EqualsMatch, ProcResult, DataResult, SemicolonMatch) ). %-----------------------------------------------------------------------% :- pred parse_entry(parse_res(asm_item)::out, pzt_tokens::in, pzt_tokens::out) is det. parse_entry(Result, !Tokens) :- get_context(!.Tokens, Context), match_token(entry, MatchEntry, !Tokens), parse_q_name(NameResult, !Tokens), match_token(semicolon, MatchSemicolon, !Tokens), ( if MatchEntry = ok(_), NameResult = ok(Name), MatchSemicolon = ok(_) then Result = ok(asm_entrypoint(Context, Name)) else Result = combine_errors_3(MatchEntry, NameResult, MatchSemicolon) ). %-----------------------------------------------------------------------% :- pred parse_import(parse_res(asm_item)::out, pzt_tokens::in, pzt_tokens::out) is det. parse_import(Result, !Tokens) :- get_context(StartTokens, Context), StartTokens = !.Tokens, match_token(import, MatchImport, !Tokens), parse_q_name(QNameResult, !Tokens), parse_sig(SigResult, !Tokens), match_token(semicolon, MatchSemicolon, !Tokens), ( if MatchImport = ok(_), QNameResult = ok(QName), SigResult = ok(Sig), MatchSemicolon = ok(_) then Result = ok(asm_item(QName, Context, asm_import(Sig))) else !:Tokens = StartTokens, Result = combine_errors_4(MatchImport, QNameResult, SigResult, MatchSemicolon) ). %-----------------------------------------------------------------------% :- pred parse_proc(parse_res(asm_item)::out, pzt_tokens::in, pzt_tokens::out) is det. parse_proc(Result, !Tokens) :- get_context(StartTokens, Context), StartTokens = !.Tokens, match_token(proc, MatchProc, !Tokens), parse_q_name(QNameResult, !Tokens), parse_sig(SigResult, !Tokens), parse_body(BodyResult, !Tokens), match_token(semicolon, MatchSemicolon, !Tokens), ( if MatchProc = ok(_), QNameResult = ok(QName), SigResult = ok(Sig), BodyResult = ok(Body), MatchSemicolon = ok(_) then Result = ok(asm_item(QName, Context, asm_proc(Sig, Body))) else !:Tokens = StartTokens, Result = combine_errors_5(MatchProc, QNameResult, SigResult, BodyResult, MatchSemicolon) ). :- pred parse_sig(parse_res(pz_signature)::out, pzt_tokens::in, pzt_tokens::out) is det. parse_sig(Result, !Tokens) :- get_context(!.Tokens, Context), match_token(open_paren, MatchOpen, !Tokens), zero_or_more(parse_width, ok(Inputs), !Tokens), match_token(dash, MatchDash, !Tokens), zero_or_more(parse_width, ok(Outputs), !Tokens), match_token(close_paren, MatchClose, !Tokens), ( if MatchOpen = ok(_), MatchDash = ok(_), MatchClose = ok(_) then Result = ok(pz_signature(Inputs, Outputs)) else Result = error(Context, "malformed signature", "Inputs '-' Outputs") ). :- pred parse_body(parse_res(list(pzt_block))::out, pzt_tokens::in, pzt_tokens::out) is det. parse_body(Result, !Tokens) :- within(open_curly, or([one_or_more(parse_block), parse_instrs]), close_curly, Result, !Tokens). :- pred parse_block(parse_res(pzt_block)::out, pzt_tokens::in, pzt_tokens::out) is det. parse_block(Result, !Tokens) :- get_context(!.Tokens, Context), match_token(block, MatchBlock, !Tokens), parse_ident(IdentResult, !Tokens), within(open_curly, zero_or_more(parse_instr), close_curly, InstrsResult, !Tokens), ( if MatchBlock = ok(_), IdentResult = ok(Ident), InstrsResult = ok(Instrs) then Result = ok(pzt_block(Ident, Instrs, Context)) else Result = combine_errors_3(MatchBlock, IdentResult, InstrsResult) ). :- pred parse_instrs(parse_res(list(pzt_block))::out, pzt_tokens::in, pzt_tokens::out) is det. parse_instrs(Result, !Tokens) :- get_context(!.Tokens, Context), one_or_more(parse_instr, InstrsResult, !Tokens), Result = map((func(Instrs) = [pzt_block("", Instrs, Context)]), InstrsResult). :- pred parse_instr(parse_res(pzt_instruction)::out, pzt_tokens::in, pzt_tokens::out) is det. parse_instr(Result, !Tokens) :- get_context(!.Tokens, Context), parse_instr_code(Result0, !Tokens), optional(parse_full_width_suffix, ok(MaybeWidth), !Tokens), ( Result0 = ok(Code), ( MaybeWidth = no, Width = no ; MaybeWidth = yes({Width1, no}), Width = one_width(Width1) ; MaybeWidth = yes({Width1, yes(Width2)}), Width = two_widths(Width1, Width2) ), Result = ok(pzt_instruction(Code, Width, Context)) ; Result0 = error(C, G, E), Result = error(C, G, E) ). :- pred parse_instr_code(parse_res(pzt_instruction_code)::out, pzt_tokens::in, pzt_tokens::out) is det. parse_instr_code(Result, !Tokens) :- or([parse_ident_instr, parse_number_instr, parse_token_ident_instr(jmp, (func(Dest) = pzti_jmp(Dest))), parse_token_ident_instr(cjmp, (func(Dest) = pzti_cjmp(Dest))), parse_token_qname_instr(call, (func(Dest) = pzti_call(Dest))), parse_token_qname_instr(tcall, (func(Dest) = pzti_tcall(Dest))), parse_token_ident_instr(alloc, (func(Struct) = pzti_alloc(Struct))), parse_token_qname_instr(make_closure, (func(Proc) = pzti_make_closure(Proc))), parse_loadstore_instr, parse_imm_instr], Result, !Tokens). :- pred parse_ident_instr(parse_res(pzt_instruction_code)::out, pzt_tokens::in, pzt_tokens::out) is det. parse_ident_instr(Result, !Tokens) :- parse_ident(Result0, !Tokens), Result = map((func(S) = pzti_word(S)), Result0). :- pred parse_number_instr(parse_res(pzt_instruction_code)::out, pzt_tokens::in, pzt_tokens::out) is det. parse_number_instr(Result, !Tokens) :- parse_number(ResNumber, !Tokens), Result = map((func(N) = pzti_load_immediate(N)), ResNumber). :- pred parse_token_ident_instr(token_basic, func(string) = pzt_instruction_code, parse_res(pzt_instruction_code), pzt_tokens, pzt_tokens). :- mode parse_token_ident_instr(in, func(in) = (out) is det, out, in, out) is det. parse_token_ident_instr(Token, F, Result, !Tokens) :- parse_token_something_instr(Token, parse_ident, F, Result, !Tokens). :- pred parse_token_qname_instr(token_basic, func(q_name) = pzt_instruction_code, parse_res(pzt_instruction_code), pzt_tokens, pzt_tokens). :- mode parse_token_qname_instr(in, func(in) = (out) is det, out, in, out) is det. parse_token_qname_instr(Token, F, Result, !Tokens) :- parse_token_something_instr(Token, parse_q_name, F, Result, !Tokens). :- pred parse_token_something_instr(token_basic, pred(parse_res(T), pzt_tokens, pzt_tokens), func(T) = pzt_instruction_code, parse_res(pzt_instruction_code), pzt_tokens, pzt_tokens). :- mode parse_token_something_instr(in, pred(out, in, out) is det, func(in) = (out) is det, out, in, out) is det. parse_token_something_instr(Token, Parse, Convert, Result, !Tokens) :- match_token(Token, MatchToken, !Tokens), Parse(SomethingResult, !Tokens), ( if MatchToken = ok(_), SomethingResult = ok(Something) then Result = ok(Convert(Something)) else Result = combine_errors_2(MatchToken, SomethingResult) ). :- pred parse_loadstore_instr(parse_res(pzt_instruction_code)::out, pzt_tokens::in, pzt_tokens::out) is det. parse_loadstore_instr(Result, !Tokens) :- get_context(!.Tokens, Context), next_token("instruction", MatchInstr, !Tokens), ( MatchInstr = ok(token_and_string(Instr, InstrString)), ( if ( Instr = load ; Instr = store ) then parse_ident(StructResult, !Tokens), parse_number(FieldNoResult, !Tokens), ( if StructResult = ok(Struct), FieldNoResult = ok(FieldNo) then ( Instr = load, Result = ok(pzti_load(Struct, field_num(FieldNo))) ; Instr = store, Result = ok(pzti_store(Struct, field_num(FieldNo))) ) else Result = combine_errors_2(StructResult, FieldNoResult) ) else Result = error(Context, InstrString, "instruction") ) ; MatchInstr = error(C, G, E), Result = error(C, G, E) ). :- pred parse_imm_instr(parse_res(pzt_instruction_code)::out, pzt_tokens::in, pzt_tokens::out) is det. parse_imm_instr(Result, !Tokens) :- next_token("instruction", InstrResult, !Tokens), parse_number(ImmResult, !Tokens), ( if InstrResult = ok(token_and_string(Instr, _)), ImmResult = ok(Imm) then ( if Instr = roll then Result = ok(pzti_roll(Imm)) else if Instr = pick then Result = ok(pzti_pick(Imm)) else unexpected($file, $pred, "instruction token") ) else Result = combine_errors_2(InstrResult, ImmResult) ). :- pred parse_full_width_suffix(parse_res({pz_width, maybe(pz_width)})::out, pzt_tokens::in, pzt_tokens::out) is det. parse_full_width_suffix(Result, !Tokens) :- parse_width_suffix(WidthResult, !Tokens), optional(parse_width_suffix, ok(MaybeWidth2), !Tokens), Result = map((func(W) = {W, MaybeWidth2}), WidthResult). :- pred parse_width_suffix(parse_res(pz_width)::out, pzt_tokens::in, pzt_tokens::out) is det. parse_width_suffix(Result, !Tokens) :- match_token(colon, MatchColon, !Tokens), parse_width(Result0, !Tokens), ( MatchColon = ok(_), Result = Result0 ; MatchColon = error(C, G, E), Result = error(C, G, E) ). %-----------------------------------------------------------------------% :- pred parse_width(parse_res(pz_width)::out, pzt_tokens::in, pzt_tokens::out) is det. parse_width(Result, !Tokens) :- get_context(!.Tokens, Context), next_token("data width", TokenResult, !Tokens), ( TokenResult = ok(token_and_string(Token, TokenString)), ( if token_is_width(Token, Width) then Result = ok(Width) else Result = error(Context, TokenString, "data width") ) ; TokenResult = error(C, G, E), Result = error(C, G, E) ). :- pred parse_ident(parse_res(string)::out, pzt_tokens::in, pzt_tokens::out) is det. parse_ident(Result, !Tokens) :- match_token(identifier, Result0, !Tokens), ( Result0 = ok(String), Result = ok(String) ; Result0 = error(C, G, E), Result = error(C, G, E) ). :- pred parse_number(parse_res(int)::out, pzt_tokens::in, pzt_tokens::out) is det. parse_number(Result, !Tokens) :- match_token(number, Result0, !Tokens), Result = map(det_to_int, Result0). %-----------------------------------------------------------------------% :- pred token_is_width(token_basic::in, pz_width::out) is semidet. token_is_width(w, pzw_fast). token_is_width(w8, pzw_8). token_is_width(w16, pzw_16). token_is_width(w32, pzw_32). token_is_width(w64, pzw_64). token_is_width(w_ptr, pzw_ptr). token_is_width(ptr, pzw_ptr). %-----------------------------------------------------------------------% %-----------------------------------------------------------------------% ================================================ FILE: src/q_name.m ================================================ %-----------------------------------------------------------------------% % vim: ts=4 sw=4 et %-----------------------------------------------------------------------% :- module q_name. % % Copyright (C) Plasma Team % Distributed under the terms of the MIT License see ../LICENSE.code % % Qualified name ADT % %-----------------------------------------------------------------------% :- interface. :- import_module list. :- import_module maybe. :- import_module util. :- import_module util.pretty. %-----------------------------------------------------------------------% % Qualified name. % :- type q_name. :- func q_name(nq_name) = q_name. :- func q_name_single(string) = q_name. :- func q_name_from_dotted_string(string) = maybe_error(q_name). :- func q_name_from_dotted_string_det(string) = q_name. % Throws an exception if the strings can't be made into nq_names. % :- func q_name_from_strings(list(string)) = q_name. % This helps the parser avoid an inefficiency, the first argument is for % the module parts and the second for the symbol itself. % :- func q_name_from_strings_2(list(string), string) = q_name. :- func q_name_to_string(q_name) = string. % Provide a clobbered version of this string suitable as a C++ % identifier. :- func q_name_clobber(q_name) = string. :- pred q_name_parts(q_name, maybe(q_name), nq_name). :- mode q_name_parts(in, out, out) is det. % True of the qualified name is just an occurance of a simple name, % eg: it could be a variable name. % :- pred q_name_is_single(q_name::in, string::out) is semidet. % Throws an exception if the string can't be made into nq_names. % :- func q_name_append_str(q_name, string) = q_name. :- pred q_name_append(q_name, nq_name, q_name). :- mode q_name_append(in, in, out) is det. :- mode q_name_append(in, out, in) is semidet. :- func q_name_append(q_name, nq_name) = q_name. % Return the unqualified part of the name (stripping the module % qualifiers away). % :- func q_name_unqual(q_name) = nq_name. %-----------------------------------------------------------------------% % Non-qualified name. % % This is an abstract type over a string, but it ensures that the string % is a legal identifier. % :- type nq_name. :- func nq_name_det(string) = nq_name. :- func nq_name_from_string(string) = maybe_error(nq_name). :- func nq_name_to_string(nq_name) = string. %-----------------------------------------------------------------------% :- func q_name_pretty(q_name) = pretty. % q_name_pretty_relative(Module, Name) = Pretty. % % Print a shortened version of the name if it's in the module Module. % If it's outside this module then print it normally. % :- func q_name_pretty_relative(q_name, q_name) = pretty. :- func nq_name_pretty(nq_name) = pretty. %-----------------------------------------------------------------------% :- type nq_named(E) ---> nq_named(nq_name, E). :- type q_named(T) ---> q_named(q_name, T). %-----------------------------------------------------------------------% %-----------------------------------------------------------------------% :- implementation. :- import_module require. :- import_module string. %-----------------------------------------------------------------------% :- type q_name ---> unqualified(nq_name) ; qualified(q_name, nq_name). q_name(Name) = unqualified(Name). q_name_single(Name) = unqualified(nq_name(Name)). q_name_from_dotted_string(Dotted) = MaybeName :- Parts0 = map(nq_name_from_string, split_at_char('.', Dotted)), ( if map(pred(ok(P)::in, P::out) is semidet, Parts0, Parts) then MaybeName = ok(q_name_from_list(Parts)) else if find_first_match(pred(error(_)::in) is semidet, Parts0, FirstError), FirstError = error(E) then MaybeName = error(E) else unexpected($file, $pred, "Couldn't find error") ). q_name_from_dotted_string_det(Dotted) = Name :- MaybeName = q_name_from_dotted_string(Dotted), ( MaybeName = ok(Name) ; MaybeName = error(Error), unexpected($file, $pred, Error) ). q_name_from_strings(Strings) = q_name_from_list(map(nq_name_det, Strings)). q_name_from_strings_2(Module, Symbol) = q_name_from_list_2(map(nq_name_det, Module), nq_name_det(Symbol)). q_name_to_string(QName) = String :- q_name_break(QName, Quals, Name), ( Quals = [_ | _], String = join_list(".", map(nq_name_to_string, Quals)) ++ "." ++ nq_name_to_string(Name) ; Quals = [], String = nq_name_to_string(Name) ). q_name_clobber(QName) = String :- q_name_break(QName, Quals, Name), ( Quals = [_ | _], String = join_list("_", map(nq_name_to_string, Quals)) ++ "_" ++ nq_name_to_string(Name) ; Quals = [], String = nq_name_to_string(Name) ). q_name_parts(QName, MaybeModule, Symbol) :- q_name_break(QName, ModuleParts, Symbol), ( ModuleParts = [], MaybeModule = no ; ModuleParts = [_ | _], MaybeModule = yes(q_name_from_list(ModuleParts)) ). q_name_is_single(QName, nq_name_to_string(NQName)) :- q_name_break(QName, [], NQName). q_name_append_str(ModuleSym, Name) = QName :- q_name_append(ModuleSym, nq_name_det(Name), QName). q_name_append(A, B, R) :- q_name_break(A, AMods, AName), Mods = q_name_from_list_2(AMods, AName), R = qualified(Mods, B). q_name_append(A, B) = R :- q_name_append(A, B, R). q_name_unqual(unqualified(NQName)) = NQName. q_name_unqual(qualified(_, NQName)) = NQName. %-----------------------------------------------------------------------% :- func q_name_from_list(list(nq_name)) = q_name. q_name_from_list(List) = QName :- det_split_last(List, Qualifiers, Name), QName = q_name_from_list_2(Qualifiers, Name). :- func q_name_from_list_2(list(nq_name), nq_name) = q_name. q_name_from_list_2([], Name) = unqualified(Name). q_name_from_list_2(Quals@[_ | _], Name) = qualified(q_name_from_list(Quals), Name). % Break up a q_name into parts. % :- pred q_name_break(q_name::in, list(nq_name)::out, nq_name::out) is det. q_name_break(unqualified(Name), [], Name). q_name_break(qualified(Modules0, Name), Modules, Name) :- Modules = reverse(q_name_break_2(Modules0)). :- func q_name_break_2(q_name) = list(nq_name). q_name_break_2(unqualified(Name)) = [Name]. q_name_break_2(qualified(Module, Name)) = [Name | q_name_break_2(Module)]. %-----------------------------------------------------------------------% %-----------------------------------------------------------------------% :- type nq_name ---> nq_name(string). nq_name_det(String) = Name :- Check = nq_name_from_string(String), ( Check = ok(Name) ; Check = error(Error), unexpected($file, $pred, Error) ). nq_name_from_string(String) = MaybeName :- ( if not is_all_alnum_or_underscore(String) then MaybeName = error("Illegal identifier") else if length(String) = 0 then MaybeName = error("Empty identifier") else MaybeName = ok(nq_name(String)) ). nq_name_to_string(nq_name(String)) = String. %-----------------------------------------------------------------------% q_name_pretty(Name) = p_str(q_name_to_string(Name)). q_name_pretty_relative(Module, Name) = Pretty :- ( if q_name_append(Module, UnqualName, Name) then Pretty = nq_name_pretty(UnqualName) else Pretty = q_name_pretty(Name) ). nq_name_pretty(Name) = p_str(nq_name_to_string(Name)). %-----------------------------------------------------------------------% %-----------------------------------------------------------------------% ================================================ FILE: src/toml.m ================================================ %-----------------------------------------------------------------------% % Plasma builder % vim: ts=4 sw=4 et % % Copyright (C) Plasma Team % Distributed under the terms of the MIT License see ../LICENSE.code % % This library parses a reduced version of toml syntax. % %-----------------------------------------------------------------------% :- module toml. %-----------------------------------------------------------------------% :- interface. :- import_module io. :- import_module list. :- import_module map. :- import_module pair. :- import_module context. :- import_module util. :- import_module util.result. %-----------------------------------------------------------------------% :- type toml == map(toml_key, pair(toml_value, context)). :- type toml_key == string. :- type toml_value ---> tv_string(string) ; tv_array(list(toml_value)) ; tv_table(toml). :- pred parse_toml(input_stream::in, string::in, result(toml, string)::out, io::di, io::uo) is det. %-----------------------------------------------------------------------% %-----------------------------------------------------------------------% :- implementation. :- import_module int. :- import_module string. :- import_module util.my_exception. %-----------------------------------------------------------------------% parse_toml(Stream, Filename, Result, !IO) :- parse_lines(Stream, Filename, 1, no_table, init, Result, !IO). :- type parse_table ---> no_table ; table( pt_context :: context, pt_name :: string, pt_map :: toml ). :- pred parse_lines(input_stream::in, string::in, int::in, parse_table::in, toml::in, result(toml, string)::out, io::di, io::uo) is det. parse_lines(Stream, Filename, LineNum, !.Table, !.Toml, Result, !IO) :- Context = context(Filename, LineNum), read_line_as_string(Stream, LineRes, !IO), ( LineRes = ok(Line0), Line = strip(strip_comment(Line0)), ( if Line = "" then parse_lines(Stream, Filename, LineNum + 1, !.Table, !.Toml, Result, !IO) else if % The beginning of a table. remove_prefix("[", Line, Name0), remove_suffix(Name0, "]", Name) then end_table(!.Table, !.Toml, Result0), ( Result0 = ok(!:Toml), parse_lines(Stream, Filename, LineNum + 1, table(Context, strip(Name), init), !.Toml, Result, !IO) ; Result0 = errors(_), Result = Result0 ) else if [LHS, RHS] = split_at_char('=', Line), LHS \= "", RHS \= "" then Value = parse_value(strip(RHS)), ( if toml_insert(strip(LHS), Value, Context, !Table, !Toml) then parse_lines(Stream, Filename, LineNum + 1, !.Table, !.Toml, Result, !IO) else Result = return_error(Context, format("Duplicate key `%s`", [s(strip(LHS))])) ) else Result = return_error(Context, "Unrecognised TOML line") ) ; LineRes = eof, end_table(!.Table, !.Toml, Result) ; LineRes = error(Error), Result = return_error(context(Filename), error_message(Error)) ). :- pred toml_insert(toml_key::in, toml_value::in, context::in, parse_table::in, parse_table::out, toml::in, toml::out) is semidet. toml_insert(Key, Value, Context, no_table, no_table, !Toml) :- insert(Key, Value - Context, !Toml). toml_insert(Key, Value, Context, !Table, !Toml) :- insert(Key, Value - Context, !.Table ^ pt_map, Map), !Table ^ pt_map := Map. :- pred end_table(parse_table::in, toml::in, result(toml, string)::out) is det. end_table(no_table, Toml, ok(Toml)). end_table(table(Context, Name, Table), !.Toml, Result) :- ( if insert(Name, tv_table(Table) - Context, !Toml) then Result = ok(!.Toml) else Result = return_error(Context, "Duplicate table: " ++ Name) ). :- func strip_comment(string) = string. strip_comment(Line) = left(Line, prefix_length( pred(C::in) is semidet :- C \= '#', Line)). :- func parse_value(string) = toml_value. parse_value(String) = Value :- ( if append("[", Rest0, String), append(Rest, "]", Rest0) then ( if contains_char(Rest, '[') then % We actually need a proper parser here to do nested structures. % So we don't support nested lists. my_exception.sorry($file, $pred, "Nested arrays") else Value = tv_array(map(parse_value, map(strip, split_at_char(',', Rest)))) ) else Value = tv_string(String) ). %-----------------------------------------------------------------------% %-----------------------------------------------------------------------% ================================================ FILE: src/util.log.m ================================================ %-----------------------------------------------------------------------% % Logging code % vim: ts=4 sw=4 et % % Copyright (C) Plasma Team % Distributed under the terms of the MIT License see ../LICENSE.code % %-----------------------------------------------------------------------% :- module util.log. :- interface. :- import_module io. :- import_module string. %-----------------------------------------------------------------------% % The desired logging level. % :- type log_config ---> silent ; verbose. :- pred verbose_output(log_config::in, string::in, io::di, io::uo) is det. %-----------------------------------------------------------------------% %-----------------------------------------------------------------------% :- implementation. %-----------------------------------------------------------------------% verbose_output(silent, _, !IO). verbose_output(verbose, Message, !IO) :- io.write_string(Message, !IO). %-----------------------------------------------------------------------% %-----------------------------------------------------------------------% ================================================ FILE: src/util.m ================================================ %-----------------------------------------------------------------------% % Utility code % vim: ts=4 sw=4 et % % Copyright (C) Plasma Team % Distributed under the terms of the MIT License see ../LICENSE.code % %-----------------------------------------------------------------------% :- module util. :- interface. :- include_module util.my_exception. :- include_module util.my_io. :- include_module util.log. :- include_module util.mercury. :- include_module util.path. :- include_module util.pretty. :- include_module util.pretty_old. :- include_module util.result. :- include_module util.my_string. :- include_module util.my_time. %-----------------------------------------------------------------------% %-----------------------------------------------------------------------% ================================================ FILE: src/util.mercury.m ================================================ %-----------------------------------------------------------------------% % Mercury Utility code % vim: ts=4 sw=4 et % % Copyright (C) Plasma Team % Distributed under the terms of the MIT License see ../LICENSE.code % %-----------------------------------------------------------------------% :- module util.mercury. :- interface. :- import_module bag. :- import_module cord. :- import_module getopt. :- import_module io. :- import_module list. :- import_module map. :- import_module maybe. :- import_module pair. :- import_module set. %-----------------------------------------------------------------------% % Print the error to stderror and set the exit code to 1. % % Does not terminate the program. % :- pred exit_error(string::in, io::di, io::uo) is det. :- func curry(func(A, B) = C, pair(A, B)) = C. % one_item([X]) = X. % :- func one_item(list(T)) = T. :- func one_item_in_set(set(T)) = T. :- func first_item(list(T)) = T. :- func maybe_list(maybe(X)) = list(X). :- func list_maybe_to_list(list(maybe(X))) = list(X). :- func maybe_cord(maybe(X)) = cord(X). % find_duplicates(List, DupsInList), % % DupsInList is the set of duplicate items in List, if DupsInList is % empty, then List contains no duplicates. % :- pred find_duplicates(list(X)::in, set(X)::out) is det. % Mercury does not provide a map over maybe_error. % :- func maybe_error_map(func(A) = B, maybe_error(A, E)) = maybe_error(B, E). :- func maybe_error_list(list(maybe_error(A, E))) = maybe_error(list(A), list(E)). % set_map_foldl2(Pred, Set0, Set, !Acc1, !Acc2), % :- pred set_map_foldl2(pred(X, Y, A, A, B, B), set(X), set(Y), A, A, B, B). :- mode set_map_foldl2(pred(in, out, in, out, in, out) is det, in, out, in, out, in, out) is det. :- pred map2_corresponding(pred(X, Y, A, B), list(X), list(Y), list(A), list(B)). :- mode map2_corresponding(pred(in, in, out, out) is det, in, in, out, out) is det. :- pred map4_corresponding2(pred(A, B, C, D, X, Y), list(A), list(B), list(C), list(D), list(X), list(Y)). :- mode map4_corresponding2(pred(in, in, in, in, out, out) is det, in, in, in, in, out, out) is det. :- pred remove_first_match_map(pred(X, Y), Y, list(X), list(X)). :- mode remove_first_match_map(pred(in, out) is semidet, out, in, out) is semidet. % det_uint32_to_int % % For some reason Mercury 20.01 doesn't provide this (it would be % uint32.det_to_int). % :- func det_uint32_to_int(uint32) = int. :- func det_uint64_to_int(uint64) = int. %-----------------------------------------------------------------------% :- func list_join(list(T), list(T)) = list(T). :- func bag_list_to_bag(list(bag(T))) = bag(T). :- func string_join(string, list(string)) = string. % delete_first_match(L1, Pred, L) :- % % L is L1 with the first element that satisfies Pred removed, it fails % if there is no element satisfying Pred. % :- pred list_delete_first_match(list(T), pred(T), list(T)). :- mode list_delete_first_match(in, pred(in) is semidet, out) is semidet. %-----------------------------------------------------------------------% :- func power_intersect_list(list(set(T))) = set(T). %-----------------------------------------------------------------------% :- func handle_bool_option(option_table(O), O, T, T) = T. %-----------------------------------------------------------------------% :- pred map_set_or_update(func(V) = V, K, V, map(K, V), map(K, V)). :- mode map_set_or_update(in, in, in, in, out) is det. %-----------------------------------------------------------------------% %-----------------------------------------------------------------------% :- implementation. :- import_module bool. :- import_module require. :- import_module string. :- import_module uint32. :- import_module uint64. %-----------------------------------------------------------------------% exit_error(ErrMsg, !IO) :- write_string(stderr_stream, ErrMsg ++ "\n", !IO), set_exit_status(1, !IO). %-----------------------------------------------------------------------% curry(F, A - B) = F(A, B). %-----------------------------------------------------------------------% one_item(Xs) = ( if Xs = [X] then X else unexpected($file, $pred, "Expected a list with only one item") ). first_item([]) = unexpected($file, $pred, "Expected a list with at least one item"). first_item([X | _]) = X. one_item_in_set(Set) = X :- ( if is_singleton(Set, X0) then X = X0 else unexpected($file, $pred, "Expected a set with only one item") ). %-----------------------------------------------------------------------% maybe_list(yes(X)) = [X]. maybe_list(no) = []. list_maybe_to_list([]) = []. list_maybe_to_list([no | List]) = list_maybe_to_list(List). list_maybe_to_list([yes(X) | List]) = [X | list_maybe_to_list(List)]. %-----------------------------------------------------------------------% maybe_cord(yes(X)) = singleton(X). maybe_cord(no) = init. %-----------------------------------------------------------------------% find_duplicates(List, Dups) :- find_duplicates_2(List, set.init, set.init, Dups). :- pred find_duplicates_2(list(X)::in, set(X)::in, set(X)::in, set(X)::out) is det. find_duplicates_2([], _, !Dups). find_duplicates_2([X | Xs], !.Seen, !Dups) :- ( if member(X, !.Seen) then insert(X, !Dups) else insert(X, !Seen) ), find_duplicates_2(Xs, !.Seen, !Dups). %-----------------------------------------------------------------------% maybe_error_map(_, error(Error)) = error(Error). maybe_error_map(Func, ok(X)) = ok(Func(X)). %-----------------------------------------------------------------------% maybe_error_list(Results) = maybe_error_list_ok(Results, []). :- func maybe_error_list_ok(list(maybe_error(A, E)), list(A)) = maybe_error(list(A), list(E)). maybe_error_list_ok([], Rev) = ok(reverse(Rev)). maybe_error_list_ok([ok(R) | Rs], Rev) = maybe_error_list_ok(Rs, [R | Rev]). maybe_error_list_ok([error(E) | Rs], _) = maybe_error_list_error(Rs, [E]). :- func maybe_error_list_error(list(maybe_error(A, E)), list(E)) = maybe_error(list(A), list(E)). maybe_error_list_error([], Rev) = error(reverse(Rev)). maybe_error_list_error([error(E) | Rs], Rev) = maybe_error_list_error(Rs, [E | Rev]). maybe_error_list_error([ok(_) | Rs], Rev) = maybe_error_list_error(Rs, Rev). %-----------------------------------------------------------------------% set_map_foldl2(Pred, Set0, Set, !Acc1, !Acc2) :- List0 = to_sorted_list(Set0), list.map_foldl2(Pred, List0, List, !Acc1, !Acc2), Set = list_to_set(List). %-----------------------------------------------------------------------% map2_corresponding(P, Xs0, Ys0, As, Bs) :- ( if Xs0 = [], Ys0 = [] then As = [], Bs = [] else if Xs0 = [X | Xs], Ys0 = [Y | Ys] then P(X, Y, A, B), map2_corresponding(P, Xs, Ys, As0, Bs0), As = [A | As0], Bs = [B | Bs0] else unexpected($file, $pred, "Mismatched inputs") ). map4_corresponding2(P, As0, Bs0, Cs0, Ds0, Xs, Ys) :- ( if As0 = [], Bs0 = [], Cs0 = [], Ds0 = [] then Xs = [], Ys = [] else if As0 = [A | As], Bs0 = [B | Bs], Cs0 = [C | Cs], Ds0 = [D | Ds] then P(A, B, C, D, X, Y), map4_corresponding2(P, As, Bs, Cs, Ds, Xs0, Ys0), Xs = [X | Xs0], Ys = [Y | Ys0] else unexpected($file, $pred, "Mismatched inputs") ). %-----------------------------------------------------------------------% remove_first_match_map(Pred, Y, [X | Xs], Ys) :- ( if Pred(X, YP) then Y = YP, Ys = Xs else remove_first_match_map(Pred, Y, Xs, Ys0), Ys = [X | Ys0] ). %-----------------------------------------------------------------------% det_uint32_to_int(Uint32) = Int :- Int = cast_to_int(Uint32), % This should catch cases when this doesn't work. ( if from_int(Int, Uint32) then true else unexpected($file, $pred, "Uint32 out of range") ). %-----------------------------------------------------------------------% det_uint64_to_int(Uint64) = Int :- Int = cast_to_int(Uint64), ( if from_int(Int, Uint64) then true else unexpected($file, $pred, "Uint64 out of range") ). %-----------------------------------------------------------------------% list_join(_, []) = []. list_join(_, [X]) = [X]. list_join(J, [X1, X2 | Xs]) = [X1 | J ++ list_join(J, [X2 | Xs])]. %-----------------------------------------------------------------------% bag_list_to_bag(LoB) = foldl(union, LoB, init). %-----------------------------------------------------------------------% string_join(Sep, List) = append_list(list_join([Sep], List)). %-----------------------------------------------------------------------% list_delete_first_match(Xs0, Pred, Xs) :- list_delete_first_match(Xs0, Pred, [], Xs). :- pred list_delete_first_match(list(T), pred(T), list(T), list(T)). :- mode list_delete_first_match(in, pred(in) is semidet, in, out) is semidet. list_delete_first_match([X | Xs0], Pred, !Xs) :- ( if Pred(X) then reverse(!Xs) else !:Xs = [X | !.Xs], list_delete_first_match(Xs0, Pred, !Xs) ). %-----------------------------------------------------------------------% power_intersect_list([]) = unexpected($file, $pred, "Answer is infinite"). power_intersect_list([H | T]) = power_intersect_list_2(H, T). :- func power_intersect_list_2(set(T), list(set(T))) = set(T). power_intersect_list_2(A, []) = A. power_intersect_list_2(A, [B | Ls]) = power_intersect_list_2(A `intersect` B, Ls). %-----------------------------------------------------------------------% handle_bool_option(OptionTable, Option, True, False) = Result :- lookup_bool_option(OptionTable, Option, Bool), ( Bool = yes, Result = True ; Bool = no, Result = False ). %-----------------------------------------------------------------------% map_set_or_update(UpdateFn, Key, Value, !Map) :- ( if search(!.Map, Key, OldValue) then det_update(Key, UpdateFn(OldValue), !Map) else set(Key, Value, !Map) ). %-----------------------------------------------------------------------% %-----------------------------------------------------------------------% ================================================ FILE: src/util.my_exception.m ================================================ %-----------------------------------------------------------------------% % Exception utility code % vim: ts=4 sw=4 et % % Copyright (C) Plasma Team % Distributed under the terms of the MIT License see ../LICENSE.code % %-----------------------------------------------------------------------% :- module util.my_exception. :- interface. :- import_module io. :- import_module maybe. :- import_module context. %-----------------------------------------------------------------------% % This exception and its routines are temporary, they should be used for % code that finds a compilation error, but error handling is not % properly setup in that area of the compiler. This helps by making % these errors a little more friendly, and by allowing us to search the % source code for these locations when we eventually add error handling. % :- type compile_error_exception ---> compile_error_exception(string, string, maybe(context), string). :- pred compile_error(string::in, string::in, string::in) is erroneous. :- pred compile_error(string::in, string::in, context::in, string::in) is erroneous. % This is an alternative to the sorry/1 predicate in the Mercury % standard library. This predicate uses a dedicated exception type and % is caught explicitly by plasmac's main/2 predicate. % :- type unimplemented_exception ---> unimplemented_exception(string, string, maybe(context), string). :- pred sorry(string::in, string::in, string::in) is erroneous. :- pred sorry(string::in, string::in, context::in, string::in) is erroneous. :- func sorry(string, string, string) = T. :- mode sorry(in, in, in) = (out) is erroneous. :- func sorry(string, string, context, string) = T. :- mode sorry(in, in, in, in) = (out) is erroneous. % Like sorry except that these exceptions are used for things we think % are unlikely. Like trying to roll more than 256 items on the PZ % stack. If they happen to real people then we'll try to address them % and can probably do something about them. % :- type design_limitation_exception ---> design_limitation_exception(string, string, string). :- pred limitation(string::in, string::in, string::in) is erroneous. % TODO: add "unexpected" exception. :- type tool ---> plzc ; plzasm ; plzgeninit ; plzlnk. :- type had_errors ---> had_errors ; did_not_have_errors. :- pred run_and_catch(pred(io, io), tool, had_errors, io, io). :- mode run_and_catch(pred(di, uo) is det, in, out, di, uo) is cc_multi. %-----------------------------------------------------------------------% %-----------------------------------------------------------------------% :- implementation. :- import_module exception. :- import_module list. :- import_module pair. :- import_module string. %-----------------------------------------------------------------------% compile_error(File, Pred, Message) :- throw(compile_error_exception(File, Pred, no, Message)). compile_error(File, Pred, Context, Message) :- throw(compile_error_exception(File, Pred, yes(Context), Message)). sorry(File, Pred, Message) :- throw(unimplemented_exception(File, Pred, no, Message)). sorry(File, Pred, Context, Message) :- throw(unimplemented_exception(File, Pred, yes(Context), Message)). sorry(File, Pred, Message) = _ :- my_exception.sorry(File, Pred, Message). sorry(File, Pred, Context, Message) = _ :- my_exception.sorry(File, Pred, Context, Message). limitation(File, Pred, Message) :- throw(design_limitation_exception(File, Pred, Message)). %-----------------------------------------------------------------------% run_and_catch(Run, Tool, HadErrors, !IO) :- ( try [io(!IO)] ( Run(!IO) ) then HadErrors = did_not_have_errors catch compile_error_exception(File, Pred, MaybeContext, Msg) -> HadErrors = had_errors, Description = "A compilation error occured and this error is not handled gracefully\n" ++ "by the " ++ tool_name(Tool) ++ ". Sorry.", ShortName = tool_short_name(Tool), print_exception(Description, ["Message" - Msg] ++ context_line(MaybeContext) ++ [(ShortName ++ " location") - Pred, (ShortName ++ " file") - File], !IO) catch unimplemented_exception(File, Pred, MaybeContext, Feature) -> HadErrors = had_errors, print_exception( "A feature required by your program is currently unimplemented,\n" ++ "however this is something we hope to implement in the future. Sorry\n", ["Feature" - Feature] ++ context_line(MaybeContext) ++ ["Location" - Pred, "File" - File], !IO) catch design_limitation_exception(File, Pred, Message) -> HadErrors = had_errors, print_exception( "This program pushes Plasma beyond what it is designed to do. If this\n" ++ "happens on real programs (not a stress test) please contact us and\n" ++ "we'll do what we can to fix it.", ["Message" - Message, "Location" - Pred, "File" - File], !IO) catch software_error(Message) -> HadErrors = had_errors, print_exception( "The " ++ tool_name(Tool) ++ " has crashed due to a bug (an assertion failure or\n" ++ "unhandled state). Please make a bug report. Sorry.", ["Message" - Message], !IO) ). :- func context_line(maybe(context)) = list(pair(string, string)). context_line(no) = []. context_line(yes(Context)) = ["Context" - context_string(Context)]. :- pred print_exception(string::in, list(pair(string, string))::in, io::di, io::uo) is det. print_exception(Message, Fields, !IO) :- write_string(stderr_stream, Message, !IO), io.nl(!IO), foldl(exit_exception_field, Fields, !IO). :- pred exit_exception_field(pair(string, string)::in, io::di, io::uo) is det. exit_exception_field(Name - Value, !IO) :- write_string(pad_right(Name ++ ": ", ' ', 20), !IO), write_string(Value, !IO), nl(!IO). :- func tool_name(tool) = string. tool_name(plzc) = "Plasma compiler". tool_name(plzasm) = "Plasma bytecode assembler". tool_name(plzlnk) = "Plasma bytecode linker". tool_name(plzgeninit) = "Plasma foreign interface generator". :- func tool_short_name(tool) = string. tool_short_name(T) = string(T). %-----------------------------------------------------------------------% %-----------------------------------------------------------------------% ================================================ FILE: src/util.my_io.m ================================================ %-----------------------------------------------------------------------% % vim: ts=4 sw=4 et %-----------------------------------------------------------------------% :- module util.my_io. % % Tag Length Value serialisation. % % Copyright (C) Plasma Team % Distributed under the terms of the MIT License see ../LICENSE.code % %-----------------------------------------------------------------------% :- interface. :- import_module io. :- import_module list. :- import_module maybe. %-----------------------------------------------------------------------% % write_len_string(Stream, String, !IO) % % Write a 16bit length followed by the string. % :- pred write_len_string(binary_output_stream::in, string::in, io::di, io::uo) is det. :- pred read_len_string(binary_input_stream::in, maybe_error(string)::out, io::di, io::uo) is det. % write_string(Stream, String, !IO) % :- pred write_string(binary_output_stream::in, string::in, io::di, io::uo) is det. :- pred read_string(binary_input_stream::in, int::in, maybe_error(string)::out, io::di, io::uo) is det. :- pred read_uint8(binary_input_stream::in, maybe_error(uint8)::out, io::di, io::uo) is det. :- pred read_uint16(binary_input_stream::in, maybe_error(uint16)::out, io::di, io::uo) is det. :- pred read_uint32(binary_input_stream::in, maybe_error(uint32)::out, io::di, io::uo) is det. :- pred read_int32(binary_input_stream::in, maybe_error(int32)::out, io::di, io::uo) is det. :- pred read_uint64(binary_input_stream::in, maybe_error(uint64)::out, io::di, io::uo) is det. %-----------------------------------------------------------------------% :- func combine_read_2(maybe_error(T1), maybe_error(T2)) = maybe_error({T1, T2}). :- func combine_read_3(maybe_error(T1), maybe_error(T2), maybe_error(T3)) = maybe_error({T1, T2, T3}). :- func combine_read_5(maybe_error(T1), maybe_error(T2), maybe_error(T3), maybe_error(T4), maybe_error(T5)) = maybe_error({T1, T2, T3, T4, T5}). :- func combine_read_6(maybe_error(T1), maybe_error(T2), maybe_error(T3), maybe_error(T4), maybe_error(T5), maybe_error(T6)) = maybe_error({T1, T2, T3, T4, T5, T6}). :- func combine_read_7(maybe_error(T1), maybe_error(T2), maybe_error(T3), maybe_error(T4), maybe_error(T5), maybe_error(T6), maybe_error(T7)) = maybe_error({T1, T2, T3, T4, T5, T6, T7}). %-----------------------------------------------------------------------% :- type temp_file_info ---> temp_file_info( tfi_temp_file :: string, tfi_final_file :: string ). % Write a temporary file that represents the final file. % % The result, if successful, contains the temporary and final filename. % It can later be used by move_temps_if_successful to move the temporary % file over the final file. % % write_temp(Write, Open, Close, FinalFilename, Result, !IO), % :- pred write_temp( pred(string, io.res(S), io, io), pred(S, io, io), pred(S, maybe_error, io, io), string, maybe_error(temp_file_info), io, io). :- mode write_temp( pred(in, out, di, uo) is det, pred(in, di, uo) is det, pred(in, out, di, uo) is det, in, out, di, uo) is det. % Given a list of results from multiple calls to write_temp. If they all % succeed then move all the files into their correct position. If any % of them fail then return the failure. % :- pred move_temps_if_successful(list(maybe_error(temp_file_info))::in, maybe_error::out, io::di, io::uo) is det. % write_temp_and_move(OpenPred, ClosePred, WritePred, Filename, Result, % !IO) % :- pred write_temp_and_move( pred(string, io.res(S), io, io), pred(S, io, io), pred(S, maybe_error, io, io), string, maybe_error, io, io). :- mode write_temp_and_move( pred(in, out, di, uo) is det, pred(in, di, uo) is det, pred(in, out, di, uo) is det, in, out, di, uo) is det. %-----------------------------------------------------------------------% % List of all the files in the named directory. % % get_dir_list(Dir, Result, !IO) % :- pred get_dir_list(string::in, maybe_error(list(string))::out, io::di, io::uo) is det. %-----------------------------------------------------------------------% %-----------------------------------------------------------------------% :- implementation. :- import_module bool. :- import_module char. :- import_module int. :- import_module string. :- import_module uint16. :- import_module uint8. :- import_module util.path. %-----------------------------------------------------------------------% write_len_string(Stream, String, !IO) :- write_binary_uint16_le(Stream, det_from_int(length(String)), !IO), write_string(Stream, String, !IO). read_len_string(Stream, MaybeString, !IO) :- read_uint16(Stream, MaybeLen, !IO), ( MaybeLen = ok(Len), read_string(Stream, to_int(Len), MaybeString, !IO) ; MaybeLen = error(Error), MaybeString = error(Error) ). write_string(Stream, String, !IO) :- foldl(write_char_as_byte(Stream), String, !IO). read_string(Stream, Len, MaybeString, !IO) :- read_string_2(Stream, Len, "", MaybeString, !IO). :- pred read_string_2(binary_input_stream::in, int::in, string::in, maybe_error(string)::out, io::di, io::uo) is det. read_string_2(Stream, Len, Head, MaybeString, !IO) :- ( if Len > 0 then read_char_as_byte(Stream, MaybeChar, !IO), ( MaybeChar = ok(Char), % This is pretty inefficient. Fix it later / after bootstrap. % It's an interesting case where we should make the efficient % thing natural/easy/convenient in Plasma. read_string_2(Stream, Len - 1, Head ++ char_to_string(Char), MaybeString, !IO) ; MaybeChar = error(Error), MaybeString = error(Error) ) else MaybeString = ok(Head) ). :- pred write_char_as_byte(binary_output_stream::in, char::in, io::di, io::uo) is det. write_char_as_byte(Stream, Char, !IO) :- write_binary_uint8(Stream, det_from_int(to_int(Char) /\ 0xFF), !IO). :- pred read_char_as_byte(binary_input_stream::in, maybe_error(char)::out, io::di, io::uo) is det. read_char_as_byte(Stream, MaybeChar, !IO) :- read_binary_uint8(Stream, Result, !IO), ( Result = ok(UInt8), MaybeChar = ok(det_from_int(to_int(UInt8))) ; Result = eof, MaybeChar = error("eof") ; Result = error(Error), MaybeChar = error(error_message(Error)) ). %-----------------------------------------------------------------------% read_uint8(Stream, Result, !IO) :- read_binary_uint8(Stream, Result0, !IO), ( Result0 = ok(UInt8), Result = ok(UInt8) ; Result0 = eof, Result = error("eof") ; Result0 = error(Error), Result = error(error_message(Error)) ). read_uint16(Stream, simplify_result(Result), !IO) :- read_binary_uint16_le(Stream, Result, !IO). read_uint32(Stream, simplify_result(Result), !IO) :- read_binary_uint32_le(Stream, Result, !IO). read_int32(Stream, simplify_result(Result), !IO) :- read_binary_int32_le(Stream, Result, !IO). read_uint64(Stream, simplify_result(Result), !IO) :- read_binary_uint64_le(Stream, Result, !IO). :- func simplify_result(maybe_incomplete_result(T)) = maybe_error(T). simplify_result(Result) = MaybeInt :- ( Result = ok(Int), MaybeInt = ok(Int) ; ( Result = eof ; Result = incomplete(_) ), MaybeInt = error("eof") ; Result = error(Error), MaybeInt = error(error_message(Error)) ). %-----------------------------------------------------------------------% combine_read_2(Res1, Res2) = Res :- ( Res1 = ok(Ok1), ( Res2 = ok(Ok2), Res = ok({Ok1, Ok2}) ; Res2 = error(Error), Res = error(Error) ) ; Res1 = error(Error), Res = error(Error) ). combine_read_3(Res1, Res2, Res3) = Res :- ( Res1 = ok(Ok1), ( Res2 = ok(Ok2), ( Res3 = ok(Ok3), Res = ok({Ok1, Ok2, Ok3}) ; Res3 = error(Error), Res = error(Error) ) ; Res2 = error(Error), Res = error(Error) ) ; Res1 = error(Error), Res = error(Error) ). combine_read_5(Res1, Res2, Res3, Res4, Res5) = Res :- ( Res1 = ok(Ok1), ( Res2 = ok(Ok2), ( Res3 = ok(Ok3), ( Res4 = ok(Ok4), ( Res5 = ok(Ok5), Res = ok({Ok1, Ok2, Ok3, Ok4, Ok5}) ; Res5 = error(Error), Res = error(Error) ) ; Res4 = error(Error), Res = error(Error) ) ; Res3 = error(Error), Res = error(Error) ) ; Res2 = error(Error), Res = error(Error) ) ; Res1 = error(Error), Res = error(Error) ). combine_read_6(Res1, Res2, Res3, Res4, Res5, Res6) = Res :- ( Res1 = ok(Ok1), ( Res2 = ok(Ok2), ( Res3 = ok(Ok3), ( Res4 = ok(Ok4), ( Res5 = ok(Ok5), ( Res6 = ok(Ok6), Res = ok({Ok1, Ok2, Ok3, Ok4, Ok5, Ok6}) ; Res6 = error(Error), Res = error(Error) ) ; Res5 = error(Error), Res = error(Error) ) ; Res4 = error(Error), Res = error(Error) ) ; Res3 = error(Error), Res = error(Error) ) ; Res2 = error(Error), Res = error(Error) ) ; Res1 = error(Error), Res = error(Error) ). combine_read_7(Res1, Res2, Res3, Res4, Res5, Res6, Res7) = Res :- ( Res1 = ok(Ok1), ( Res2 = ok(Ok2), ( Res3 = ok(Ok3), ( Res4 = ok(Ok4), ( Res5 = ok(Ok5), ( Res6 = ok(Ok6), ( Res7 = ok(Ok7), Res = ok({Ok1, Ok2, Ok3, Ok4, Ok5, Ok6, Ok7}) ; Res7 = error(Error), Res = error(Error) ) ; Res6 = error(Error), Res = error(Error) ) ; Res5 = error(Error), Res = error(Error) ) ; Res4 = error(Error), Res = error(Error) ) ; Res3 = error(Error), Res = error(Error) ) ; Res2 = error(Error), Res = error(Error) ) ; Res1 = error(Error), Res = error(Error) ). %-----------------------------------------------------------------------% write_temp(Open, Close, Write, Filename, Result, !IO) :- TempFilename = make_temp_filename(Filename), Open(TempFilename, MaybeFile, !IO), ( MaybeFile = ok(File), Write(File, Result1, !IO), Close(File, !IO), ( Result1 = ok, Result = ok(temp_file_info(TempFilename, Filename)) ; Result1 = error(Error), Result = error(Error) ) ; MaybeFile = error(Error), Result = error(format("%s: %s", [s(Filename), s(error_message(Error))])) ). move_temps_if_successful([], ok, !IO). move_temps_if_successful([R | Rs], Result, !IO) :- ( R = ok(TempFileInfo), move_temps_if_successful(Rs, Result0, !IO), ( Result0 = ok, TempFilename = TempFileInfo ^ tfi_temp_file, Filename = TempFileInfo ^ tfi_final_file, io.rename_file(TempFilename, Filename, MoveRes, !IO), ( MoveRes = ok, Result = ok ; MoveRes = error(Error), Result = error(format("%s: %s", [s(Filename), s(error_message(Error))])) ) ; Result0 = error(_), Result = Result0 ) ; R = error(Error), Result = error(Error) ). write_temp_and_move(Open, Close, Write, Filename, Result, !IO) :- write_temp(Open, Close, Write, Filename, Result0, !IO), ( Result0 = ok(TempFileInfo), io.rename_file(TempFileInfo ^ tfi_temp_file, Filename, MoveRes, !IO), ( MoveRes = ok, Result = ok ; MoveRes = error(Error), Result = error(format("%s: %s", [s(Filename), s(error_message(Error))])) ) ; Result0 = error(Error), Result = error(Error) ). %-----------------------------------------------------------------------% get_dir_list(Dirname, MaybeFiles, !IO) :- opendir(Dirname, MaybeDir, !IO), ( MaybeDir = ok(Dir), lsdir(Dir, [], MaybeFiles, !IO), closedir(Dir, !IO) ; MaybeDir = error(Error), MaybeFiles = error(Error) ). :- pragma foreign_decl("C", local, " #include #include "). :- type dir. :- pragma foreign_type("C", dir, "DIR*"). :- pred opendir(string::in, maybe_error(dir)::out, io::di, io::uo) is det. opendir(Name, MaybeDir, !IO) :- opendir_c(Name, Ok, Dir, Error, !IO), ( Ok = yes, MaybeDir = ok(Dir) ; Ok = no, MaybeDir = error(Error) ). :- pred opendir_c(string::in, bool::out, dir::out, string::out, io::di, io::uo) is det. :- pragma foreign_proc("C", opendir_c(Name::in, Ok::out, Dir::out, Error::out, _IO0::di, _IO::uo), [promise_pure, will_not_call_mercury, will_not_throw_exception, thread_safe], " Dir = opendir(Name); if (Dir) { Ok = MR_TRUE; Error = NULL; } else { Ok = MR_FALSE; Error = GC_strdup(strerror(errno)); } "). :- pred closedir(dir::in, io::di, io::uo) is det. :- pragma foreign_proc("C", closedir(Dir::in, _IO0::di, _IO::uo), [promise_pure, will_not_call_mercury, will_not_throw_exception, thread_safe], " closedir(Dir); "). :- pred lsdir(dir::in, list(string)::in, maybe_error(list(string))::out, io::di, io::uo) is det. lsdir(Dir, Acc, Result, !IO) :- readdir(Dir, MaybeRead, !IO), ( MaybeRead = ok(Name), lsdir(Dir, [Name | Acc], Result, !IO) ; MaybeRead = eof, Result = ok(reverse(Acc)) ; MaybeRead = error(Error), Result = error(Error) ). :- type readdir_result ---> ok(string) ; eof ; error(string). :- pred readdir(dir::in, readdir_result::out, io::di, io::uo) is det. readdir(Dir, Result, !IO) :- readdir_c(Dir, Ok, EOF, Entry, Error, !IO), ( Ok = yes, Result = ok(Entry) ; Ok = no, ( EOF = yes, Result = eof ; EOF = no, Result = error(Error) ) ). :- pred readdir_c(dir::in, bool::out, bool::out, string::out, string::out, io::di, io::uo) is det. :- pragma foreign_proc("C", readdir_c(Dir::in, Ok::out, Eof::out, Entry::out, Error::out, _IO0::di, _IO::uo), [promise_pure, will_not_call_mercury, will_not_throw_exception], " errno = 0; // readdir is not defined to be threadsafe, but most modern systems // will implement it this way. We don not need to take any chances. struct dirent *ent = readdir(Dir); if (ent) { Ok = MR_TRUE; Entry = GC_strdup(ent->d_name); } else { Ok = MR_FALSE; if (errno) { Eof = MR_FALSE; Error = GC_strdup(strerror(errno)); } else { Eof = MR_TRUE; } } "). %-----------------------------------------------------------------------% ================================================ FILE: src/util.my_string.m ================================================ %-----------------------------------------------------------------------% % vim: ts=4 sw=4 et %-----------------------------------------------------------------------% :- module util.my_string. % % String manipulation utils. % % Copyright (C) Plasma Team % Distributed under the terms of the MIT License see ../LICENSE.code % % Routines for escaping and unescaping strings. % %-----------------------------------------------------------------------% :- interface. %-----------------------------------------------------------------------% :- func escape_string(string) = string. :- func unescape_string(string) = string. %-----------------------------------------------------------------------% %-----------------------------------------------------------------------% :- implementation. :- import_module char. :- import_module int. :- import_module list. :- import_module string. :- import_module util.my_exception. %-----------------------------------------------------------------------% escape_string(String) = from_char_list(['"'] ++ escape_chars(to_char_list(String), []) ++ ['"']). :- func escape_chars(list(char), list(char)) = list(char). escape_chars([], Done) = reverse(Done). escape_chars([C0 | Cs], Done0) = Done :- ( if escape_char(C, C0) then Done1 = [C, '\\' | Done0] else if C0 = ('\"') then Done1 = ['"', '\\' | Done0] else Done1 = [C0 | Done0] ), Done = escape_chars(Cs, Done1). unescape_string(S0) = from_char_list(C) :- between(S0, 1, length(S0) - 1, S1), C1 = to_char_list(S1), unescape_string_loop(C1) = C. :- func unescape_string_loop(list(char)) = list(char). unescape_string_loop([]) = []. unescape_string_loop([C | Cs0]) = Cs :- ( if C = ('\\') then Cs = unescape_string_loop_do_escape(Cs0) else Cs = [C | unescape_string_loop(Cs0)] ). :- func unescape_string_loop_do_escape(list(char)) = list(char). unescape_string_loop_do_escape([]) = util.my_exception.sorry($file, $pred, "Lexer does not support escaping the double quote"). unescape_string_loop_do_escape([C0 | Cs0]) = Cs :- ( if escape_char(C0, C1) then C = C1 else % Interpret the escaped character as if it was not escaped. C = C0 ), Cs = [C | unescape_string_loop(Cs0)]. :- pred escape_char(char, char). :- mode escape_char(in, out) is semidet. :- mode escape_char(out, in) is semidet. escape_char('n', '\n'). escape_char('r', '\r'). escape_char('t', '\t'). escape_char('v', '\v'). escape_char('f', '\f'). escape_char('b', '\b'). escape_char('\\', '\\'). %-----------------------------------------------------------------------% %-----------------------------------------------------------------------% ================================================ FILE: src/util.my_time.m ================================================ %-----------------------------------------------------------------------% % Timing utility code % vim: ts=4 sw=4 et % % Copyright (C) Plasma Team % Distributed under the terms of the MIT License see ../LICENSE.code % %-----------------------------------------------------------------------% :- module util.my_time. :- interface. :- import_module io. :- import_module string. %-----------------------------------------------------------------------% :- type time2(T) ---> time2( t_real_time :: T, t_cpu_time :: T ). :- type timestamp. :- type duration. %-----------------------------------------------------------------------% :- pred now(time2(timestamp)::out, io::di, io::uo) is det. :- func diff_time(time2(timestamp), time2(timestamp)) = time2(duration). :- func str_time(duration) = string. :- func format_duration(time2(duration)) = string. %-----------------------------------------------------------------------% %-----------------------------------------------------------------------% :- implementation. :- import_module float. :- import_module int64. :- import_module list. :- type timestamp == timespec. :- type duration == timespec. %-----------------------------------------------------------------------% :- pragma foreign_decl("C", "#include "). :- type clock_id ---> clock_real ; clock_cpu. :- pragma foreign_enum("C", clock_id/0, [ clock_real - "CLOCK_MONOTONIC", % Linux specific clock_cpu - "CLOCK_PROCESS_CPUTIME_ID" ]). :- type timespec. :- pragma foreign_type("C", timespec, "struct timespec"). :- pred timespec(timespec, int64, int64). :- mode timespec(in, out, out) is det. :- mode timespec(out, in, in) is det. :- pragma foreign_proc("C", timespec(TS::in, Secs::out, NSecs::out), [promise_pure, thread_safe, will_not_throw_exception, will_not_call_mercury], " Secs = TS.tv_sec; NSecs = TS.tv_nsec; "). :- pragma foreign_proc("C", timespec(TS::out, Secs::in, NSecs::in), [promise_pure, thread_safe, will_not_throw_exception, will_not_call_mercury], " TS.tv_sec = Secs; TS.tv_nsec = NSecs; "). %-----------------------------------------------------------------------% now(time2(Real, CPU), !IO) :- now(clock_real, Real, !IO), now(clock_cpu, CPU, !IO). :- pred now(clock_id::in, timestamp::out, io::di, io::uo) is det. :- pragma foreign_proc("C", now(Clock::in, Time::out, _IO0::di, _IO::uo), [promise_pure, thread_safe, will_not_throw_exception, will_not_call_mercury], " int ret = clock_gettime(Clock, &Time); if (ret != 0) { perror(""Warning, clock_gettime""); Time.tv_sec = 0; Time.tv_nsec = 0; } "). %-----------------------------------------------------------------------% diff_time(time2(RealAfter, CPUAfter), time2(RealBefore, CPUBefore)) = time2(RealAfter - RealBefore, CPUAfter - CPUBefore). :- func timespec - timespec = timespec. T1 - T2 = T :- timespec(T1, T1Sec0, T1NSec0), timespec(T2, T2Sec, T2NSec), ( if T1NSec0 < T2NSec then % Need to carry. T1Sec = T1Sec0 - 1i64, T1NSec = T1NSec0 + 1_000_000_000i64 else T1Sec = T1Sec0, T1NSec = T1NSec0 ), timespec(T, T1Sec - T2Sec, T1NSec - T2NSec). %-----------------------------------------------------------------------% str_time(Duration) = format("%.2f%s", [f(Float), s(Unit)]) :- timespec(Duration, Secs, NSecs), ( if Secs > 0i64 then Float = float.cast_from_int64(Secs) + (float.cast_from_int64(NSecs) / 1_000_000_000.0), Unit = "s" else if NSecs > 1_000_000i64 then Float = float.cast_from_int64(NSecs) / 1_000_000.0, Unit = "ms" else if NSecs > 1_000i64 then Float = float.cast_from_int64(NSecs) / 1_000.0, Unit = "us" else Float = float.cast_from_int64(NSecs), Unit = "ns" ). format_duration(Time) = format("real: %s, cpu: %s", [s(str_time(Time ^ t_real_time)), s(str_time(Time ^ t_cpu_time))]). %-----------------------------------------------------------------------% %-----------------------------------------------------------------------% ================================================ FILE: src/util.path.m ================================================ %-----------------------------------------------------------------------% % Path Utility code % vim: ts=4 sw=4 et % % Copyright (C) Plasma Team % Distributed under the terms of the MIT License see ../LICENSE.code % %-----------------------------------------------------------------------% :- module util.path. :- interface. %-----------------------------------------------------------------------% % file_and_dir(Path, Dir, File). % % Path = Dir ++ "/" ++ File AND File has no '/'. % :- pred file_and_dir(string, string, string). :- mode file_and_dir(in, out, out) is semidet. :- mode file_and_dir(out, in, in) is det. % file_and_dir(DefaultDir, Path, Dir, File). % % As above except if Path is unqualified then Dir = DefaultDir. % :- pred file_and_dir_det(string, string, string, string). :- mode file_and_dir_det(in, in, out, out) is det. % file_part(Path, File) :- % file_and_dir(Path, _, File). % :- pred file_part(string::in, string::out) is det. % file_change_extension(ExtA, ExtB, FileA, FileB) % Basename ++ ExtA = FileA, % Basename ++ ExtB = FileB % :- pred file_change_extension(string, string, string, string). :- mode file_change_extension(in, in, in, out) is semidet. % If the original source file doesn't have the right extension, then % simply append the new extension on the end. % :- pred file_change_extension_det(string, string, string, string). :- mode file_change_extension_det(in, in, in, out) is det. % filename_extension(Ext, FullName, Base). % % FullName = Base ++ Ext % :- pred filename_extension(string, string, string). :- mode filename_extension(in, in, out) is semidet. :- pred is_absolute(string::in) is semidet. :- pred is_relative(string::in) is semidet. %-----------------------------------------------------------------------% % TempFilename = make_temp_filename(Filename), % % Make a file name similar to Filename that can be used to write % incomplete data before moving it to Filename. % :- func make_temp_filename(string) = string. %-----------------------------------------------------------------------% %-----------------------------------------------------------------------% :- implementation. :- import_module char. :- import_module int. :- import_module list. :- import_module pair. :- import_module require. :- import_module string. %-----------------------------------------------------------------------% :- pragma promise_equivalent_clauses(file_and_dir/3). file_and_dir(Path::in, Dir::out, File::out) :- FilePartLength = suffix_length((pred(C::in) is semidet :- C \= ('/') ), Path), % This length is in code units. left(Path, length(Path) - FilePartLength - 1, Dir), Dir \= "", right(Path, FilePartLength, File). file_and_dir(Path::out, Dir::in, File::in) :- Path = Dir ++ "/" ++ File. file_and_dir_det(DefaultDir, Path, Dir, File) :- ( if file_and_dir(Path, Dir0, File0) then Dir = Dir0, File = File0 else Dir = DefaultDir, File = Path ). file_part(Path, File) :- file_and_dir_det("", Path, _, File). file_change_extension(ExtA, ExtB, FileA, FileB) :- filename_extension(ExtA, FileA, Base), FileB = Base ++ ExtB. file_change_extension_det(ExtA, ExtB, FileA, FileB) :- ( if file_change_extension(ExtA, ExtB, FileA, FileB0) then FileB = FileB0 else FileB = FileA ++ ExtB ). filename_extension(Ext, File, Base) :- remove_suffix(File, Ext, Base). is_absolute(Path) :- append("/", _, Path). is_relative(Path) :- \+ is_absolute(Path). %-----------------------------------------------------------------------% make_temp_filename(Orig) = ( if Orig = "" then unexpected($file, $pred, "Empty filename") else Orig ++ "~" ). %-----------------------------------------------------------------------% %-----------------------------------------------------------------------% ================================================ FILE: src/util.pretty.m ================================================ %-----------------------------------------------------------------------% % vim: ts=4 sw=4 et %-----------------------------------------------------------------------% :- module util.pretty. % % Pretty printer utils. % % Copyright (C) Plasma Team % Distributed under the terms of the MIT License see ../LICENSE.code % %-----------------------------------------------------------------------% :- interface. :- import_module cord. :- import_module list. %-----------------------------------------------------------------------% :- type pretty ---> p_unit(cord(string)) ; p_group(pretty_group_type, list(pretty)) ; p_group_curly( pgc_first_line :: list(pretty), pgc_open :: cord(string), pgc_inside :: list(pretty), pgc_close :: cord(string) ) ; p_comment( pc_comment_begin :: cord(string), pc_inside :: list(pretty) ) ; p_spc ; p_empty ; p_nl_hard ; p_nl_soft ; p_nl_double % A hard break that adds an extra newline. ; p_tabstop. :- type pretty_group_type ---> g_expr ; g_list ; g_para. :- func p_str(string) = pretty. % p_words will add soft breaks at every space character. :- func p_words(string) = list(pretty). :- func p_cord(cord(string)) = pretty. :- func p_quote(string, pretty) = pretty. :- func p_spc_nl = list(pretty). % The first type of pretty group is for expressions. It's what's been used % so far to format an expression like: % % let x = a + % b % y = foo() % z % :- func p_expr(list(pretty)) = pretty. % The second type is for lists, subsequent items arn't indented by a default % amount, they always start at the beginning, it can look like % % let x = [1, % 2, % 3] % % (the group is within the list). % :- func p_list(list(pretty)) = pretty. % The third type is for paragraphs. It is like the first type except % that each soft break is choosen individually rather than all-or-none. % :- func p_para(list(pretty)) = pretty. :- type options ---> options( o_max_line :: int, o_indent :: int ). :- func default_indent = int. :- func max_line = int. :- func default_options = options. % pretty(Options, CurIndent, Pretty) = Cord % :- func pretty(options, int, list(pretty)) = cord(string). % These do the same as the pretty function above, except they use % default options. They're useful for prettifying something with % defautl options to print it while throwing an exception. :- func pretty(list(pretty)) = cord(string). :- func pretty_str(list(pretty)) = string. %-----------------------------------------------------------------------% % pretty_callish(Prefix, Args), % pretty_callish(Prefix, Args, Postfix), % :- func pretty_callish(pretty, list(pretty)) = pretty. :- func pretty_optional_args(pretty, list(pretty)) = pretty. :- func pretty_seperated(list(pretty), list(pretty)) = list(pretty). % A shorthand for pretty_seperated([p_str(", "), p_nl_soft], X) % :- func pretty_comma_seperated(list(pretty)) = list(pretty). % maybe_pretty_args_maybe_prefix(Prefix, Items) = Pretty. % % Print a list of items with a prefix (if there are any items) and % parens if there are more than one item. % % [] -> "" % [X] -> Prefix ++ X % Xs -> pretty_callish(Prefix, Xs) % :- func maybe_pretty_args_maybe_prefix(list(pretty), list(pretty)) = pretty. :- func pretty_string(cord(string)) = string. %-----------------------------------------------------------------------% %-----------------------------------------------------------------------% :- implementation. :- import_module int. :- import_module maybe. :- import_module require. :- import_module string. :- import_module util.mercury. :- import_module util.my_string. %-----------------------------------------------------------------------% p_str(String) = p_unit(singleton(String)). p_words(String) = list_join([p_spc, p_nl_soft], map(p_str, words(String))). p_cord(Cord) = p_unit(Cord). p_quote(Q, P) = p_group(g_list, [p_str(Q), P, p_str(Q)]). p_spc_nl = [p_spc, p_nl_soft]. p_expr(Pretties) = p_group(g_expr, Pretties). p_list(Pretties) = p_group(g_list, Pretties). p_para(Pretties) = p_group(g_para, Pretties). %-----------------------------------------------------------------------% default_indent = 2. max_line = 80. default_options = options(max_line, default_indent). % % The pretty printer is implemented in three stages: % % + The first is the "client" of this API that turns something like Plasma's % core representation the pretty printer expression defined in this % module's interface. One example of this is core.pretty. % % + The second is in pretty_to_pis. It turns this nested expression into a % flat sequence of "print instructions". It is not stateful and will % allow for some memorisation/caching. % % + The third turns this series of instructions into the final cord(string). % it is in pis_to_output and is stateful. % % The main state we're concerned with is the current indentation level and % column number, these change depending on indentation choices. % pretty(Opts, Indent0, Pretties) = Cord :- ( if Pretties = [Pretty], ( Pretty = p_group(_, _) ; Pretty = p_group_curly(_, _, _, _) ) then DoIndent = no_indent else DoIndent = may_indent ), Indent = indent(Indent0, duplicate_char(' ', Indent0)), pretty_to_cord_retry(Opts, DoIndent, Indent, g_expr, Pretties, _DidBreak, empty_output(Indent0), Output), Cord = output_to_cord(Output). pretty(Pretties) = pretty(default_options, 0, Pretties). pretty_str(Pretties) = append_list(list(pretty(Pretties))). :- type print_instr ---> pi_cord(cord(string)) ; pi_nl ; pi_nl_hard % Start a comment without a newline ; pi_start_comment ; pi_nested(pretty_group_type, list(pretty)) % Nested pretties with open and close (oc) print instructions ; pi_nested_oc( pinoc_first_line :: list(print_instr), pinoc_open :: list(print_instr), pinoc_body :: list(pretty), pinoc_close :: list(print_instr) ) ; pi_custom_indent(string, list(print_instr)). %-----------------------------------------------------------------------% :- type break ---> no_break ; break. :- func pretty_to_pis(break, pretty) = list(print_instr). pretty_to_pis(_, p_unit(Cord)) = [pi_cord(Cord)]. pretty_to_pis(Break, p_group(Type, Pretties)) = Out :- ( if Pretties = [p_group(TypeInner, InnerPretties)] then Out = pretty_to_pis(Break, p_group(TypeInner, InnerPretties)) else if Pretties = [G @ p_group_curly(_, _, _, _)] then Out = pretty_to_pis(Break, G) else if all [P] ( member(P, Pretties) => not ( P = p_nl_hard ; P = p_nl_soft ) ) then % Don't add an indent if there's no linebreaks in this group. Out = condense(map(pretty_to_pis(Break), Pretties)) else Out = [pi_nested(Type, Pretties)] ). pretty_to_pis(Break, p_group_curly(First0, Open, Body, Close)) = Out :- ( if any_true(unify(p_nl_soft), Body) then unexpected($file, $pred, "Soft linebreak in curly group") else First = pretty_to_pis(Break, p_expr(First0)), Out = [pi_nested_oc(First, [pi_cord(Open)], Body, [pi_cord(Close)])] ). pretty_to_pis(Break, p_comment(Begin, Body)) = [pi_custom_indent( pretty_string(Begin), condense(map(pretty_to_pis(Break), Body)))]. pretty_to_pis(_, p_spc) = [pi_cord(singleton(" "))]. pretty_to_pis(_, p_empty) = []. pretty_to_pis(_, p_nl_hard) = [pi_nl_hard]. pretty_to_pis(_, p_nl_double) = [pi_nl_hard, pi_nl_hard]. pretty_to_pis(break, p_nl_soft) = [pi_nl]. pretty_to_pis(no_break, p_nl_soft) = []. pretty_to_pis(_, p_tabstop) = []. :- type indent_diff ---> id_default ; id_rel(int). %-----------------------------------------------------------------------% :- type retry_or_commit % A choicepoint further up the calltree needs retrying so that % it can enable soft breaks. ---> fail_if_overrun % Our caller has enabled soft breaks, we may retry if we need to % do the same. ; may_break_lines. % Whether or not a newline was "printed". % :- type did_break ---> did_break ; did_not_break. :- type indent ---> indent( i_pos :: int, i_string :: string ). :- pred pis_to_output(options::in, retry_or_commit::in, indent::in, list(print_instr)::in, output_builder::in, maybe(output_builder)::out, did_break::out) is det. pis_to_output(_, _, _, [], Output, yes(Output), did_not_break). pis_to_output(Opts, RoC, Indent, [Pi | Pis], !.Output, MaybeOutput, DidBreak) :- ( Pi = pi_cord(New), ( if !.Output ^ pos + cord_string_len(New) > Opts ^ o_max_line, % We only fail here if our caller is prepared to handle it. RoC = fail_if_overrun then MaybeOutput = no, DidBreak = did_not_break else output_add_new(New, !Output), pis_to_output(Opts, RoC, Indent, Pis, !.Output, MaybeOutput, DidBreak) ) ; ( Pi = pi_nl, output_newline(Indent, !Output), DidBreak = did_break % Hard breaks are only used in paragraphs, they're equivilent here. ; Pi = pi_nl_hard, output_newline(Indent, !Output), DidBreak = did_break ; Pi = pi_start_comment, output_start_comment(Indent, DidBreak, !Output) ), pis_to_output(Opts, RoC, Indent, Pis, !.Output, MaybeOutput, _) ; Pi = pi_nested(Type, Pretties), chain_op([ pis_to_output_nested(Opts, RoC, Type, Indent, may_indent, Pretties), pis_to_output(Opts, RoC, Indent, Pis) ], !.Output, MaybeOutput, DidBreak) ; Pi = pi_nested_oc(First, Open, Nested, Close), PosOpen = !.Output ^ pos, chain_op([ (pred(O::in, MO::out, DB::out) is det :- pis_to_output(Opts, RoC, Indent, First, O, MaybeFirst, FirstDidBreak), ( MaybeFirst = no, MO = no, DB = FirstDidBreak ; MaybeFirst = yes(FirstOutput), ( FirstDidBreak = did_break, MaybeNL = pi_nl ; FirstDidBreak = did_not_break, MaybeNL = pi_cord(singleton(" ")) ), pis_to_output(Opts, RoC, Indent, [MaybeNL] ++ Open, FirstOutput, MO, OpenDidBreak), DB = did_break_combine(FirstDidBreak, OpenDidBreak) ) ), (pred(O0::in, MO::out, DB::out) is det :- ( if PosOpen > Indent ^ i_pos then NewLevel = PosOpen + Opts ^ o_indent else NewLevel = Indent ^ i_pos + Opts ^ o_indent ), move_indent(NewLevel, Indent, SubIndent), output_newline(SubIndent, O0, O), pis_to_output_nested(Opts, RoC, g_expr, SubIndent, no_indent, Nested, O, MO, DB) ), pis_to_output(Opts, RoC, Indent, [pi_nl] ++ Close), pis_to_output(Opts, RoC, Indent, Pis) ], !.Output, MaybeOutput, DidBreak) ; Pi = pi_custom_indent(Begin, PisIndent), IndentCustom = indent(Indent ^ i_pos + length(Begin), Indent ^ i_string ++ Begin), chain_op([ pis_to_output(Opts, RoC, IndentCustom, [pi_start_comment] ++ PisIndent), pis_to_output(Opts, RoC, Indent, Pis) ], !.Output, MaybeOutput, DidBreak) ). :- pred pis_to_output_para(options::in, indent::in, list(print_instr)::in, output_builder::in, output_builder::out, did_break::in, did_break::out) is det. pis_to_output_para(_, _, [], !Output, !DidBreak) :- output_end_para(!Output). pis_to_output_para(Opts, Indent, [Pi | Pis], !Output, !DidBreak) :- ( Pi = pi_cord(New), output_add_new(New, !Output), ( if !.Output ^ pos > Opts ^ o_max_line then output_newline(Indent, !Output), !:DidBreak = did_break else true ) ; Pi = pi_nl, output_para_linebreak_maybe(!Output) ; Pi = pi_nl_hard, output_para_linebreak_maybe(!Output), output_newline(Indent, !Output) ; Pi = pi_start_comment, unexpected($file, $pred, "comment in paragraph") ; Pi = pi_nested(Type, Pretties), pis_to_output_nested(Opts, fail_if_overrun, Type, Indent, may_indent, Pretties, !.Output, MaybeOutputA, DidBreakA), ( MaybeOutputA = no, % Break at the most recent linebreak then try again. output_newline(Indent, !Output), !:DidBreak = did_break, pis_to_output_nested(Opts, fail_if_overrun, Type, Indent, may_indent, Pretties, !.Output, MaybeOutputB, DidBreakB), ( MaybeOutputB = no, pis_to_output_nested(Opts, may_break_lines, Type, Indent, may_indent, Pretties, !.Output, MaybeOutputC, DidBreakC), ( MaybeOutputC = no, unexpected($file, $pred, "Won't happen") ; MaybeOutputC = yes(!:Output), !:DidBreak = did_break_combine(DidBreakC, !.DidBreak) ) ; MaybeOutputB = yes(!:Output), !:DidBreak = did_break_combine(DidBreakB, !.DidBreak) ) ; MaybeOutputA = yes(!:Output), !:DidBreak = did_break_combine(DidBreakA, !.DidBreak) ) ; Pi = pi_nested_oc(_, _, _, _), unexpected($file, $pred, "nested_oc in paragraph") ; Pi = pi_custom_indent(_, _), unexpected($file, $pred, "custom in paragraph") ), pis_to_output_para(Opts, Indent, Pis, !Output, !DidBreak). :- pred pis_to_output_nested(options::in, retry_or_commit::in, pretty_group_type::in, indent::in, may_indent::in, list(pretty)::in, output_builder::in, maybe(output_builder)::out, did_break::out) is det. pis_to_output_nested(Opts, RoC, Type, Indent0, MayIndent, Pretties, !.Output, MaybeOutput, DidBreak) :- ( RoC = may_break_lines, pretty_to_cord_retry(Opts, MayIndent, Indent0, Type, Pretties, DidBreak, !Output), MaybeOutput = yes(!.Output) ; RoC = fail_if_overrun, ( MayIndent = may_indent, find_and_add_indent(Opts, no_break, Type, Pretties, !.Output ^ pos, Indent0, Indent) ; MayIndent = no_indent, Indent = Indent0 ), InstrsBreak = map(pretty_to_pis(no_break), Pretties), pis_to_output(Opts, RoC, Indent, condense(InstrsBreak), !.Output, MaybeOutput, DidBreak) ). :- type may_indent ---> may_indent ; no_indent. :- pred pretty_to_cord_retry(options::in, may_indent::in, indent::in, pretty_group_type::in, list(pretty)::in, did_break::out, output_builder::in, output_builder::out) is det. pretty_to_cord_retry(Opts, MayIndent, Indent0, Type, Pretties, DidBreak, !Output) :- ( MayIndent = may_indent, find_and_add_indent(Opts, no_break, Type, Pretties, !.Output ^ pos, Indent0, IndentA) ; MayIndent = no_indent, IndentA = Indent0 ), ( ( Type = g_expr ; Type = g_list ), InstrsNoBreak = condense(map(pretty_to_pis(no_break), Pretties)), % Without breaking on soft breaks, can we format all this code without % overrunning a line? pis_to_output(Opts, fail_if_overrun, IndentA, InstrsNoBreak, !.Output, MaybeOutput0, DidBreakA), ( MaybeOutput0 = yes(!:Output), DidBreak = DidBreakA ; MaybeOutput0 = no, % We can't so retry with soft breaks. ( MayIndent = may_indent, find_and_add_indent(Opts, no_break, Type, Pretties, !.Output ^ pos, Indent0, IndentB) ; MayIndent = no_indent, IndentB = Indent0 ), InstrsBreak = map(pretty_to_pis(break), Pretties), pis_to_output(Opts, may_break_lines, IndentB, condense(InstrsBreak), !.Output, MaybeOutput1, DidBreakB), DidBreak = DidBreakB, ( MaybeOutput1 = no, unexpected($file, $pred, "Fallback failed") ; MaybeOutput1 = yes(!:Output) ) ) ; Type = g_para, % For paragraphs there's no retry, we insert all breaks then % honner them only if we've exceeded the line length. ( MayIndent = may_indent, find_and_add_indent(Opts, no_break, Type, Pretties, !.Output ^ pos, Indent0, IndentB) ; MayIndent = no_indent, IndentB = Indent0 ), InstrsBreak = condense(map(pretty_to_pis(break), Pretties)), pis_to_output_para(Opts, IndentB, InstrsBreak, !Output, did_not_break, DidBreak) ). :- func did_break_combine(did_break, did_break) = did_break. did_break_combine(did_not_break, did_not_break) = did_not_break. did_break_combine(did_not_break, did_break) = did_break. did_break_combine(did_break, _) = did_break. %-----------------------------------------------------------------------% :- pred find_and_add_indent(options::in, break::in, pretty_group_type::in, list(pretty)::in, int::in, indent::in, indent::out) is det. find_and_add_indent(Opts, Break, GType, Pretties, Pos, !Indent) :- ( GType = g_expr ; GType = g_para ), find_indent(Break, Pretties, 0, FoundIndent), ( FoundIndent = id_default, ( if !.Indent ^ i_pos + Opts ^ o_indent > Pos then NewLevel = !.Indent ^ i_pos + Opts ^ o_indent else NewLevel = Pos + Opts ^ o_indent ) ; FoundIndent = id_rel(Rel), NewLevel = Pos + Rel ), move_indent(NewLevel, !Indent). find_and_add_indent(_, _, g_list, _, Pos, !Indent) :- ( if !.Indent ^ i_pos =< Pos then move_indent(Pos, !Indent) else true ). :- pred find_indent(break::in, list(pretty)::in, int::in, indent_diff::out) is det. find_indent(_, [], _, id_default). find_indent(Break, [P | Ps], Acc, Indent) :- ( P = p_unit(Cord), find_indent(Break, Ps, Acc + cord_string_len(Cord), Indent) ; P = p_spc, find_indent(Break, Ps, Acc + 1, Indent) ; P = p_empty, find_indent(Break, Ps, Acc, Indent) ; ( P = p_nl_hard ; P = p_nl_double ; P = p_nl_soft ), Indent = id_default, ( if all [T] ( member(T, Ps) => not T = p_tabstop ) then true else unexpected($file, $pred, "Break followed by tabstop") ) ; P = p_tabstop, Indent = id_rel(Acc), ( if some [B] ( member(B, Ps), ( B = p_nl_hard ; B = p_nl_soft ) ) then true else unexpected($file, $pred, "tabstop not followed by newline") ) ; P = p_group(Type, Pretties), FoundBreak = single_line_len(Break, Pretties, 0), ( FoundBreak = found_break, % If there was an (honored) break in the inner group the % outer group has a fixed indent of "offset" ( ( Type = g_expr ; Type = g_para ), Indent = id_default ; Type = g_list, Indent = id_rel(0) ) ; FoundBreak = single_line(Len), % But if the inner group had no breaks then the search for the % outer group's tabstop continues. % We can pass Break directly since if we didn't break outside % the group then the group is very likely to have the same break % when it set-out. (Not a guarantee but a good guess). find_indent(Break, Ps, Acc + Len, Indent) ) ; P = p_group_curly(_, _, _, _), % We always use the default indents for curly groups. Indent = id_default ; P = p_comment(Begin, Body), find_indent(Break, Body, Acc + cord_string_len(Begin), Indent) ). :- type single_line_len ---> found_break % When there was no break this returns the total length. ; single_line(int). :- func single_line_len(break, list(pretty), int) = single_line_len. single_line_len(_, [], Acc) = single_line(Acc). single_line_len(Break, [P | Ps], Acc) = FoundBreak :- ( P = p_unit(Cord), FoundBreak = single_line_len(Break, Ps, Acc + cord_string_len(Cord)) ; P = p_spc, FoundBreak = single_line_len(Break, Ps, Acc + 1) ; P = p_empty, FoundBreak = single_line_len(Break, Ps, Acc) ; ( P = p_nl_hard ; P = p_nl_double ), FoundBreak = found_break ; P = p_nl_soft, ( Break = break, FoundBreak = found_break ; Break = no_break, FoundBreak = single_line_len(Break, Ps, Acc + 1) ) ; P = p_tabstop, FoundBreak = single_line_len(Break, Ps, Acc) ; P = p_group(_, Pretties), FoundBreak = single_line_len(Break, Pretties ++ Ps, Acc) ; P = p_group_curly(_, _, _, _), unexpected($file, $pred, "I don't think this makes sense") ; P = p_comment(Begin, Body), FoundBreak = single_line_len(Break, Body, Acc + cord_string_len(Begin)) ). %-----------------------------------------------------------------------% % chain_op(Ops, Input, MaybeOutput, DidBreak, !B), % % Perform each operation in Ops (so long as they return yes(_), passing % the output of each to the input of the next, and threading the states % !A and !B. % :- pred chain_op( list(pred(A, maybe(A), did_break)), A, maybe(A), did_break). :- mode chain_op( in(list(pred(in, out, out) is det)), in, out, out) is det. chain_op([], Cord, yes(Cord), did_not_break). chain_op([Op | Ops], Cord0, MaybeCord, DidBreak) :- Op(Cord0, MaybeCord0, DidBreakA), ( MaybeCord0 = no, MaybeCord = no, DidBreak = DidBreakA ; MaybeCord0 = yes(Cord), chain_op(Ops, Cord, MaybeCord, DidBreakB), DidBreak = did_break_combine(DidBreakA, DidBreakB) ). %-----------------------------------------------------------------------% :- pred move_indent(int::in, indent::in, indent::out) is det. move_indent(NewLevel, Indent0, Indent) :- RelLevel = NewLevel - Indent0 ^ i_pos, String = Indent0 ^ i_string ++ duplicate_char(' ', RelLevel), Indent = indent(NewLevel, String). %-----------------------------------------------------------------------% % Use this type to build the output % :- type output_builder ---> output( output :: cord(string), last_line :: cord(string), pos :: int, since_break :: maybe(cord(string)) ). :- func empty_output(int) = output_builder. empty_output(InitialPos) = output(empty, empty, InitialPos, no). :- func output_to_cord(output_builder) = cord(string). output_to_cord(!.Output) = Cord :- output_end_line(!Output), Cord = !.Output ^ output. :- pred output_end_line(output_builder::in, output_builder::out) is det. output_end_line(!Output) :- ( if is_empty(!.Output ^ output) then Prev = init else Prev = !.Output ^ output ++ singleton("\n") ), LastLine = trim_line(!.Output ^ last_line), !Output ^ output := Prev ++ singleton(LastLine), !Output ^ last_line := init, !Output ^ pos := 0. :- pred output_add_new(cord(string)::in, output_builder::in, output_builder::out) is det. output_add_new(New, !Output) :- !Output ^ pos := !.Output ^ pos + cord_string_len(New), MbSinceBreak = !.Output ^ since_break, ( MbSinceBreak = no, !Output ^ last_line := !.Output ^ last_line ++ New ; MbSinceBreak = yes(SinceBreak), !Output ^ since_break := yes(SinceBreak ++ New) ). :- pred output_newline(indent::in, output_builder::in, output_builder::out) is det. output_newline(Indent, !Output) :- output_end_line(!Output), !Output ^ last_line := singleton(Indent ^ i_string), MbSinceBreak = !.Output ^ since_break, ( MbSinceBreak = no, !Output ^ pos := Indent ^ i_pos ; MbSinceBreak = yes(SinceBreak), !Output ^ pos := Indent ^ i_pos + cord_string_len(SinceBreak), !Output ^ last_line := !.Output ^ last_line ++ SinceBreak, !Output ^ since_break := no ). % There's a potential line break so move the stuff since the last % linebreak into output. % :- pred output_para_linebreak_maybe(output_builder::in, output_builder::out) is det. output_para_linebreak_maybe(!Output) :- SinceBreak = !.Output ^ since_break, ( SinceBreak = no, Since = init ; SinceBreak = yes(Since) ), !Output ^ since_break := yes(init), !Output ^ last_line := !.Output ^ last_line ++ Since. :- pred output_end_para(output_builder::in, output_builder::out) is det. output_end_para(!Output) :- % Commit to the current line (same as if a linebreak is encountered). output_para_linebreak_maybe(!Output), !Output ^ since_break := no. :- pred output_start_comment(indent::in, did_break::out, output_builder::in, output_builder::out) is det. output_start_comment(Indent, DidBreak, !Output) :- ( if is_output_line_empty(!.Output) then % Reset the indent without a newline. !Output ^ last_line := singleton(Indent ^ i_string), !Output ^ pos := Indent ^ i_pos, DidBreak = did_break else % Do a normal newline output_newline(Indent, !Output), DidBreak = did_not_break ). :- pred is_output_line_empty(output_builder::in) is semidet. is_output_line_empty(Output) :- LastLine = trim_line(Output ^ last_line), LastLine = "". :- func trim_line(cord(string)) = string. trim_line(Line) = rstrip(append_list(list(Line))). %-----------------------------------------------------------------------% :- func cord_string_len(cord(string)) = int. cord_string_len(Cord) = foldl(func(S, L) = length(S) + L, Cord, 0). %-----------------------------------------------------------------------% %-----------------------------------------------------------------------% pretty_callish(Prefix, Args) = Pretty :- ( if % If the prefix is sagnificant and either... is_sagnificant(Prefix), ( % there's only one argument being formatted or... Args = [_] ; % at least one argument is sagnificant... all [Arg] ( member(Arg, Args), is_sagnificant(Arg) ) ) then % then add a break after the opening paren. MaybeBreak = [p_nl_soft] else MaybeBreak = [] ), Pretty = p_expr([Prefix, p_str("(")] ++ MaybeBreak ++ [p_list(pretty_comma_seperated(Args)), p_str(")")]). :- pred is_sagnificant(pretty::in) is semidet. is_sagnificant(Pretty) :- SLLen = single_line_len(no_break, [Pretty], 0), ( SLLen = found_break ; SLLen = single_line(Len), Len > default_indent*3 ). pretty_optional_args(Prefix, []) = p_expr([Prefix]). pretty_optional_args(Prefix, Args@[_ | _]) = pretty_callish(Prefix, Args). pretty_seperated(Sep, Items) = list_join(Sep, Items). pretty_comma_seperated(Items) = pretty_seperated([p_str(", "), p_nl_soft], Items). maybe_pretty_args_maybe_prefix(_, []) = p_empty. maybe_pretty_args_maybe_prefix(Prefix, [X]) = p_expr(Prefix ++ [X]). maybe_pretty_args_maybe_prefix(Prefix, Xs@[_, _ | _]) = pretty_callish(p_expr(Prefix), Xs). %-----------------------------------------------------------------------% pretty_string(Cord) = append_list(list(Cord)). %-----------------------------------------------------------------------% %-----------------------------------------------------------------------% ================================================ FILE: src/util.pretty_old.m ================================================ %-----------------------------------------------------------------------% % vim: ts=4 sw=4 et %-----------------------------------------------------------------------% :- module util.pretty_old. % % Pretty printer utils. % % Copyright (C) Plasma Team % Distributed under the terms of the MIT License see ../LICENSE.code % %-----------------------------------------------------------------------% :- interface. :- import_module cord. :- import_module list. %-----------------------------------------------------------------------% :- func join(cord(T), list(cord(T))) = cord(T). :- func nl = cord(string). :- func spc = cord(string). :- func semicolon = cord(string). :- func colon = cord(string). :- func comma = cord(string). :- func period = cord(string). :- func comma_spc = cord(string). :- func bang = cord(string). :- func open_curly = cord(string). :- func close_curly = cord(string). :- func open_paren = cord(string). :- func close_paren = cord(string). :- func equals = cord(string). :- func indent(int) = cord(string). :- func line(int) = cord(string). %-----------------------------------------------------------------------% %-----------------------------------------------------------------------% :- implementation. :- import_module int. :- import_module util.mercury. %-----------------------------------------------------------------------% join(J, Xs) = cord_list_to_cord(list_join([J], Xs)). %-----------------------------------------------------------------------% nl = singleton("\n"). spc = singleton(" "). semicolon = singleton(";"). colon = singleton(":"). comma = singleton(","). period = singleton("."). comma_spc = comma ++ spc. bang = singleton("!"). open_curly = singleton("{"). close_curly = singleton("}"). open_paren = singleton("("). close_paren = singleton(")"). equals = singleton("="). %-----------------------------------------------------------------------% indent(N) = ( if N = 0 then init else singleton(" ") ++ indent(N-1) ). line(N) = nl ++ indent(N). %-----------------------------------------------------------------------% %-----------------------------------------------------------------------% ================================================ FILE: src/util.result.m ================================================ %-----------------------------------------------------------------------% % vim: ts=4 sw=4 et %-----------------------------------------------------------------------% :- module util.result. % % Copyright (C) Plasma Team % Distributed under the terms of the MIT License see ../LICENSE.code % % A result type, like maybe_error however it can track multiple compilation % errors. % %-----------------------------------------------------------------------% :- interface. :- import_module io. :- import_module cord. :- import_module list. :- import_module map. :- import_module maybe. :- import_module context. :- import_module util.pretty. %-----------------------------------------------------------------------% :- type result(T, E) ---> ok(T) ; errors(errors(E)). :- type result_partial(T, E) ---> ok(T, errors(E)) ; errors(errors(E)). :- type errors(E) == cord(error(E)). :- type error(E) ---> error( e_context :: context, e_error :: E ). %-----------------------------------------------------------------------% :- typeclass error(E) where [ % pretty(Error, ParaPart, ExtraPart) pred pretty(string::in, E::in, list(pretty)::out, list(pretty)::out) is det, func error_or_warning(E) = error_or_warning ]. :- instance error(string). :- type error_or_warning ---> error ; warning. %-----------------------------------------------------------------------% :- pred add_error(context::in, E::in, errors(E)::in, errors(E)::out) is det. % add_errors(NewErrors, !Errors) % % Add NewErrors to !Errors. % :- pred add_errors(errors(E)::in, errors(E)::in, errors(E)::out) is det. % Add errors if the result contains any. % :- pred add_errors_from_result(result(T, E)::in, errors(E)::in, errors(E)::out) is det. %-----------------------------------------------------------------------% :- func error(context, E) = errors(E). :- func return_error(context, E) = result(T, E). :- func return_error_p(context, E) = result_partial(T, E). :- func maybe_to_result(context, func(string) = string, maybe_error(T)) = result(T, string). %-----------------------------------------------------------------------% :- pred has_fatal_errors(errors(E)::in) is semidet <= error(E). % report_errors(SourcePath, Errors, !IO). % :- pred report_errors(string::in, errors(E)::in, io::di, io::uo) is det <= error(E). %-----------------------------------------------------------------------% :- pred result_list_to_result(list(result(T, E))::in, result(list(T), E)::out) is det. :- func result_list_to_result(list(result(T, E))) = result(list(T), E). :- func result_map((func(T) = U), result(T, E)) = result(U, E). %-----------------------------------------------------------------------% % foldl over a list except the accumulator includes a result that must % be unpact before processing the next item. If mercury had monads this % would be bind. % :- pred foldl_result(pred(X, A, result(A, E)), list(X), A, result(A, E)). :- mode foldl_result(pred(in, in, out) is det, in, in, out) is det. % Set or update the value within a map at the given key. if the update % function fails then return that error. % :- pred map_set_or_update_result(func(V) = result(V, E), K, V, map(K, V), result(map(K, V), E)). :- mode map_set_or_update_result(in, in, in, in, out) is det. %-----------------------------------------------------------------------% :- func errors_map((func(E1) = E2), errors(E1)) = errors(E2). %-----------------------------------------------------------------------% %-----------------------------------------------------------------------% :- implementation. :- import_module string. %-----------------------------------------------------------------------% add_error(Context, ErrorType, !Errors) :- Error = error(Context, ErrorType), !:Errors = snoc(!.Errors, Error). %-----------------------------------------------------------------------% add_errors(NewErrors, !Errors) :- !:Errors = !.Errors ++ NewErrors. add_errors_from_result(ok(_), !Errors). add_errors_from_result(errors(NewErrors), !Errors) :- add_errors(NewErrors, !Errors). %-----------------------------------------------------------------------% error(Context, Error) = singleton(error(Context, Error)). return_error(Context, Error) = errors(singleton(error(Context, Error))). return_error_p(Context, Error) = errors(singleton(error(Context, Error))). maybe_to_result(_, _, ok(X)) = ok(X). maybe_to_result(Context, Wrap, error(Msg)) = return_error(Context, Wrap(Msg)). %-----------------------------------------------------------------------% has_fatal_errors(Errors) :- member(Error, Errors), error_or_warning(Error ^ e_error) = error. report_errors(SourcePath, Errors, !IO) :- ErrorStrings = map(func(E) = error_to_string(SourcePath, E) ++ "\n", list(Errors)), write_string(append_list(ErrorStrings), !IO). :- func error_to_string(string, error(E)) = string <= error(E). error_to_string(SourcePath, error(Context, Error)) = String :- Type = error_or_warning(Error), ( if not is_nil_context(Context) then ( Type = error, Prefix = [p_str(context_string(SourcePath, Context)), p_str(":"), p_spc, p_tabstop] ; Type = warning, Prefix = [p_str(context_string(SourcePath, Context)), p_str(":"), p_spc, p_tabstop, p_str("Warning: ")] ) else ( Type = error, EoW = "Error: " ; Type = warning, EoW = "Warning: " ), Prefix = [p_str(EoW), p_tabstop] ), pretty(SourcePath, Error, Para, Extra), ( Extra = [], Pretty = [p_para(Prefix ++ Para)] ; Extra = [_ | _], Pretty = [p_para(Prefix ++ Para), p_nl_hard] ++ Extra ), String = append_list(list(pretty(options(80, 2), 0, Pretty))). %-----------------------------------------------------------------------% result_list_to_result(Results, Result) :- list.foldl(build_result, Results, ok([]), Result0), ( Result0 = ok(RevList), Result = ok(reverse(RevList)) ; Result0 = errors(_), Result = Result0 ). result_list_to_result(Results) = Result :- result_list_to_result(Results, Result). :- pred build_result(result(T, E)::in, result(list(T), E)::in, result(list(T), E)::out) is det. build_result(ok(X), ok(Xs), ok([X | Xs])). build_result(ok(_), R@errors(_), R). build_result(errors(E), ok(_), errors(E)). build_result(errors(E), errors(Es0), errors(Es)) :- add_errors(E, Es0, Es). %-----------------------------------------------------------------------% result_map(Func, ok(X)) = ok(Func(X)). result_map(_, errors(E)) = errors(E). %-----------------------------------------------------------------------% foldl_result(_, [], Acc, ok(Acc)). foldl_result(Pred, [X | Xs], Acc0, MaybeAcc) :- Pred(X, Acc0, MaybeAcc1), ( MaybeAcc1 = ok(Acc1), foldl_result(Pred, Xs, Acc1, MaybeAcc) ; MaybeAcc1 = errors(Error), MaybeAcc = errors(Error) ). %-----------------------------------------------------------------------% map_set_or_update_result(UpdateFn, Key, Value, !.Map, MaybeMap) :- ( if search(!.Map, Key, Old) then MaybeNew = UpdateFn(Old), ( MaybeNew = ok(New), det_update(Key, New, !Map), MaybeMap = ok(!.Map) ; MaybeNew = errors(Error), MaybeMap = errors(Error) ) else set(Key, Value, !Map), MaybeMap = ok(!.Map) ). %-----------------------------------------------------------------------% errors_map(Func, Errors) = map(error_map(Func), Errors). :- func error_map((func(E1) = E2), error(E1)) = error(E2). error_map(Func, error(Context, E)) = error(Context, Func(E)). %-----------------------------------------------------------------------% :- instance error(string) where [ pretty(_, S, p_words(S), []), error_or_warning(_) = error ]. %-----------------------------------------------------------------------% %-----------------------------------------------------------------------% ================================================ FILE: src/varmap.m ================================================ %-----------------------------------------------------------------------% % vim: ts=4 sw=4 et %-----------------------------------------------------------------------% :- module varmap. % % Copyright (C) Plasma Team % Distributed under the terms of the MIT License see ../LICENSE.code % % Plasma variable map data structure. % %-----------------------------------------------------------------------% :- interface. :- import_module list. :- import_module set. :- import_module string. :- import_module util. :- import_module util.pretty. :- type var. :- type var_or_wildcard(V) ---> var(V) ; wildcard. :- pred vow_is_var(var_or_wildcard(V)::in, V::out) is semidet. % A varmap provides name -> var and var -> name mappings. Note that % multiple variables can share the same name, for example on seperate % execution branches. In this way names are only a convenience to the % user. % :- type varmap. %-----------------------------------------------------------------------% :- func init = varmap. :- func get_var_name(varmap, var) = string. :- func get_var_name_no_suffix(varmap, var) = string. %-----------------------------------------------------------------------% % % This interface is constrained to one name per variable. It is used when % first setting up the varmap. These functions and predicates throw an % exception of they find multiple variables with the same name. % :- pred add_unique_var(string::in, var::out, varmap::in, varmap::out) is det. :- pred get_or_add_var(string::in, var::out, varmap::in, varmap::out) is det. :- pred add_anon_var(var::out, varmap::in, varmap::out) is det. :- pred add_n_anon_vars(int::in, list(var)::out, varmap::in, varmap::out) is det. :- pred search_var(varmap::in, string::in, var::out) is semidet. :- pred search_var_det(varmap::in, string::in, var::out) is det. %-----------------------------------------------------------------------% % % This interface allows multiple names per variable, it is used after % variable renaming has occured. % :- pred add_fresh_var(string::in, var::out, varmap::in, varmap::out) is det. :- pred search_vars(varmap::in, string::in, set(var)::out) is semidet. %-----------------------------------------------------------------------% :- pred var_or_make_var(var_or_wildcard(var)::in, var::out, varmap::in, varmap::out) is det. %-----------------------------------------------------------------------% :- func var_pretty(varmap, var) = pretty. :- func var_or_wild_pretty(varmap, var_or_wildcard(var)) = pretty. :- func vars_pretty(varmap, list(var)) = pretty. :- func vars_set_pretty(varmap, set(var)) = pretty. %-----------------------------------------------------------------------% %-----------------------------------------------------------------------% :- implementation. :- import_module int. :- import_module map. :- import_module require. %-----------------------------------------------------------------------% :- type var == int. %-----------------------------------------------------------------------% vow_is_var(var(V), V). %-----------------------------------------------------------------------% %-----------------------------------------------------------------------% :- type varmap ---> varmap( vm_forward :: map(var, string), vm_backward :: map(string, set(var)), vm_next_var :: var ). %-----------------------------------------------------------------------% init = varmap(init, init, 0). get_var_name(Varmap, Var) = Name :- Name = format("%s_%d", [s(get_var_name_no_suffix(Varmap, Var)), i(Var)]). get_var_name_no_suffix(Varmap, Var) = Name :- ( if search(Varmap ^ vm_forward, Var, Name0Prime) then Name = Name0Prime else Name = "v" ). %-----------------------------------------------------------------------% add_unique_var(Name, Var, !Varmap) :- add_anon_var(Var, !Varmap), add_forward_name(Name, Var, !Varmap), ( if search(!.Varmap ^ vm_backward, Name, _) then unexpected($file, $pred, "Variable already exists") else det_insert(Name, make_singleton_set(Var), !.Varmap ^ vm_backward, Backward), !Varmap ^ vm_backward := Backward ). get_or_add_var(Name, Var, !Varmap) :- ( if search_var(!.Varmap, Name, VarPrime) then Var = VarPrime else add_unique_var(Name, Var, !Varmap) ). add_anon_var(Var, !Varmap) :- Var = !.Varmap ^ vm_next_var, !Varmap ^ vm_next_var := Var + 1. add_n_anon_vars(N, Vars, !Varmap) :- ( if N < 1 then Vars = [] else add_n_anon_vars(N - 1, Vars0, !Varmap), add_anon_var(Var, !Varmap), Vars = [Var | Vars0] ). search_var(Varmap, Name, Var) :- search_vars(Varmap, Name, Vars), ( if singleton_set(VarPrime, Vars) then Var = VarPrime else unexpected($file, $pred, format("%s is ambigious", [s(Name)])) ). search_var_det(Varmap, Name, Var) :- ( if search_var(Varmap, Name, VarPrime) then Var = VarPrime else unexpected($file, $pred, "Var not found") ). %-----------------------------------------------------------------------% add_fresh_var(Name, Var, !Varmap) :- add_anon_var(Var, !Varmap), add_forward_name(Name, Var, !Varmap), ( if search(!.Varmap ^ vm_backward, Name, Vars0) then Vars = set.insert(Vars0, Var) else Vars = make_singleton_set(Var) ), map.set(Name, Vars, !.Varmap ^ vm_backward, Backward), !Varmap ^ vm_backward := Backward. search_vars(Varmap, Name, Var) :- search(Varmap ^ vm_backward, Name, Var). %-----------------------------------------------------------------------% var_or_make_var(var(Var), Var, !Varmap). var_or_make_var(wildcard, Var, !Varmap) :- add_anon_var(Var, !Varmap). %-----------------------------------------------------------------------% :- pred add_forward_name(string::in, var::in, varmap::in, varmap::out) is det. add_forward_name(Name, Var, !Varmap) :- det_insert(Var, Name, !.Varmap ^ vm_forward, Forward), !Varmap ^ vm_forward := Forward. %-----------------------------------------------------------------------% var_pretty(Varmap, Var) = p_str(get_var_name(Varmap, Var)). var_or_wild_pretty(Varmap, var(Var)) = var_pretty(Varmap, Var). var_or_wild_pretty(_, wildcard) = p_str("_"). vars_pretty(Varmap, Vars) = p_list((pretty_comma_seperated(map(var_pretty(Varmap), Vars)))). vars_set_pretty(Varmap, Vars) = vars_pretty(Varmap, to_sorted_list(Vars)). %-----------------------------------------------------------------------% %-----------------------------------------------------------------------% ================================================ FILE: src/write_interface.m ================================================ %-----------------------------------------------------------------------% % Write a Plasma interface file % vim: ts=4 sw=4 et % % Copyright (C) Plasma Team % Distributed under the terms of the MIT License see ../LICENSE.code % % This module provides the code for writing out an interface file. % %-----------------------------------------------------------------------% :- module write_interface. %-----------------------------------------------------------------------% :- interface. :- import_module io. :- import_module maybe. :- import_module string. :- import_module core. :- pred write_interface(string::in, core::in, maybe_error::out, io::di, io::uo) is det. %-----------------------------------------------------------------------% %-----------------------------------------------------------------------% :- implementation. :- import_module cord. :- import_module list. :- import_module pair. :- import_module common_types. :- import_module core.function. :- import_module core.pretty. :- import_module core.types. :- import_module core.resource. :- import_module q_name. :- import_module util. :- import_module util.my_io. :- import_module util.pretty. %-----------------------------------------------------------------------% write_interface(Filename, Core, Result, !IO) :- PrettyStr = pretty_str([pretty_interface(Core)]), write_temp_and_move(open_output, close_output, (pred(File::in, ok::out, IO0::di, IO::uo) is det :- io.write_string(File, PrettyStr, IO0, IO) ), Filename, Result, !IO). :- func pretty_interface(core) = pretty. pretty_interface(Core) = Pretty :- ModuleName = q_name_to_string(module_name(Core)), ExportedResources = core_all_exported_resources(Core), ExportedTypes = core_all_exported_types(Core), ExportedFuncs = core_all_exported_functions(Core), Pretty = p_list([ p_str("// Plasma interface file"), p_nl_hard, p_str("module"), p_spc, p_str(ModuleName), p_nl_double] ++ condense(map(pretty_resource_interface(Core), ExportedResources)) ++ condense(map(pretty_type_interface(Core), ExportedTypes)) ++ condense(map(pretty_func_interface(Core), ExportedFuncs))). :- func pretty_resource_interface(core, pair(resource_id, resource)) = list(pretty). pretty_resource_interface(Core, _ - R) = [resource_interface_pretty(Core, R), p_nl_double]. :- func pretty_type_interface(core, pair(type_id, user_type)) = list(pretty). pretty_type_interface(Core, _ - Type) = Pretty :- Pretty = [type_interface_pretty(Core, Type), p_nl_double]. :- func pretty_func_interface(core, pair(func_id, function)) = list(pretty). pretty_func_interface(Core, _ - Func) = Pretty :- Pretty = [p_expr(func_decl_pretty(Core, Func)), p_nl_double]. %-----------------------------------------------------------------------% %-----------------------------------------------------------------------% ================================================ FILE: template.mk ================================================ # # This is free and unencumbered software released into the public domain. # See ../LICENSE.unlicense # # vim: noet sw=4 ts=4 ft=make # # Basic configuration # =================== # # To configure Plasma copy this file `template.mk` to `build.mk` and then # modify it there. # # Sensible defaults are already set by defaults.mk, so to change them # uncomment and modify the settings in this file to override those defaults. # # Where programs are installed (PREFIX options show system/user, but any # path is okay) # PREFIX=/usr/local # PREFIX=~/.local # BINDIR=$(PREFIX)/bin # DOCDIR=$(PREFIX)/share/doc/plasma # How the Mercury compiler should be called. You may need to adjust this if # it is not in your path. # MMC_MAKE=mmc --make -j$(JOBS) --use-grade-subdirs # The number of parallel jobs the Mercury compiler should spawn (set # automatically for the Mercury code on systems with `nproc`). # JOBS=8 # How the C compiler should be called. gcc and clang should both work. # Note that Mercury has its own configuration for its C backend, which is # not, and must not be changed here. # CC=gcc # CXX=g++ # Some basic build flags to get things working for either C or C++ # C_CXX_FLAGS_BASE=-D_POSIX_C_SOURCE=200809L -D_DEFAULT_SOURCE # C_ONLY_FLAGS=-std=c99 # CXX_ONLY_FLAGS=-std=c++11 -fno-rtti -fno-exceptions # gcc and probably clang support dependency tracking. If your compiler # doesn't uncomment the 2nd line. # DEPDIR=.dep # DEPFLAGS=-MT $@ -MMD -MP -MF $(DEPDIR)/$(basename $*).Td # How to install programs, specify here the owner, group and mode of # installed files. # INSTALL=install # INSTALL_STRIP=install -s # INSTALL_DIR=install -d # How to call asciidoc (optional). A full path or any flags here won't work # without other changes to the makefile. # ASCIIDOC=asciidoc # How to call clang-format (optional) # CLANGFORMAT=clang-format # How to call indent (optional) # INDENT=indent # Build type options (normal, optimised, debugging) # ------------------------------------------------- # # The following settings are closely related and therefore we provide # suggestions in groups, depending on what type of build you want. # # Note that there are also some build parameters in src/Mercury.options # # This is a suitable build for development. It has assertions enabled in # the C code some of which are slow, so they shouldn't be used for # performance measurement. Comment it out to use one of the optimised # builds below. # C_CXX_FLAGS=$(C_CXX_FLAGS_BASE) -O1 -Wall # BUILD_TYPE=rel # Uncomment to add fatal warnings and runtime assertions. Also see the # corresponding code to uncomment in src/Mercury.options # # C_CXX_FLAGS+=-Werror -DDEBUG -DPZ_DEV # BUILD_TYPE=dev # You can uncomment _at most one_ of the following sets of options, or write # your own. # Enable C and Mercury debugging. # MCFLAGS+=--grade asm_fast.gc.decldebug.stseg # C_CXX_FLAGS=$(C_CXX_FLAGS_BASE) -O0 -DDEBUG -g -DPZ_DEV # BUILD_TYPE=dev # Enable static linking # MCFLAGS+=--mercury-linkage static # C_CXX_FLAGS=$(C_CXX_FLAGS_BASE) -O2 # BUILD_TYPE=rel # Enable optimisation, # Remember to comment-out the development build options above. # MCFLAGS+=-O4 --intermodule-optimisation # C_CXX_FLAGS=$(C_CXX_FLAGS_BASE) -O3 # BUILD_TYPE=rel # Enable both static linking and optimisation # Remember to comment-out the development build options above. # MCFLAGS+=-O4 --intermodule-optimisation \ # --mercury-linkage static # C_CXX_FLAGS=$(C_CXX_FLAGS_BASE) -O3 # BUILD_TYPE=rel # Enable Mercury profiling # MCFLAGS+=--grade asm_fast.gc.profdeep.stseg # Extra features # -------------- # # These can be uncommented to add extra features of interest to developers. # Tracing of the type checking/inference solver. # MCFLAGS+=--trace-flag typecheck_solve ================================================ FILE: tests/.gitignore ================================================ _build *.out *.outs *.pi *.pz *.pzo *.dir ================================================ FILE: tests/BUILD.plz ================================================ # This is free and unencumbered software released into the public domain. # See ../LICENSE.unlicense [hello] type = program modules = [Hello] ================================================ FILE: tests/README.md ================================================ Plasma Test Suite ================= Test suite organisation ----------------------- Tests are organised into the following directories: * **build**: Test the build system. * **builtins**: Test builtin functions. * **ffi**: Test the foreign function interface. * **language**: Test language features (syntax and semantics). * **library**: Test library code. * **modules**: Test the module system. * **runtime**: Test runtime features like the GC. Plus the **examples** directory from the root of the project. For more information about the test suite please see the documentation at https://plasmalang.org/docs/dev_testing.html ================================================ FILE: tests/build/bad_file_1.build ================================================ # This is free and unencumbered software released into the public domain. # See ../LICENSE.unlicense # PLZTEST type compile_failure base = toml = file ================================================ FILE: tests/build/bad_file_1.exp ================================================ bad_file_1.build:6: Unrecognised TOML line ================================================ FILE: tests/build/bad_file_2.exp ================================================ not_exist.build: can't open input file: No such file or directory ================================================ FILE: tests/build/bad_file_2.test ================================================ # This is free and unencumbered software released into the public domain. # See ../LICENSE.unlicense # PLZTEST type compile_failure # PLZTEST build_args --rebuild --build-file not_exist.build ================================================ FILE: tests/build/bad_file_3.build ================================================ # This is free and unencumbered software released into the public domain. # See ../LICENSE.unlicense # PLZTEST type compile_failure [good_name] type = program modules = [ AMod ] # Duplicate name [good_name] type = program modules = [ AMod ] ================================================ FILE: tests/build/bad_file_3.exp ================================================ bad_file_3.build:11: Duplicate table: good_name ================================================ FILE: tests/build/bad_file_4.build ================================================ # This is free and unencumbered software released into the public domain. # See ../LICENSE.unlicense # PLZTEST type compile_failure [] type = program [abc!!!def] type = program [good_name1] type = program # no module list [good_name2] type = program # bad module list modules = NotAList [good_name4] type = program modules = [ bad!!Name, another!bad!name ] ================================================ FILE: tests/build/bad_file_4.exp ================================================ bad_file_4.build:6: Invalid name '' bad_file_4.build:9: Invalid name 'abc!!!def' bad_file_4.build:12: Key not found 'modules' bad_file_4.build:19: Invalid modules field: Value is not an array bad_file_4.build:23: Invalid modules field: 'bad!!Name' Illegal identifier bad_file_4.build:23: Invalid modules field: 'another!bad!name' Illegal identifier ================================================ FILE: tests/build/bad_module_name.build ================================================ # This is free and unencumbered software released into the public domain. # See ../LICENSE.unlicense # PLZTEST type compile_failure # PLZTEST build_args --rebuild --build-file bad_module_name.build quack!!bad, GoodName # PLZTEST output stderr ================================================ FILE: tests/build/bad_module_name.exp ================================================ Plasma program name 'quack!!bad,' is invalid: Illegal identifier. ================================================ FILE: tests/build/bad_module_name_2.build ================================================ # This is free and unencumbered software released into the public domain. # See ../LICENSE.unlicense # PLZTEST type compile_failure [bad_module_name_2] type = program # When the module name doesn't match by only case or underscores the # compiler would crash. modules = [BADMODULENAME2] ================================================ FILE: tests/build/bad_module_name_2.exp ================================================ bad_module_name_2.p:10: The module name from the source file 'BadModuleName2' does not match the module name from the BUILD.plz file 'BADMODULENAME2' ================================================ FILE: tests/build/bad_module_name_2.p ================================================ /* * vim: ft=plasma * This is free and unencumbered software released into the public domain. * See ../LICENSE.unlicense */ // When a program's module doesn't match the one listed in the build file it // causes the build program to crash. module BadModuleName2 entrypoint func main() uses IO -> Int { print!("Test!\n") return 0 } ================================================ FILE: tests/build/dup_module_name.build ================================================ # This is free and unencumbered software released into the public domain. # See ../LICENSE.unlicense # PLZTEST type compile_failure [dup_module_name] type = program # List a module name twice. modules = [DupModuleName, SingleModuleName, DupModuleName, NameAgain, NameAgain, NameAgain] ================================================ FILE: tests/build/dup_module_name.exp ================================================ dup_module_name.build:6: The following modules were listed more than once: 'DupModuleName', 'NameAgain' ================================================ FILE: tests/build/dup_module_name_2.build ================================================ # This is free and unencumbered software released into the public domain. # See ../LICENSE.unlicense # PLZTEST type compile_failure [dup_module_name_2] type = program # List a module name twice, this time with a case or underscore difference. # THis will be caught when the compiler checks that it got the right module. modules = [DupModuleName2, Dup_ModuleName2] ================================================ FILE: tests/build/dup_module_name_2.exp ================================================ dup_module_name_2.p:10: The module name from the source file 'DupModuleName2' does not match the module name from the BUILD.plz file 'Dup_ModuleName2' ================================================ FILE: tests/build/dup_module_name_2.p ================================================ /* * vim: ft=plasma * This is free and unencumbered software released into the public domain. * See ../LICENSE.unlicense */ // When a program's module doesn't match the one listed in the build file it // causes the build program to crash. module DupModuleName2 entrypoint func main() uses IO -> Int { print!("Test!\n") return 0 } ================================================ FILE: tests/build/extra_module.p ================================================ /* * vim: ft=plasma * This is free and unencumbered software released into the public domain. * See ../LICENSE.unlicense */ module ExtraModule This is an extra module with bad syntax, it checks that the tests here don't pick it up by mistake. ================================================ FILE: tests/build/file_in_other_program.build ================================================ # This is free and unencumbered software released into the public domain. # See ../LICENSE.unlicense # Test that including a file that's part of a different program has the # correct error message. [file_in_other_program] type = program modules = [ FileInOtherProgram ] [other_program] type = program modules = [ OtherProgram ] ================================================ FILE: tests/build/file_in_other_program.expish ================================================ file_in_other_program.p:9: The module OtherProgram can't be included because it is not listed in all the build file's module lists that include module FileInOtherProgram ================================================ FILE: tests/build/file_in_other_program.p ================================================ /* * vim: ft=plasma * This is free and unencumbered software released into the public domain. * See ../LICENSE.unlicense */ module FileInOtherProgram import OtherProgram entrypoint func main() uses IO -> Int { print!("Hello\n") return 0 } ================================================ FILE: tests/build/include_file_nobuild.build ================================================ # This is free and unencumbered software released into the public domain. # See ../LICENSE.unlicense # PLZTEST type compile_failure [include_file_nobuild] type = program modules = [IncludeFileNobuild, NotExist3] ================================================ FILE: tests/build/include_file_nobuild.exp ================================================ include_file_nobuild.build:8: Can't find source for NotExist3 module ================================================ FILE: tests/build/include_file_nobuild.p ================================================ /* * vim: ft=plasma * This is free and unencumbered software released into the public domain. * See ../LICENSE.unlicense */ module IncludeNofileNobuild import NotExist3 entrypoint func main() uses IO -> Int { return 0 } ================================================ FILE: tests/build/include_nofile_build.build ================================================ # This is free and unencumbered software released into the public domain. # See ../LICENSE.unlicense # PLZTEST type compile_failure [include_nofile_build] type = program modules = [IncludeNofileBuild, NotExist2] ================================================ FILE: tests/build/include_nofile_build.exp ================================================ include_nofile_build.build:8: Can't find source for NotExist2 module ================================================ FILE: tests/build/include_nofile_build.p ================================================ /* * vim: ft=plasma * This is free and unencumbered software released into the public domain. * See ../LICENSE.unlicense */ module IncludeNofileBuild import NotExist2 entrypoint func main() uses IO -> Int { return 0 } ================================================ FILE: tests/build/include_nofile_nobuild.build ================================================ # This is free and unencumbered software released into the public domain. # See ../LICENSE.unlicense [include_nofile_nobuild] type = program modules = [IncludeNofileNobuild] ================================================ FILE: tests/build/include_nofile_nobuild.expish ================================================ include_nofile_nobuild.p:9: The module NotExist1 can't be included because it is not listed in all the build file's module lists that include module IncludeNofileNobuild ================================================ FILE: tests/build/include_nofile_nobuild.p ================================================ /* * vim: ft=plasma * This is free and unencumbered software released into the public domain. * See ../LICENSE.unlicense */ module IncludeNofileNobuild import NotExist1 entrypoint func main() uses IO -> Int { return 0 } ================================================ FILE: tests/build/options_compiler_01.build ================================================ # This is free and unencumbered software released into the public domain. # See ../LICENSE.unlicense [options_compiler_01] type = program modules = [ OptionsCompiler01 ] compiler_opts = "--no-simplify" ================================================ FILE: tests/build/options_compiler_01.exp ================================================ Hello world ================================================ FILE: tests/build/options_compiler_01.p ================================================ /* * vim: ft=plasma * This is free and unencumbered software released into the public domain. * See ../LICENSE.unlicense */ module OptionsCompiler01 entrypoint func hello() uses IO -> Int { print!("Hello world\n") return 0 } ================================================ FILE: tests/build/options_compiler_02.build ================================================ # This is free and unencumbered software released into the public domain. # See ../LICENSE.unlicense # PLZTEST type compile_failure [options_compiler_02] type = program modules = [ OptionsCompiler02 ] compiler_opts = "--nonexistant-option" ================================================ FILE: tests/build/options_compiler_02.exp ================================================ Error processing command line options: unrecognized option `--nonexistant-option' ================================================ FILE: tests/build/options_compiler_02.p ================================================ /* * vim: ft=plasma * This is free and unencumbered software released into the public domain. * See ../LICENSE.unlicense */ module OptionsCompiler02 entrypoint func hello() uses IO -> Int { print!("Hello world\n") return 0 } ================================================ FILE: tests/build/options_compiler_03.build ================================================ # This is free and unencumbered software released into the public domain. # See ../LICENSE.unlicense # PLZTEST type compile_failure # This test asks the build system to build the same module with different # settings, it should fail. [options_compiler_03a] type = program modules = [ OptionsCompiler03a, OptionsCompiler03 ] compiler_opts = "--no-simplify" [options_compiler_03b] type = program modules = [ OptionsCompiler03b, OptionsCompiler03 ] ================================================ FILE: tests/build/options_compiler_03.exp ================================================ options_compiler_03.build:11: Flags set for the same module in different programs do not match ================================================ FILE: tests/build/other_program.p ================================================ /* * vim: ft=plasma * This is free and unencumbered software released into the public domain. * See ../LICENSE.unlicense */ module OtherProgram entrypoint func other_main() uses IO -> Int { print!("Other Hello\n") return 0 } ================================================ FILE: tests/builtins/BUILD.plz ================================================ # This is free and unencumbered software released into the public domain. # See ../LICENSE.unlicense [builtin_01] type = program modules = [Builtin01] [builtin_02_int] type = program modules = [Builtin02Int] [builtin_03_bool] type = program modules = [Builtin03Bool] [builtin_04_string] type = program modules = [Builtin04String] [builtin_05_list] type = program modules = [Builtin05List] ================================================ FILE: tests/builtins/builtin_01.exp ================================================ Map result: None Map result: Some(24) Print works, duh setenv result: True ================================================ FILE: tests/builtins/builtin_01.p ================================================ /* * vim: ft=plasma * This is free and unencumbered software released into the public domain. * See ../LICENSE.unlicense */ module Builtin01 /* * This test should be kept up-to-date with the documentation for the * builtins in docs/plasma_ref.txt */ entrypoint func main() uses IO -> Int { test_maybe!() test_misc!() return 0 } /* ****************************************** */ func test_maybe() uses IO { var a = None var b = Some(23) func maybe_str(m : Maybe(String)) -> String { return match(m) { None -> "None" Some(var x) -> "Some(" ++ x ++ ")" } } print!("Map result: " ++ maybe_str(maybe_map(int_to_string, maybe_map(plus1, a))) ++ "\n") print!("Map result: " ++ maybe_str(maybe_map(int_to_string, maybe_map(plus1, b))) ++ "\n") } func maybe_map(f : func('a) -> 'b, m : Maybe('a)) -> Maybe('b) { return match(m) { None -> None Some(var x) -> Some(f(x)) } } func plus1(x : Int) -> Int { return x + 1 } /* ****************************************** */ // We can name some resources resource A from IO resource B from Time resource C from Environment func test_misc() uses IO { print!("Print works, duh\n") // By using a function we test that `IOResult` can be named. func sink_ioresult(rl : func () uses IO -> IOResult(String)) uses IO { // Don't actually do it because the test doesn't read any standard // input. We have other tests for that. if (False) { match (rl!()) { Ok(_) -> {} EOF -> {} } } else {} } // The readline function matches sink_ioresult!(readline) _ = Builtin.set_parameter!("nothing", 2) _, _ = Builtin.get_parameter!("heap_usage") func do_setenv() uses Environment -> Bool { // Wrap in this function to test that it uses the right resource. return setenv!("Foo", "Bar") } var r = do_setenv!() print!("setenv result: " ++ bool_to_string(r) ++ "\n") func do_gettimeofday() uses Time { _, _, _ = Builtin.gettimeofday!() } do_gettimeofday!() if (False) { Builtin.die("Die!") } else {} } // Test that we can define a function with the same name as a hidden builtin func die() uses IO { print!("I'm dead\n") // not really. } ================================================ FILE: tests/builtins/builtin_02_int.exp ================================================ int_add(5, 3) = 8 int_sub(5, 3) = 2 int_mul(5, 3) = 15 int_div(36, 7) = 5 int_mod(36, 7) = 1 int_minus(23) = -23 int_leftshift(5, 3) = 40 int_rightshift(37, 2) = 9 int_and(15, 28) = 12 int_or(15, 28) = 31 int_xor(15, 28) = 19 int_comp(5) = -6 int_gt(3, 5) = False int_lt(3, 5) = True int_gteq(3, 5) = False int_lteq(3, 5) = True int_eq(3, 5) = False int_neq(3, 5) = True ================================================ FILE: tests/builtins/builtin_02_int.p ================================================ /* * vim: ft=plasma * This is free and unencumbered software released into the public domain. * See ../LICENSE.unlicense */ module Builtin02Int /* * This test should be kept up-to-date with the documentation for the * builtins in docs/plasma_ref.txt */ entrypoint func main() uses IO -> Int { // Tests for integer oeprators are in operators.p // We can name the Int type. func foo(v : Int) -> Int { return v * 42 } print!("int_add(5, 3) = " ++ int_to_string(Builtin.int_add(5, 3)) ++ "\n") print!("int_sub(5, 3) = " ++ int_to_string(Builtin.int_sub(5, 3)) ++ "\n") print!("int_mul(5, 3) = " ++ int_to_string(Builtin.int_mul(5, 3)) ++ "\n") print!("int_div(36, 7) = " ++ int_to_string(Builtin.int_div(36, 7)) ++ "\n") print!("int_mod(36, 7) = " ++ int_to_string(Builtin.int_mod(36, 7)) ++ "\n") print!("int_minus(23) = " ++ int_to_string(Builtin.int_minus(23)) ++ "\n") // Builtin Int functions that are not operators, including // int_to_string. print!("int_leftshift(5, 3) = " ++ int_to_string(Builtin.int_lshift(5, 3)) ++ "\n") print!("int_rightshift(37, 2) = " ++ int_to_string(Builtin.int_rshift(37, 2)) ++ "\n") print!("int_and(15, 28) = " ++ int_to_string(Builtin.int_and(15, 28)) ++ "\n") print!("int_or(15, 28) = " ++ int_to_string(Builtin.int_or(15, 28)) ++ "\n") print!("int_xor(15, 28) = " ++ int_to_string(Builtin.int_xor(15, 28)) ++ "\n") print!("int_comp(5) = " ++ int_to_string(Builtin.int_comp(5)) ++ "\n") print!("int_gt(3, 5) = " ++ bool_to_string(Builtin.int_gt(3, 5)) ++ "\n") print!("int_lt(3, 5) = " ++ bool_to_string(Builtin.int_lt(3, 5)) ++ "\n") print!("int_gteq(3, 5) = " ++ bool_to_string(Builtin.int_gteq(3, 5)) ++ "\n") print!("int_lteq(3, 5) = " ++ bool_to_string(Builtin.int_lteq(3, 5)) ++ "\n") print!("int_eq(3, 5) = " ++ bool_to_string(Builtin.int_eq(3, 5)) ++ "\n") print!("int_neq(3, 5) = " ++ bool_to_string(Builtin.int_neq(3, 5)) ++ "\n") return 0 } ================================================ FILE: tests/builtins/builtin_03_bool.exp ================================================ test: False and True and: False or: True not: False ================================================ FILE: tests/builtins/builtin_03_bool.p ================================================ /* * vim: ft=plasma * This is free and unencumbered software released into the public domain. * See ../LICENSE.unlicense */ module Builtin03Bool /* * This test should be kept up-to-date with the documentation for the * builtins in docs/plasma_ref.txt */ entrypoint func main() uses IO -> Int { // Show that we can name the type and constructor. func do_a_bool(a : Bool) -> Bool { return not a and True } print!("test: " ++ bool_to_string(do_a_bool(True)) ++ " and " ++ bool_to_string(do_a_bool(False)) ++ "\n") // Let's use some builtin functions, but as higher-order values. func do_test(name : String, f : func(Bool, Bool) -> Bool) uses IO { print!(name ++ ": " ++ bool_to_string(f(True, False)) ++ "\n") } do_test!("and", Builtin.bool_and) do_test!("or", Builtin.bool_or) print!("not: " ++ bool_to_string(Builtin.bool_not(True)) ++ "\n") return 0 } ================================================ FILE: tests/builtins/builtin_04_string.exp ================================================ aaabbb abc123 world == world = True cl1 is Whitespace cl2 is Whitespace Check codepoint_to_number('a') = 97 Check int_to_codepoint(112) = p ================================================ FILE: tests/builtins/builtin_04_string.p ================================================ /* * vim: ft=plasma * This is free and unencumbered software released into the public domain. * See ../LICENSE.unlicense */ module Builtin04String /* * This test should be kept up-to-date with the documentation for the * builtins in docs/plasma_ref.txt */ entrypoint func main() uses IO -> Int { // Show that we can name the type and constructor. func name_some_types(s : String, c : CodePoint, cc : CodepointCategory) -> StringPos { return string_begin(s) } // Concat print!("aaa" ++ "bbb" ++ "\n") print!(Builtin.string_concat("abc", "123") ++ "\n") // string_begin and string_end var s = "Hello world" var begin = string_begin(s) var end = string_end(s) // Strpos stuff. var moved = repeat(6, strpos_forward, begin) var moved2 = strpos_backward(moved) // substring var s2 = string_substring(moved, end) // String equals print!("world == " ++ s2 ++ " = " ++ bool_to_string(string_equals("world", s2)) ++ "\n") var mc1 = strpos_prev(moved) var mc2 = strpos_next(moved2) match (mc1) { None -> { print!("Failed to get prev character from moved\n") } Some(var c1) -> { match (mc2) { None -> { print!("Failed to get next character from moved2\n") } Some(var c2) -> { // codepoint category var cl1 = codepoint_category(c1) var cl2 = codepoint_category(c2) print!("cl1 is " ++ category_string(cl1) ++ "\n") print!("cl2 is " ++ category_string(cl2) ++ "\n") } } } } print!("Check codepoint_to_number('a') = " ++ int_to_string(codepoint_to_number("a")) ++ "\n") print!("Check int_to_codepoint(112) = " ++ codepoint_to_string(Builtin.int_to_codepoint(112)) ++ "\n") return 0 } func category_string(c : CodepointCategory) -> String { return match (c) { Whitespace -> "Whitespace" Other -> "Other" } } func repeat(num : Int, f : func('x) -> 'x, x : 'x) -> 'x { if (num > 0) { return repeat(num - 1, f, f(x)) } else { return x } } ================================================ FILE: tests/builtins/builtin_05_list.exp ================================================ The final list is: 1, 2, 3, 4, 5, 6 ================================================ FILE: tests/builtins/builtin_05_list.p ================================================ /* * vim: ft=plasma * This is free and unencumbered software released into the public domain. * See ../LICENSE.unlicense */ module Builtin05List /* * This test should be kept up-to-date with the documentation for the * builtins in docs/plasma_ref.txt */ entrypoint func main() uses IO -> Int { // Nil can be spelt. var nil1 = Builtin.list_nil() var nil2 = [] // Cons can be spelt var list1 = [1, 2, 3] var list2 = Builtin.list_cons(4, Builtin.list_cons(5, [6])) // Constrain the types. var final_list = concat([list1, nil1, list2, nil2]) print!("The final list is: " ++ join(", ", map(int_to_string, final_list)) ++ "\n") return 0 } func append(l1 : List('t), l2 : List('t)) -> List('t) { return match (l1) { [] -> l2 [var x | var xs] -> [x | append(xs, l2)] } } func concat(l : List(List('t))) -> List('t) { return match (l) { [] -> [] [var x | var xs] -> append(x, concat(xs)) } } func join(j : String, l : List(String)) -> String { func join2(x : String, xs : List(String)) -> String { return match (xs) { [] -> x [var y | var ys] -> x ++ j ++ join2(y, ys) } } return match (l) { [] -> "" [var x | var xs] -> join2(x, xs) } } func map(f : func('x) -> 'y, l : List('x)) -> List('y) { return match (l) { [] -> [] [var x | var xs] -> [f(x) | map(f, xs)] } } ================================================ FILE: tests/builtins/builtin_not_found.build ================================================ # This is free and unencumbered software released into the public domain. # See ../LICENSE.unlicense # PLZTEST type compile_failure [builtin_not_found] type = program modules = [BuiltinNotFound] ================================================ FILE: tests/builtins/builtin_not_found.exp ================================================ A compilation error occured and this error is not handled gracefully by the Plasma compiler. Sorry. Message: Unknown symbol: string_concat Context: ../builtin_not_found.p:13 plzc location: predicate `pre.from_ast.ast_to_pre_expr_2'/7 plzc file: pre.from_ast.m ================================================ FILE: tests/builtins/builtin_not_found.p ================================================ /* * vim: ft=plasma * This is free and unencumbered software released into the public domain. * See ../LICENSE.unlicense */ module BuiltinNotFound entrypoint func main() uses IO -> Int { // string_concat is a builtin, but it's not imported so this should // generate a compiler error. print!(string_concat("abc", "def")) return 0 } ================================================ FILE: tests/ffi/.gitignore ================================================ *.o *.so ================================================ FILE: tests/ffi/BUILD.plz ================================================ # This is free and unencumbered software released into the public domain. # See ../LICENSE.unlicense # # This is a Plasma build file, it will tell Plasma about the programs in # this directory and what modules they're made from. # [import_function] type = program modules = [ImportFunction] c_sources = [import_function.cpp] [import_from_two_modules] type = program modules = [ImportFromTwoModules1, ImportFromTwoModules2] c_sources = [import_from_two_modules.cpp] [import_two_sources] type = program modules = [ImportTwoSources] c_sources = [import_two_sources.cpp, import_shared_module.cpp] [import_shared_module] type = program modules = [ImportSharedModule] c_sources = [import_shared_module.cpp] ================================================ FILE: tests/ffi/import_from_two_modules.cpp ================================================ /* * This is free and unencumbered software released into the public domain. * See ../LICENSE.unlicense */ #include #include #include #include "../../runtime/pz_common.h" #include "../../runtime/pz_foreign.h" #include "../../runtime/pz_generic_run.h" #include "import_function.h" using namespace pz; unsigned bar(void * stack_, unsigned sp) { printf("Hi mum\n"); return sp; } unsigned my_getpid(void * stack_, unsigned sp) { StackValue * stack = reinterpret_cast(stack_); stack[++sp].u32 = getpid(); return sp; } ================================================ FILE: tests/ffi/import_from_two_modules.exp ================================================ Hello world My pid didn't change Doing another foreign call Hi mum done ================================================ FILE: tests/ffi/import_from_two_modules.h ================================================ /* * This is free and unencumbered software released into the public domain. * See ../LICENSE.unlicense */ #ifndef IMPORT_FROM_TWO_MODULES_H #define IMPORT_FROM_TWO_MODULES_H unsigned bar(void * stack_, unsigned sp); unsigned my_getpid(void * stack_, unsigned sp); #endif /* ! IMPORT_FROM_TWO_MODULES_H */ ================================================ FILE: tests/ffi/import_from_two_modules_1.p ================================================ /* * vim: ft=plasma * This is free and unencumbered software released into the public domain. * See ../LICENSE.unlicense */ module ImportFromTwoModules1 import ImportFromTwoModules2 as I2M2 pragma foreign_include("import_from_two_modules.h") func getpid() -> Int foreign(my_getpid) entrypoint func hello() uses IO -> Int { print!("Hello world\n") var pid = getpid!() print!("# My pid is " ++ int_to_string(pid) ++ "\n") var pid2 = getpid!() if (pid == pid2) { print!("My pid didn't change\n") } else { print!("My pid changed, that's weird\n") } I2M2.test!() return 0 } ================================================ FILE: tests/ffi/import_from_two_modules_2.p ================================================ /* * vim: ft=plasma * This is free and unencumbered software released into the public domain. * See ../LICENSE.unlicense */ module ImportFromTwoModules2 pragma foreign_include("import_from_two_modules.h") func bar() uses IO foreign(bar) export func test() uses IO { print!("Doing another foreign call\n") bar!() print!("done\n") } ================================================ FILE: tests/ffi/import_function.cpp ================================================ /* * This is free and unencumbered software released into the public domain. * See ../LICENSE.unlicense */ #include #include #include #include "../../runtime/pz_common.h" #include "../../runtime/pz_foreign.h" #include "../../runtime/pz_generic_run.h" #include "import_function.h" using namespace pz; unsigned foo(void * stack_, unsigned sp) { printf("Hi mum\n"); return sp; } unsigned my_getpid(void * stack_, unsigned sp) { StackValue * stack = reinterpret_cast(stack_); stack[++sp].u32 = getpid(); return sp; } ================================================ FILE: tests/ffi/import_function.exp ================================================ Hello world My pid didn't change Doing another foreign call Hi mum done ================================================ FILE: tests/ffi/import_function.h ================================================ /* * This is free and unencumbered software released into the public domain. * See ../LICENSE.unlicense */ #ifndef IMPORT_FONCTION_H #define IMPORT_FONCTION_H unsigned foo(void * stack_, unsigned sp); unsigned my_getpid(void * stack_, unsigned sp); #endif /* ! IMPORT_FONCTION_H */ ================================================ FILE: tests/ffi/import_function.p ================================================ /* * vim: ft=plasma * This is free and unencumbered software released into the public domain. * See ../LICENSE.unlicense */ module ImportFunction pragma foreign_include("import_function.h") func getpid() -> Int foreign(my_getpid) func foo() uses IO foreign(foo) entrypoint func hello() uses IO -> Int { print!("Hello world\n") var pid = getpid!() print!("# My pid is " ++ int_to_string(pid) ++ "\n") var pid2 = getpid!() if (pid == pid2) { print!("My pid didn't change\n") } else { print!("My pid changed, that's weird\n") } print!("Doing another foreign call\n") foo!() print!("done\n") return 0 } ================================================ FILE: tests/ffi/import_shared_module.cpp ================================================ /* * This is free and unencumbered software released into the public domain. * See ../LICENSE.unlicense */ #include #include "../../runtime/pz_common.h" #include "../../runtime/pz_foreign.h" #include "../../runtime/pz_generic_run.h" #include "import_shared_module.h" using namespace pz; unsigned test_extra(void * stack_, unsigned sp) { printf("Test Extra\n"); return sp; } ================================================ FILE: tests/ffi/import_shared_module.h ================================================ /* * This is free and unencumbered software released into the public domain. * See ../LICENSE.unlicense */ #ifndef IMPORT_SHARED_MODULE_H #define IMPORT_SHARED_MODULE_H unsigned test_extra(void * stack_, unsigned sp); #endif /* ! IMPORT_SHARED_MODULE_H */ ================================================ FILE: tests/ffi/import_shared_module.p ================================================ /* * vim: ft=plasma * This is free and unencumbered software released into the public domain. * See ../LICENSE.unlicense */ module ImportSharedModule pragma foreign_include("import_shared_module.h") func test_extra() foreign(test_extra) entrypoint func test() uses IO -> Int { test_extra!() return 0 } ================================================ FILE: tests/ffi/import_two_sources.cpp ================================================ /* * This is free and unencumbered software released into the public domain. * See ../LICENSE.unlicense */ #include #include "../../runtime/pz_common.h" #include "../../runtime/pz_foreign.h" #include "../../runtime/pz_generic_run.h" #include "import_two_sources.h" using namespace pz; unsigned test_a(void * stack_, unsigned sp) { printf("Test A\n"); return sp; } ================================================ FILE: tests/ffi/import_two_sources.exp ================================================ Test A Test Extra ================================================ FILE: tests/ffi/import_two_sources.h ================================================ /* * This is free and unencumbered software released into the public domain. * See ../LICENSE.unlicense */ #ifndef IMPORT_TWO_SOURCES_H #define IMPORT_TWO_SOURCES_H unsigned test_a(void * stack_, unsigned sp); #endif /* ! IMPORT_TWO_SOURCES */ ================================================ FILE: tests/ffi/import_two_sources.p ================================================ /* * vim: ft=plasma * This is free and unencumbered software released into the public domain. * See ../LICENSE.unlicense */ module ImportTwoSources pragma foreign_include("import_two_sources.h") pragma foreign_include("import_shared_module.h") func test_a() foreign(test_a) func test_extra() foreign(test_extra) entrypoint func test() uses IO -> Int { test_a!() test_extra!() return 0 } ================================================ FILE: tests/ffi/unrecognised_extension.build ================================================ # This is free and unencumbered software released into the public domain. # See ../LICENSE.unlicense # PLZTEST type compile_failure [unrecognised_extension] type = program modules = [UnrecognisedExtension] c_sources = [bad.extension] ================================================ FILE: tests/ffi/unrecognised_extension.exp ================================================ unrecognised_extension.build:9: Unrecognised extensions on these files: bad.extension ================================================ FILE: tests/ffi/unrecognised_extension.p ================================================ ================================================ FILE: tests/hello.exp ================================================ Hello world ================================================ FILE: tests/hello.p ================================================ /* * vim: ft=plasma * This is free and unencumbered software released into the public domain. * See ../LICENSE.unlicense */ // Module declaration, this sets the name of the module. module Hello // The main function, there's multiple things in the signature: // * It has zero parameters but in the future it will probably take an // argument for command line options. // * It returns Int. // * It uses the IO resource. // * It has the 'entrypoint' keyword entrypoint func main() uses IO -> Int { // the ! indicates that this call uses a resource, which resource is // determined automatically. print!("Hello world\n") // 0 is the operating system's exit code for success. This should be // symbolic in the future. return 0 } ================================================ FILE: tests/language/BUILD.plz ================================================ # This is free and unencumbered software released into the public domain. # See ../LICENSE.unlicense [arity_01] type = program modules = [Arity01] [comment] type = program modules = [Comment] [ite_1] type = program modules = [Ite_1] [ite_2] type = program modules = [Ite_2] [ite_3] type = program modules = [Ite_3] [list] type = program modules = [List] [operators] type = program modules = [Operators] [string] type = program modules = [String] ================================================ FILE: tests/language/arity_01.exp ================================================ 8 p: 7, m: -7 p: 23, m: -23 Test foo2 Test foo3 foo4 pm(8) -> 8, -8 Test5 : 285, -285 ================================================ FILE: tests/language/arity_01.p ================================================ /* * vim: ft=plasma * This is free and unencumbered software released into the public domain. * See ../LICENSE.unlicense */ module Arity01 entrypoint func main() uses IO -> Int { foo!(int_to_string(bar(3, 5)) ++ "\n") do_pm!(7) do_pm!(-23) var x = 3 // Check that the stack is still aligned. foo2!("Test foo2\n") foo3!("Test foo3\n") noop!() foo4!(4) // Multi-arity in higher-order code. var n = 8 var f = fst(pm, n) var s = snd(pm, n) print!("pm(" ++ int_to_string(n) ++ ") -> " ++ int_to_string(f) ++ ", " ++ int_to_string(s) ++ "\n") var f5a, var f5b = foo5() print!("Test5 : " ++ int_to_string(f5a) ++ ", " ++ int_to_string(f5b) ++ "\n") return x - 3 + f + s } // Test a function that returns nothing. func foo(x : String) uses IO { print!(x) } // This function returns numthing, but ends in an assignment, which is stupid // but for now legal. It should generate a warning in the future. func foo2(x : String) uses IO { print!(x) var y = x } // Test a function that returns nothing, and has an empty return statement. func foo3(x : String) uses IO { print!(x) return } func noop() uses IO {} // A function that returns one thing. func bar(a : Int, b : Int) -> Int { return a + b } func do_pm(x : Int) uses IO { var p, var m = pm(x) print!("p: " ++ int_to_string(p) ++ ", m: " ++ int_to_string(m) ++ "\n") } func fst(f : func(Int) -> (Int, Int), input : Int) -> Int { var a, _ = f(input) return a } func snd(f : func(Int) -> (Int, Int), input : Int) -> Int { _, var b = f(input) return b } // A function that returns two things. func pm(x : Int) -> (Int, Int) { var x_abs if (x < 0) { x_abs = x * -1 } else { x_abs = x } return x_abs, x_abs * -1 } // Something that returns something may have its result thrown away. // Although this specific example should be a warning since the call to bar // also has no affects, it would be optimised away. func foo4(x : Int) uses IO { print!("foo4\n") _ = bar(x, 23) } func foo5() -> (Int, Int) { // Bug 285 return pm(285) } ================================================ FILE: tests/language/arity_02.build ================================================ # This is free and unencumbered software released into the public domain. # See ../LICENSE.unlicense # PLZTEST type compile_failure [arity_02] type = program modules = [Arity02] ================================================ FILE: tests/language/arity_02.exp ================================================ arity_02.p:12: Arity error got 2 values, but 1 values were expected arity_02.p:13: Arity error got 1 values, but 0 values were expected arity_02.p:19: Arity error got 0 values, but 1 values were expected arity_02.p:23: Arity error got 1 values, but 0 values were expected arity_02.p:28: Arity error got 1 values, but 0 values were expected arity_02.p:32: Arity error got 1 values, but 0 values were expected arity_02.p:38: Arity error got 0 values, but 1 values were expected arity_02.p:42: Arity error got 0 values, but 1 values were expected ================================================ FILE: tests/language/arity_02.p ================================================ /* * vim: ft=plasma * This is free and unencumbered software released into the public domain. * See ../LICENSE.unlicense */ module Arity02 export func main() uses IO -> Int { // Arity mismatch in call print!(hello()) bar!() return 0 } func bar() uses IO -> Int { // Arity mismatch in return. return } func bar2() uses IO { return 3 } func test1() uses IO { // It is an error not to capture the returned values when there are some. cube(3) } func test2() uses IO { cube(2) return } func test3() uses IO { // There are no returned values here, this is an arity mismatch. _ = print!("Boo\n") } func test4() uses IO { _ = print!("Boo\n") return } func cube(n : Int) -> Int { return n * n * n } func hello() -> (String, Int) { return "Hi", 3 } ================================================ FILE: tests/language/arity_ho_1.build ================================================ # This is free and unencumbered software released into the public domain. # See ../LICENSE.unlicense # PLZTEST type compile_failure [arity_ho_1] type = program modules = [Arity_HO_1] ================================================ FILE: tests/language/arity_ho_1.exp ================================================ arity_ho_1.p:12: "func(int) -> int" and "func(int) -> (int, int)" are not the same ================================================ FILE: tests/language/arity_ho_1.p ================================================ /* * vim: ft=plasma * This is free and unencumbered software released into the public domain. * See ../LICENSE.unlicense */ module Arity_HO_1 export func main() uses IO -> Int { // Incorrect arity (type) in function passed to higher order function. var f = fst(add4, 3) return 0 } func fst(f : func(Int) -> (Int, Int), input : Int) -> Int { var a, _ = f(input) return a } func add4(n : Int) -> Int { return n + 4 } ================================================ FILE: tests/language/arity_ho_2.build ================================================ # This is free and unencumbered software released into the public domain. # See ../LICENSE.unlicense # PLZTEST type compile_failure [arity_ho_2] type = program modules = [Arity_HO_2] ================================================ FILE: tests/language/arity_ho_2.exp ================================================ arity_ho_2.p:16: "func(int) -> int" and "func(int) -> (int, int)" are not the same ================================================ FILE: tests/language/arity_ho_2.p ================================================ /* * vim: ft=plasma * This is free and unencumbered software released into the public domain. * See ../LICENSE.unlicense */ module Arity_HO_2 export func main() uses IO -> Int { var f = fst(pm, 3) return 0 } func fst(f : func(Int) -> (Int, Int), input : Int) -> Int { // Incorrect arity in call to higher-order function. var a = f(input) return a } // A function that returns two things. func pm(x : Int) -> (Int, Int) { var x_abs if (x < 0) { x_abs = x * -1 } else { x_abs = x } return x_abs, x_abs * -1 } ================================================ FILE: tests/language/arity_lambda.build ================================================ # This is free and unencumbered software released into the public domain. # See ../LICENSE.unlicense # PLZTEST type compile_failure [arity_lambda] type = program modules = [ArityLambda] ================================================ FILE: tests/language/arity_lambda.exp ================================================ arity_lambda.p:11: Function returns 1 results but this path has no return statement ================================================ FILE: tests/language/arity_lambda.p ================================================ /* * vim: ft=plasma * This is free and unencumbered software released into the public domain. * See ../LICENSE.unlicense */ module ArityLambda export func main() uses IO -> Int { func test() -> Int { // Error, there's no return statment } return 0 } ================================================ FILE: tests/language/comment.exp ================================================ 1e2e3e4e5e6e7e8e // comment in a string, not realy a comment. /* comment in a string, not realy a comment. */ comment in a string, not realy a comment. ================================================ FILE: tests/language/comment.p ================================================ /* * vim: ft=plasma * This is free and unencumbered software released into the public domain. * See ../LICENSE.unlicense */ module Comment entrypoint func main() uses IO -> Int { // We support coments like this. /* and like this */ var str = "" ++ // this comments out the rest of the line "1" ++ /* this commented out */ "e" ++ // but the line continued "2" ++ /**/ "e" ++ "3" ++ /* * */ "e" ++ "4" ++ /* ** */ "e" ++ "5" ++ /* *** */ "e" ++ "6" ++ /*** */ "e" ++ "7" ++ /* // aq */ "e" ++ "8" ++ // /*<- not the beginning of a comment. "e" ++ "" /* * Note that we don't support a * next to the ending star-slash due to * limitations in the regex library. */ print!(str ++ "\n") print!(" // comment in a string, not realy a comment.\n") print!(" /* comment in a string, not realy a comment.\n") print!(" */ comment in a string, not realy a comment.\n") return 0 } ================================================ FILE: tests/language/comment_end.build ================================================ # This is free and unencumbered software released into the public domain. # See ../LICENSE.unlicense # PLZTEST type compile_failure # PLZTEST todo commend end lexing [comment_end] type = program modules = [CommentEnd] ================================================ FILE: tests/language/comment_end.exp ================================================ comment_end.p:18: The tokeniser got confused, until we improve it please don't end comments with **/ comment_end.p:19: Warning: The tokeniser can get confused, until we improve it please don't end comments with **/ ================================================ FILE: tests/language/comment_end.p ================================================ /* * vim: ft=plasma * This is free and unencumbered software released into the public domain. * See ../LICENSE.unlicense */ module CommentEnd export func main() uses IO -> Int { print!("Hello world\n") // This will match the second */ and so we must throw an error if there's a // */ within a coment. // It's an odd number of *'s in the middle to trigger the test, but try // with an even number too and we'll know if the test changes. /*****/ /* */ /****/ /* */ return 0 } ================================================ FILE: tests/language/coverage_1.build ================================================ # This is free and unencumbered software released into the public domain. # See ../LICENSE.unlicense # PLZTEST type compile_failure [coverage_1] type = program modules = [Coverage_1] ================================================ FILE: tests/language/coverage_1.exp ================================================ coverage_1.p:19: Match does not cover all cases coverage_1.p:28: Match does not cover all cases coverage_1.p:41: This case will never be tested because earlier cases cover all values coverage_1.p:53: This case will never be tested because earlier cases cover all values coverage_1.p:64: This case occurs multiple times in this match coverage_1.p:76: This case occurs multiple times in this match ================================================ FILE: tests/language/coverage_1.p ================================================ /* * vim: ft=plasma * This is free and unencumbered software released into the public domain. * See ../LICENSE.unlicense */ module Coverage_1 type Suit = Hearts | Diamonds | Spades | Clubs func main() uses IO -> Int { print!("Queen of " ++ suit_str(Hearts) ++ "\n") print!("Ace of " ++ suit_str(Spades) ++ "\n") return 0 } func suit_str(s : Suit) -> String { // Uncovered data tag. match (s) { Hearts -> { return "Hearts" } Diamonds -> { return "Diamonds" } Clubs -> { return "Clubs" } } } func num_word(n : Int) -> String { // Uncovered data. match (n) { 0 -> { return "zero" } 1 -> { return "one" } } } func num_word2(n : Int) -> String { match (n) { 0 -> { return "zero" } 1 -> { return "one" } _ -> { return "many" } // This case is never tested. 5 -> { return "five" } } } func suit_str2(s : Suit) -> String { match (s) { Hearts -> { return "Hearts" } Diamonds -> { return "Diamonds" } Clubs -> { return "Clubs" } Spades -> { return "Spades" } // This case is never tested. _ -> { return "Unknown" } } } func suit_str3(s : Suit) -> String { // Uncovered data tag. match (s) { Hearts -> { return "Hearts" } Diamonds -> { return "Diamonds" } // This case always fails. Diamonds -> { return "Girl's best friend" } Clubs -> { return "Clubs" } Spades -> { return "Spades" } } } func num_word3(n : Int) -> String { match (n) { 0 -> { return "zero" } 1 -> { return "one" } // This case always fails. 1 -> { return "onesies" } _ -> { return "many" } } } ================================================ FILE: tests/language/entrypoint_bad_sig.build ================================================ # This is free and unencumbered software released into the public domain. # See ../LICENSE.unlicense # PLZTEST type compile_failure [entrypoint_bad_sig] type = program modules = [EntrypointBadSig] ================================================ FILE: tests/language/entrypoint_bad_sig.exp ================================================ entrypoint_bad_sig.p:15: A function that is marked as an entrypoint does not have the correct signature for an entrypoint. ================================================ FILE: tests/language/entrypoint_bad_sig.p ================================================ /* * vim: ft=plasma * This is free and unencumbered software released into the public domain. * See ../LICENSE.unlicense */ module EntrypointBadSig /* * This program has an entrypoint function, but it has an incorrect * signature for an entrypoint. */ entrypoint func main(foo : String) uses IO -> Int { // the ! indicates that this call uses a resource, which resource is // determined automatically where possible. print!("Hello world\n") // The value of a function (or block) is the value of its last // statement. // XXX EXIT_SUCCESS return 0 } ================================================ FILE: tests/language/entrypoint_multi.build ================================================ # This is free and unencumbered software released into the public domain. # See ../LICENSE.unlicense # PLZTEST type compile_failure [entrypoint_multi] type = program modules = [EntrypointMulti] ================================================ FILE: tests/language/entrypoint_multi.exp ================================================ Error: No unique entrypoint found, found 2 entrypoints ================================================ FILE: tests/language/entrypoint_multi.p ================================================ /* * vim: ft=plasma * This is free and unencumbered software released into the public domain. * See ../LICENSE.unlicense */ module EntrypointMulti entrypoint func name1() uses IO -> Int { print!("Hello world 1\n") return 0 } entrypoint func name2() uses IO -> Int { print!("Hello world 2\n") return 0 } ================================================ FILE: tests/language/entrypoint_none.build ================================================ # This is free and unencumbered software released into the public domain. # See ../LICENSE.unlicense # PLZTEST type compile_failure [entrypoint_none] type = program modules = [EntrypointNone] ================================================ FILE: tests/language/entrypoint_none.exp ================================================ Error: No unique entrypoint found, found 0 entrypoints ================================================ FILE: tests/language/entrypoint_none.p ================================================ /* * vim: ft=plasma * This is free and unencumbered software released into the public domain. * See ../LICENSE.unlicense */ module EntrypointNone // This is exported but not marked as an entrypoint, the linker will be // unable to find an entrypoint in the program. export func main() uses IO -> Int { // the ! indicates that this call uses a resource, which resource is // determined automatically where possible. print!("Hello world\n") // The value of a function (or block) is the value of its last // statement. // XXX EXIT_SUCCESS return 0 } ================================================ FILE: tests/language/export_bad_resource.build ================================================ # This is free and unencumbered software released into the public domain. # See ../LICENSE.unlicense # PLZTEST type compile_failure [export_bad_resource] type = program modules = [ExportBadResource] ================================================ FILE: tests/language/export_bad_resource.exp ================================================ export_bad_resource.p:19: The resource Bar is exported, but it depends on Foo which is not export_bad_resource.p:23: The resource Bar2 is exported, but it depends on Foo which is not export_bad_resource.p:66: The type Type1 is exported, but it refers to the resource Baz which is not exported export_bad_resource.p:72: The type Type2 is exported, but it refers to the resource Baz which is not exported export_bad_resource.p:72: The type Type2 is exported, but it refers to the resource Baz2 which is not exported export_bad_resource.p:35: The function troz is exported, but it refers to the resource Foo which is not exported export_bad_resource.p:40: The function zort is exported, but it refers to the resource Baz which is not exported export_bad_resource.p:49: The function silly_sound is exported, but it refers to the resource Baz which is not exported export_bad_resource.p:54: The function silly_sound2 is exported, but it refers to the resource Baz which is not exported export_bad_resource.p:54: The function silly_sound2 is exported, but it refers to the resource Baz2 which is not exported export_bad_resource.p:59: The function silly_sound3 is exported, but it refers to the resource Baz which is not exported ================================================ FILE: tests/language/export_bad_resource.p ================================================ /* * vim: ft=plasma * This is free and unencumbered software released into the public domain. * See ../LICENSE.unlicense */ module ExportBadResource resource Foo from IO /* * The error will be reported on the exported item that need a non-exported * resource. It should (but doesn't) refer to the line of the non-exported * resource. A non-exported thing can be reported more than once. */ // Error Foo is not exported and Bar expects this. export resource Bar from Foo // also an error. export resource Bar2 from Foo // Not an error export resource BarBar from Bar // No error. resource Baz from Foo resource Baz2 from Foo // Error Foo is not exported export func troz() uses Foo { } // Error Baz is not exported export func zort() uses Baz { } // No error. func zort2() uses Baz { } // This time the error is in a type used by a function. export func silly_sound(x : func(Int) uses Baz) { } // Should have two errors, for Baz and Baz2 export func silly_sound2(x : func(Int) uses (Bar, Baz, Baz2)) { } // Should have only one error (same resource twice) export func silly_sound3(x : func(Int) uses (Baz, Bar), y : func(String) uses Baz) uses Baz { } // Error export type Type1 = Type1( a : func(Int) uses Baz ) // Multiple errors. export type Type2 = Type2( b : func(Int) uses (Baz, Bar), c : List(func(Int) uses Baz2) ) // No errors. type Type3 = Type3( d : func(Int) uses (Baz, Bar), e : List(func(Int) uses Baz2) ) // No errors. export opaque type Type4 = Type4( f : func(Int) uses (Baz, Bar), g : List(func(Int) uses Baz2) ) ================================================ FILE: tests/language/export_bad_type.build ================================================ # This is free and unencumbered software released into the public domain. # See ../LICENSE.unlicense # PLZTEST type compile_failure [export_bad_type] type = program modules = [ExportBadType] ================================================ FILE: tests/language/export_bad_type.exp ================================================ export_bad_type.p:20: The type T1 is exported, but it refers to another type T0 which is not. export_bad_type.p:26: The type T2 is exported, but it refers to another type T0 which is not. export_bad_type.p:62: The function fun1 is exported, but it refers to the type T0 which is not. export_bad_type.p:67: The function fun2 is exported, but it refers to the type T0 which is not. ================================================ FILE: tests/language/export_bad_type.p ================================================ /* * vim: ft=plasma * This is free and unencumbered software released into the public domain. * See ../LICENSE.unlicense */ module ExportBadType type T0 = T0 ( f1 : Int ) export opaque type T0a = T0a ( f1a : Int ) // Error, T0 is not exported. export type T1 = T1 ( f2 : T0 ) // Error, T0 is not exported. export type T2 = T2 ( f3 : List(T0) ) // No error, because T3 isn't exported type T3 = T3 ( f4 : T0, f5 : List(T0) ) // No error, because the type we refer to is exported abstractly. export type T1ia = T1ia ( f2ia : T0a ) // No error export type T2ia = T2ia ( f3ia : List(T0a) ) // No error, because importing libraries don't need to know what this refers // to. export opaque type T1a = T1a ( f2a : T0 ) export opaque type T2a = T2a ( f2a : List(T0) ) // Error export func fun1(a : T0) uses IO { } // Error export func fun2(a : List(T0)) uses IO { } // No-error func fun3(a : T0, b : List(T0)) uses IO { } // No-error func fun4(a : T0a, b : List(T0a)) uses IO { } ================================================ FILE: tests/language/ho/BUILD.plz ================================================ # This is free and unencumbered software released into the public domain. # See ../LICENSE.unlicense [closure_01] type = program modules = [Closure_01] [closure_02] type = program modules = [Closure_02] [closure_03] type = program modules = [Closure_03] [closure_04] type = program modules = [Closure_04] [closure_05] type = program modules = [Closure_05] [closure_06] type = program modules = [Closure_06] [ho_1] type = program modules = [HO_1] [ho_2] type = program modules = [HO_2] [ho_call_bug_30] type = program modules = [HOCallBug30] ================================================ FILE: tests/language/ho/closure_01.exp ================================================ Hello Paul ================================================ FILE: tests/language/ho/closure_01.p ================================================ /* * vim: ft=plasma * This is free and unencumbered software released into the public domain. * See ../LICENSE.unlicense */ module Closure_01 entrypoint func main() uses IO -> Int { var greeting = "Hello " func hi(name : String) -> String { return greeting ++ name ++ "\n" } print!(hi("Paul")) return 0 } ================================================ FILE: tests/language/ho/closure_02.exp ================================================ Hello Paul ================================================ FILE: tests/language/ho/closure_02.p ================================================ /* * vim: ft=plasma * This is free and unencumbered software released into the public domain. * See ../LICENSE.unlicense */ module Closure_02 entrypoint func main() uses IO -> Int { var greeting = "Hello " func hi(name : String) -> String { var msg = greeting ++ name ++ "\n" return msg } // We should be able to use this variable here, the above one isn't in // scope. var msg = hi("Paul") print!(msg) return 0 } ================================================ FILE: tests/language/ho/closure_03.exp ================================================ G'day Paul G'day James ================================================ FILE: tests/language/ho/closure_03.p ================================================ /* * vim: ft=plasma * This is free and unencumbered software released into the public domain. * See ../LICENSE.unlicense */ module Closure_03 entrypoint func main() uses IO -> Int { var salutation = "G'day" func greet(name : String) uses IO { print!(salutation ++ " " ++ name) // Try to trick the compiler with two bang statements inside the one // closure which is itself a single statement. print!("\n") } greet!("Paul") greet!("James") return 0 } ================================================ FILE: tests/language/ho/closure_04.exp ================================================ 7 bottles of wine... 6 bottles of wine... 5 bottles of wine... 4 bottles of wine... 3 bottles of wine... 2 bottles of wine... 1 bottles of wine... No more wine ================================================ FILE: tests/language/ho/closure_04.p ================================================ /* * vim: ft=plasma * This is free and unencumbered software released into the public domain. * See ../LICENSE.unlicense */ module Closure_04 func make_closure(drink : String) -> func() uses IO { func sing(n : Int) -> String { if (n == 0) { return "No more " ++ drink ++ "\n" } else { return int_to_string(n) ++ " bottles of " ++ drink ++ "...\n" ++ sing(n - 1) } } func doit() uses IO { print!(sing(7)) } return doit } entrypoint func main() uses IO -> Int { var my_closure = make_closure("wine") my_closure!() return 0 } ================================================ FILE: tests/language/ho/closure_05.exp ================================================ 4 bottles of wine... 3 bottles of wine... 2 bottles of wine... 1 bottles of wine... No more wine ================================================ FILE: tests/language/ho/closure_05.p ================================================ /* * vim: ft=plasma * This is free and unencumbered software released into the public domain. * See ../LICENSE.unlicense */ module Closure_05 // Wrap this in a function to help the typechecker. func lines() -> Int { return 4 } entrypoint func main() uses IO -> Int { func phrase1(drink : String) -> String { return "No more " ++ drink ++ "\n" } func make_closure(drink : String) -> func() uses IO { func sing(n : Int) -> String { if (n == 0) { return phrase1(drink) } else { return int_to_string(n) ++ " bottles of " ++ drink ++ "...\n" ++ sing(n - 1) } } func doit() uses IO { print!(sing(lines())) } return doit } var my_closure = make_closure("wine") my_closure!() return 0 } ================================================ FILE: tests/language/ho/closure_06.exp ================================================ 4 bottles of wine... 3 bottles of wine... 2 bottles of wine... 1 bottles of wine... No more wine ================================================ FILE: tests/language/ho/closure_06.p ================================================ /* * vim: ft=plasma * This is free and unencumbered software released into the public domain. * See ../LICENSE.unlicense */ module Closure_06 func phrase1(drink : String) -> String { return "No more " ++ drink ++ "\n" } func make_closure(drink : String) -> func(Int) uses IO { func sing(n : Int) uses IO { if (n == 0) { // The compiler will generate a call that does not set the // environment. print!(phrase1(drink)) } else { print!(int_to_string(n) ++ " bottles of " ++ drink ++ "...\n") sing!(n - 1) } } return sing } entrypoint func main() uses IO -> Int { var my_closure = make_closure("wine") my_closure!(4) return 0 } ================================================ FILE: tests/language/ho/closure_bad_01.build ================================================ # This is free and unencumbered software released into the public domain. # See ../LICENSE.unlicense # PLZTEST type compile_failure [closure_bad_01] type = program modules = [Closure_Bad_01] ================================================ FILE: tests/language/ho/closure_bad_01.exp ================================================ closure_bad_01.p:15: Arity error got 1 values, but 0 values were expected ================================================ FILE: tests/language/ho/closure_bad_01.p ================================================ /* * vim: ft=plasma * This is free and unencumbered software released into the public domain. * See ../LICENSE.unlicense */ module Closure_Bad_01 export func main() uses IO -> Int { var greeting = "Hello " // The compiler crashs when we forget the return type for the closure. func hi(name : String) { return greeting ++ name ++ "\n" } print!(hi("Paul")) return 0 } ================================================ FILE: tests/language/ho/closure_bad_02.build ================================================ # This is free and unencumbered software released into the public domain. # See ../LICENSE.unlicense # PLZTEST type compile_failure [closure_bad_02] type = program modules = [Closure_Bad_02] ================================================ FILE: tests/language/ho/closure_bad_02.exp ================================================ A compilation error occured and this error is not handled gracefully by the Plasma compiler. Sorry. Message: Unknown symbol: msg Context: ../closure_bad_02.p:22 plzc location: predicate `pre.from_ast.ast_to_pre_expr_2'/7 plzc file: pre.from_ast.m ================================================ FILE: tests/language/ho/closure_bad_02.p ================================================ /* * vim: ft=plasma * This is free and unencumbered software released into the public domain. * See ../LICENSE.unlicense */ module Closure_Bad_02 export func main() uses IO -> Int { var greeting = "Hello " // The compiler crashs when we forget the return type for the closure. func hi(name : String) -> String { var msg = greeting ++ name ++ "\n" return msg } print!(hi("Paul")) // msg wont be available here print!(msg) return 0 } ================================================ FILE: tests/language/ho/closure_bad_03.build ================================================ # This is free and unencumbered software released into the public domain. # See ../LICENSE.unlicense # PLZTEST type compile_failure [closure_bad_03] type = program modules = [Closure_Bad_03] ================================================ FILE: tests/language/ho/closure_bad_03.exp ================================================ A compilation error occured and this error is not handled gracefully by the Plasma compiler. Sorry. Message: The variable 'msg' is already declared Context: ../closure_bad_03.p:17 plzc location: predicate `pre.from_ast.pattern_simple_vars_or_wildcards'/9 plzc file: pre.from_ast.m ================================================ FILE: tests/language/ho/closure_bad_03.p ================================================ /* * vim: ft=plasma * This is free and unencumbered software released into the public domain. * See ../LICENSE.unlicense */ module Closure_Bad_03 export func main() uses IO -> Int { var greeting = "Hello " var msg // The compiler crashs when we forget the return type for the closure. func hi(name : String) -> String { var msg = greeting ++ name ++ "\n" return msg } print!(hi("Paul")) // msg wont be available here print!(msg) return 0 } ================================================ FILE: tests/language/ho/closure_bad_04.build ================================================ # This is free and unencumbered software released into the public domain. # See ../LICENSE.unlicense # PLZTEST type compile_failure [closure_bad_04] type = program modules = [Closure_Bad_04] ================================================ FILE: tests/language/ho/closure_bad_04.exp ================================================ A compilation error occured and this error is not handled gracefully by the Plasma compiler. Sorry. Message: The variable 'msg' is already declared Context: ../closure_bad_04.p:17 plzc location: predicate `pre.from_ast.pattern_simple_vars_or_wildcards'/9 plzc file: pre.from_ast.m ================================================ FILE: tests/language/ho/closure_bad_04.p ================================================ /* * vim: ft=plasma * This is free and unencumbered software released into the public domain. * See ../LICENSE.unlicense */ module Closure_Bad_04 export func main() uses IO -> Int { var greeting = "Hello " var msg = "quack!" // The compiler crashs when we forget the return type for the closure. func hi(name : String) -> String { var msg = greeting ++ name ++ "\n" return msg } print!(hi("Paul")) // msg wont be available here print!(msg) return 0 } ================================================ FILE: tests/language/ho/closure_bad_05.build ================================================ # This is free and unencumbered software released into the public domain. # See ../LICENSE.unlicense # PLZTEST type compile_failure [closure_bad_05] type = program modules = [Closure_Bad_05] ================================================ FILE: tests/language/ho/closure_bad_05.exp ================================================ A compilation error occured and this error is not handled gracefully by the Plasma compiler. Sorry. Message: Unknown variable or constructor 'msg' Context: ../closure_bad_05.p:15 plzc location: predicate `pre.from_ast.ast_to_pre_pattern'/8 plzc file: pre.from_ast.m ================================================ FILE: tests/language/ho/closure_bad_05.p ================================================ /* * vim: ft=plasma * This is free and unencumbered software released into the public domain. * See ../LICENSE.unlicense */ module Closure_Bad_05 export func main() uses IO -> Int { var greeting = "Hello " // The compiler crashs when we forget the return type for the closure. func hi(name : String) -> String { msg = greeting ++ name ++ "\n" return msg } print!(hi("Paul")) // msg wont be available here print!(msg) return 0 } ================================================ FILE: tests/language/ho/closure_bad_06.build ================================================ # This is free and unencumbered software released into the public domain. # See ../LICENSE.unlicense # PLZTEST type compile_failure [closure_bad_06] type = program modules = [Closure_Bad_06] ================================================ FILE: tests/language/ho/closure_bad_06.exp ================================================ A compilation error occured and this error is not handled gracefully by the Plasma compiler. Sorry. Message: The variable 'msg' is defined in an outer scope and cannot be initialised from within this closure Context: ../closure_bad_06.p:17 plzc location: predicate `pre.from_ast.pattern_simple_vars_or_wildcards'/9 plzc file: pre.from_ast.m ================================================ FILE: tests/language/ho/closure_bad_06.p ================================================ /* * vim: ft=plasma * This is free and unencumbered software released into the public domain. * See ../LICENSE.unlicense */ module Closure_Bad_06 export func main() uses IO -> Int { var greeting = "Hello " var msg // The compiler crashs when we forget the return type for the closure. func hi(name : String) -> String { msg = greeting ++ name ++ "\n" return msg } print!(hi("Paul")) // msg wont be available here print!(msg) return 0 } ================================================ FILE: tests/language/ho/closure_bad_07.build ================================================ # This is free and unencumbered software released into the public domain. # See ../LICENSE.unlicense # PLZTEST type compile_failure [closure_bad_07] type = program modules = [Closure_Bad_07] ================================================ FILE: tests/language/ho/closure_bad_07.exp ================================================ A compilation error occured and this error is not handled gracefully by the Plasma compiler. Sorry. Message: The variable 'msg' is already initialised Context: ../closure_bad_07.p:17 plzc location: predicate `pre.from_ast.pattern_simple_vars_or_wildcards'/9 plzc file: pre.from_ast.m ================================================ FILE: tests/language/ho/closure_bad_07.p ================================================ /* * vim: ft=plasma * This is free and unencumbered software released into the public domain. * See ../LICENSE.unlicense */ module Closure_Bad_07 export func main() uses IO -> Int { var greeting = "Hello " var msg = "quack!" // The compiler crashs when we forget the return type for the closure. func hi(name : String) -> String { msg= greeting ++ name ++ "\n" return msg } print!(hi("Paul")) // msg wont be available here print!(msg) return 0 } ================================================ FILE: tests/language/ho/closure_bad_08.build ================================================ # This is free and unencumbered software released into the public domain. # See ../LICENSE.unlicense # PLZTEST type compile_failure [closure_bad_08] type = program modules = [Closure_Bad_08] ================================================ FILE: tests/language/ho/closure_bad_08.exp ================================================ closure_bad_08.p:17: Call uses or observes a resource but has no ! ================================================ FILE: tests/language/ho/closure_bad_08.p ================================================ /* * vim: ft=plasma * This is free and unencumbered software released into the public domain. * See ../LICENSE.unlicense */ module Closure_Bad_08 export func main() uses IO -> Int { var salutation = "G'day" func greet(name : String) uses IO { print!(salutation ++ " " ++ name ++ "\n") } greet("Paul") return 0 } ================================================ FILE: tests/language/ho/closure_bad_09.build ================================================ # This is free and unencumbered software released into the public domain. # See ../LICENSE.unlicense # PLZTEST type compile_failure [closure_bad_09] type = program modules = [Closure_Bad_09] ================================================ FILE: tests/language/ho/closure_bad_09.exp ================================================ closure_bad_09.p:14: Call uses or observes a resource but has no ! ================================================ FILE: tests/language/ho/closure_bad_09.p ================================================ /* * vim: ft=plasma * This is free and unencumbered software released into the public domain. * See ../LICENSE.unlicense */ module Closure_Bad_09 export func main() uses IO -> Int { var salutation = "G'day" func greet(name : String) uses IO { print(salutation ++ " " ++ name ++ "\n") } greet!("Paul") return 0 } ================================================ FILE: tests/language/ho/closure_bad_10.build ================================================ # This is free and unencumbered software released into the public domain. # See ../LICENSE.unlicense # PLZTEST type compile_failure [closure_bad_10] type = program modules = [Closure_Bad_10] ================================================ FILE: tests/language/ho/closure_bad_10.exp ================================================ closure_bad_10.p:14: One or more resources needed for this call is unavailable in this function ================================================ FILE: tests/language/ho/closure_bad_10.p ================================================ /* * vim: ft=plasma * This is free and unencumbered software released into the public domain. * See ../LICENSE.unlicense */ module Closure_Bad_10 export func main() uses IO -> Int { var salutation = "G'day" func greet(name : String) -> Int { print!(salutation ++ " " ++ name ++ "\n") return 3 } _ = greet("Paul") return 0 } ================================================ FILE: tests/language/ho/closure_mut_rec.build ================================================ # This is free and unencumbered software released into the public domain. # See ../LICENSE.unlicense # PLZTEST todo Closure mutual recursion # PLZTEST type compile_failure [closure_mut_rec] type = program modules = [ClosureMutRec] ================================================ FILE: tests/language/ho/closure_mut_rec.exp ================================================ A feature required by your program is currently unimplemented, however this is something we hope to implement in the future. Sorry Feature: is_even is possibly involved in a mutual recursion of closures. If they're not mutually recursive try re-ordering them. Context: ../closure_mut_rec.p:14 Location: predicate `pre.from_ast.ast_to_pre_expr_2'/7 File: pre.from_ast.m ================================================ FILE: tests/language/ho/closure_mut_rec.p ================================================ /* * vim: ft=plasma * This is free and unencumbered software released into the public domain. * See ../LICENSE.unlicense */ module ClosureMutRec func make_is_odd() -> func(Int) -> Bool { func is_odd(n : Int) -> Bool { if (n == 0) { return False } else { return is_even(n-1) } } func is_even(n : Int) -> Bool { if (n == 0) { return True } else { return is_odd(n-1) } } return is_odd } export func main() uses IO -> Int { func odd_or_even(n : Int) -> String { var is_odd = make_is_odd() if (is_odd(n)) { return "odd" } else { return "even" } } var n = 23 print!(int_to_string(n) ++ " is " ++ odd_or_even(n)) return 0 } ================================================ FILE: tests/language/ho/ho_1.exp ================================================ Hello Paul Hello Paul again 55 13, 24, 1728 My favorite colours is Blue My favorite season is Winter My favorite season is Snow time ================================================ FILE: tests/language/ho/ho_1.p ================================================ /* * vim: ft=plasma * This is free and unencumbered software released into the public domain. * See ../LICENSE.unlicense */ module HO_1 // TODO: // Need to implement and test HO values in type arguments func f1(a : Int) -> Int { return a + 1 } func f2(a : Int) -> Int { return a * 2 } func f3(a : Int) -> Int { return pow(a, 3) } entrypoint func main() uses IO -> Int { // Basic HO use. var x = hello_msg print!(x("Paul")) // Basic HO call print!(apply(hello_msg, "Paul again")) // Reduce a function over a list. print!(int_to_string(reduce(add, up_to(10), 0)) ++ "\n") // Store functions in data. var l = map(apply_to_12, [f1, f2, f3]) // TODO: make this more abstract to deomonstrate more higher order code. print!(join(", ", map(int_to_string, l)) ++ "\n") // Return functions from other functions. var f = get_func(Colour) print!(f("Blue") ++ "\n") // Function application syntax. print!(get_func(Season)("Winter") ++ "\n") // Function application syntax as a statement. var fav_season = get_func(Season)("Snow time") print!(fav_season ++ "\n") return 0 } func hello_msg(name : String) -> String { return "Hello " ++ name ++ "\n" } func apply(f : func('a) -> ('b), arg : 'a) -> 'b { return f(arg) } func reduce(f : func('x, 'a) -> ('a), l : List('x), a : 'a) -> 'a { match (l) { [] -> { return a } [var x | var xs] -> { return f(x, reduce(f, xs, a)) } } } func map(f : func('x) -> ('y), l : List('x)) -> List('y) { match (l) { [] -> { return [] } [var x | var xs] -> { return [f(x) | map(f, xs)] } } } func apply_to_12(f : func(Int) -> ('y)) -> 'y { return f(12) } func join(j : String, l0 : List(String)) -> String { match (l0) { [] -> { return "" } // TODO once supported, test a nested pattern match: // [var x] -> { return x } // [var x, var y | var l] -> { return x ++ j ++ join(j, [y | l]) } // for now: [var x | var l] -> { match (l) { [] -> { return x } [_ | _] -> { return x ++ j ++ join(j, l) } } } } } /*-----*/ func add(a : Int, b : Int) -> Int { return a + b } func pow(a : Int, b : Int) -> Int { match b { 0 -> { return 1 } 1 -> { return a } var n -> { return a * pow(a, n-1) } } } func up_to(a : Int) -> List(Int) { if (a == 0) { return [] } else { return [a | up_to(a - 1)] } } /*-----*/ // TODO: This example would be more idiomatic if we supported currying or lambdas type FavouriteThing = Colour | Season func favourite_colour(c : String) -> String { return "My favorite colours is " ++ c } func favourite_season(s : String) -> String { return "My favorite season is " ++ s } func get_func(thing : FavouriteThing) -> func(String) -> String { match(thing) { Colour -> { return favourite_colour } Season -> { return favourite_season } } } ================================================ FILE: tests/language/ho/ho_2.exp ================================================ 1, 2, 3, Hi My favorite colour is Blue ================================================ FILE: tests/language/ho/ho_2.p ================================================ /* * vim: ft=plasma * This is free and unencumbered software released into the public domain. * See ../LICENSE.unlicense */ module HO_2 // Test higher-order code that uses resources // TODO: Polymorphic resource use. entrypoint func main() uses IO -> Int { // Ho code with a resource. do_for!(print_one, [1, 2, 3]) print!("\n") // Put a higher order thing in a structure, then use it. var x = MyType(print) do!(x, "Hi\n") // Return a resource using function from a function and call it. var f = get_func(Colour) f!("Blue") return 0 } /*-----*/ func print_one(n : Int) uses IO { print!(int_to_string(n) ++ ", ") } func do_for(f : func('x) uses IO, l : List('x)) uses IO { match (l) { [] -> {} [var x | var xs] -> { f!(x) do_for!(f, xs) } } } /*-----*/ type MyType('x) = MyType(x : 'x) func do(tf : MyType(func('x) uses IO), x : 'x) uses IO { MyType(var f) = tf f!(x) } /*-----*/ // TODO: This example would be more idiomatic if we supported currying or lambdas type FavouriteThing = Colour | Season func favourite_colour(c : String) uses IO { print!("My favorite colour is " ++ c ++ "\n") } func favourite_season(s : String) uses IO { print!("My favorite season is " ++ s ++ "\n") } func get_func(thing : FavouriteThing) -> func(String) uses IO { match(thing) { Colour -> { return favourite_colour } Season -> { return favourite_season } } } /*-----*/ ================================================ FILE: tests/language/ho/ho_bad_7.build ================================================ # This is free and unencumbered software released into the public domain. # See ../LICENSE.unlicense # PLZTEST type compile_failure [ho_bad_7] type = program modules = [HO_Bad_7] ================================================ FILE: tests/language/ho/ho_bad_7.exp ================================================ ho_bad_7.p:12: One or more resources needed for an argument to a call is not provided in by the passed-in value ho_bad_7.p:18: One or more resources needed for an argument to a call is not provided in by the passed-in value ho_bad_7.p:30: One or more resources needed for this call is unavailable in this function ho_bad_7.p:44: Call uses or observes a resource but has no ! ho_bad_7.p:55: Warning: Call has a ! but does not need it ho_bad_7.p:78: Call uses or observes a resource but has no ! ho_bad_7.p:90: One or more resources needed for this call is unavailable in this function ho_bad_7.p:111: The function returns a higher order value that uses or observes one or more resources, however the resources arn't declared in the function's return type ================================================ FILE: tests/language/ho/ho_bad_7.p ================================================ /* * vim: ft=plasma * This is free and unencumbered software released into the public domain. * See ../LICENSE.unlicense */ module HO_Bad_7 export func main() uses IO -> Int { // print_one uses a resource that do_for will not make available. do_for2!(print_one, [1, 2, 3]) print!("\n") // Put a higher order thing in a structure, then use it but without the // correct resource. var x = MyType(print) apply!(x, "Hi\n") return 0 } //////// func test() { // Basic HO use. // These currently generate confusing error messages, but it's still // something we can test. var x = hello_msg x!("Paul") } func hello_msg(name : String) uses IO { print!("Hello " ++ name ++ "\n") } //////// func do_for1(f : func('x) uses IO, l : List('x)) uses IO { match (l) { [] -> {} [var x | var xs] -> { // Missing bang. f(x) do_for1!(f, xs) } } } func do_for2(f : func('x), l : List('x)) uses IO { match (l) { [] -> {} [var x | var xs] -> { // f doesn't use a resource. f!(x) do_for2!(f, xs) } } } func print_one(n : Int) uses IO { print!(int_to_string(n) ++ ", ") } //////// type MyType('x) = MyType(x : 'x) func apply(mt : MyType(func('x)), x : 'x) uses IO { match(mt) { MyType(var f) -> { f(x) } } } func apply2(mt : MyType(func('x) uses IO), x : 'x) uses IO { match(mt) { // Call to f should have a !. MyType(var f) -> { f(x) } } } ////// resource A from IO resource B from IO func test_return() uses A { // Return a resource using function from a function and call it. var f = get_func(Colour) f!("Blue") } // TODO: This example would be more idiomatic if we supported currying or lambdas type FavouriteThing = Colour | Season func favourite_colour(c : String) uses B { // print!("My favorite colour is " ++ c ++ "\n") } func favourite_season(s : String) uses B { // print!("My favorite season is " ++ s ++ "\n") } func get_func(thing : FavouriteThing) -> func(String) uses B { match(thing) { Colour -> { return favourite_colour } Season -> { return favourite_season } } } func get_func_broke(thing : FavouriteThing) -> func(String) uses A { match(thing) { Colour -> { return favourite_colour } Season -> { return favourite_season } } } ////// ================================================ FILE: tests/language/ho/ho_call_bug_30.exp ================================================ 1, 2, 3 ================================================ FILE: tests/language/ho/ho_call_bug_30.p ================================================ /* * vim: ft=plasma * This is free and unencumbered software released into the public domain. * See ../LICENSE.unlicense */ module HOCallBug30 // TODO: // Need to implement and test HO values in type arguments entrypoint func main() uses IO -> Int { // Higher order calls to builtins used to crash. print!(join(", ", map(int_to_string, [1, 2, 3])) ++ "\n") return 0 } func map(f : func('x) -> ('y), l : List('x)) -> List('y) { match (l) { [] -> { return [] } [var x | var xs] -> { return [f(x) | map(f, xs)] } } } func join(j : String, l0 : List(String)) -> String { match (l0) { [] -> { return "" } [var x | var l] -> { match (l) { [] -> { return x } [_ | _] -> { return x ++ j ++ join(j, l) } } } } } ================================================ FILE: tests/language/ite_1.exp ================================================ fib(16) = 1597 ================================================ FILE: tests/language/ite_1.p ================================================ /* * vim: ft=plasma * This is free and unencumbered software released into the public domain. * See ../LICENSE.unlicense */ module Ite_1 entrypoint func main() uses IO -> Int { print!("fib(16) = " ++ int_to_string(fib(16)) ++ "\n") return 0 } func fib(n : Int) -> Int { if (n < 2) { return 1 } else { return fib(n-1) + fib(n-2) } } ================================================ FILE: tests/language/ite_2.exp ================================================ fib(16) = 1597 ================================================ FILE: tests/language/ite_2.p ================================================ /* * vim: ft=plasma * This is free and unencumbered software released into the public domain. * See ../LICENSE.unlicense */ module Ite_2 entrypoint func main() uses IO -> Int { print!("fib(16) = " ++ int_to_string(fib(16)) ++ "\n") return 0 } func fib(n : Int) -> Int { // Parens are optional if n == 0 { return 1 } else if (n == 1) { return 1 } else { return fib(n-1) + fib(n-2) } } ================================================ FILE: tests/language/ite_3.exp ================================================ fib1(16) = 1597 fib2(16) = 1597 fib4(16) = 1597 10 more beers left. 5 more beers left. Only one beer left. worry... No more beer! PANIC! You owe someone a beer! Better repay them! ================================================ FILE: tests/language/ite_3.p ================================================ /* * vim: ft=plasma * This is free and unencumbered software released into the public domain. * See ../LICENSE.unlicense */ module Ite_3 entrypoint func main() uses IO -> Int { print!("fib1(16) = " ++ int_to_string(fib1(16)) ++ "\n") print!("fib2(16) = " ++ int_to_string(fib2(16)) ++ "\n") print!("fib4(16) = " ++ int_to_string(fib4(16)) ++ "\n") test5!() return 0 } func fib1(n : Int) -> Int { if (n <= 1) { return 1 } else { return fib1(n-1) + fib1(n-2) } } func fib2(n : Int) -> Int { var r if (n <= 1) { r = 1 } else { r = fib2(n-1) + fib2(n-2) } return r } func fib4(n : Int) -> Int { var r if (n <= 1) { var m = "fish" r = 1 } else { var m = n r = fib4(m-1) + fib4(m-2) } return r } func test5() uses IO { print!(beer(10) ++ "\n") print!(beer(5) ++ "\n") print!(beer(1) ++ "\n") print!(beer(0) ++ "\n") print!(beer(-1) ++ "\n") } /* * Test switches that provide multiple values * Test wildcard matches * Test negative patterns */ func beer(n : Int) -> String { // This could be an expression but those are tested in match_2.p var beer_str var panic if (n < 0) { beer_str = "You owe someone a beer!" panic = "Better repay them!" } else if (n == 0) { beer_str = "No more beer!" panic = "PANIC!" } else if (n == 1) { beer_str = "Only one beer left." panic = "worry..." } else { beer_str = int_to_string(n) ++ " more beers left." panic = "" } return beer_str ++ " " ++ panic } ================================================ FILE: tests/language/list.exp ================================================ 15 215 4215 ================================================ FILE: tests/language/list.p ================================================ /* * vim: ft=plasma * This is free and unencumbered software released into the public domain. * See ../LICENSE.unlicense */ module List entrypoint func main() uses IO -> Int { var list1 = [1, 2, 3, 4, 5] print!(int_to_string(reduce(add, list1, 0)) ++ "\n") var list2 = [200 | list1] print!(int_to_string(reduce(add, list2, 0)) ++ "\n") var list3 = [4000, 200 | list1] print!(int_to_string(reduce(add, list3, 0)) ++ "\n") // list4 = [1..10] // print!(int_to_string(reduce(add, list4, 0)) ++ "\n") return 0 } func reduce(f : func('a, 'a) -> ('a), l : List('a), acc0 : 'a) -> 'a { match (l) { [] -> { return acc0 } [var x | var xs] -> { var acc = f(x, acc0) return reduce(f, xs, acc) } } } func add(a : Int, b : Int) -> Int { return a + b } ================================================ FILE: tests/language/match/BUILD.plz ================================================ # This is free and unencumbered software released into the public domain. # See ../LICENSE.unlicense [match_1] type = program modules = [Match_1] [match_2] type = program modules = [Match_2] [match_empty_case] type = program modules = [MatchEmptyCase] [unpack_1] type = program modules = [Unpack_1] ================================================ FILE: tests/language/match/match_1.exp ================================================ fib1(16) = 1597 fib2(16) = 1597 fib3(16) = 1597 fib4(16) = 1597 10 more beers left. 5 more beers left. Only one beer left. worry... No more beer! PANIC! You owe someone a beer! Better repay them! 0 is zero 5 is more ================================================ FILE: tests/language/match/match_1.p ================================================ /* * vim: ft=plasma * This is free and unencumbered software released into the public domain. * See ../LICENSE.unlicense */ module Match_1 entrypoint func main() uses IO -> Int { print!("fib1(16) = " ++ int_to_string(fib1(16)) ++ "\n") print!("fib2(16) = " ++ int_to_string(fib2(16)) ++ "\n") print!("fib3(16) = " ++ int_to_string(fib3(16)) ++ "\n") print!("fib4(16) = " ++ int_to_string(fib4(16)) ++ "\n") test5!() test6!() return 0 } func fib1(n : Int) -> Int { match (n) { 0 -> { return 1 } 1 -> { return 1 } var m -> { return fib1(m-1) + fib1(m-2) } } } func fib2(n : Int) -> Int { var r match (n) { 0 -> { r = 1 } 1 -> { r = 1 } var m -> { r = fib2(m-1) + fib2(m-2) } } return r } func fib3(n : Int) -> Int { var r match (n) { 0 -> { r = 1 } 1 -> { var m = 1 r = m } var m -> { r = fib3(m-1) + fib3(m-2) } } return r } func fib4(n : Int) -> Int { var r match (n) { 0 -> { r = 1 } 1 -> { var m = "fish" r = 1 } var m -> { r = fib4(m-1) + fib4(m-2) } } return r } func test5() uses IO { print!(beer(10) ++ "\n") print!(beer(5) ++ "\n") print!(beer(1) ++ "\n") print!(beer(0) ++ "\n") print!(beer(-1) ++ "\n") } /* * Test switches that provide multiple values * Test wildcard matches * Test negative patterns */ func beer(n : Int) -> String { var beer_str var panic match (n) { -1 -> { beer_str = "You owe someone a beer!" panic = "Better repay them!" } 0 -> { beer_str = "No more beer!" panic = "PANIC!" } 1 -> { beer_str = "Only one beer left." panic = "worry..." } _ -> { beer_str = int_to_string(n) ++ " more beers left." panic = "" } } return beer_str ++ " " ++ panic } func test6() uses IO { func t(a : Int) -> String { var b var str match (a) { 0 -> { b = 0 str = "zero" } // Matches anything and binds it to b which is visible outside. b -> { str = "more" } } return int_to_string(b) ++ " is " ++ str ++ "\n" } print!(t(0)) print!(t(5)) } ================================================ FILE: tests/language/match/match_2.exp ================================================ 10 more beers left. 5 more beers left. Only one beer left. worry... No more beer! PANIC! You owe someone a beer! Better repay them! 10 more beers left. 5 more beers left. Only one beer left. worry... No more beer! PANIC! You owe someone a beer! Better repay them! 10 more beers left. 5 more beers left. Only one beer left. worry... No more beer! PANIC! You owe someone a beer! Better repay them! 10 more beers left. 5 more beers left. Only one beer left. worry... No more beer! PANIC! You owe someone a beer! Better repay them! ================================================ FILE: tests/language/match/match_2.p ================================================ /* * vim: ft=plasma * This is free and unencumbered software released into the public domain. * See ../LICENSE.unlicense */ module Match_2 entrypoint func main() uses IO -> Int { func test(beer : func(Int) -> String) uses IO { print!(beer(10) ++ "\n") print!(beer(5) ++ "\n") print!(beer(1) ++ "\n") print!(beer(0) ++ "\n") print!(beer(-1) ++ "\n") } test!(beer1) test!(beer2) test!(beer3) test!(beer4) return 0 } func beer1(n : Int) -> String { // This match expression returns two items. var beer_str, var panic = match (n) { -1 -> "You owe someone a beer!", "Better repay them!" 0 -> "No more beer!", "PANIC!" 1 -> "Only one beer left.", "worry..." _ -> int_to_string(n) ++ " more beers left.", "" } return beer_str ++ " " ++ panic } func beer2(n : Int) -> String { var beer_str, var panic = if (n < 0) then "You owe someone a beer!", "Better repay them!" else if (n == 1) then "Only one beer left.", "worry..." else if (n == 0) then "No more beer!", "PANIC!" else int_to_string(n) ++ " more beers left.", "" return beer_str ++ " " ++ panic } func beer3(n : Int) -> String { var beer_str, var panic = // Check that different arms of the if-then-else can can have // different expressions although the expression on the else branch // returns 2 items. if (n < 0) then "You owe someone a beer!", "Better repay them!" else beer3_aux(n) return beer_str ++ " " ++ panic } func beer4(n : Int) -> String { var beer_str, var panic = // Check that different arms of the if-then-else can can have // different expressions although the expression on the else branch // returns 2 items. match (n) { -1 -> "You owe someone a beer!", "Better repay them!" _ -> beer3_aux(n) } return beer_str ++ " " ++ panic } // This can work to return multiple values. func beer3_aux(n : Int) -> (String, String) { return if (n == 0) then "No more beer!", "PANIC!" else if (n == 1) then "Only one beer left.", "worry..." else int_to_string(n) ++ " more beers left.", "" } ================================================ FILE: tests/language/match/match_bad_1.build ================================================ # This is free and unencumbered software released into the public domain. # See ../LICENSE.unlicense # PLZTEST type compile_failure [match_bad_1] type = program modules = [Match_Bad_1] ================================================ FILE: tests/language/match/match_bad_1.exp ================================================ A compilation error occured and this error is not handled gracefully by the Plasma compiler. Sorry. Message: Unknown variable or constructor 'yy' Context: ../match_bad_1.p:13 plzc location: predicate `pre.from_ast.ast_to_pre_pattern'/8 plzc file: pre.from_ast.m ================================================ FILE: tests/language/match/match_bad_1.p ================================================ /* * vim: ft=plasma * This is free and unencumbered software released into the public domain. * See ../LICENSE.unlicense */ module Match_Bad_1 export func main() uses IO -> Int { var x = 3 var y match (x) { 3 -> { y = 2 } // yy does not exist yy -> { y = yy * 26 } } print!(int_to_string(y)) return 0 } ================================================ FILE: tests/language/match/match_bad_2.build ================================================ # This is free and unencumbered software released into the public domain. # See ../LICENSE.unlicense # PLZTEST type compile_failure [match_bad_2] type = program modules = [Match_Bad_2] ================================================ FILE: tests/language/match/match_bad_2.exp ================================================ A feature required by your program is currently unimplemented, however this is something we hope to implement in the future. Sorry Feature: Cannot handle some branches returning and others falling-through Context: ../match_bad_2.p:13 Location: predicate `pre.to_core.pre_to_core_stmt'/7 File: pre.to_core.m ================================================ FILE: tests/language/match/match_bad_2.p ================================================ /* * vim: ft=plasma * This is free and unencumbered software released into the public domain. * See ../LICENSE.unlicense */ module Match_Bad_2 export func main() uses IO -> Int { var x = 3 var y match (x) { 3 -> { y = 2 return 4 } var yy -> { y = yy * 26 } } print!(int_to_string(y)) return 0 } ================================================ FILE: tests/language/match/match_bad_3.build ================================================ # This is free and unencumbered software released into the public domain. # See ../LICENSE.unlicense # PLZTEST type compile_failure [match_bad_3] type = program modules = [Match_Bad_3] ================================================ FILE: tests/language/match/match_bad_3.exp ================================================ A compilation error occured and this error is not handled gracefully by the Plasma compiler. Sorry. Message: Variable 'a' already defined Context: ../match_bad_3.p:15 plzc location: predicate `pre.from_ast.ast_to_pre_pattern'/8 plzc file: pre.from_ast.m ================================================ FILE: tests/language/match/match_bad_3.p ================================================ /* * vim: ft=plasma * This is free and unencumbered software released into the public domain. * See ../LICENSE.unlicense */ module Match_Bad_3 type Foo = Foo ( a : Int, b : Int ) export func main() uses IO -> Int { var x = Foo(2, 170) var y match (x) { // Error, variable used twice in the same pattern Foo(var a, var a) -> { y = a + a } } print!("Number is " ++ int_to_string(y) ++ "\n") return 0 } ================================================ FILE: tests/language/match/match_bad_error_1.build ================================================ # This is free and unencumbered software released into the public domain. # See ../LICENSE.unlicense # PLZTEST todo Pattern match on multiple levels # PLZTEST type compile_failure [match_bad_error_1] type = program modules = [MatchBadError1] ================================================ FILE: tests/language/match/match_bad_error_1.exp ================================================ A compilation error occured and this error is not handled gracefully by the Plasma compiler. Sorry. Message: The variable 'varctorname' is already defined Context: ../match_bad_error_1.p:23 plzc location: predicate `pre.from_ast.ast_to_pre_stmt_var'/9 plzc file: pre.from_ast.m ================================================ FILE: tests/language/match/match_bad_error_1.p ================================================ /* * vim: ft=plasma * This is free and unencumbered software released into the public domain. * See ../LICENSE.unlicense */ module MatchBadError1 export func main() uses IO -> Int { test7!() return 0 } type TypeExists = varctorname func test7() uses IO { func t(a : Int) -> String { // This generates an error from the compiler, it's the wrong error // since it's a constructor that's already defined, but maybe it // should be a warning when a *local variable* does this to another // symbol? var varctorname var str match (a) { 0 -> { varctorname = 0 str = "zero" } // Same as test6 except this name is also a constructor name, // but eh compiler will choose the type. varctorname -> { str = "more" } } return int_to_string(varctorname) ++ " is " ++ str ++ "\n" } print!(t(0)) print!(t(5)) } ================================================ FILE: tests/language/match/match_empty_case.exp ================================================ Hello ================================================ FILE: tests/language/match/match_empty_case.p ================================================ /* * vim: ft=plasma * This is free and unencumbered software released into the public domain. * See ../LICENSE.unlicense */ module MatchEmptyCase entrypoint func main() uses IO -> Int { var x = 3 if (x == 4) { // The compiler would crash for an empty case like this. } else { print!("Hello\n") } match (x) { 0 -> { print!("bye?") } // The compiler would crash for an empty case like this. 3 -> { } _ -> { print!("hello?") } } return 0 } ================================================ FILE: tests/language/match/match_multiple.build ================================================ # This is free and unencumbered software released into the public domain. # See ../LICENSE.unlicense # PLZTEST todo Pattern match on multiple levels # PLZTEST type compile_failure [match_multiple] type = program modules = [MatchMultiple] ================================================ FILE: tests/language/match/match_multiple.exp ================================================ A feature required by your program is currently unimplemented, however this is something we hope to implement in the future. Sorry Feature: Nested pattern matching (constructor within other pattern) Location: predicate `pre.to_core.make_pattern_arg_var'/4 File: pre.to_core.m ================================================ FILE: tests/language/match/match_multiple.p ================================================ /* * vim: ft=plasma * This is free and unencumbered software released into the public domain. * See ../LICENSE.unlicense */ module MatchMultiple export func main() uses IO -> Int { var list1 = [1, 2, 3, 4, 5] print!(int_to_string(reduce(add, list1)) ++ "\n") return 0 } func reduce(f : func(Int, Int) -> (Int), l : List(Int)) -> Int { match (l) { [] -> { return 0 } [var x] -> { return x } [var a, var b | var xs ] -> { return add(a, reduce(f, [b | xs])) } } } func add(a : Int, b : Int) -> Int { return a + b } ================================================ FILE: tests/language/match/unpack_1.exp ================================================ x part is 3 p1 + p2 = 1, 9 ================================================ FILE: tests/language/match/unpack_1.p ================================================ /* * vim: ft=plasma * This is free and unencumbered software released into the public domain. * See ../LICENSE.unlicense */ module Unpack_1 entrypoint func main() uses IO -> Int { test1!() test2!() return 0 } type Point = Point(x : Int, y : Int) func test1() uses IO { // Initially we could only extract a single variable. Point(var x, _) = Point(3, 6) print!("x part is " ++ int_to_string(x) ++ "\n") } func point_to_str(p : Point) -> String { // Test that we can unpack fields from a structure Point(var x, var y) = p return int_to_string(x) ++ ", " ++ int_to_string(y) } func add(a : Point, b : Point) -> Point { Point(var x1, var y1) = a // We can declare the variables before unpacking them, like other // asignments. var x2 var y2 Point(x2, y2) = b return Point(x1 + x2, y1 + y2) } func test2() uses IO { var p1 = Point(3, 2) var p2 = Point(-2, 7) print!("p1 + p2 = " ++ point_to_str(add(p1, p2)) ++ "\n") } ================================================ FILE: tests/language/match/unpack_nest.build ================================================ # This is free and unencumbered software released into the public domain. # See ../LICENSE.unlicense # PLZTEST todo nested constructors in unpack statements # PLZTEST type compile_failure [unpack_nest] type = program modules = [UnpackNest] ================================================ FILE: tests/language/match/unpack_nest.exp ================================================ A feature required by your program is currently unimplemented, however this is something we hope to implement in the future. Sorry Feature: Nested pattern matching (constructor within other pattern) Location: predicate `pre.to_core.make_pattern_arg_var'/4 File: pre.to_core.m ================================================ FILE: tests/language/match/unpack_nest.p ================================================ /* * vim: ft=plasma * This is free and unencumbered software released into the public domain. * See ../LICENSE.unlicense */ module UnpackNest export func main() uses IO -> Int { test3!() return 0 } type Foo = Foo(a : Bar, b : Int) // We have to test with the unit type to make an irrefutable pattern type Bar = Bar func foo_to_str(f : Foo) -> String { Foo(Bar, var n) = f return "Foo(Bar, " ++ int_to_string(n) ++ ")" } func test3() uses IO { var a = Foo(Bar, 28) print!("a = " ++ foo_to_str(a) ++ "\n") } ================================================ FILE: tests/language/operators.exp ================================================ 27 + 3 = 30 27 - 3 = 24 3 - 27 = -24 5 * 5 = 25 37 / 5 = 7 -37 / 5 = -7 37 / -5 = -7 -37 / -5 = 7 37 % 5 = 2 -37 % 5 = -2 37 % -5 = 2 -37 % -5 = -2 -3 = -3 12 + 3 * 4 = 24 12 - (8 + 2) = 2 6 + 6 == 3 * 4 = True 5 < 3 = False 5 > 3 = True 5 <= 3 = False 5 >= 3 = True 5 == 3 = False 5 != 3 = True 5 < 4 = False 5 > 4 = True 5 <= 4 = False 5 >= 4 = True 5 == 4 = False 5 != 4 = True 5 < 5 = False 5 > 5 = False 5 <= 5 = True 5 >= 5 = True 5 == 5 = True 5 != 5 = False 5 < 6 = True 5 > 6 = False 5 <= 6 = True 5 >= 6 = False 5 == 6 = False 5 != 6 = True 5 < 7 = True 5 > 7 = False 5 <= 7 = True 5 >= 7 = False 5 == 7 = False 5 != 7 = True not True = False not False = True False and False = False False and True = False True and False = False True and True = True False or False = False False or True = True True or False = True True or True = True ================================================ FILE: tests/language/operators.p ================================================ /* * vim: ft=plasma * This is free and unencumbered software released into the public domain. * See ../LICENSE.unlicense */ module Operators /* * Please keep this up to date with the documentation in docs/plasma_ref.txt */ entrypoint func main() uses IO -> Int { // Arithmetic print!("27 + 3 = " ++ int_to_string(27 + 3) ++ "\n") print!("27 - 3 = " ++ int_to_string(27 - 3) ++ "\n") print!("3 - 27 = " ++ int_to_string(3 - 27) ++ "\n") print!("5 * 5 = " ++ int_to_string(5 * 5) ++ "\n") print!("37 / 5 = " ++ int_to_string(37 / 5) ++ "\n") print!("-37 / 5 = " ++ int_to_string(-37 / 5) ++ "\n") print!("37 / -5 = " ++ int_to_string(37 / -5) ++ "\n") print!("-37 / -5 = " ++ int_to_string(-37 / -5) ++ "\n") print!("37 % 5 = " ++ int_to_string(37 % 5) ++ "\n") print!("-37 % 5 = " ++ int_to_string(-37 % 5) ++ "\n") print!("37 % -5 = " ++ int_to_string(37 % -5) ++ "\n") print!("-37 % -5 = " ++ int_to_string(-37 % -5) ++ "\n") print!("-3 = " ++ int_to_string(-3) ++ "\n") // Order of operations print!("12 + 3 * 4 = " ++ int_to_string(12 + 3 * 4) ++ "\n") print!("12 - (8 + 2) = " ++ int_to_string(12 - (8 + 2)) ++ "\n") print!("6 + 6 == 3 * 4 = " ++ bool_to_string(6 + 6 == 3 * 4) ++ "\n") // Comparison func test_compare(x : Int) uses IO { print!("5 < " ++ int_to_string(x) ++ " = " ++ bool_to_string(5 < x) ++ "\n") print!("5 > " ++ int_to_string(x) ++ " = " ++ bool_to_string(5 > x) ++ "\n") print!("5 <= " ++ int_to_string(x) ++ " = " ++ bool_to_string(5 <= x) ++ "\n") print!("5 >= " ++ int_to_string(x) ++ " = " ++ bool_to_string(5 >= x) ++ "\n") print!("5 == " ++ int_to_string(x) ++ " = " ++ bool_to_string(5 == x) ++ "\n") print!("5 != " ++ int_to_string(x) ++ " = " ++ bool_to_string(5 != x) ++ "\n") } var list = [3, 4, 5, 6, 7] do_list!(test_compare, list) // Bool print!("not True = " ++ bool_to_string(not True) ++ "\n") print!("not False = " ++ bool_to_string(not False) ++ "\n") func test_and(b1 : Bool, b2 : Bool) uses IO { print!(bool_to_string(b1) ++ " and " ++ bool_to_string(b2) ++ " = " ++ bool_to_string(b1 and b2) ++ "\n") } test_and!(False, False) test_and!(False, True) test_and!(True, False) test_and!(True, True) func test_or(b1 : Bool, b2 : Bool) uses IO { print!(bool_to_string(b1) ++ " or " ++ bool_to_string(b2) ++ " = " ++ bool_to_string(b1 or b2) ++ "\n") } test_or!(False, False) test_or!(False, True) test_or!(True, False) test_or!(True, True) // String append is tested throughout this test anyway. return 0 } func do_list(f : func('x) uses IO, l : List('x)) uses IO { match (l) { [] -> { } [var x | var xs] -> { f!(x) do_list!(f, xs) } } } ================================================ FILE: tests/language/pragma_bad_args.build ================================================ # This is free and unencumbered software released into the public domain. # See ../LICENSE.unlicense # PLZTEST type compile_failure [pragma_bad_args] type = program modules = [PragmaBadArgs] ================================================ FILE: tests/language/pragma_bad_args.exp ================================================ pragma_bad_args.p:10: Unrecognised argument for this pragma ================================================ FILE: tests/language/pragma_bad_args.p ================================================ /* * vim: ft=plasma * This is free and unencumbered software released into the public domain. * See ../LICENSE.unlicense */ module PragmaBadArgs pragma foreign_include("globly", "glorp") entrypoint func hello() uses IO -> Int { print!("Hello world\n") return 0 } ================================================ FILE: tests/language/pragma_unknown_1.build ================================================ # This is free and unencumbered software released into the public domain. # See ../LICENSE.unlicense # PLZTEST type compile_failure [pragma_unknown_1] type = program modules = [PragmaUnknown1] compiler_opts = "--warnings-as-errors" ================================================ FILE: tests/language/pragma_unknown_1.exp ================================================ pragma_unknown_1.p:9: Warning: Pragma 'sillyname' is unrecognised and will be ignored ================================================ FILE: tests/language/pragma_unknown_1.p ================================================ /* * vim: ft=plasma * This is free and unencumbered software released into the public domain. * See ../LICENSE.unlicense */ module PragmaUnknown1 pragma sillyname("skidoo") entrypoint func main() uses IO -> Int { print!("Hello world!\n") return 0 } ================================================ FILE: tests/language/pragma_unknown_2.build ================================================ # This is free and unencumbered software released into the public domain. # See ../LICENSE.unlicense # This still has an unknown pragma but it will be mearly a warning and the # program will still execute. [pragma_unknown_2] type = program modules = [PragmaUnknown2] ================================================ FILE: tests/language/pragma_unknown_2.exp ================================================ Hello world! ================================================ FILE: tests/language/pragma_unknown_2.p ================================================ /* * vim: ft=plasma * This is free and unencumbered software released into the public domain. * See ../LICENSE.unlicense */ module PragmaUnknown2 pragma sillyname("skidoo") entrypoint func main() uses IO -> Int { print!("Hello world!\n") return 0 } ================================================ FILE: tests/language/res/BUILD.plz ================================================ # This is free and unencumbered software released into the public domain. # See ../LICENSE.unlicense [resource] type = program modules = [Resource] ================================================ FILE: tests/language/res/multiple_bang.build ================================================ # This is free and unencumbered software released into the public domain. # See ../LICENSE.unlicense # PLZTEST type compile_failure [multiple_bang] type = program modules = [MultipleBang] ================================================ FILE: tests/language/res/multiple_bang.exp ================================================ multiple_bang.p:12: Statement has more than one ! call multiple_bang.p:16: Statement has more than one ! call ================================================ FILE: tests/language/res/multiple_bang.p ================================================ /* * vim: ft=plasma * This is free and unencumbered software released into the public domain. * See ../LICENSE.unlicense */ module MultipleBang export func main() uses IO -> Int { // Future: Use disjoint resources in the same statement. _ = use_env!() + test_gettimeofday!() // Future: Observe the same or related resources in the same statement. // XXX But not use and observe var d = test_gettimeofday!() - test_gettimeofday!() print!("# The difference between two times is: " ++ int_to_string(d) ++ "\n") return 0 } func use_env() uses Environment -> Int { return 0 } func test_gettimeofday() observes Time -> Int { var b, var s, var us = Builtin.gettimeofday!() if (b) { return s } else { return -1 } } ================================================ FILE: tests/language/res/resource.exp ================================================ Hello world Two uses of IO Within the same compound statement (the if) ================================================ FILE: tests/language/res/resource.p ================================================ /* * vim: ft=plasma * This is free and unencumbered software released into the public domain. * See ../LICENSE.unlicense */ module Resource entrypoint func main() uses IO -> Int { print!("Hello world\n") use_state!() test_setenv!("test_env", "test value") var time_s = test_gettimeofday!() print!("# The time is " ++ int_to_string(time_s) ++ "s\n") var r = use_foo!() // Safe resource use in a sub-statement. if (0 == 0) { print!("Two uses of IO\n") print!("Within the same compound statement (the if)\n") } else { print!("Are okay, also okay in different branches\n") } return r } func use_env() uses Environment -> Int { return 0 } resource MyState from IO resource MySubState from MyState // Parens are valid but optional here. func use_state() uses (MySubState) {} // resource Environment from IO func test_setenv(name : String, value : String) uses Environment { _ = setenv!(name, value) return } // resource Time from IO func test_gettimeofday() observes Time -> Int { var b, var s, var us = Builtin.gettimeofday!() if (b) { return s } else { return -1 } } // define our own resources resource Foo from IO resource Bar from Foo resource Bax from Foo func use_foo() uses Foo -> Int { return 0 } func observe_foo() observes Foo -> Int { return observe_bar!() } func observe_bar() observes Bar -> Int { return 42 } func use_bar_and_baz() uses (Bar, Bax) -> Int { return 43 } ================================================ FILE: tests/language/res/resource_invalid_1.build ================================================ # This is free and unencumbered software released into the public domain. # See ../LICENSE.unlicense # PLZTEST type compile_failure [resource_invalid_1] type = program modules = [ResourceInvalid1] ================================================ FILE: tests/language/res/resource_invalid_1.exp ================================================ resource_invalid_1.p:20: Warning: Call has a ! but does not need it resource_invalid_1.p:12: Call uses or observes a resource but has no ! resource_invalid_1.p:13: Call uses or observes a resource but has no ! resource_invalid_1.p:29: One or more resources needed for this call is unavailable in this function resource_invalid_1.p:36: One or more resources needed for this call is unavailable in this function resource_invalid_1.p:49: One or more resources needed for this call is unavailable in this function resource_invalid_1.p:54: One or more resources needed for this call is unavailable in this function ================================================ FILE: tests/language/res/resource_invalid_1.p ================================================ /* * vim: ft=plasma * This is free and unencumbered software released into the public domain. * See ../LICENSE.unlicense */ module ResourceInvalid1 export func main() uses IO -> Int { // Calls without bang. foo() baz() // These calls are okay. foo!() baz!() // Unnecessary bang return bar!() } func foo() uses IO { print!("Hello world\n") } func bar() -> Int { // Use of a resource we don't have. print!("Hi\n") return 3 } func baz() observes IO { // Use of a resource we only have read access to. print!("Hi baz\n") } // Function declares that it uses a resource but doesn't actually need it. func troz() uses IO -> Int { return 6 } resource Foo from IO resource Bar from Foo func use_bar_call_foo() uses Bar -> Int { // We need the parent resource for this call. Bar isn't enough. return use_foo!() } func use_foo() uses Foo -> Int { // We need a sibling resource for this call. Foo isn't enough. _ = setenv!("abc", "xyz") return 3 } ================================================ FILE: tests/language/res/resource_invalid_2.build ================================================ # This is free and unencumbered software released into the public domain. # See ../LICENSE.unlicense # PLZTEST type compile_failure [resource_invalid_2] type = program modules = [ResourceInvalid2] ================================================ FILE: tests/language/res/resource_invalid_2.exp ================================================ resource_invalid_2.p:10: Unknown resource 'Fipbib' ================================================ FILE: tests/language/res/resource_invalid_2.p ================================================ /* * vim: ft=plasma * This is free and unencumbered software released into the public domain. * See ../LICENSE.unlicense */ module ResourceInvalid2 // Undeclared resource. func zort() uses Fipbib -> Int { return 42 } ================================================ FILE: tests/language/res/resource_invalid_3.build ================================================ # This is free and unencumbered software released into the public domain. # See ../LICENSE.unlicense # PLZTEST type compile_failure [resource_invalid_3] type = program modules = [ResourceInvalid3] ================================================ FILE: tests/language/res/resource_invalid_3.exp ================================================ resource_invalid_3.p:15: Statement has more than one ! call resource_invalid_3.p:19: Statement has more than one ! call resource_invalid_3.p:22: Statement has more than one ! call resource_invalid_3.p:25: Statement has more than one ! call resource_invalid_3.p:28: Statement has more than one ! call resource_invalid_3.p:31: Statement has more than one ! call resource_invalid_3.p:35: Statement has more than one ! call ================================================ FILE: tests/language/res/resource_invalid_3.p ================================================ /* * vim: ft=plasma * This is free and unencumbered software released into the public domain. * See ../LICENSE.unlicense */ module ResourceInvalid3 export func main() uses IO -> Int { // These should all fail for different reasons, but right now the // implementation doesn't attempt to detect them. // It's an error to use the same resource twice in the same statement. print!(use_io_and_return_string!()) // It's also an error to use a parent and child resource in the same // statement. print!(int_to_string(test_uses_time!())) // Or to use and observe related resources. print!(int_to_string(observe_io!())) // or any ancestor and child (using/using). print!(int_to_string(test_uses_time!())) // or any ancestor and child (using/observing). print!(int_to_string(test_gettimeofday!())) // Like above but the other way around. _ = use_env!() + observe_io!() if (3 == 3) { // Any test within a compound statement. var x = use_env!() + observe_io!() } else {} return 0 } func use_io_and_return_string() uses IO -> String { return "Hello world\n" } func test_uses_time() uses Time -> Int { return test_gettimeofday!() } func test_gettimeofday() observes Time -> Int { var ok, var s, _ = Builtin.gettimeofday!() if (ok) { return s } else { return 0 } } func observe_io() observes IO -> Int { return 4 } func use_env() uses Environment -> Int { return 12 } ================================================ FILE: tests/language/return.build ================================================ # This is free and unencumbered software released into the public domain. # See ../LICENSE.unlicense # PLZTEST type compile_failure [return] type = program modules = [Return] ================================================ FILE: tests/language/return.exp ================================================ return.p:12: Function returns 1 results but this path has no return statement return.p:16: Function returns 1 results but this path has no return statement ================================================ FILE: tests/language/return.p ================================================ /* * vim: ft=plasma * This is free and unencumbered software released into the public domain. * See ../LICENSE.unlicense */ module Return func foo() uses IO -> Int { // The arity of the expression matches, but there's no explicit return // statement. This was silently accepted as correct. return1() } // The same but when there's no statements at all. func bar() -> Int { } func return1() -> Int { return 3 } ================================================ FILE: tests/language/string.exp ================================================ This is a string Append: abcdef The End. A codepoint: . A codepoint: A codepoint: q ================================================ FILE: tests/language/string.p ================================================ /* * vim: ft=plasma * This is free and unencumbered software released into the public domain. * See ../LICENSE.unlicense */ module String entrypoint func example() uses IO -> Int { // We can print strings print!("This is a string\n") // Assign them to variables var s1 = "abc" var s2 = "def" // append them print!("Append: " ++ s1 ++ s2 ++ "\n") // A single character in quotes can be a string var dot = "." var nl = "\n" print!("The End" ++ dot ++ nl) // Or a codepoint (aka character) print!("A codepoint: " ++ codepoint_to_string(".") ++ nl) print!("A codepoint: " ++ codepoint_to_string("\n") ++ nl) print!("A codepoint: " ++ codepoint_to_string( Builtin.int_to_codepoint(113)) ++ nl) return 0 } ================================================ FILE: tests/language/types/BUILD.plz ================================================ # This is free and unencumbered software released into the public domain. # See ../LICENSE.unlicense [constructor_overload] type = program modules = [ConstructorOverload] [enum] type = program modules = [Enum] [parametric] type = program modules = [Parametric] [playing_card] type = program modules = [PlayingCard] [polymorphic] type = program modules = [Polymorphic] [recursive] type = program modules = [Recursive] [tagging1] type = program modules = [Tagging1] [tagging2] type = program modules = [Tagging2] ================================================ FILE: tests/language/types/bug_375.build ================================================ # This is free and unencumbered software released into the public domain. # See ../LICENSE.unlicense # PLZTEST type compile_failure [bug_375] type = program modules = [Bug375] ================================================ FILE: tests/language/types/bug_375.exp ================================================ bug_375.p:22: "func(C()) -> Builtin.Bool()" and "func(SP()) -> Builtin.Bool()" are not the same, because "C()" and "SP()" are not the same bug_375.p:36: "func(C()) -> Builtin.Bool()" and "func(SP()) -> Builtin.Bool()" are not the same, because "C()" and "SP()" are not the same ================================================ FILE: tests/language/types/bug_375.p ================================================ /* * vim: ft=plasma * This is free and unencumbered software released into the public domain. * See ../LICENSE.unlicense */ module Bug375 type C = C type SP = SP func sp_is_a(sp : SP) -> Bool { return False } // A mistaken type here. func sp_to_c(sp : SP) -> SP { return SP } // Fixed func sp_to_c_good(sp : SP) -> C { return C } func find_last(test : func(C) -> Bool, string : String) { func loop(pos : SP) -> SP { if sp_is_a(pos) { return pos // Is not detected as an error here. } else if test(sp_to_c(pos)) { return pos } else { return pos } } } func find_last2(test : func(C) -> Bool, string : String) { func loop(pos : SP) -> SP { // This version does catch the error. if test(sp_to_c(pos)) { return pos } else { return pos } } } func find_last3(test : func(C) -> Bool, string : String) { func loop(pos : SP) -> SP { // This version has no error. if test(sp_to_c_good(pos)) { return pos } else { return pos } } } ================================================ FILE: tests/language/types/closure_infer_1.build ================================================ # This is free and unencumbered software released into the public domain. # See ../LICENSE.unlicense # PLZTEST todo type inference # PLZTEST type compile_failure [closure_infer_1] type = program modules = [ClosureInfer1] ================================================ FILE: tests/language/types/closure_infer_1.exp ================================================ closure_infer_1.p:22: Ambigious types The unbound solver variables are: 'Sv_greet_1 = func(string, _) 'Sv_opening_4 = _ The unresolved solver clauses are: 'Sv_greet_1 = func('Sv_name_6, 'Sv_opening_4) ================================================ FILE: tests/language/types/closure_infer_1.p ================================================ /* * vim: ft=plasma * This is free and unencumbered software released into the public domain. * See ../LICENSE.unlicense */ module ClosureInfer1 export func main() uses IO -> Int { var salutation = "G'day" func greet(name : String, opening : String) uses IO { print!(salutation ++ " " ++ name ++ " " ++ opening ++ "\n") } var opening = "How's it goin?" // Because closures are typechecked before their containing functions, // not enough type information is passed into this closure from the // outside and it has an ambigious type. func greet2(name : String) uses IO { greet!(name, opening) } greet2!("Paul") greet2!("James") return 0 } ================================================ FILE: tests/language/types/closure_infer_2.build ================================================ # This is free and unencumbered software released into the public domain. # See ../LICENSE.unlicense # PLZTEST todo type inference # PLZTEST type compile_failure [closure_infer_2] type = program modules = [ClosureInfer2] ================================================ FILE: tests/language/types/closure_infer_2.exp ================================================ closure_infer_2.p:21: "func(func(int) -> int, Builtin.Maybe(_)) -> Builtin.Maybe(string)" and "func(func(int) -> string, Builtin.Maybe(string)) -> Builtin.Maybe(string)" are not the same, because "func(int) -> int" and "func(int) -> string" are not the same, because "int" and "string" are not the same closure_infer_2.p:33: "func(_, Builtin.Maybe(int)) -> Builtin.Maybe(string)" and "func(func(int) -> int, Builtin.Maybe(int)) -> Builtin.Maybe( int)" are not the same, because "Builtin.Maybe(string)" and "Builtin.Maybe(int)" are not the same, because "string" and "int" are not the same ================================================ FILE: tests/language/types/closure_infer_2.p ================================================ /* * vim: ft=plasma * This is free and unencumbered software released into the public domain. * See ../LICENSE.unlicense */ module ClosureInfer2 /* * The type checker seems to be giving an over-specific type to some of the * higher order code here that later causes a type conflict. */ func test1() uses IO -> String { func map(f : func('a) -> 'b, m : Maybe('a)) -> Maybe('b) { return match(m) { None -> None Some(var x) -> Some(f(x)) } } return maybe_str(map(int_to_string, map(plus1, None))) } // There's a different error when you pass a Some(3) in func test2() uses IO -> String { func map(f : func('a) -> 'b, m : Maybe('a)) -> Maybe('b) { return match(m) { None -> None Some(var x) -> Some(f(x)) } } return maybe_str(map(int_to_string, map(plus1, Some(3)))) } func plus1(x : Int) -> Int { return x + 1 } func maybe_str(m : Maybe(String)) -> String { return match(m) { None -> "None" Some(var x) -> "Some(" ++ x ++ ")" } } ================================================ FILE: tests/language/types/constructor_duplicate.build ================================================ # This is free and unencumbered software released into the public domain. # See ../LICENSE.unlicense # PLZTEST type compile_failure [constructor_duplicate] type = program modules = [ConstructorDuplicate] ================================================ FILE: tests/language/types/constructor_duplicate.exp ================================================ constructor_duplicate.p:10: This type already has a constructor named 'ConstructorDuplicate.Diamonds' ================================================ FILE: tests/language/types/constructor_duplicate.p ================================================ /* * vim: ft=plasma * This is free and unencumbered software released into the public domain. * See ../LICENSE.unlicense */ module ConstructorDuplicate // Simple enum, but it is invalid because a constructor is duplicated. type Suit = Hearts | Diamonds | Diamonds | Clubs func main() uses IO -> Int { print!("Queen of " ++ suit_str(Hearts) ++ "\n") print!("Ace of " ++ suit_str(Clubs) ++ "\n") return 0 } func suit_str(s : Suit) -> String { match (s) { Hearts -> { return "Hearts" } Diamonds -> { return "Diamonds" } Clubs -> { return "Clubs" } } } ================================================ FILE: tests/language/types/constructor_overload.exp ================================================ Queen of Hearts Ace of Spades ================================================ FILE: tests/language/types/constructor_overload.p ================================================ /* * vim: ft=plasma * This is free and unencumbered software released into the public domain. * See ../LICENSE.unlicense */ module ConstructorOverload // Simple enum type Suit = Hearts | Diamonds | Spades | Clubs type RedSuit = Hearts | Diamonds entrypoint func main() uses IO -> Int { print!("Queen of " ++ suit_str(Hearts) ++ "\n") print!("Ace of " ++ suit_str(Spades) ++ "\n") return 0 } func suit_str(s : Suit) -> String { match (s) { Hearts -> { return "Hearts" } Diamonds -> { return "Diamonds" } Spades -> { return "Spades" } Clubs -> { return "Clubs" } } } ================================================ FILE: tests/language/types/enum.exp ================================================ Queen of Hearts Ace of Spades ================================================ FILE: tests/language/types/enum.p ================================================ /* * vim: ft=plasma * This is free and unencumbered software released into the public domain. * See ../LICENSE.unlicense */ module Enum // Simple enum type Suit = Hearts | Diamonds | Spades | Clubs entrypoint func main() uses IO -> Int { print!("Queen of " ++ suit_str(Hearts) ++ "\n") print!("Ace of " ++ suit_str(Spades) ++ "\n") return 0 } func suit_str(s : Suit) -> String { match (s) { Hearts -> { return "Hearts" } Diamonds -> { return "Diamonds" } Spades -> { return "Spades" } Clubs -> { return "Clubs" } } } ================================================ FILE: tests/language/types/ho_bad_1.build ================================================ # This is free and unencumbered software released into the public domain. # See ../LICENSE.unlicense # PLZTEST type compile_failure [ho_bad_1] type = program modules = [HO_Bad_1] ================================================ FILE: tests/language/types/ho_bad_1.exp ================================================ ho_bad_1.p:14: "func(int) -> string" and "func(string) -> string" are not the same, because "int" and "string" are not the same ================================================ FILE: tests/language/types/ho_bad_1.p ================================================ /* * vim: ft=plasma * This is free and unencumbered software released into the public domain. * See ../LICENSE.unlicense */ module HO_Bad_1 func main() uses IO -> Int { // Only one of these will be raised until compiler error handling is // improved. // Type mismatched ho call passed in print!(apply(hello_msg, 3)) // Return type mismatch: print!(int_to_string(apply(hello_msg, "ho"))) // TODO different function types in homogenous array. return 0 } func hello_msg(name : String) -> String { return "Hello " ++ name ++ "\n" } func apply(f : func('a) -> ('b), arg : 'a) -> 'b { return f(arg) } ================================================ FILE: tests/language/types/ho_bad_2.build ================================================ # This is free and unencumbered software released into the public domain. # See ../LICENSE.unlicense # PLZTEST type compile_failure [ho_bad_2] type = program modules = [HO_Bad_2] ================================================ FILE: tests/language/types/ho_bad_2.exp ================================================ ho_bad_2.p:19: "func('a) -> 'a" and "func('a) -> 'b" are not the same, because "'a" and "'b" are not the same ================================================ FILE: tests/language/types/ho_bad_2.p ================================================ /* * vim: ft=plasma * This is free and unencumbered software released into the public domain. * See ../LICENSE.unlicense */ module HO_Bad_2 func main() uses IO -> Int { print!(apply(hello_msg, "Paul")) return 0 } func hello_msg(name : String) -> String { return "Hello " ++ name ++ "\n" } func apply(f : func('a) -> ('b), arg : 'a) -> 'a { // Return type of f doesn't match apply's return type. return f(arg) } ================================================ FILE: tests/language/types/ho_bad_3.build ================================================ # This is free and unencumbered software released into the public domain. # See ../LICENSE.unlicense # PLZTEST type compile_failure [ho_bad_3] type = program modules = [HO_Bad_3] ================================================ FILE: tests/language/types/ho_bad_3.exp ================================================ ho_bad_3.p:12: "func(string) -> string" and "func(int, string) -> string" are not the same ================================================ FILE: tests/language/types/ho_bad_3.p ================================================ /* * vim: ft=plasma * This is free and unencumbered software released into the public domain. * See ../LICENSE.unlicense */ module HO_Bad_3 func main() uses IO -> Int { // hello_msg takes one argument but apply expects its first argument to // take two. print!(apply(hello_msg, "Paul")) return 0 } func hello_msg(name : String) -> String { return "Hello " ++ name ++ "\n" } func apply(f : func(Int, 'a) -> ('b), arg : 'a) -> 'b { return f(3, arg) } ================================================ FILE: tests/language/types/ho_bad_4.build ================================================ # This is free and unencumbered software released into the public domain. # See ../LICENSE.unlicense # PLZTEST type compile_failure [ho_bad_4] type = program modules = [HO_Bad_4] ================================================ FILE: tests/language/types/ho_bad_4.exp ================================================ ho_bad_4.p:11: "func(string) -> (string, int)" and "func(string) -> string" are not the same ================================================ FILE: tests/language/types/ho_bad_4.p ================================================ /* * vim: ft=plasma * This is free and unencumbered software released into the public domain. * See ../LICENSE.unlicense */ module HO_Bad_4 func main() uses IO -> Int { // hello_msg returns one argument but apply expects it to return two. print!(apply(hello_msg, "Paul")) return 0 } func hello_msg(name : String) -> String { return "Hello " ++ name ++ "\n" } func apply(f : func('a) -> ('b, Int), arg : 'a) -> 'b { var b, _ = f(arg) return b } ================================================ FILE: tests/language/types/ho_bad_5.build ================================================ # This is free and unencumbered software released into the public domain. # See ../LICENSE.unlicense # PLZTEST type compile_failure [ho_bad_5] type = program modules = [HO_Bad_5] ================================================ FILE: tests/language/types/ho_bad_5.exp ================================================ ho_bad_5.p:21: "func(_) -> _" and "func(_) -> (_, _)" are not the same ================================================ FILE: tests/language/types/ho_bad_5.p ================================================ /* * vim: ft=plasma * This is free and unencumbered software released into the public domain. * See ../LICENSE.unlicense */ module HO_Bad_5 func main() uses IO -> Int { print!(apply(hello_msg, "Paul")) return 0 } func hello_msg(name : String) -> String { return "Hello " ++ name ++ "\n" } func apply(f : func('a) -> ('b), arg : 'a) -> 'b { // Expect f to return two values when it returns only one. var b, _ = f(arg) return b } ================================================ FILE: tests/language/types/ho_bad_6.build ================================================ # This is free and unencumbered software released into the public domain. # See ../LICENSE.unlicense # PLZTEST type compile_failure [ho_bad_6] type = program modules = [HO_Bad_6] ================================================ FILE: tests/language/types/ho_bad_6.exp ================================================ ho_bad_6.p:21: "func(_) -> _" and "func(_, int) -> _" are not the same ================================================ FILE: tests/language/types/ho_bad_6.p ================================================ /* * vim: ft=plasma * This is free and unencumbered software released into the public domain. * See ../LICENSE.unlicense */ module HO_Bad_6 func main() uses IO -> Int { print!(apply(hello_msg, "Paul")) return 0 } func hello_msg(name : String) -> String { return "Hello " ++ name ++ "\n" } func apply(f : func('a) -> ('b), arg : 'a) -> 'b { // Expect f to take two paramers when it takes only 1. var b = f(arg, 5) return b } ================================================ FILE: tests/language/types/occurs1.build ================================================ # This is free and unencumbered software released into the public domain. # See ../LICENSE.unlicense # PLZTEST type compile_failure [occurs1] type = program modules = [Occurs1] ================================================ FILE: tests/language/types/occurs1.exp ================================================ occurs1.p:11: "int" and "Occurs(int)" are not the same ================================================ FILE: tests/language/types/occurs1.p ================================================ /* * vim: ft=plasma * This is free and unencumbered software released into the public domain. * See ../LICENSE.unlicense */ module Occurs1 type Occurs('x) = Occurs ( v : 'x ) func occurs1(a : Occurs('o), b : 'o) -> Bool { return a == b } ================================================ FILE: tests/language/types/occurs2.build ================================================ # This is free and unencumbered software released into the public domain. # See ../LICENSE.unlicense # PLZTEST type compile_failure [occurs2] type = program modules = [Occurs2] ================================================ FILE: tests/language/types/occurs2.exp ================================================ occurs2.p:11: Type error: The type "'Sv_a_0" cannot be bound to "Occurs('Sv_a_0)" because it can't contain itself. ================================================ FILE: tests/language/types/occurs2.p ================================================ /* * vim: ft=plasma * This is free and unencumbered software released into the public domain. * See ../LICENSE.unlicense */ module Occurs2 type Occurs('x) = Occurs ( v : 'x ) func occurs2(a : Occurs('o)) -> 'o { return a } ================================================ FILE: tests/language/types/occurs3.build ================================================ # This is free and unencumbered software released into the public domain. # See ../LICENSE.unlicense # PLZTEST type compile_failure [occurs3] type = program modules = [Occurs3] ================================================ FILE: tests/language/types/occurs3.exp ================================================ occurs3.p:11: Type error: The type "'Sv_a_0" cannot be bound to "Occurs('Sv_a_0)" because it can't contain itself. ================================================ FILE: tests/language/types/occurs3.p ================================================ /* * vim: ft=plasma * This is free and unencumbered software released into the public domain. * See ../LICENSE.unlicense */ module Occurs3 type Occurs('x) = Occurs ( v : 'x ) func occurs3(a : Occurs('o), b : 'o, c : Bool) uses IO { var r if (c) { r = a } else { r = b } sink!(r) } func sink(o : Occurs('o)) uses IO { } ================================================ FILE: tests/language/types/occurs4.build ================================================ # This is free and unencumbered software released into the public domain. # See ../LICENSE.unlicense # PLZTEST type compile_failure [occurs4] type = program modules = [Occurs4] ================================================ FILE: tests/language/types/occurs4.exp ================================================ occurs4.p:15: Type error: The type "'Sv_o1_0" cannot be bound to "Occurs('Sv_o1_0)" because it can't contain itself. ================================================ FILE: tests/language/types/occurs4.p ================================================ /* * vim: ft=plasma * This is free and unencumbered software released into the public domain. * See ../LICENSE.unlicense */ module Occurs4 type Occurs('x) = Occurs ( v : 'x ) | Nil func occurs4() uses IO{ var o1 = faucet() match (o1) { Occurs(var o2) -> { if (eq(o1, o2)) { print!("True") } else { print!("False") } } Nil -> { Builtin.die!("Die!") } } } func eq(x : 'a, y : 'a) -> Bool { return True } func faucet() -> Occurs('o) { return Nil } /* * We should also test the occurs check on function types, but the test can't * be described in Plasma yet without more functional features. */ ================================================ FILE: tests/language/types/occurs5.build ================================================ # This is free and unencumbered software released into the public domain. # See ../LICENSE.unlicense # PLZTEST type compile_failure [occurs5] type = program modules = [Occurs5] ================================================ FILE: tests/language/types/occurs5.exp ================================================ occurs5.p:13: "Occurs1(_)" and "'o" are not the same ================================================ FILE: tests/language/types/occurs5.p ================================================ /* * vim: ft=plasma * This is free and unencumbered software released into the public domain. * See ../LICENSE.unlicense */ module Occurs5 type Occurs1('x) = Occurs1 ( v : 'x ) type Occurs2('x) = Occurs2 ( v : 'x ) type Occurs3('x) = Occurs3 ( v : 'x ) func occurs5(a : Occurs1(Occurs2(Occurs3('o))), b : 'o, c : Bool) uses IO { var r // This doesn't seem to be failing due to the occurs check, but it does // cause a type error so at least the compiler won't accept this invalid // program. if (c) { r = a } else { r = b } sink!(r) } func sink(a : 'a) uses IO { } ================================================ FILE: tests/language/types/parametric.exp ================================================ 4 3 ================================================ FILE: tests/language/types/parametric.p ================================================ /* * vim: ft=plasma * This is free and unencumbered software released into the public domain. * See ../LICENSE.unlicense */ module Parametric entrypoint func main() uses IO -> Int { var list1 = MyCons(1, MyCons(2, MyCons(3, MyCons(4, MyNil)))) print!(int_to_string(list_length(list1)) ++ "\n") var list2 = MyCons("A", MyCons("B", MyCons("C", MyNil))) print!(int_to_string(list_length(list2)) ++ "\n") // Oh, if we use strings of length one the typechecker can't decide if // these are strings of charaters. It doesn't matter for our program. // So by doing this we give the typechecker enough information to // resolve it. _ = MyCons("a string", list2) return 0 } // Demonstrate a parametric type. type MyList('a) = MyNil | MyCons ( head : 'a, tail : MyList('a) ) func list_length(l : MyList('t)) -> Int { match (l) { MyNil -> { return 0 } MyCons(_, var rest) -> { return 1 + list_length(rest) } } } // Attempt to confuse type inference: // This type has constructor symbols with the same names as above. type OtherList('a) = MyCons ( ohead : 'a, otail : OtherList('a) ) | ONil // Again with different type variable nmaes, type OtherList2('b) = MyCons ( o2head : 'b, o2tail : OtherList('b) ) | ONil ================================================ FILE: tests/language/types/playing_card.exp ================================================ Queen of Hearts Ace of Spades 3 of Clubs INVALID of Diamonds ================================================ FILE: tests/language/types/playing_card.p ================================================ /* * vim: ft=plasma * This is free and unencumbered software released into the public domain. * See ../LICENSE.unlicense */ module PlayingCard // Simple enum type Suit = Hearts | Diamonds | Spades | Clubs type Card = Card( c_suit : Suit, c_face : Int ) entrypoint func main() uses IO -> Int { print!(card_str(Card(Hearts, 12)) ++ "\n") print!(card_str(Card(Spades, 1)) ++ "\n") print!(card_str(Card(Clubs, 3)) ++ "\n") print!(card_str(Card(Diamonds, 0)) ++ "\n") return 0 } func card_str(c : Card) -> String { match (c) { Card(var s, var f) -> { return face_str(f) ++ " of " ++ suit_str(s) } } } func suit_str(s : Suit) -> String { match (s) { Hearts -> { return "Hearts" } Diamonds -> { return "Diamonds" } Spades -> { return "Spades" } Clubs -> { return "Clubs" } } } func face_str(f : Int) -> String { match (f) { 1 -> { return "Ace" } 11 -> { return "Jack" } 12 -> { return "Queen" } 13 -> { return "King" } _ -> { if (f < 2) or (f > 10) { return "INVALID" } else { return int_to_string(f) } } } } ================================================ FILE: tests/language/types/polymorphic.exp ================================================ 1, 2 1, 2 3, 4 3 ================================================ FILE: tests/language/types/polymorphic.p ================================================ /* * vim: ft=plasma * This is free and unencumbered software released into the public domain. * See ../LICENSE.unlicense */ module Polymorphic // Type parameters. entrypoint func main() uses IO -> Int { // Type checking must accept this, a, and a are the same. print_list!(int_to_string, foo([1, 2], [3, 4])) // Even if the full type of the second a is unknown, there's enough to // constrain it. print_list!(int_to_string, foo([1, 2], [])) // They're also allowed to be the same if bar accepts a and b. print_list!(int_to_string, bar([1, 2], [3, 4])) // This also works when the type parameter is buried deep within a type // expression in the callee's declaration. print!(int_to_string(baz(Troz(Zort(return3)))) ++ "\n") return 0 } // Some of the same except from a polymorphic context func test2(a1 : 'a, c : 'c, a2 : 'a, la1 : List('a), la2 : List('a)) uses IO { // Type checking must accept this, a, and a are the same. _ = foo(a1, a1) _ = foo(a1, a2) _ = foo(la1, la2) // They're also allowed to be the same if bar accepts a and b. _ = bar(a1, a1) _ = bar(a1, a2) _ = bar(la1, la2) } func foo(a1 : 'a, a2 : 'a) -> 'a { return a1 } func bar(a : 'a, b : 'b) -> 'b { return b } func return3() -> Int { return 3 } type Troz('x) = Troz(x : 'x) type Zort('x) = Zort(x : 'x) func baz(t : Troz(Zort(func() -> 'q))) -> 'q { match (t) { Troz(var z) -> { match (z) { Zort(var f) -> { return f() } } } } } /*-----*/ func print_list(f : func('a) -> String, l0 : List('a)) uses IO { print!(join(", ", (map(f, l0))) ++ "\n") } func map(f : func('a) -> 'b, l : List('a)) -> List('b) { match (l) { [] -> { return [] } [var x | var xs] -> { return [f(x) | map(f, xs)] } } } func join(j : String, l : List(String)) -> String { match (l) { [] -> { return "" } [var x | var xs] -> { match (xs) { [] -> { return x } [_ | _] -> { return x ++ j ++ join(j, xs) } } } } } ================================================ FILE: tests/language/types/recursive.exp ================================================ 1, 2, 3 9 ================================================ FILE: tests/language/types/recursive.p ================================================ /* * vim: ft=plasma * This is free and unencumbered software released into the public domain. * See ../LICENSE.unlicense */ module Recursive entrypoint func main() uses IO -> Int { print!(list_str(MyCons(1, MyCons(2, MyCons(3, MyNil)))) ++ "\n") print!(a_str(TermAB(TermBA(TermA(2), 2), 5)) ++ "\n") return 0 } // Demonstrate a recursive type type MyList = MyNil | MyCons ( head : Int, tail : MyList ) func list_str(c : MyList) -> String { match (c) { MyNil -> { return "" } MyCons(var n, var l) -> { return int_to_string(n) ++ list_str2(l) } } } func list_str2(c : MyList) -> String { match (c) { MyNil -> { return "" } MyCons(var n, var l) -> { return ", " ++ int_to_string(n) ++ list_str2(l) } } } // And mutually recursive types (and functions). type TermA = TermA (ai : Int) | TermAB (ab : TermB, abi : Int) type TermB = TermBA (ba : TermA, bai : Int) func a_str(a : TermA) -> String { return int_to_string(a_int(a)) } func a_int(a : TermA) -> Int { match (a) { TermA(var n) -> { return n } TermAB(var b, var n) -> { return b_int(b) + n } } } func b_int(b : TermB) -> Int { match(b) { TermBA(var a, var n) -> { return a_int(a) * n } } } ================================================ FILE: tests/language/types/tagging1.exp ================================================ Diamonds A 3 A B C 4 dee ================================================ FILE: tests/language/types/tagging1.p ================================================ /* * vim: ft=plasma * This is free and unencumbered software released into the public domain. * See ../LICENSE.unlicense */ module Tagging1 // Simple enum type Suit = Hearts | Diamonds | Spades | Clubs type Type2 = A | B (bf : Int ) type Type3 = A | B | C (cf : Int) | D (df : String) entrypoint func main() uses IO -> Int { print!(suit_str(Diamonds) ++ "\n") print!(type2_str(A) ++ "\n") print!(type2_str(B(3)) ++ "\n") print!(type3_str(A) ++ "\n") print!(type3_str(B) ++ "\n") print!(type3_str(C(4)) ++ "\n") print!(type3_str(D("dee")) ++ "\n") return 0 } func suit_str(s : Suit) -> String { match (s) { Hearts -> { return "Hearts" } Diamonds -> { return "Diamonds" } Spades -> { return "Spades" } Clubs -> { return "Clubs" } } } func type2_str(x : Type2) -> String { match (x) { A -> { return "A" } B(var v) -> { return int_to_string(v) } } } func type3_str(x : Type3) -> String { match (x) { A -> { return "A" } B -> { return "B" } C(var n) -> { return "C " ++ int_to_string(n) } D(var s) -> { return s } } } ================================================ FILE: tests/language/types/tagging2.exp ================================================ A B C 4 D dee E 53 F fFfFf ================================================ FILE: tests/language/types/tagging2.p ================================================ /* * vim: ft=plasma * This is free and unencumbered software released into the public domain. * See ../LICENSE.unlicense */ module Tagging2 // Simple enum type Type = A // ptag 0, value 0 | B // ptag 0, value 1 | C (cf : Int) // ptag 1 | D (df : String) // ptag 2 | E (ef : Int) // ptag 3, stag 0 | F (ff : String) // ptag 3, stag 1 entrypoint func main() uses IO -> Int { print!(type_str(A) ++ "\n") print!(type_str(B) ++ "\n") print!(type_str(C(4)) ++ "\n") print!(type_str(D("dee")) ++ "\n") print!(type_str(E(53)) ++ "\n") print!(type_str(F("fFfFf")) ++ "\n") return 0 } func type_str(x : Type) -> String { match (x) { A -> { return "A" } B -> { return "B" } C(var n) -> { return "C " ++ int_to_string(n) } D(var s) -> { return "D " ++ s } E(var n) -> { return "E " ++ int_to_string(n) } F(var s) -> { return "F " ++ s } } } ================================================ FILE: tests/language/types/types_invalid_02.build ================================================ # This is free and unencumbered software released into the public domain. # See ../LICENSE.unlicense # PLZTEST type compile_failure [types_invalid_02] type = program modules = [TypesInvalid_02] ================================================ FILE: tests/language/types/types_invalid_02.exp ================================================ types_invalid_02.p:14: Wrong number of type args for 'MyList', expected: 1, got: 0 types_invalid_02.p:16: Wrong number of type args for 'MyList', expected: 1, got: 2 ================================================ FILE: tests/language/types/types_invalid_02.p ================================================ /* * vim: ft=plasma * This is free and unencumbered software released into the public domain. * See ../LICENSE.unlicense */ module TypesInvalid_02 func main() uses IO -> Int { return 0 } // List is not a concrete type. type MyList('a) = MyNil | MyCons ( head : 'a, tail : MyList ) func list_length(l : MyList('t, 'w)) -> Int { match (l) { MyNil -> { return 0 } MyCons(_, var rest) -> { return 1 + list_length(rest) } } } ================================================ FILE: tests/language/types/types_invalid_03.build ================================================ # This is free and unencumbered software released into the public domain. # See ../LICENSE.unlicense # PLZTEST type compile_failure [types_invalid_03] type = program modules = [TypesInvalid_03] ================================================ FILE: tests/language/types/types_invalid_03.exp ================================================ types_invalid_03.p:14: Type variable 'b' does not appear on left of '=' in type definition ================================================ FILE: tests/language/types/types_invalid_03.p ================================================ /* * vim: ft=plasma * This is free and unencumbered software released into the public domain. * See ../LICENSE.unlicense */ module TypesInvalid_03 func main() uses IO -> Int { return 0 } // Type variable 'b is not on the LHS. type MyList('a) = MyNil | MyCons ( head : 'a, tail : MyList('b) ) ================================================ FILE: tests/language/types/types_invalid_04.build ================================================ # This is free and unencumbered software released into the public domain. # See ../LICENSE.unlicense # PLZTEST type compile_failure [types_invalid_04] type = program modules = [TypesInvalid_04] ================================================ FILE: tests/language/types/types_invalid_04.exp ================================================ types_invalid_04.p:13: "MyList(string)" and "MyList(int)" are not the same, because "string" and "int" are not the same ================================================ FILE: tests/language/types/types_invalid_04.p ================================================ /* * vim: ft=plasma * This is free and unencumbered software released into the public domain. * See ../LICENSE.unlicense */ module TypesInvalid_04 func main() uses IO -> Int { var list1 = MyCons(1, MyCons(2, MyCons(3, MyCons(4, MyNil)))) var list2 = MyCons("Aa", MyCons("Bb", MyCons("Cc", MyNil))) print!(int_to_string(list_length(append(list1, list2))) ++ "\n") return 0 } // Demonstrate an abstract type. type MyList('a) = MyNil | MyCons ( head : 'a, tail : MyList('a) ) func list_length(l : MyList('t)) -> Int { match (l) { MyNil -> { return 0 } MyCons(_, var rest) -> { return 1 + list_length(rest) } } } func append(l1 : MyList('a), l2 : MyList('a)) -> MyList('a) { match (l1) { MyNil -> { return l2 } MyCons(var head, var tail) -> { return MyCons(head, append(tail, l2)) } } } ================================================ FILE: tests/language/types/types_invalid_05.build ================================================ # This is free and unencumbered software released into the public domain. # See ../LICENSE.unlicense # PLZTEST type compile_failure [types_invalid_05] type = program modules = [TypesInvalid_05] ================================================ FILE: tests/language/types/types_invalid_05.exp ================================================ types_invalid_05.p:29: "MyList('a)" and "MyList('b)" are not the same, because "'a" and "'b" are not the same ================================================ FILE: tests/language/types/types_invalid_05.p ================================================ /* * vim: ft=plasma * This is free and unencumbered software released into the public domain. * See ../LICENSE.unlicense */ module TypesInvalid_05 func main() uses IO -> Int { var list1 = MyCons(1, MyCons(2, MyCons(3, MyCons(4, MyNil)))) var list2 = MyCons("Aa", MyCons("B", MyCons("C", MyNil))) print!(int_to_string(list_length(append(list1, list2))) ++ "\n") return 0 } // Demonstrate an abstract type. type MyList('a) = MyNil | MyCons ( head : 'a, tail : MyList('a) ) func list_length(l : MyList('t)) -> Int { match (l) { MyNil -> { return 0 } MyCons(_, var rest) -> { return 1 + list_length(rest) } } } // Type error here, because a != b. func append(l1 : MyList('a), l2 : MyList('b)) -> MyList('a) { match (l1) { MyNil -> { return l2 } MyCons(var head, var tail) -> { return MyCons(head, append(tail, l2)) } } } ================================================ FILE: tests/language/types/types_invalid_06.build ================================================ # This is free and unencumbered software released into the public domain. # See ../LICENSE.unlicense # PLZTEST type compile_failure [types_invalid_06] type = program modules = [TypesInvalid_06] ================================================ FILE: tests/language/types/types_invalid_06.exp ================================================ types_invalid_06.p:15: Ambigious types The unbound solver variables are: 'Sv_v_19 = MyList(_) 'Anon_21 = _ # ? no 1 'Anon_22 = _ # ? no 1 The unresolved solver clauses are: % ../types_invalid_06.p:15 'Sv_v_19 = MyList('Anon_22) % ../types_invalid_06.p:15 'Sv_v_19 = MyList('Anon_21) ================================================ FILE: tests/language/types/types_invalid_06.p ================================================ /* * vim: ft=plasma * This is free and unencumbered software released into the public domain. * See ../LICENSE.unlicense */ module TypesInvalid_06 func main() uses IO -> Int { var list1 = MyCons(1, MyCons(2, MyCons(3, MyCons(4, MyNil)))) var list2 = MyCons("A", MyCons("B", MyCons("Cc", MyNil))) // Type error here because the return type of append isn't constrained // enough. The typechecker should fail to find a unique solution. print!(int_to_string(list_length(append(list1, list2))) ++ "\n") return 0 } // Demonstrate an abstract type. type MyList('a) = MyNil | MyCons ( head : 'a, tail : MyList('a) ) func list_length(l : MyList('t)) -> Int { match (l) { MyNil -> { return 0 } MyCons(_, var rest) -> { return 1 + list_length(rest) } } } func append(l1 : MyList('a), l2 : MyList('b)) -> MyList('c) { return MyNil } ================================================ FILE: tests/language/types/types_invalid_07.build ================================================ # This is free and unencumbered software released into the public domain. # See ../LICENSE.unlicense # PLZTEST type compile_failure [types_invalid_07] type = program modules = [TypesInvalid_07] ================================================ FILE: tests/language/types/types_invalid_07.exp ================================================ types_invalid_07.p:10: Unknown type: INt ================================================ FILE: tests/language/types/types_invalid_07.p ================================================ /* * vim: ft=plasma * This is free and unencumbered software released into the public domain. * See ../LICENSE.unlicense */ module TypesInvalid_07 // Check that we get an okay error message when a type is not known. func main() uses IO -> INt { return 0 } ================================================ FILE: tests/language/types/types_invalid_08.build ================================================ # This is free and unencumbered software released into the public domain. # See ../LICENSE.unlicense # PLZTEST type compile_failure [types_invalid_08] type = program modules = [TypesInvalid_08] ================================================ FILE: tests/language/types/types_invalid_08.exp ================================================ types_invalid_08.p:15: "Zort(func() -> int)" and "Zort(func() -> string)" are not the same, because "func() -> int" and "func() -> string" are not the same, because "int" and "string" are not the same ================================================ FILE: tests/language/types/types_invalid_08.p ================================================ /* * vim: ft=plasma * This is free and unencumbered software released into the public domain. * See ../LICENSE.unlicense */ module TypesInvalid_08 // Test type parameters. func main() uses IO -> Int { // TODO: Improve the typechecker's error handling and add tests that // mirror those in valid/types_8.p print!(baz(Troz(Zort(return3))) ++ "\n") return 0 } func return3() -> Int { return 3 } type Troz('x) = Troz(x : 'x) type Zort('x) = Zort(x : 'x) func baz(t : Troz(Zort(func() -> 'q))) -> 'q { match (t) { Troz(var z) -> { match (z) { Zort(var f) -> { return f() } } } } } ================================================ FILE: tests/language/vars/BUILD.plz ================================================ # This is free and unencumbered software released into the public domain. # See ../LICENSE.unlicense [vars_1] type = program modules = [Vars_1] [vars_2] type = program modules = [Vars_2] ================================================ FILE: tests/language/vars/vars_1.exp ================================================ x, y: 5, 1 z: 24 ================================================ FILE: tests/language/vars/vars_1.p ================================================ /* * vim: ft=plasma * This is free and unencumbered software released into the public domain. * See ../LICENSE.unlicense */ module Vars_1 entrypoint func main() uses IO -> Int { // We can assign to _ as many times as we want. _ = foo(1) _, var x = bar(3) _ = foo(2) var y, _ = bar(4) print!("x, y: " ++ int_to_string(x) ++ ", " ++ int_to_string(y) ++ "\n") print!("z: " ++ int_to_string(baz(x, y, x+y)) ++ "\n") return 0 } // Wildcards can appear as function arguments. func foo(_ : Int) -> Int { return 3 } func bar(n : Int) -> (Int, Int) { return n - 3, n+2 } // Wildcards can appear multiple times as function arguments, and also in the // body: func baz(_ : Int, _ : Int, c : Int) -> Int { _ = foo(c) return c*4 } ================================================ FILE: tests/language/vars/vars_2.exp ================================================ Hello test 1 Test 2: a + b is 8 test 3: 3 is less than 4 ================================================ FILE: tests/language/vars/vars_2.p ================================================ /* * vim: ft=plasma * This is free and unencumbered software released into the public domain. * See ../LICENSE.unlicense */ module Vars_2 entrypoint func main() uses IO -> Int { test1!() test2!() test3!(3) return 0 } func test1() uses IO { // You can introduce a variable var msg1 // Then initialise it msg1 = "Hello " // Or introduce and initialise it var msg2 = "test 1" print!(msg1 ++ msg2 ++ "\n") } func test2() uses IO { var a, var b = 3, 5 print!("Test 2: a + b is " ++ int_to_string(a + b) ++ "\n") } func test3(q : Int) uses IO { var x if (q < 4) { x = "less than" } else { x = "greater than or equal to" } print!("test 3: " ++ int_to_string(q) ++ " is " ++ x ++ " 4\n") } ================================================ FILE: tests/language/vars/vars_invalid_01.build ================================================ # This is free and unencumbered software released into the public domain. # See ../LICENSE.unlicense # PLZTEST type compile_failure [vars_invalid_01] type = program modules = [VarsInvalid_01] ================================================ FILE: tests/language/vars/vars_invalid_01.exp ================================================ A compilation error occured and this error is not handled gracefully by the Plasma compiler. Sorry. Message: Unknown symbol: y Context: ../vars_invalid_01.p:12 plzc location: predicate `pre.from_ast.ast_to_pre_expr_2'/7 plzc file: pre.from_ast.m ================================================ FILE: tests/language/vars/vars_invalid_01.p ================================================ /* * vim: ft=plasma * This is free and unencumbered software released into the public domain. * See ../LICENSE.unlicense */ module VarsInvalid_01 export func main() uses IO -> Int { var x = 3 print!(int_to_string(y)) return 0 } ================================================ FILE: tests/language/vars/vars_invalid_02.build ================================================ # This is free and unencumbered software released into the public domain. # See ../LICENSE.unlicense # PLZTEST type compile_failure [vars_invalid_02] type = program modules = [VarsInvalid_02] ================================================ FILE: tests/language/vars/vars_invalid_02.exp ================================================ A compilation error occured and this error is not handled gracefully by the Plasma compiler. Sorry. Message: Two or more parameters have the same name Context: ../vars_invalid_02.p:10 plzc location: predicate `pre.from_ast.ast_to_pre_body'/10 plzc file: pre.from_ast.m ================================================ FILE: tests/language/vars/vars_invalid_02.p ================================================ /* * vim: ft=plasma * This is free and unencumbered software released into the public domain. * See ../LICENSE.unlicense */ module VarsInvalid_02 export func foo(a : Int, a : Int) -> Int { return a + a } ================================================ FILE: tests/language/vars/vars_invalid_03.build ================================================ # This is free and unencumbered software released into the public domain. # See ../LICENSE.unlicense # PLZTEST type compile_failure [vars_invalid_03] type = program modules = [VarsInvalid_03] ================================================ FILE: tests/language/vars/vars_invalid_03.exp ================================================ A compilation error occured and this error is not handled gracefully by the Plasma compiler. Sorry. Message: The variable 'b' is already initialised Context: ../vars_invalid_03.p:11 plzc location: predicate `pre.from_ast.pattern_simple_vars_or_wildcards'/9 plzc file: pre.from_ast.m ================================================ FILE: tests/language/vars/vars_invalid_03.p ================================================ /* * vim: ft=plasma * This is free and unencumbered software released into the public domain. * See ../LICENSE.unlicense */ module VarsInvalid_03 export func foo(a : Int, b : Int) -> Int { b = a * 3 return b } ================================================ FILE: tests/language/vars/vars_invalid_04.build ================================================ # This is free and unencumbered software released into the public domain. # See ../LICENSE.unlicense # PLZTEST type compile_failure [vars_invalid_04] type = program modules = [VarsInvalid_04] ================================================ FILE: tests/language/vars/vars_invalid_04.exp ================================================ A compilation error occured and this error is not handled gracefully by the Plasma compiler. Sorry. Message: The variable 'c' is already declared Context: ../vars_invalid_04.p:12 plzc location: predicate `pre.from_ast.pattern_simple_vars_or_wildcards'/9 plzc file: pre.from_ast.m ================================================ FILE: tests/language/vars/vars_invalid_04.p ================================================ /* * vim: ft=plasma * This is free and unencumbered software released into the public domain. * See ../LICENSE.unlicense */ module VarsInvalid_04 export func foo(a : Int, b : Int) -> Int { var c = a + b var c = a * b return c } ================================================ FILE: tests/language/vars/vars_invalid_05.build ================================================ # This is free and unencumbered software released into the public domain. # See ../LICENSE.unlicense # PLZTEST type compile_failure [vars_invalid_05] type = program modules = [VarsInvalid_05] ================================================ FILE: tests/language/vars/vars_invalid_05.exp ================================================ A compilation error occured and this error is not handled gracefully by the Plasma compiler. Sorry. Message: Variable 'b' already defined Context: ../vars_invalid_05.p:11 plzc location: predicate `pre.from_ast.ast_to_pre_pattern'/8 plzc file: pre.from_ast.m ================================================ FILE: tests/language/vars/vars_invalid_05.p ================================================ /* * vim: ft=plasma * This is free and unencumbered software released into the public domain. * See ../LICENSE.unlicense */ module VarsInvalid_05 export func foo(a : Int, b : Int) -> Int { match (a) { 1 -> { return 1 } var b -> { return b*3 } } } ================================================ FILE: tests/language/vars/vars_invalid_06.build ================================================ # This is free and unencumbered software released into the public domain. # See ../LICENSE.unlicense # PLZTEST type compile_failure [vars_invalid_06] type = program modules = [VarsInvalid_06] ================================================ FILE: tests/language/vars/vars_invalid_06.exp ================================================ vars_invalid_06.p:14: Parse error, read ident expected statement or closing brace ================================================ FILE: tests/language/vars/vars_invalid_06.p ================================================ /* * vim: ft=plasma * This is free and unencumbered software released into the public domain. * See ../LICENSE.unlicense */ module VarsInvalid_06 export func main() uses IO -> Int { _ = foo(1) // It is an error to read from _. print!(int_to_string(_)) return 0 } func foo(n : Int) -> Int { return n + 3 } ================================================ FILE: tests/language/vars/vars_invalid_07.build ================================================ # This is free and unencumbered software released into the public domain. # See ../LICENSE.unlicense # PLZTEST type compile_failure [vars_invalid_07] type = program modules = [VarsInvalid_07] ================================================ FILE: tests/language/vars/vars_invalid_07.exp ================================================ A compilation error occured and this error is not handled gracefully by the Plasma compiler. Sorry. Message: The variable 'c' is already initialised Context: ../vars_invalid_07.p:12 plzc location: predicate `pre.from_ast.pattern_simple_vars_or_wildcards'/9 plzc file: pre.from_ast.m ================================================ FILE: tests/language/vars/vars_invalid_07.p ================================================ /* * vim: ft=plasma * This is free and unencumbered software released into the public domain. * See ../LICENSE.unlicense */ module VarsInvalid_07 export func foo(a : Int, b : Int) -> Int { var c = a + b c = a * b return c } ================================================ FILE: tests/language/vars/vars_invalid_08.build ================================================ # This is free and unencumbered software released into the public domain. # See ../LICENSE.unlicense # PLZTEST type compile_failure [vars_invalid_08] type = program modules = [VarsInvalid_08] ================================================ FILE: tests/language/vars/vars_invalid_08.exp ================================================ A compilation error occured and this error is not handled gracefully by the Plasma compiler. Sorry. Message: Unknown variable or constructor 'c' Context: ../vars_invalid_08.p:11 plzc location: predicate `pre.from_ast.ast_to_pre_pattern'/8 plzc file: pre.from_ast.m ================================================ FILE: tests/language/vars/vars_invalid_08.p ================================================ /* * vim: ft=plasma * This is free and unencumbered software released into the public domain. * See ../LICENSE.unlicense */ module VarsInvalid_08 export func foo(a : Int, b : Int) -> Int { c = a + b return c } ================================================ FILE: tests/language/vars/vars_invalid_09.build ================================================ # This is free and unencumbered software released into the public domain. # See ../LICENSE.unlicense # PLZTEST type compile_failure [vars_invalid_09] type = program modules = [VarsInvalid_09] ================================================ FILE: tests/language/vars/vars_invalid_09.exp ================================================ vars_invalid_09.p:16: This branch did not initialise variables initialised on other branches, they are: y, y2 ================================================ FILE: tests/language/vars/vars_invalid_09.p ================================================ /* * vim: ft=plasma * This is free and unencumbered software released into the public domain. * See ../LICENSE.unlicense */ module VarsInvalid_09 export func main() uses IO -> Int { var x = 3 var y var y2 match (x) { 3 -> { var z = 4 } var yy -> { y = yy * 26 y2 = y * 2 } } print!(int_to_string(y + y2)) return 0 } ================================================ FILE: tests/language/vars/vars_invalid_10.build ================================================ # This is free and unencumbered software released into the public domain. # See ../LICENSE.unlicense # PLZTEST type compile_failure [vars_invalid_10] type = program modules = [VarsInvalid_10] ================================================ FILE: tests/language/vars/vars_invalid_10.exp ================================================ A compilation error occured and this error is not handled gracefully by the Plasma compiler. Sorry. Message: The variable 'y' is already initialised Context: ../vars_invalid_10.p:19 plzc location: predicate `pre.from_ast.pattern_simple_vars_or_wildcards'/9 plzc file: pre.from_ast.m ================================================ FILE: tests/language/vars/vars_invalid_10.p ================================================ /* * vim: ft=plasma * This is free and unencumbered software released into the public domain. * See ../LICENSE.unlicense */ module VarsInvalid_10 export func main() uses IO -> Int { var x = 3 var y if (x == 4) { y = 2 } else { var yy = "f" } y = 3 print!(int_to_string(y)) return 0 } ================================================ FILE: tests/language/vars/vars_invalid_11.build ================================================ # This is free and unencumbered software released into the public domain. # See ../LICENSE.unlicense # PLZTEST type compile_failure [vars_invalid_11] type = program modules = [VarsInvalid_11] ================================================ FILE: tests/language/vars/vars_invalid_11.exp ================================================ A compilation error occured and this error is not handled gracefully by the Plasma compiler. Sorry. Message: Unknown symbol: z Context: ../vars_invalid_11.p:22 plzc location: predicate `pre.from_ast.ast_to_pre_expr_2'/7 plzc file: pre.from_ast.m ================================================ FILE: tests/language/vars/vars_invalid_11.p ================================================ /* * vim: ft=plasma * This is free and unencumbered software released into the public domain. * See ../LICENSE.unlicense */ module VarsInvalid_11 export func main() uses IO -> Int { var x = 3 var y match (x) { 3 -> { var z = 4 } var yy -> { y = yy * 26 } } print!(int_to_string(z)) return 0 } ================================================ FILE: tests/language/vars/vars_invalid_12.build ================================================ # This is free and unencumbered software released into the public domain. # See ../LICENSE.unlicense # PLZTEST type compile_failure [vars_invalid_12] type = program modules = [VarsInvalid_12] ================================================ FILE: tests/language/vars/vars_invalid_12.exp ================================================ A compilation error occured and this error is not handled gracefully by the Plasma compiler. Sorry. Message: Unknown symbol: z Context: ../vars_invalid_12.p:21 plzc location: predicate `pre.from_ast.ast_to_pre_expr_2'/7 plzc file: pre.from_ast.m ================================================ FILE: tests/language/vars/vars_invalid_12.p ================================================ /* * vim: ft=plasma * This is free and unencumbered software released into the public domain. * See ../LICENSE.unlicense */ module VarsInvalid_12 export func main() uses IO -> Int { var x = 3 match (x) { 3 -> { var z = 4 } var yy -> { var z = yy * 26 } } print!(int_to_string(z)) return 0 } ================================================ FILE: tests/language/vars/vars_invalid_13.build ================================================ # This is free and unencumbered software released into the public domain. # See ../LICENSE.unlicense # PLZTEST type compile_failure [vars_invalid_13] type = program modules = [VarsInvalid_13] ================================================ FILE: tests/language/vars/vars_invalid_13.exp ================================================ A compilation error occured and this error is not handled gracefully by the Plasma compiler. Sorry. Message: Variable not initalised: x Context: ../vars_invalid_13.p:12 plzc location: predicate `pre.from_ast.ast_to_pre_expr_2'/7 plzc file: pre.from_ast.m ================================================ FILE: tests/language/vars/vars_invalid_13.p ================================================ /* * vim: ft=plasma * This is free and unencumbered software released into the public domain. * See ../LICENSE.unlicense */ module VarsInvalid_13 export func main() uses IO -> Int { var x print!(int_to_string(x)) return 0 } ================================================ FILE: tests/language/vars/vars_invalid_14.build ================================================ # This is free and unencumbered software released into the public domain. # See ../LICENSE.unlicense # PLZTEST type compile_failure [vars_invalid_14] type = program modules = [VarsInvalid_14] ================================================ FILE: tests/language/vars/vars_invalid_14.exp ================================================ A compilation error occured and this error is not handled gracefully by the Plasma compiler. Sorry. Message: Variable not initalised: x Context: ../vars_invalid_14.p:13 plzc location: predicate `pre.from_ast.ast_to_pre_expr_2'/7 plzc file: pre.from_ast.m ================================================ FILE: tests/language/vars/vars_invalid_14.p ================================================ /* * vim: ft=plasma * This is free and unencumbered software released into the public domain. * See ../LICENSE.unlicense */ module VarsInvalid_14 export func main() uses IO -> Int { var x func foo() uses IO { print!(int_to_string(x)) } return 0 } ================================================ FILE: tests/language/vars/vars_invalid_15.build ================================================ # This is free and unencumbered software released into the public domain. # See ../LICENSE.unlicense # PLZTEST type compile_failure [vars_invalid_15] type = program modules = [VarsInvalid_15] ================================================ FILE: tests/language/vars/vars_invalid_15.exp ================================================ A compilation error occured and this error is not handled gracefully by the Plasma compiler. Sorry. Message: Compilation error, cannot unify types plzc location: predicate `core.type_chk.unify_type_or_var'/5 plzc file: core.type_chk.m ================================================ FILE: tests/language/vars/vars_invalid_15.p ================================================ /* * vim: ft=plasma * This is free and unencumbered software released into the public domain. * See ../LICENSE.unlicense */ module VarsInvalid_15 export func main() uses IO -> Int { var x var y = 2 if (3 > y) { x = "Greater than" } else { x = -1 } return 0 } ================================================ FILE: tests/library/BUILD.plz ================================================ # This is free and unencumbered software released into the public domain. # See ../LICENSE.unlicense [args] type = program modules = [Args] ================================================ FILE: tests/library/args.exp ================================================ Unsupported, cannot execute programs that accept command line arguments. (Bug ================================================ FILE: tests/library/args.p ================================================ /* * vim: ft=plasma * This is free and unencumbered software released into the public domain. * See ../LICENSE.unlicense * * PLZTEST todo runtime doesn't support command line args * PLZTEST output stderr */ module Args entrypoint func main(args : List(String)) uses IO -> Int { foldl!(say_hi, args) return 0 } func say_hi(name : String) uses IO { print!("Hello " ++ name ++ "\n") } func foldl(f : func('t) uses IO, l : List('t)) uses IO { match (l) { [] -> {} [var x | var xs] -> { f!(x) foldl!(f, xs) } } } ================================================ FILE: tests/modules/BUILD.plz ================================================ # This is free and unencumbered software released into the public domain. # See ../LICENSE.unlicense [entrypoint_2] type = program modules = [Entrypoint2a, Entrypoint2b] [entrypoint_3] type = program modules = [Entrypoint3a, Entrypoint3b] [module_04] type = program modules = [Module_04, Module_04a] [module_05] type = program modules = [Module_05, Module_05a] [module_06] type = program modules = [Module_06, Module_06a] [module_07] type = program modules = [Module_07, Module_07a] [res_vis_01] type = program modules = [ResVis01, ResVis01.A, ResVis01.B, ResVis01.C, ResVis01.D] ================================================ FILE: tests/modules/Makefile ================================================ # # This is free and unencumbered software released into the public domain. # See ../LICENSE.unlicense # # We don't normally use make to build Plasma programs, but it helps in this # case where we want to check some of the individual tools work when called # in "different" ways. # # vim: noet sw=4 ts=4 # TOP=../.. .PHONY: all all: module_03a.pzo module_03b.pzo module_03c.pzo module_08.pzo \ dyn_link_01_a.pz dyn_link_01.pz \ dyn_link_02_ab.pz dyn_link_02.pz %.pi : %.p $(TOP)/src/plzc $(TOP)/src/plzc --mode make-interface $< %.typeres : %.p $(TOP)/src/plzc $(TOP)/src/plzc --mode make-typeres-exports $< %.pzo : %.p $(TOP)/src/plzc $(TOP)/src/plzc $< %.pz : %.pzo $(TOP)/src/plzlnk $(TOP)/src/plzlnk -n ${subst .pz,,$@} -o $@ $< dyn_link_01.pzo : dyn_link_01_a.pi dyn_link_01_a.pz : dyn_link_01_a.pzo $(TOP)/src/plzlnk -n DynLink01A --library -o $@ \ dyn_link_01_a.pzo dyn_link_02.pzo : dyn_link_02_a.pi dyn_link_02_b.pi dyn_link_02_ab.pz : dyn_link_02_a.pzo dyn_link_02_b.pzo $(TOP)/src/plzlnk -n DynLink02A -n DynLink02B --library -o $@ \ dyn_link_02_a.pzo dyn_link_02_b.pzo ================================================ FILE: tests/modules/dyn_link_01.exp ================================================ Hello universe! ================================================ FILE: tests/modules/dyn_link_01.p ================================================ /* * vim: ft=plasma * This is free and unencumbered software released into the public domain. * See ../LICENSE.unlicense */ module DynLink01 // The import declaration works, it causes the interface file to be read. import DynLink01A as A entrypoint func main() uses IO -> Int { // The calls to the imported functions work. A.printMessage!("Hello " ++ A.getMessage()) return 0 } ================================================ FILE: tests/modules/dyn_link_01.sh ================================================ #!/bin/sh TOP=../.. $TOP/runtime/plzrun -l dyn_link_01_a.pz dyn_link_01.pz ================================================ FILE: tests/modules/dyn_link_01_a.p ================================================ /* * vim: ft=plasma * This is free and unencumbered software released into the public domain. * See ../LICENSE.unlicense */ module DynLink01A export func getMessage() -> String { return "universe!" } export func printMessage(message : String) uses IO { print!(message ++ "\n") } ================================================ FILE: tests/modules/dyn_link_02.exp ================================================ Hello universe! ================================================ FILE: tests/modules/dyn_link_02.p ================================================ /* * vim: ft=plasma * This is free and unencumbered software released into the public domain. * See ../LICENSE.unlicense */ module DynLink02 import DynLink02A as A import DynLink02B as B entrypoint func main() uses IO -> Int { A.printMessage!("Hello " ++ B.getMessage()) return 0 } ================================================ FILE: tests/modules/dyn_link_02.sh ================================================ #!/bin/sh TOP=../.. $TOP/runtime/plzrun -l dyn_link_02_ab.pz dyn_link_02.pz ================================================ FILE: tests/modules/dyn_link_02_a.p ================================================ /* * vim: ft=plasma * This is free and unencumbered software released into the public domain. * See ../LICENSE.unlicense */ module DynLink02A export func printMessage(message : String) uses IO { print!(message ++ "\n") } ================================================ FILE: tests/modules/dyn_link_02_b.p ================================================ /* * vim: ft=plasma * This is free and unencumbered software released into the public domain. * See ../LICENSE.unlicense */ module DynLink02B export func getMessage() -> String { return "universe!" } ================================================ FILE: tests/modules/entrypoint_1.build ================================================ # This is free and unencumbered software released into the public domain. # See ../LICENSE.unlicense # PLZTEST type compile_failure [Entrypoint_1] type = program modules = [Entrypoint1a, Entrypoint1b] ================================================ FILE: tests/modules/entrypoint_1.exp ================================================ A compilation error occured and this error is not handled gracefully by the Plasma compiler. Sorry. Message: Unknown symbol: T1a.test1a Context: ../entrypoint_1b.p:14 plzc location: predicate `pre.from_ast.ast_to_pre_expr_2'/7 plzc file: pre.from_ast.m ================================================ FILE: tests/modules/entrypoint_1a.p ================================================ /* * vim: ft=plasma * This is free and unencumbered software released into the public domain. * See ../LICENSE.unlicense */ module Entrypoint1a // Function is not exported. entrypoint func test1a() uses IO -> Int { print!("Test 1\n") return 0 } ================================================ FILE: tests/modules/entrypoint_1b.p ================================================ /* * vim: ft=plasma * This is free and unencumbered software released into the public domain. * See ../LICENSE.unlicense */ module Entrypoint1b import Entrypoint1a as T1a func test1b() uses IO -> Int { // Call should fail because although test2a is an entrypoin it is not // exported. return T1a.test1a!() } ================================================ FILE: tests/modules/entrypoint_2.exp ================================================ Test 2 ================================================ FILE: tests/modules/entrypoint_2a.p ================================================ /* * vim: ft=plasma * This is free and unencumbered software released into the public domain. * See ../LICENSE.unlicense */ module Entrypoint2a export entrypoint func test2a() uses IO -> Int { print!("Test 2\n") return 0 } ================================================ FILE: tests/modules/entrypoint_2b.p ================================================ /* * vim: ft=plasma * This is free and unencumbered software released into the public domain. * See ../LICENSE.unlicense */ module Entrypoint2b import Entrypoint2a as T2a func test2b() uses IO -> Int { return T2a.test2a!() } ================================================ FILE: tests/modules/entrypoint_3.exp ================================================ Test 3 ================================================ FILE: tests/modules/entrypoint_3a.p ================================================ /* * vim: ft=plasma * This is free and unencumbered software released into the public domain. * See ../LICENSE.unlicense */ module Entrypoint3a // entrypoint2 has the keywords in the opposite order. entrypoint export func test3a() uses IO -> Int { print!("Test 3\n") return 0 } ================================================ FILE: tests/modules/entrypoint_3b.p ================================================ /* * vim: ft=plasma * This is free and unencumbered software released into the public domain. * See ../LICENSE.unlicense */ module Entrypoint3b import Entrypoint3a as T3a func test3b() uses IO -> Int { return T3a.test3a!() } ================================================ FILE: tests/modules/heir.foo.p ================================================ /* * vim: ft=plasma * This is free and unencumbered software released into the public domain. * See ../LICENSE.unlicense */ module Heir.Foo export func test1() uses IO { print!("Test1\n") } ================================================ FILE: tests/modules/heir.foo_bar.p ================================================ /* * vim: ft=plasma * This is free and unencumbered software released into the public domain. * See ../LICENSE.unlicense */ module Heir.Foo.Bar export func test() uses IO { print!("Test from bar\n") } ================================================ FILE: tests/modules/heir_test.build ================================================ # This is free and unencumbered software released into the public domain. # See ../LICENSE.unlicense [heir_test] type = program modules = [HeirTest, Heir.Foo, Heir.Foo.Bar] ================================================ FILE: tests/modules/heir_test.exp ================================================ Test1 Test from bar Test1 Test1 ================================================ FILE: tests/modules/heir_test.p ================================================ /* * vim: ft=plasma * This is free and unencumbered software released into the public domain. * See ../LICENSE.unlicense */ module HeirTest // Test modules that are organised in a heirachy. Also test importing them // _to_ different names and multiple times. import Heir.Foo import Heir.Foo as Foo import Heir.Foo as F import Heir.Foo.Bar entrypoint func main() uses IO -> Int { Heir.Foo.test1!() Heir.Foo.Bar.test!() Foo.test1!() F.test1!() return 0 } ================================================ FILE: tests/modules/module_01.build ================================================ # This is free and unencumbered software released into the public domain. # See ../LICENSE.unlicense [module_01] type = program modules = [Module_01, Module_01a] ================================================ FILE: tests/modules/module_01.exp ================================================ Hello universe! ================================================ FILE: tests/modules/module_01.p ================================================ /* * vim: ft=plasma * This is free and unencumbered software released into the public domain. * See ../LICENSE.unlicense */ module Module_01 // The import declaration works, it causes the interface file to be read. import Module_01a entrypoint func main() uses IO -> Int { // The calls to the imported functions work. Module_01a.printMessage!("Hello " ++ Module_01a.getMessage()) return 0 } ================================================ FILE: tests/modules/module_01a.p ================================================ /* * vim: ft=plasma * This is free and unencumbered software released into the public domain. * See ../LICENSE.unlicense */ module Module_01a export func getMessage() -> String { return "universe!" } export func printMessage(message : String) uses IO { print!(message ++ "\n") } ================================================ FILE: tests/modules/module_02.build ================================================ # This is free and unencumbered software released into the public domain. # See ../LICENSE.unlicense [module_02] type = program modules = [Module_02, Module_02a] ================================================ FILE: tests/modules/module_02.exp ================================================ is_odd(0) = False is_odd(1) = True is_odd(2) = False is_odd(34) = False is_odd(35) = True ================================================ FILE: tests/modules/module_02.p ================================================ /* * vim: ft=plasma * This is free and unencumbered software released into the public domain. * See ../LICENSE.unlicense */ module Module_02 // The import declaration works, it causes the interface file to be read. import Module_02a export func is_odd(n : Int) -> Bool { if (n == 0) { return False } else { return Module_02a.is_even(n - 1) } } entrypoint func main() uses IO -> Int { print!("is_odd(0) = " ++ bool_to_string(is_odd(0)) ++ "\n") print!("is_odd(1) = " ++ bool_to_string(is_odd(1)) ++ "\n") print!("is_odd(2) = " ++ bool_to_string(is_odd(2)) ++ "\n") print!("is_odd(34) = " ++ bool_to_string(is_odd(34)) ++ "\n") print!("is_odd(35) = " ++ bool_to_string(is_odd(35)) ++ "\n") return 0 } ================================================ FILE: tests/modules/module_02a.p ================================================ /* * vim: ft=plasma * This is free and unencumbered software released into the public domain. * See ../LICENSE.unlicense */ module Module_02a import Module_02 export func is_even(n : Int) -> Bool { if (n == 0) { return True } else { return Module_02.is_odd(n - 1) } } ================================================ FILE: tests/modules/module_03a.exp ================================================ This is Module_03a ================================================ FILE: tests/modules/module_03a.p ================================================ /* * vim: ft=plasma * This is free and unencumbered software released into the public domain. * See ../LICENSE.unlicense */ module Module_03a entrypoint func main() uses IO -> Int { print!("This is Module_03a\n") return 0 } ================================================ FILE: tests/modules/module_03a.sh ================================================ #!/bin/sh TOP=../.. # Link two modules, both with entry points and check that we get the correct # one. # # Test b chooses the "other" entrypoint, # Test ar and br link the modules in the reverse order. # Test c links only one module with an entry point and checks that it is # selected implicity. $TOP/src/plzlnk -n Module_03a -e Module_03a.main -o module_03a.pz \ module_03a.pzo module_03b.pzo $TOP/runtime/plzrun module_03a.pz ================================================ FILE: tests/modules/module_03ar.exp ================================================ This is Module_03a ================================================ FILE: tests/modules/module_03ar.sh ================================================ #!/bin/sh TOP=../.. $TOP/src/plzlnk -n Module_03a -e Module_03a.main -o module_03a.pz \ module_03b.pzo module_03a.pzo $TOP/runtime/plzrun module_03a.pz ================================================ FILE: tests/modules/module_03b.exp ================================================ This is Module_03b ================================================ FILE: tests/modules/module_03b.p ================================================ /* * vim: ft=plasma * This is free and unencumbered software released into the public domain. * See ../LICENSE.unlicense */ module Module_03b entrypoint func main() uses IO -> Int { print!("This is Module_03b\n") return 0 } ================================================ FILE: tests/modules/module_03b.sh ================================================ #!/bin/sh TOP=../.. $TOP/src/plzlnk -n Module_03b -e Module_03b.main -o module_03b.pz \ module_03a.pzo module_03b.pzo $TOP/runtime/plzrun module_03b.pz ================================================ FILE: tests/modules/module_03br.exp ================================================ This is Module_03b ================================================ FILE: tests/modules/module_03br.sh ================================================ #!/bin/sh TOP=../.. $TOP/src/plzlnk -n Module_03b -e Module_03b.main -o module_03b.pz \ module_03b.pzo module_03a.pzo $TOP/runtime/plzrun module_03b.pz ================================================ FILE: tests/modules/module_03c.exp ================================================ This is Module_03a ================================================ FILE: tests/modules/module_03c.p ================================================ /* * vim: ft=plasma * This is free and unencumbered software released into the public domain. * See ../LICENSE.unlicense */ module Module_03c export func main() uses IO -> Int { print!("This is Module_03c. But not an entrypoint!\n") return 0 } ================================================ FILE: tests/modules/module_03c.sh ================================================ #!/bin/sh TOP=../.. $TOP/src/plzlnk -n Module_03c -o module_03c.pz \ module_03a.pzo module_03c.pzo $TOP/runtime/plzrun module_03c.pz ================================================ FILE: tests/modules/module_03cr.exp ================================================ This is Module_03a ================================================ FILE: tests/modules/module_03cr.sh ================================================ #!/bin/sh TOP=../.. $TOP/src/plzlnk -n Module_03c -o module_03c.pz \ module_03a.pzo module_03c.pzo $TOP/runtime/plzrun module_03c.pz ================================================ FILE: tests/modules/module_04.exp ================================================ Your card is the Ace of Spades Str is Boo! ================================================ FILE: tests/modules/module_04.p ================================================ /* * vim: ft=plasma * This is free and unencumbered software released into the public domain. * See ../LICENSE.unlicense */ module Module_04 // The import declaration works, it causes the interface file to be read. import Module_04a entrypoint func main() uses IO -> Int { test1!() Module_04a.Pair(var s, _) = test2!() print!("Str is " ++ s ++ "\n") return 0 } func test1() uses IO { // Test that we can use constructors from types defined in another // module. var c = Module_04a.Card(Module_04a.Spade, Module_04a.Ace) print!("Your card is the " ++ Module_04a.card_str(c) ++ "\n") } // Test that we can reference types defined in another module, and the types // may be polymorphic. func test2() uses IO -> Module_04a.Pair(String, Int) { return Module_04a.Pair("Boo!", 28) } ================================================ FILE: tests/modules/module_04a.p ================================================ /* * vim: ft=plasma * This is free and unencumbered software released into the public domain. * See ../LICENSE.unlicense */ module Module_04a export type Suit = Diamond | Heart | Spade | Club export type CardNum = Ace | Num ( num : Int ) | Jack | Queen | King export type Card = Card(suit : Suit, num : CardNum) export type Pair('a, 'b) = Pair(pa : 'a, pb : 'b) export func card_str(c : Card) -> String { Card(var s, var n) = c var num_str = match (n) { Ace -> "Ace" Num(var no) -> int_to_string(no) Jack -> "Jack" Queen -> "Queen" King -> "King" } var suit_str = match (s) { Diamond -> "Diamonds" Heart -> "Hearts" Spade -> "Spades" Club -> "Clubs" } return num_str ++ " of " ++ suit_str } ================================================ FILE: tests/modules/module_05.exp ================================================ Hello ================================================ FILE: tests/modules/module_05.p ================================================ /* * vim: ft=plasma * This is free and unencumbered software released into the public domain. * See ../LICENSE.unlicense */ module Module_05 import Module_05a entrypoint func main() uses IO -> Int { print!("Hello\n") return 0 } ================================================ FILE: tests/modules/module_05a.p ================================================ /* * vim: ft=plasma * This is free and unencumbered software released into the public domain. * See ../LICENSE.unlicense */ module Module_05a // Type references form a cycle. export type Foo = Foo ( a : Bar ) export type Bar = Bar ( b : Foo ) ================================================ FILE: tests/modules/module_06.exp ================================================ zort ================================================ FILE: tests/modules/module_06.p ================================================ /* * vim: ft=plasma * This is free and unencumbered software released into the public domain. * See ../LICENSE.unlicense */ module Module_06 import Module_06a entrypoint func main() uses IO -> Int { var s = test1!() print!(s ++ "\n") return 0 } func test1() uses Module_06a.Foo -> String { Module_06a.troz!() return zort!() } resource Zort from Module_06a.Bar func zort() uses Zort -> String { return "zort" } ================================================ FILE: tests/modules/module_06a.p ================================================ /* * vim: ft=plasma * This is free and unencumbered software released into the public domain. * See ../LICENSE.unlicense */ module Module_06a // export resources export resource Foo from IO export resource Bar from Foo resource Baz from Foo export func troz() uses Bar { } ================================================ FILE: tests/modules/module_07.exp ================================================ foo is: Foo(84) ================================================ FILE: tests/modules/module_07.p ================================================ /* * vim: ft=plasma * This is free and unencumbered software released into the public domain. * See ../LICENSE.unlicense */ module Module_07 import Module_07a entrypoint func main() uses IO -> Int { var f = Module_07a.makeFoo(28) print!("foo is: " ++ Module_07a.fooStr(f) ++ "\n") return 0 } ================================================ FILE: tests/modules/module_07a.p ================================================ /* * vim: ft=plasma * This is free and unencumbered software released into the public domain. * See ../LICENSE.unlicense */ module Module_07a export opaque type Foo = Foo ( a : Int ) export func makeFoo(n : Int) -> Foo { return Foo(n*3) } export func fooStr(f : Foo) -> String { Foo(var n) = f return "Foo(" ++ int_to_string(n) ++ ")" } ================================================ FILE: tests/modules/module_08.p ================================================ /* * vim: ft=plasma * This is free and unencumbered software released into the public domain. * See ../LICENSE.unlicense */ module Module_08 /* * Test that we can set this as the entrypoint on the linker command line */ entrypoint func name1() uses IO -> Int { print!("Hello world 1\n") return 0 } entrypoint func name2() uses IO -> Int { print!("Hello world 2\n") return 0 } ================================================ FILE: tests/modules/module_08a.exp ================================================ Hello world 1 ================================================ FILE: tests/modules/module_08a.sh ================================================ #/bin/sh TOP=../.. $TOP/src/plzlnk -n Module_08a -e Module_08.name1 -o module_08a.pz \ module_08.pzo $TOP/runtime/plzrun module_08a.pz ================================================ FILE: tests/modules/module_08b.exp ================================================ Hello world 2 ================================================ FILE: tests/modules/module_08b.sh ================================================ #/bin/sh TOP=../.. $TOP/src/plzlnk -n Module_08a -e Module_08.name2 -o module_08b.pz \ module_08.pzo $TOP/runtime/plzrun module_08b.pz ================================================ FILE: tests/modules/module_name_test.build ================================================ # This is free and unencumbered software released into the public domain. # See ../LICENSE.unlicense # PLZTEST type compile_failure [module_name_test] type = program modules = [ModuleNameTest] ================================================ FILE: tests/modules/module_name_test.exp ================================================ module_name_test.p:8: The module name from the source file 'ModuleNameTestQUACK' does not match the module name from the BUILD.plz file 'ModuleNameTest' module_name_test.p:8: The source filename 'module_name_test.p' does not match the module name 'ModuleNameTestQUACK' module_name_test.p:8: The output filename 'ModuleNameTest.dep' does not match the module name 'ModuleNameTestQUACK' ================================================ FILE: tests/modules/module_name_test.p ================================================ /* * vim: ft=plasma * This is free and unencumbered software released into the public domain. * See ../LICENSE.unlicense */ // This module name wont match the file name. module ModuleNameTestQUACK ================================================ FILE: tests/modules/opaque_resource.p ================================================ /* * vim: ft=plasma * This is free and unencumbered software released into the public domain. * See ../LICENSE.unlicense */ module OpaqueResource export resource Res1 from IO export opaque resource Res2 from Res1 export func do_with_res(f : func('t1) uses Res2 -> 't2, x : 't1) uses Res1 -> 't2 { return f!(x) } ================================================ FILE: tests/modules/opaque_resource_1.build ================================================ # This is free and unencumbered software released into the public domain. # See ../LICENSE.unlicense [opaque_resource_1] type = program modules = [OpaqueResource1, OpaqueResource] ================================================ FILE: tests/modules/opaque_resource_1.exp ================================================ Hi Bob. ================================================ FILE: tests/modules/opaque_resource_1.p ================================================ /* * vim: ft=plasma * This is free and unencumbered software released into the public domain. * See ../LICENSE.unlicense */ module OpaqueResource1 import OpaqueResource as OR entrypoint func test() uses IO -> Int { var s = test2!("Bob") print!(s ++ "\n") return 0 } func test2(s : String) uses OR.Res1 -> String { // The only way to get Res2 is by calling into the module that can // access it. return OR.do_with_res!(test3, s) } func test3(s : String) uses OR.Res2 -> String { return "Hi " ++ s ++ "." } ================================================ FILE: tests/modules/opaque_resource_2.build ================================================ # This is free and unencumbered software released into the public domain. # See ../LICENSE.unlicense # PLZTEST type compile_failure [opaque_resource_2] type = program modules = [OpaqueResource2, OpaqueResource] ================================================ FILE: tests/modules/opaque_resource_2.exp ================================================ opaque_resource_2.p:22: One or more resources needed for this call is unavailable in this function ================================================ FILE: tests/modules/opaque_resource_2.p ================================================ /* * vim: ft=plasma * This is free and unencumbered software released into the public domain. * See ../LICENSE.unlicense */ module OpaqueResource2 import OpaqueResource as OR entrypoint func test() uses IO -> Int { var s = test2!("Bob") print!(s ++ "\n") return 0 } func test2(s : String) uses OR.Res1 -> String { // Calling test3 directly is illegal. although Res2 comes from Res1 this // module doesn't know that because Res2 is opaque. return test3!(s) } func test3(s : String) uses OR.Res2 -> String { return "Hi " ++ s ++ "." } ================================================ FILE: tests/modules/res_vis_01.a.p ================================================ /* * vim: ft=plasma * This is free and unencumbered software released into the public domain. * See ../LICENSE.unlicense */ module ResVis01.A import ResVis01.B as B export resource Res1 from IO export resource Res3 from B.Res2 export type TypeA1 = StructA1 ( n : Int ) export type TypeA3 = StructA3 ( t2 : B.TypeA2 ) export type TypeB1('t) = StructB1 ( n : 't ) export type TypeB3('t) = StructB3 ( t2 : B.TypeB2('t) ) ================================================ FILE: tests/modules/res_vis_01.b.p ================================================ /* * vim: ft=plasma * This is free and unencumbered software released into the public domain. * See ../LICENSE.unlicense */ module ResVis01.B import ResVis01.A as A export resource Res2 from A.Res1 export resource Res4 from A.Res3 export type TypeA2 = StructA2 ( t1 : A.TypeA1 ) export type TypeA4 = StructA4 ( t3 : A.TypeA3 ) export type TypeB2('t) = StructB2 ( t1 : A.TypeB1('t) ) export type TypeB4('t) = StructB4 ( t3 : A.TypeB3('t) ) ================================================ FILE: tests/modules/res_vis_01.c.p ================================================ /* * vim: ft=plasma * This is free and unencumbered software released into the public domain. * See ../LICENSE.unlicense */ module ResVis01.C import ResVis01.D as D export resource Res1 from IO export resource Res3 from D.Res2 export func test(f : func() uses Res3) uses Res1 { f!() } // Show that we can export a function that depends on another module's // resource, which also isn't visible to ResVis01. export func test2() uses D.Res2 { } // Same, but Res4 doesn't get implicitly created by this module's own // resources (different path in the compiler). export func test3() uses D.Res4 { } export type TypeA1 = StructA1 ( n : Int ) export type TypeA3 = StructA3 ( t2 : D.TypeA2 ) export func makeDA2(v : TypeA1) -> D.TypeA2 { return D.StructA2(v) } export type TypeB1('t) = StructB1 ( n : 't ) export type TypeB3('t) = StructB3 ( t3 : D.TypeB2('t) ) export func makeDB2(v : TypeB1('t)) -> D.TypeB2('t) { return D.StructB2(v) } // Also test that referring to a type in a function but not another type // works. export func referToDType(v1 : D.TypeA4, v2 : D.TypeB4('t)) -> String { return "Hello" } ================================================ FILE: tests/modules/res_vis_01.d.p ================================================ /* * vim: ft=plasma * This is free and unencumbered software released into the public domain. * See ../LICENSE.unlicense */ module ResVis01.D import ResVis01.C as C export resource Res2 from C.Res1 export resource Res4 from C.Res3 export type TypeA2 = StructA2 ( t2 : C.TypeA1 ) export type TypeA4 = StructA4 ( t4 : C.TypeA3 ) export type TypeB2('t) = StructB2 ( t2 : C.TypeB1('t) ) export type TypeB4('t) = StructB4 ( t4 : C.TypeB3('t) ) ================================================ FILE: tests/modules/res_vis_01.exp ================================================ Test! The meaning of life: 42 ================================================ FILE: tests/modules/res_vis_01.p ================================================ /* * vim: ft=plasma * This is free and unencumbered software released into the public domain. * See ../LICENSE.unlicense */ module ResVis01 import ResVis01.B as B // Remove this once we make transitive resource names available. import ResVis01.A as A entrypoint func main() uses IO -> Int { print!("Test!\n") var r = do2!() print!("The meaning of life: " ++ int_to_string(r) ++ "\n") return 0 } func do2() uses B.Res2 -> Int { return do4!() * 2 } func do4() uses B.Res4 -> Int { return 21 } func testType1() -> A.TypeA1 { return A.StructA1(23) } func testTypeA4() -> B.TypeA4 { return B.StructA4(A.StructA3(B.StructA2(testType1()))) } func testTypeB4() -> B.TypeB4(Int) { return B.StructB4(A.StructB3(B.StructB2(A.StructB1(555)))) } // Import C but not D, show that we can use both C's resources, even the // one that depends on D. import ResVis01.C as C func testCallsCRes3() uses IO { C.test!(testUsesCRes3) } // We can't convert into this resource because we can't see Res2 without // another import. func testUsesCRes3() uses C.Res3 { } func testUsesCTypesA() -> C.TypeA3 { return C.StructA3(C.makeDA2(C.StructA1(3))) } func testUsesCTypesBStr() -> C.TypeB3(String) { return C.StructB3(C.makeDB2(C.StructB1("Hello"))) } func testUsesCTypesBAbs(v : 't) -> C.TypeB3('t) { return C.StructB3(C.makeDB2(C.StructB1(v))) } ================================================ FILE: tests/pretty.lua ================================================ #!/usr/bin/env lua5.3 -- -- Pretty test output -- -- This is free and unencumbered software released into the public domain. -- See ../LICENSE.unlicense -- -- Print without newline, for the test "dots" function printn(str) io.write(str) io.flush() end -- TODO: Replace with ncurses. local get_term_escape_failed = false function getTermEscape(command) if get_term_escape_failed then return nil end local pipe = io.popen("tput "..command) if not pipe then get_term_escape_failed = true return nil end local result = pipe:read("*a") pipe:close() return result end local term_bold = getTermEscape("bold") local term_green = getTermEscape("setaf 2") local term_red = getTermEscape("setaf 1") local term_yellow = getTermEscape("setaf 3") local term_cyan = getTermEscape("setaf 6") local term_reset = getTermEscape("sgr0") -- If one of these was unsuccesful then we set the terminal escape strings -- to empty strings and they'll have no effect. local term_success = "" local term_failure = "" local term_skip = "" local term_todo = "" if term_bold and term_green and term_red and term_reset then term_success = term_green .. term_bold term_failure = term_red .. term_bold term_skip = term_yellow .. term_bold term_todo = term_cyan .. term_bold end term_reset = term_reset or "" local num_tests local num_ok = 0 local num_fail = 0 local num_skip = 0 local num_todo = 0 local num_todo_ok = 0 local failed_tests = {} local todo_ok_tests = {} local line for line in io.lines() do if not num_tests then local parse = line:match("^1..(%d+)") if parse then num_tests = tonumber(parse) end end local parse_skip = line:match("# [sS][kK][iI][pP]") local parse_todo = line:match("# [tT][oO][dD][oO]") local parse_ok = line:match("^ok") if parse_ok then if parse_skip then num_skip = num_skip + 1 printn(term_skip .. "-") else if parse_todo then num_todo_ok = num_todo_ok + 1 printn(term_success .. "?") table.insert(todo_ok_tests, line) else num_ok = num_ok + 1 printn(term_success .. ".") end end else local parse_nok = line:match("^not ok") if parse_nok then if parse_skip then num_skip = num_skip + 1 printn(term_skip .. "-") elseif parse_todo then num_todo = num_todo + 1 printn(term_todo .. "=") else num_fail = num_fail + 1 printn(term_failure .. "+") table.insert(failed_tests, line) end end end end -- print a newline print(term_reset) if num_ok + num_fail + num_skip + num_todo + num_todo_ok ~= num_tests then print("Missing / extra tests: "..num_ok.." (pass) + "..num_fail.." (fail) + "..num_skip.." (skip) + "..num_todo.." (todo) + "..num_todo_ok.." (todo ok) = "..num_tests) os.exit(1) end printn(num_ok + num_todo_ok .. " / "..num_tests.." tests passed") if num_fail ~= 0 or num_skip ~= 0 or num_todo ~= 0 then printn(" (") if num_fail ~= 0 then printn(term_failure..num_fail.." failed"..term_reset) if num_skip ~= 0 or num_todo ~= 0 then printn(", ") end end if num_todo ~= 0 then printn(term_todo..num_todo.." todo"..term_reset) if num_skip ~= 0 then printn(", ") end end if num_skip ~= 0 then printn(term_skip..num_skip.." skipped"..term_reset) end printn(")") end print("") if num_fail ~= 0 then print("Failed tests:") for _, failed in pairs(failed_tests) do print(" "..failed) end end if num_todo_ok ~= 0 then print("Some TODO tests are now passing:") for _, todo_ok in pairs(todo_ok_tests) do print(" "..todo_ok) end end if num_fail ~= 0 then os.exit(1) end ================================================ FILE: tests/run-tests.lua ================================================ #!/usr/bin/env lua5.3 -- -- Plasma testing script -- -- This command expects to be passed directories in which it can find Plasma -- tests. Information about how it finds tests can be found in README.md. -- It uses the TAP protocol (http://testanything.org/tap-specification.html) -- so that its output may be further processed by other tools including CI. -- -- This is free and unencumbered software released into the public domain. -- See ../LICENSE.unlicense -- -- XXX: I couldn't make strict work, it caught errors, but execution just -- seemed to stop within dir_recursive() -- -- local _ENV = require 'std.strict'(_G) local lfs = require "lfs" -- -- Constants ------------- local root_dir = lfs.currentdir() local plzbuild_bin = root_dir .. "/src/plzbuild" local plzrun_bin = root_dir .. "/runtime/plzrun" local build_type = os.getenv("BUILD_TYPE") local logging = os.getenv("LOGGING") -- -- Utility functions --------------------- function debug(message) -- print(message) end function log(message) if logging then print(message) end end function list_append(l1, l2) local l = {} for _, v in ipairs(l1) do table.insert(l, v) end for _, v in ipairs(l2) do table.insert(l, v) end return l end function all(t, f) for _, v in ipairs(t) do if not f(v) then return false end end return true end function string_split(str) local l = {} for token in str:gmatch("%S+") do table.insert(l, token) end return l end function list_string(l) local s = "" for _, i in ipairs(l) do if (s ~= "") then s = s .. " " end s = s .. i end return s end function file_exists(path) return lfs.attributes(path) and path or nil end -- Return an iterator that produces all the files under dirs (an array) -- recursively. function dir_recursive(dirs) function is_dir(path) return path:sub(-1) == "/" or lfs.attributes(path, "mode") == "directory" end -- A recursive function generates file names function list_dir(dir) for file in lfs.dir(dir) do if (file ~= "." and file ~= "..") then local full_name = string.format("%s/%s", dir, file) if is_dir(full_name) then list_dir(full_name) else coroutine.yield({dir=dir, file=file}) end end end end return coroutine.wrap(function() for _, dir in ipairs(dirs) do list_dir(dir) end end) end -- Execute a command and capture the result code. -- -- Args: -- dir: the working directory -- bin: the binary to call -- args: the arguments -- mb_input_file: a file name for input, or nil to not redirect input. -- mb_output_file: a file name for output, or nil to return output as a -- string. -- mb_stderr_file: a file name for stderr, or nil to return stderr as a -- string. -- -- Returns -- "exited"/"killed": Did the process terminate itself, or was it killed. -- Number: The return code / signal number -- String: The output, if mb_output_file was nil. -- String: The stderr, if mb_stderr_file was nil. -- -- A lot of this could be accomplished with popen, however I have a later -- refinement that I actually want the process control features I can use -- here. function execute(dir, bin, args, mb_input_file, mb_output_file, mb_stderr_file) local E = require 'posix.errno' local U = require 'posix.unistd' local W = require 'posix.sys.wait' local F = require 'posix.fcntl' local S = require 'posix.stdio' local P = require 'posix.sys.stat' -- Before doing any "work" (creating pipes and opening files) remove any -- stale files so that a failure doesn't leave a previous output file in -- place. if mb_output_file and lfs.attributes(mb_output_file) then assert(os.remove(mb_output_file)) end if mb_stderr_file and lfs.attributes(mb_stderr_file) then assert(os.remove(mb_stderr_file)) end local mb_output_pipe_read, mb_output_pipe_write if (not mb_output_file) then mb_output_pipe_read, mb_output_pipe_write = assert(U.pipe()) end local mb_stderr_pipe_read, mb_stderr_pipe_write if (not mb_stderr_file) then mb_stderr_pipe_read, mb_stderr_pipe_write = assert(U.pipe()) end local child = assert(U.fork()) if child == 0 then -- We are the child. lfs.chdir(dir) -- Remap our side side of the pipes function remap(from, to) U.close(to) U.dup2(from, to) U.close(from) end -- Remap input first, in case there's an error we can complain with -- stdout. if (mb_input_file) then remap(assert(F.open(mb_input_file, F.O_RDONLY), 0)) end local open_opts = F.O_WRONLY | F.O_TRUNC | F.O_CREAT local open_mode = P.S_IRUSR | P.S_IWUSR | P.S_IRGRP | P.S_IWGRP | P.S_IROTH | P.S_IWOTH if (mb_output_file) then remap(assert(F.open(mb_output_file, open_opts, open_mode)), 1) else U.close(mb_output_pipe_read) remap(mb_output_pipe_write, 1) end if (mb_stderr_file) then remap(assert(F.open(mb_stderr_file, open_opts, open_mode)), 2) else U.close(mb_stderr_pipe_read) remap(mb_stderr_pipe_write, 2) end local _, err = U.execp(bin, args) print("Exec of %s failed: %s", bin, err) print("Bail out!") os.exit(1) end log(string.format("Running: %s %s", bin, list_string(args))) function read_stream(stream) local output = "" repeat local str = U.read(stream, 4096) if str then str = string.gsub(str, "%s*$", "") if str ~= "" then log(str) output = output .. str end end until not str or str == "" return output end local output = "" if mb_output_pipe_read then U.close(mb_output_pipe_write) output = read_stream(mb_output_pipe_read) end -- This is a bad way to read two streams since we could deadlock -- TODO: make them non-blocking. local stderr = "" if mb_stderr_pipe_read then U.close(mb_stderr_pipe_write) stderr = read_stream(mb_stderr_pipe_read) end local pid, exit, status repeat pid, exit, status = W.wait(child, 0) if pid == nil then debug("wait: " .. exit) exit_error('wait') end debug(string.format("child: %d exit: %s status: %d", pid, exit, status)) until (pid == child) and (exit == "exited" or exit == "killed") -- TODO: if killed by SIGINT we should abort the whole test suite. return exit, status, output, stderr end -- -- Gather all the tests ------------------------ -- Gather test configuration for this test. -- -- Parameters: -- path - the path to the test's .exp file -- -- Returns: -- A table containing the keys: -- expect_return - the test's expected return code -- check_stderr - if we should check stderr output rather than stdout -- build_type - The build type to enable this test for (nil for all) -- test_type - The type of this test (nil for auto or compile_failure) -- is_todo - This test represents an unimplemented feature -- build_args - The arguments for the plzbuild command -- function test_configuration(filename) local expect_return = 0 local check_stderr = false local build_type local test_type local is_todo = false local build_args function invalid_value(key, value) print(string.format("%s: Invalid value '%s' for key %s", filename, value, key)) end local file = io.open(filename) if file then -- File exists, we can parse it for test declarations. local line_no = 0 for line in file:lines() do line_no = line_no + 1 local _, _, key, value = string.find(line, "PLZTEST%s+(%S+)%s+(.-)%s*$") if key then if key == "returns" then expect_return = tonumber(value) if not expect_return then invalid_value(line_no, key, value) end elseif key == "output" then if value == "stdout" then check_stderr = false elseif value == "stderr" then check_stderr = true else invalid_value(line_no, key, value) end elseif key == "build_type" then build_type = value elseif key == "type" then test_type = value elseif key == "build_args" then build_args = string_split(value) elseif key == "todo" then is_todo = value else print(string.format("%s:%d: Unknown key in test configuration %s", filename, line_no, key)) end end end file:close() end return { expect_return = expect_return, check_stderr = check_stderr, build_type = build_type, test_type = test_type, is_todo = is_todo, build_args = build_args, } end -- gen_all_tests is a generator of dictionaries. each dictionary has: -- -- name: String, the name of the test -- desc: String, a description of the test (unique) -- type: either "plzbuild" or "run" -- dir: String, the working directory for the test -- output: String, the file name to write the test output to. -- depends: List of tests that this test needs before it can run. -- -- plzbuild tests: -- These tests will run "plzbuild" in a directory, they check that is -- returns a zero exit code. -- -- run tests: -- These tests will run a plasma program, check that it returns 0. -- and compare its output with an exptected output. -- -- expect: String, the path to the expected output file -- input: nil or String, the path to an input for stdin -- program: String, the path to the Plasma bytecode -- gen_all_tests = coroutine.wrap(function() function file_is_test(file) return file:match(".exp$") end local dirs = {} function maybe_add_build_dir(dir) if (not dirs[dir]) then dirs[dir] = {} local make_file = string.format("%s/Makefile", dir) if (lfs.attributes(make_file)) then local test = { name = "make", type = "make", dir = dir, desc = string.format("%s/Makefile", dir), output = "make.out", config = {}, } table.insert(dirs[dir], test) coroutine.yield(test) end local build_file = string.format("%s/BUILD.plz", dir) if (lfs.attributes(build_file)) then local test = { name = "BUILD.plz", type = "plzbuild", dir = dir, desc = string.format("%s/BUILD.plz", dir), output = "plzbuild.out", config = {}, } table.insert(dirs[dir], test) coroutine.yield(test) end end end function path_to_test(file, dir) maybe_add_build_dir(dir) local maybe_input = file:gsub(".exp", ".in") if not lfs.attributes( string.format("%s/%s", dir, maybe_input)) then maybe_input = nil end function name_if_exists(dir, file, new_ext) local path = string.format("%s/%s", dir, file:gsub(".exp", new_ext)) return file_exists(path) end local build_file = name_if_exists(dir, file, ".build") local source_file = name_if_exists(dir, file, ".p") local shell_file = name_if_exists(dir, file, ".sh") local test_file = name_if_exists(dir, file, ".test") local foreign_file = name_if_exists(dir, file, ".cpp") local name = file:gsub(".exp", "") local desc = string.format("%s/%s", dir, name) local dir_build if not build_file and dirs[dir] ~= "none" then dir_build = dirs[dir] end local config if build_file then config = test_configuration(build_file) elseif source_file then config = test_configuration(source_file) elseif shell_file then config = test_configuration(shell_file) elseif test_file then config = test_configuration(test_file) else -- Some module tests have neither a build file nor a source file config = {} end coroutine.yield({ name = name, type = config.test_type or "run", dir = dir, desc = desc, depends = dir_build, build_file = build_file and file:gsub(".exp", ".build"), shell_file = shell_file and file:gsub(".exp", ".sh"), output = file:gsub(".exp", ".out"), expect = file, input = maybe_input, program = file:gsub(".exp", ".pz"), foreign_module = foreign_file and file:gsub(".exp", ".so"), config = config, }) end -- a is for 'arg' but I don't want to clubber the real 'arg'. for _, a in ipairs(arg) do if (file_exists(a .. ".exp")) then local dir, test = string.match(a, "(.-)/([^/]*)$") path_to_test(test .. ".exp", dir) else for path in dir_recursive({a}) do if (file_is_test(path.file)) then path_to_test(path.file, path.dir) end end end end end) -- -- These functions format TAP output ------------------------------------- -- Each of the tap_ functions writes a TAP test output line. They all take -- the test and stage as the first two parameters. test_no = 0 -- -- Write a generic tap output line based on the status (bool) and any extra -- information. -- function tap_result(test, stage, status, extra) test_no = test_no + 1 extra = extra and (" # " .. extra) or "" local status_str = status and "ok" or "not ok" print(string.format("%s %d %s %s%s", status_str, test_no, test.desc, stage, extra)) end -- -- Indicate that this step was skipped. -- function tap_skip(test, stage, why) tap_result(test, stage, true, "SKIP" .. (why and (" " .. why) or "")) end -- -- Indicate that this step was executed with the given how it -- exited ("exited" or "killed") and the exit/signal code. -- function tap_exec(test, stage, exit, code, expect_return, is_todo) local todo_text = "" if is_todo then todo_text = "TODO "..is_todo end if exit == "exited" then if code == expect_return then tap_result(test, stage, true, todo_text) return true else if is_todo then tap_result(test, stage, false, todo_text) return true else tap_result(test, stage, false, string.format("exited with %d expected %d", code, expect_return)) return false end end else tap_result(test, stage, false, "killed by signal " .. code) return false end end -- True if at least one test failed, then we should return non-zero local a_test_failed = false -- -- Run a command for testing. -- function execute_test_command(test, stage, cmd, args, input, exp_out, exp_stderr, exp_return, is_todo) exp_return = exp_return or 0 local exit, status, output, stderr = execute(test.dir, cmd, args, input, exp_out, exp_stderr) local r = tap_exec(test, stage, exit, status, exp_return, is_todo) for line in stderr:gmatch("[^\n]+") do print(" " .. line) end if not r then a_test_failed = true -- Maybe enable this for a verbose mode. for line in output:gmatch("[^\n]+") do print(" " .. line) end end return r end -- -- This function allows chaining of test steps, and will skip a later step -- when an earlier one fails. For example: -- -- local result = true -- result = test_step(test, "step 1", result, ...) -- result = test_step(test, "step 2", result, ...) -- ... -- function test_step(test, stage, prev_result, func) local depends_result = true if test.depends then depends_result = all(test.depends, function(x) return x.result end) end local result if test.config.build_type ~= nil and test.config.build_type ~= build_type then tap_skip(test, stage, string.format("%s test in %s build", test.config.build_type, build_type)) result = false elseif not depends_result then tap_skip(test, stage, "dependecy failed") result = false elseif not prev_result then tap_skip(test, stage) result = false else result = func() end test.result = result return result end -- -- Return the number of steps in this test -- function test_num_steps(test) if test.type == "plzbuild" then return 1 elseif test.type == "compile_failure" then return 2 elseif test.type == "run" then if test.build_file then return 3 else return 2 end else -- Unknown tests are caught later and become part of TAP output. return 1 end end local num_tests = 0 local all_tests = {} for test in gen_all_tests do num_tests = num_tests + test_num_steps(test) table.insert(all_tests, test) end -- The TAP test plan print("1.." .. num_tests) -- -- Filter compiler output for processing by diff -- function filter_compiler_output(dir, input_name, output_name) local input = assert(io.open(dir .. "/" .. input_name)) local output = assert(io.open(dir .. "/" .. output_name, "w")) local all_lines = {} -- True if we find the right section of output to filter. local output_found = false for line in input:lines() do table.insert(all_lines, line) if line:match("^%S+plzc ") or line:match("^%S+plzlnk ") then output_found = true break end end if output_found then for line in input:lines() do if line:match("^ninja: build stopped") or line:match("^%[%d+/%d+%]") then break end output:write(line .. "\n") end else -- We didn't find the right output, write out everything. for _, line in ipairs(all_lines) do output:write(line .. "\n") end end input:close() output:close() end -- -- Run the test -- function run_test(test) local result = true -- we start in a good state local build_args = {} if (test.config.build_args) then build_args = test.config.build_args end local extra_args = {"--rebuild"} if test.type == "plzbuild" then result = test_step(test, "build", result, function() return execute_test_command(test, "build", plzbuild_bin, list_append(extra_args, build_args), nil, nil, nil, 0) end) elseif test.type == "make" then result = test_step(test, "build", result, function() return execute_test_command(test, "make", "make", {}, nil, nil, nil, 0) end) elseif test.type == "run" then if (test.build_file) then result = test_step(test, "build", result, function() local build_dir = test.name .. ".dir" extra_args = list_append(extra_args, {"--build-file", test.build_file, "--build-dir", build_dir, "--rebuild"}) return execute_test_command(test, "build", plzbuild_bin, list_append(extra_args, build_args), nil, nil, nil, 0) end) end result = test_step(test, "run", result, function() local exp_stdout = nil local exp_stderr = nil if (test.config.check_stderr) then exp_stderr = test.output else exp_stdout = test.output end if test.shell_file then return execute_test_command(test, "run", "./"..test.shell_file, {}, test.input, exp_stdout, exp_stderr, test.config.expect_return, test.config.is_todo) else local program_str = test.program if (test.foreign_module) then program_str = program_str .. ":" .. test.foreign_module end return execute_test_command(test, "run", plzrun_bin, {program_str}, test.input, exp_stdout, exp_stderr, test.config.expect_return, test.config.is_todo) end end) result = test_step(test, "diff", result, function() local filtered_output = test.output:gsub(".out", ".outs") -- grep removes entire lines beginning with a # -- sed removes the ends of lines after a # assert(execute(test.dir, "sh", {"-c", "grep -v '^#' | sed -e 's/#.*$//'"}, test.output, filtered_output)) return execute_test_command(test, "diff", "diff", {"-u", test.expect, filtered_output}, nil, nil, nil) end) elseif test.type == "compile_failure" then result = test_step(test, "build-failure", result, function() local build_dir = test.name .. ".dir" local extra_args = {"--build-dir", build_dir} if (test.build_file) then extra_args = list_append(extra_args, {"--build-file", test.build_file}) end local exp_stdout = nil local exp_stderr = nil if (test.config.check_stderr) then exp_stderr = test.output else exp_stdout = test.output end local exp_return = 1 if test.config.is_todo then exp_return = 0 end return execute_test_command(test, "build-failure", plzbuild_bin, list_append(build_args, extra_args), nil, exp_stdout, exp_stderr, exp_return, test.config.is_todo) end) result = test_step(test, "diff", result, function() local filtered_output = test.output:gsub(".out", ".outs") -- grep removes entire lines beginning with a # -- sed removes the ends of lines after a # filter_compiler_output(test.dir, test.output, filtered_output) return execute_test_command(test, "diff", "diff", {"-u", test.expect, filtered_output}, nil, nil, nil) end) else tap_result(test, "unknown test type "..test.type, false) return end end for _, test in pairs(all_tests) do run_test(test) end os.exit(a_test_failed and 1 or 0) ================================================ FILE: tests/runtime/BUILD.plz ================================================ # This is free and unencumbered software released into the public domain. # See ../LICENSE.unlicense [allocateLots] type = program modules = [AllocateLots] [die] type = program modules = [Die] [parameters] type = program modules = [Parameters] ================================================ FILE: tests/runtime/allocateLots.exp ================================================ item 0 item 1 item 2 item 3 item 4 item 5 item 6 item 7 item 8 item 9 item 10 item 11 item 12 item 13 item 14 item 15 item 16 item 17 item 18 item 19 item 20 item 21 item 22 item 23 item 24 item 25 item 26 item 27 item 28 item 29 item 30 item 31 item 32 item 33 item 34 item 35 item 36 item 37 item 38 item 39 item 40 item 41 item 42 item 43 item 44 item 45 item 46 item 47 item 48 item 49 item 50 item 51 item 52 item 53 item 54 item 55 item 56 item 57 item 58 item 59 item 60 item 61 item 62 item 63 item 64 item 65 item 66 item 67 item 68 item 69 item 70 item 71 item 72 item 73 item 74 item 75 item 76 item 77 item 78 item 79 item 80 item 81 item 82 item 83 item 84 item 85 item 86 item 87 item 88 item 89 item 90 item 91 item 92 item 93 item 94 item 95 item 96 item 97 item 98 item 99 item 100 item 101 item 102 item 103 item 104 item 105 item 106 item 107 item 108 item 109 item 110 item 111 item 112 item 113 item 114 item 115 item 116 item 117 item 118 item 119 item 120 item 121 item 122 item 123 item 124 item 125 item 126 item 127 item 128 item 129 item 130 item 131 item 132 item 133 item 134 item 135 item 136 item 137 item 138 item 139 item 140 item 141 item 142 item 143 item 144 item 145 item 146 item 147 item 148 item 149 item 150 item 151 item 152 item 153 item 154 item 155 item 156 item 157 item 158 item 159 item 160 item 161 item 162 item 163 item 164 item 165 item 166 item 167 item 168 item 169 item 170 item 171 item 172 item 173 item 174 item 175 item 176 item 177 item 178 item 179 item 180 item 181 item 182 item 183 item 184 item 185 item 186 item 187 item 188 item 189 item 190 item 191 item 192 item 193 item 194 item 195 item 196 item 197 item 198 item 199 item 200 item 201 item 202 item 203 item 204 item 205 item 206 item 207 item 208 item 209 item 210 item 211 item 212 item 213 item 214 item 215 item 216 item 217 item 218 item 219 item 220 item 221 item 222 item 223 item 224 item 225 item 226 item 227 item 228 item 229 item 230 item 231 item 232 item 233 item 234 item 235 item 236 item 237 item 238 item 239 item 240 item 241 item 242 item 243 item 244 item 245 item 246 item 247 item 248 item 249 item 250 item 251 item 252 item 253 item 254 item 255 item 256 item 257 item 258 item 259 item 260 item 261 item 262 item 263 item 264 item 265 item 266 item 267 item 268 item 269 item 270 item 271 item 272 item 273 item 274 item 275 item 276 item 277 item 278 item 279 item 280 item 281 item 282 item 283 item 284 item 285 item 286 item 287 item 288 item 289 item 290 item 291 item 292 item 293 item 294 item 295 item 296 item 297 item 298 item 299 ================================================ FILE: tests/runtime/allocateLots.p ================================================ /* * vim: ft=plasma * This is free and unencumbered software released into the public domain. * See ../LICENSE.unlicense */ // This test only works in development builds where the GC is more // aggressive. // PLZTEST build_type dev module AllocateLots entrypoint func main() uses IO -> Int { print_heap_size!() var collections_start = heap_collections!() var tree = foldl(insert_wrapper, big_list(), Empty) traverse!(print_node, tree) print_heap_size!() var collections_end = heap_collections!() if (collections_end <= collections_start) { print!("Allocate lots did not GC\n") return 1 } else { print!("# There were " ++ int_to_string(collections_end - collections_start) ++ " collections during the test.\n") return 0 } } func heap_collections() uses IO -> Int { var res, var collections = Builtin.get_parameter!("heap_collections") if (res) { print!("# There have been " ++ int_to_string(collections) ++ " GCs.\n") } else { Builtin.die("Can't retrive heap_collections\n") } return collections } func print_heap_size() uses IO { var res, var heap_size = Builtin.get_parameter!("heap_usage") if (res) { print!("# Heap_size: " ++ int_to_string(heap_size/1024) ++ "KB\n") } else { } } func foldl(f : func('x, 'a) -> 'a, l : List('x), a0 : 'a) -> 'a { match (l) { [] -> { return a0 } [var x | var xs] -> { var a1 = f(x, a0) var a = foldl(f, xs, a1) return a } } } func insert_wrapper(x : Int, t : Tree(Int, String)) -> Tree(Int, String) { return insert(compare_num, t, x, "item " ++ int_to_string(x)) } func compare_num(a : Int, b : Int) -> Int { return a - b } func print_node(k : Int, v : String) uses IO { print!(v ++ "\n") } type Tree('k, 'v) = Empty | Tree( left : Tree('k, 'v), key : 'k, value : 'v, right : Tree('k, 'v) ) func insert(compare : func('k, 'k) -> Int, tree : Tree('k, 'v), key : 'k, value : 'v) -> Tree('k, 'v) { match (tree) { Empty -> { return Tree(Empty, key, value, Empty) } Tree(var left, var tkey, var tvalue, var right) -> { if (compare(key, tkey) < 0) { return Tree( insert(compare, left, key, value), tkey, tvalue, right) } else { return Tree(left, tkey, tvalue, insert(compare, right, key, value)) } } } } func traverse(f : func('k, 'v) uses IO, tree : Tree('k, 'v)) uses IO { match (tree) { Empty -> {} Tree(var left, var key, var value, var right) -> { traverse!(f, left) f!(key, value) traverse!(f, right) } } } func big_list() -> List(Int) { return [136, 294, 197, 215, 192, 127, 105, 212, 48, 161, 209, 119, 71, 141, 165, 291, 181, 169, 221, 56, 280, 222, 29, 267, 235, 140, 54, 157, 80, 37, 234, 242, 12, 53, 92, 194, 102, 200, 43, 179, 51, 44, 166, 177, 173, 150, 42, 198, 31, 104, 162, 205, 229, 286, 213, 262, 281, 261, 133, 189, 112, 257, 9, 18, 100, 204, 75, 57, 299, 28, 269, 47, 138, 41, 66, 25, 288, 109, 185, 130, 49, 193, 147, 285, 292, 207, 196, 245, 111, 239, 240, 260, 106, 86, 137, 70, 271, 247, 160, 52, 8, 259, 190, 217, 45, 21, 23, 91, 79, 117, 0, 270, 236, 99, 59, 223, 295, 64, 206, 38, 3, 224, 128, 220, 231, 101, 171, 125, 1, 90, 254, 17, 34, 230, 120, 110, 30, 210, 39, 11, 67, 232, 84, 186, 156, 24, 20, 187, 93, 19, 163, 266, 108, 132, 195, 129, 116, 146, 178, 69, 33, 26, 290, 250, 144, 131, 233, 263, 2, 50, 73, 134, 175, 226, 168, 248, 297, 60, 228, 225, 107, 145, 237, 55, 65, 96, 279, 155, 287, 6, 256, 296, 182, 293, 202, 46, 152, 118, 265, 201, 218, 149, 15, 61, 208, 95, 277, 219, 273, 275, 298, 227, 72, 68, 252, 268, 167, 40, 143, 97, 124, 284, 77, 191, 83, 164, 13, 78, 114, 282, 126, 244, 148, 58, 278, 238, 82, 115, 113, 211, 98, 289, 151, 135, 89, 243, 153, 216, 251, 74, 184, 246, 214, 122, 174, 94, 7, 22, 253, 87, 81, 183, 283, 188, 16, 10, 203, 241, 264, 274, 27, 159, 4, 276, 88, 32, 158, 154, 139, 14, 255, 199, 5, 121, 272, 258, 176, 170, 103, 172, 142, 85, 35, 36, 76, 249, 63, 62, 123, 180] } ================================================ FILE: tests/runtime/die.exp ================================================ Die: Dieing ================================================ FILE: tests/runtime/die.p ================================================ /* * vim: ft=plasma * This is free and unencumbered software released into the public domain. * See ../LICENSE.unlicense */ module Die // PLZTEST returns 1 // PLZTEST output stderr entrypoint func main() uses IO -> Int { Builtin.die("Dieing") /* * Return shouldn't be necessary since die won't fall-through. However * Plasma doesn't yet understand exceptions and we'll implement that once * exceptions exist. */ return 0 } ================================================ FILE: tests/runtime/parameters.exp ================================================ TEST: Squark!: 26 Failed to get Squark! Failed to set Squark! to 26 Failed to get Squark! TEST: heap_usage: 100 Succeeded to get heap_usage: Failed to set heap_usage to 100 Succeeded to get heap_usage: TEST: heap_collections: 100 Succeeded to get heap_collections: Failed to set heap_collections to 100 Succeeded to get heap_collections: ================================================ FILE: tests/runtime/parameters.p ================================================ /* * vim: ft=plasma * This is free and unencumbered software released into the public domain. * See ../LICENSE.unlicense */ module Parameters entrypoint func main() uses IO -> Int { test_parameter!("Squark!", 26, Stable) test_parameter!("heap_usage", 100, Volatile) test_parameter!("heap_collections", 100, Volatile) return 0 } type Volatile = Volatile | Stable func test_parameter(name : String, value : Int, volatile : Volatile) uses IO { print!("TEST: " ++ name ++ ": " ++ int_to_string(value) ++ "\n") var res1, var val1 = Builtin.get_parameter!(name) print!(pretty_get_result(res1, name, val1, volatile)) var res2 = Builtin.set_parameter!(name, value) print!(pretty_set_result(res2, name, value)) var res3, var val3 = Builtin.get_parameter!(name) print!(pretty_get_result(res1, name, val3, volatile)) } func pretty_set_result(res : Bool, label : String, value : Int) -> String { var res_str = match (res) { True -> "Succeeded" False -> "Failed" } return res_str ++ " to set " ++ label ++ " to " ++ int_to_string(value) ++ "\n" } func pretty_get_result(res : Bool, label : String, value : Int, volatile : Volatile) -> String { var res_str var maybe_value match (res) { True -> { res_str = "Succeeded" var maybe_hash = match (volatile) { Volatile -> "# " Stable -> "" } maybe_value = ": " ++ maybe_hash ++ int_to_string(value) } False -> { res_str = "Failed" maybe_value = "" } } return res_str ++ " to get " ++ label ++ maybe_value ++ "\n" } ================================================ FILE: tests/update-outputs.sh ================================================ #!/bin/sh set -e # This script will help update test expected outputs for failed tests. It # is useful when line numbers within tests or the compiler's error messages # change. The user should check the diffs before committing them. # Only work in tests directories that incorporate compiler error messages. DIRS="tests-old/invalid tests-old/modules-invalid" for TESTDIR in $DIRS; do for OUTPUT in $TESTDIR/*.out; do # If the glob didn't match anything then output won't exist. if [ -e $OUTPUT ]; then BASE=$TESTDIR/`basename $OUTPUT .out` # Only copy the file if there's already an .exp file. It's # possible there may be a .out file but no .exp if we've # switched branches recently. This also has the effect of not # updating .expish files, which is good since those must be # updated manually. if [ -e $BASE.exp ]; then mv $OUTPUT $BASE.exp fi fi done done # Do the same for the new test suite, this will need tweaking as we # develop the test suite though. TESTDIR=tests/types for OUTPUT in $TESTDIR/*.outs; do # If the glob didn't match anything then output won't exist. if [ -e $OUTPUT ]; then BASE=$TESTDIR/`basename $OUTPUT .outs` # Only copy the file if there's already an .exp file. It's # possible there may be a .out file but no .exp if we've # switched branches recently. This also has the effect of not # updating .expish files, which is good since those must be # updated manually. if [ -e $BASE.exp ]; then mv $OUTPUT $BASE.exp fi fi done ================================================ FILE: tests-old/.gitignore ================================================ *.diff *.log *.out *.outs *.pzo *.pz *.plasma-dump_* *.trace _build ================================================ FILE: tests-old/README.md ================================================ # Plasma Test Suite Note that some of the programs in examples/ are also used as part of the test suite. * [pzt](pzt) - Plasma bytecode tests * [modules-invalid](modules-invalid) - Invalid programs that use multiple modules ================================================ FILE: tests-old/modules-invalid/.gitignore ================================================ *.pi ================================================ FILE: tests-old/modules-invalid/BUILD.plz ================================================ [module_08] type = program modules = [Module_08, Module_08.C, Module_08.D] [module_08b] type = program modules = [Module_08b, Module_08.C, Module_08.D] ================================================ FILE: tests-old/modules-invalid/Makefile ================================================ # # This is free and unencumbered software released into the public domain. # See ../LICENSE.unlicense # # vim: noet sw=4 ts=4 # TOP=../.. .PHONY: all all: @echo This Makefile does not have an "all" target @echo Use the run_tests.sh script in the parent directory to run all tests @echo or use "make test_name.test" to run a single test. @false .PRECIOUS: %.out %.out : %.p $(TOP)/src/plzc if $(TOP)/src/plzc $< > $@ 2>&1 ; then \ echo "Compilation succeeded" ; \ echo "Compilation succeeded" >> $@ ; \ false ; \ fi module_03.out : module_03a.pi module_04a.out : module_04import.pi module_04b.out : module_04import.pi module_04c.out : module_04import.pi module_04d.out : module_04import.pi module_02a.pi: ; %.pi : %.p $(TOP)/src/plzc $(TOP)/src/plzc --mode make-interface $< %.pzo : %.p $(TOP)/src/plzc $(TOP)/src/plzc $< %.pz : %.pzo $(TOP)/src/plzlnk $(TOP)/src/plzlnk -n ${subst .pz,,$@} -o $@ $< module_05.out : module_05.pzo module_05_.pzo $(TOP)/src/plzlnk if $(TOP)/src/plzlnk module_05.pzo module_05_.pzo \ -n Module_05 -o module_05.pz > $@ 2>&1 ; then \ echo "Linking succeeded" ; \ echo "Linking succeeded" >> $@ ; \ false ; \ fi module_06.out : module_06.p $(TOP)/src/plzc module_06a.pi module_08.out : module_08.p module_08.c.p module_08.d.p BUILD.plz BINS if $(TOP)/src/plzbuild module_08 > $@ 2>&1 ; then \ echo "Build succeeded" ; \ echo "Build succeeded" >> $@ ; \ false ; \ fi module_08b.out : module_08b.p module_08.c.p module_08.d.p BUILD.plz BINS if $(TOP)/src/plzbuild module_08b > $@ 2>&1 ; then \ echo "Build succeeded" ; \ echo "Build succeeded" >> $@ ; \ false ; \ fi .PHONY: BINS BINS: $(TOP)/src/plzc $(TOP)/src/plzlnk $(TOP)/src/plzbuild .PHONY: %.test %.test : %.exp %.outs diff -u $^ .PHONY: %.test %.test : %.expish %.outs grep -cF -f $^ %.outs : %.out grep -v '^#' < $< | sed -e 's/#.*$$//' > $@ .PHONY: clean clean: rm -rf *.pz *.pzo *.out *.diff *.log *.trace rm -f module_03a.pi module_04import.pi module_06a.pi rm -rf _build .PHONY: realclean realclean: clean rm -rf *.plasma-dump_* ================================================ FILE: tests-old/modules-invalid/module_01.exp ================================================ module_01.p:10: The interface file for the imported module (Module_01a) cannot be found. Was the module listed in BUILD.plz? ================================================ FILE: tests-old/modules-invalid/module_01.p ================================================ /* * vim: ft=plasma * This is free and unencumbered software released into the public domain. * See ../LICENSE.unlicense */ module Module_01 // The imported module cannot be found. import Module_01a export func main() uses IO -> Int { return 0 } ================================================ FILE: tests-old/modules-invalid/module_02.exp ================================================ module_02a.pi:8: The interface file 'module_02a.pi' describes the wrong module, got: 'BogusName' expected: 'Module_02a' ================================================ FILE: tests-old/modules-invalid/module_02.p ================================================ /* * vim: ft=plasma * This is free and unencumbered software released into the public domain. * See ../LICENSE.unlicense */ module Module_02 // The interface matching this module name has the wrong module inside it. import Module_02a export func main() uses IO -> Int { return 0 } ================================================ FILE: tests-old/modules-invalid/module_03.exp ================================================ module_03.p:11: The import of 'Module_03a' clobbers a previous import to that name module_03.p:11: Warning: The import of 'Module_03a' is redundant, this module is already imported ================================================ FILE: tests-old/modules-invalid/module_03.p ================================================ /* * vim: ft=plasma * This is free and unencumbered software released into the public domain. * See ../LICENSE.unlicense */ module Module_03 // Duplicate import import Module_03a import Module_03a export func main() uses IO -> Int { return 0 } ================================================ FILE: tests-old/modules-invalid/module_03a.p ================================================ /* * vim: ft=plasma * This is free and unencumbered software released into the public domain. * See ../LICENSE.unlicense */ module Module_03a ================================================ FILE: tests-old/modules-invalid/module_04a.exp ================================================ module_04a.p:14: "int" and "string" are not the same ================================================ FILE: tests-old/modules-invalid/module_04a.p ================================================ /* * vim: ft=plasma * This is free and unencumbered software released into the public domain. * See ../LICENSE.unlicense */ module Module_04a import Module_04import export func main() uses IO -> Int { // Mismatched type in imported function's use. _ = Module_04import.someInt(3) return 0 } ================================================ FILE: tests-old/modules-invalid/module_04b.exp ================================================ module_04b.p:14: Wrong number of parameters in function call, expected 1 got 0 ================================================ FILE: tests-old/modules-invalid/module_04b.p ================================================ /* * vim: ft=plasma * This is free and unencumbered software released into the public domain. * See ../LICENSE.unlicense */ module Module_04b import Module_04import export func main() uses IO -> Int { // Mismatched number of parameters _ = Module_04import.someInt() return 0 } ================================================ FILE: tests-old/modules-invalid/module_04c.exp ================================================ module_04c.p:14: Arity error got 1 values, but 0 values were expected ================================================ FILE: tests-old/modules-invalid/module_04c.p ================================================ /* * vim: ft=plasma * This is free and unencumbered software released into the public domain. * See ../LICENSE.unlicense */ module Module_04c import Module_04import export func main() uses IO -> Int { // Mismatched arity Module_04import.someInt("Boo") return 0 } ================================================ FILE: tests-old/modules-invalid/module_04d.exp ================================================ module_04d.p:20: One or more resources needed for this call is unavailable in this function ================================================ FILE: tests-old/modules-invalid/module_04d.p ================================================ /* * vim: ft=plasma * This is free and unencumbered software released into the public domain. * See ../LICENSE.unlicense */ module Module_04d import Module_04import export func main() uses IO -> Int { _ = test() return 0 } func test() -> Int { // Mismatched resources Module_04import.someAction!() return 1 } ================================================ FILE: tests-old/modules-invalid/module_04import.p ================================================ /* * vim: ft=plasma * This is free and unencumbered software released into the public domain. * See ../LICENSE.unlicense */ module Module_04import export func someInt(v : String) -> Int { return 0 } export func someAction() uses IO {} ================================================ FILE: tests-old/modules-invalid/module_05.exp ================================================ A compilation error occured and this error is not handled gracefully by the Plasma bytecode linker. Sorry. Message: Cannot link two modules containing the same module plzlnk location: predicate `pz.link.calculate_offsets_and_build_maps'/20 plzlnk file: pz.link.m ================================================ FILE: tests-old/modules-invalid/module_05.p ================================================ /* * vim: ft=plasma * This is free and unencumbered software released into the public domain. * See ../LICENSE.unlicense */ module Module_05 // This file and module_05_.p contain the same module, linking them should // cause an error. export func main() uses IO -> Int { return 0 } ================================================ FILE: tests-old/modules-invalid/module_05_.p ================================================ /* * vim: ft=plasma * This is free and unencumbered software released into the public domain. * See ../LICENSE.unlicense */ module Module_05 export func main_() uses IO -> Int { return 0 } ================================================ FILE: tests-old/modules-invalid/module_06.exp ================================================ A compilation error occured and this error is not handled gracefully by the Plasma compiler. Sorry. Message: Unknown symbol: Module_06a.Foo Context: module_06.p:15 plzc location: predicate `pre.from_ast.ast_to_pre_expr_2'/7 plzc file: pre.from_ast.m ================================================ FILE: tests-old/modules-invalid/module_06.p ================================================ /* * vim: ft=plasma * This is free and unencumbered software released into the public domain. * See ../LICENSE.unlicense */ module Module_06 import Module_06a export func main() uses IO -> Int { // The foo type is abstractly-exported, we should not be able to access // the constructor. var f = Module_06a.Foo(3) Module_06a.Foo(var n) = f return 0 } ================================================ FILE: tests-old/modules-invalid/module_06a.p ================================================ /* * vim: ft=plasma * This is free and unencumbered software released into the public domain. * See ../LICENSE.unlicense */ module Module_06a export opaque type Foo = Foo ( a : Int ) export func makeFoo(n : Int) -> Foo { return Foo(n*3) } export func fooStr(f : Foo) -> String { Foo(var n) = f return "Foo(" ++ int_to_string(n) ++ ")" } ================================================ FILE: tests-old/modules-invalid/module_07.exp ================================================ module_07.p:9: The interface file for the imported module (Foo) cannot be found. Was the module listed in BUILD.plz? module_07.p:10: The import of 'Bar' clobbers 'F' which is used by a previous import module_07.p:10: The interface file for the imported module (Bar) cannot be found. Was the module listed in BUILD.plz? ================================================ FILE: tests-old/modules-invalid/module_07.p ================================================ /* * vim: ft=plasma * This is free and unencumbered software released into the public domain. * See ../LICENSE.unlicense */ module Module07 import Foo as F import Bar as F ================================================ FILE: tests-old/modules-invalid/module_08.c.p ================================================ /* * vim: ft=plasma * This is free and unencumbered software released into the public domain. * See ../LICENSE.unlicense */ module Module_08.C import Module_08.D as D export resource Res1 from IO export resource Res3 from D.Res2 export func test1() uses D.Res4 { } export func test2() uses Res3 { } ================================================ FILE: tests-old/modules-invalid/module_08.d.p ================================================ /* * vim: ft=plasma * This is free and unencumbered software released into the public domain. * See ../LICENSE.unlicense */ module Module_08.D import Module_08.C as C export resource Res2 from C.Res1 export resource Res4 from C.Res3 ================================================ FILE: tests-old/modules-invalid/module_08.expish ================================================ module_08.p:19: One or more resources needed for this call is unavailable in this function module_08.p:15: One or more resources needed for this call is unavailable in this function module_08.p:18: One or more resources needed for this call is unavailable in this function ================================================ FILE: tests-old/modules-invalid/module_08.p ================================================ /* * vim: ft=plasma * This is free and unencumbered software released into the public domain. * See ../LICENSE.unlicense */ module Module_08 // Import C but not D, show that we can use both C's resources, even the // one that depends on D. import Module_08.C as C func testCallsCRes3() uses IO { // Using a resource from Module D does not work. C.test1!() // Or even using a resource from module C that is "from" a resource in D C.test2!() my_test!() } func my_test() uses C.Res3 { } ================================================ FILE: tests-old/modules-invalid/module_08b.expish ================================================ module_08b.p:14: Unknown resource 'D.Res2' module_08b.p:14: Unknown resource 'Module_08.D.Res2' ================================================ FILE: tests-old/modules-invalid/module_08b.p ================================================ /* * vim: ft=plasma * This is free and unencumbered software released into the public domain. * See ../LICENSE.unlicense */ module Module_08b // Import C but not D, show that we can use both C's resources, even the // one that depends on D. import Module_08.C as C // These resources shouldn't exist in this environment. func bad_use() uses (D.Res2, Module_08.D.Res2) { } ================================================ FILE: tests-old/pzt/Makefile ================================================ # # This is free and unencumbered software released into the public domain. # See ../LICENSE.unlicense # # vim: noet sw=4 ts=4 # TOP=../.. .PHONY: all all: @echo This Makefile does not have an "all" target @echo Use the run_tests.sh script in the parent directory to run all tests @echo or use "make test_name.test" to run a single test. @false %.pzo : %.pzt $(TOP)/src/plzasm $(TOP)/src/plzasm $< %.pz : %.pzo $(TOP)/src/plzlnk $(TOP)/src/plzlnk -n ${subst .pz,,$@} -o $@ $< link_01.pz : link_01.pzo link_target_01.pzo $(TOP)/src/plzlnk $(TOP)/src/plzlnk -n ${subst .pz,,$@} -e link_01.main_closure -o $@ link_01.pzo link_target_01.pzo link_02.pz : link_02.pzo link_target_01.pzo $(TOP)/src/plzlnk $(TOP)/src/plzlnk -n ${subst .pz,,$@} -e link_02.main_closure -o $@ link_02.pzo link_target_01.pzo link_03.pz : link_03.pzo link_target_02.pzo $(TOP)/src/plzlnk $(TOP)/src/plzlnk -n ${subst .pz,,$@} -e link_03.main_closure -o $@ link_03.pzo link_target_02.pzo .PHONY: %.test %.test : %.exp %.out diff -u $^ .PHONY: %.gctest %.gctest : %.pz $(TOP)/runtime/plzrun PZ_RUNTIME_DEV_OPTS=gc_zealous $(TOP)/runtime/plzrun $< > /dev/null %.out : %.pz $(TOP)/runtime/plzrun $(TOP)/runtime/plzrun $< > $@ .PHONY: clean clean: rm -rf *.pz *.pzo *.out *.diff *.log .PHONY: realclean realclean: clean ================================================ FILE: tests-old/pzt/ccov.exp ================================================ Hello closure Hello proc Hello closure tail Hello proc tail Hello ind Hello ind tail ================================================ FILE: tests-old/pzt/ccov.pzt ================================================ // Test calling conventions // This is free and unencumbered software released into the public domain. // See ../LICENSE.unlicense module ccov; // Constant static data. // data NAME = TYPE VALUE; data hello_string = string { 72 101 108 108 111 32 }; data closure_string = string { 99 108 111 115 117 114 101 10 }; data proc_string = string { 112 114 111 99 10 }; data closure_tail_string = string { 99 108 111 115 117 114 101 32 116 97 105 108 10 }; data proc_tail_string = string { 112 114 111 99 32 116 97 105 108 10 }; data ind_string = string { 105 110 100 10 }; data ind_tail_string = string { 105 110 100 32 116 97 105 108 10 }; // Forward declaration for imported procedure. // These are required for the assembler to build the string table and will // be encoded into the PZ bytecode so that a code generator can see the // signature of the call. import Builtin.print (ptr - ); import Builtin.string_concat (ptr ptr - ptr); proc test_proc (ptr - ) { get_env dup load main_env_struct 2:ptr load main_env_struct 3:ptr drop // Stack: who env greeting strcat pick 4 swap call_ind // Stack: who env message swap load main_env_struct 1:ptr drop // Stack: who message print call_ind drop ret }; // proc test_proc_tcall (ptr - ) { // get_env // dup // load main_env_struct 2:ptr // load main_env_struct 3:ptr // drop // // Stack: who env greeting strcat // roll 4 // swap // call_ind // // // Stack: env message // swap // load main_env_struct 1:ptr drop // // Stack: message print // tcall_ind // }; closure test_clo = test_proc main_env; proc tcall_test1 ( - ) { // A closure tail call. get_env load main_env_struct 6:ptr drop tcall test_clo }; proc tcall_test2 ( - ) { // A proc tail call. get_env load main_env_struct 7:ptr drop tcall test_proc }; proc tcall_test3 ( - ) { // A proc tail call. get_env load main_env_struct 9:ptr load main_env_struct 10:ptr drop tcall_ind }; proc main_proc (- w) { get_env // Use a closure call to the same environment. load main_env_struct 4:ptr swap call test_clo // use a proc call, this is an optimsation, but it's very common. load main_env_struct 5:ptr swap call test_proc call tcall_test1 call tcall_test2 // use a indirect call. load main_env_struct 8:ptr load main_env_struct 10:ptr roll 3 roll 3 call_ind call tcall_test3 drop 0 ret }; struct main_env_struct { ptr ptr ptr ptr ptr ptr ptr ptr ptr ptr }; data main_env = main_env_struct { Builtin.print hello_string Builtin.string_concat closure_string proc_string closure_tail_string proc_tail_string ind_string ind_tail_string test_clo }; // Build a closure. export closure main_closure = main_proc main_env; entry main_closure; ================================================ FILE: tests-old/pzt/closure.exp ================================================ Hello Goodbye ================================================ FILE: tests-old/pzt/closure.pzt ================================================ // Hello world example // This is free and unencumbered software released into the public domain. // See ../LICENSE.unlicense module closure_; data hello_string = string { 72 101 108 108 111 10 }; import Builtin.print (ptr - ); proc main_p (- w) { // Place the current environment on the stack for later checking. get_env // Make and call a closure. dup load main_s 1:ptr drop get_env alloc my_env store my_env 1:ptr store my_env 2:ptr make_closure foo call_ind // Call the statically created closure get_env load main_s 3:ptr drop call_ind // Get the env again and compare it with the previous one. get_env // Should return zero. eq not ret }; struct my_env { ptr ptr }; proc foo (-) { get_env load my_env 2:ptr load my_env 1:ptr drop load main_s 2:ptr drop call_ind ret }; data goodbye_string = string { 71 111 111 100 98 121 101 10 }; data closure2_env = my_env { main_d goodbye_string }; closure closure2 = foo closure2_env; struct main_s { ptr ptr ptr }; data main_d = main_s { hello_string Builtin.print closure2 }; export closure main = main_p main_d; entry main; ================================================ FILE: tests-old/pzt/fib.exp ================================================ fibs(35) = 14930352 ================================================ FILE: tests-old/pzt/fib.pzt ================================================ // This is free and unencumbered software released into the public domain. // See ../LICENSE.unlicense module fib; import Builtin.print (ptr - ); import Builtin.int_to_string (w - ptr); proc print_int (w -) { call Builtin.int_to_string call Builtin.print ret }; proc fibs (w - w) { block entry_ { // if the input is less than two jump to the base case dup 2 lt_u cjmp base // Otherwise execute the recursive calls, and add their results. dup 1 sub call fibs swap 2 sub call fibs add ret } block base { drop 1 ret } }; proc main_p ( - w) { get_env load main_s 3:ptr load main_s 2:ptr load main_s 1:ptr drop // consume label1 call Builtin.print 35 call print_int // Consume label2 call Builtin.print 35 call fibs call Builtin.int_to_string call Builtin.print // Consome nl call Builtin.print 0 ret }; data nl = string { 10 0 }; data label1 = string { 102 105 98 115 40 }; data label2 = string { 41 32 61 32 }; struct main_s { ptr ptr ptr }; data main_d = main_s { label1 label2 nl }; export closure main = main_p main_d; entry main; ================================================ FILE: tests-old/pzt/hello.exp ================================================ Hello ================================================ FILE: tests-old/pzt/hello.pzt ================================================ // Hello world example // This is free and unencumbered software released into the public domain. // See ../LICENSE.unlicense module hello; // Entries all begin with a keyword saying what type of entry they // are. Here we have data and proc. Extra keywords will be needed later // for sharing/linkage stuff. // Constant static data. // data NAME = TYPE VALUE; data hello_string = string { 72 101 108 108 111 10 }; // Forward declaration for imported procedure. // These are required for the assembler to build the string table and will // be encoded into the PZ bytecode so that a code generator can see the // signature of the call. import Builtin.print (ptr - ); proc main_proc (- w) { get_env load main_env_struct 2:ptr load main_env_struct 1:ptr drop call_ind 0 ret }; struct main_env_struct { ptr ptr }; data main_env = main_env_struct { Builtin.print hello_string }; // Build a closure. export closure main_closure = main_proc main_env; entry main_closure; ================================================ FILE: tests-old/pzt/link_01.exp ================================================ Hello ================================================ FILE: tests-old/pzt/link_01.p ================================================ ================================================ FILE: tests-old/pzt/link_01.pzt ================================================ module link_01; data hello_string = string { 72 101 108 108 111 10 }; import Builtin.print (ptr - ); proc main_proc (- w) { get_env load main_env_struct 2:ptr load main_env_struct 1:ptr drop call_ind 0 ret }; struct main_env_struct { ptr ptr }; data main_env = main_env_struct { Builtin.print hello_string }; // Build a closure. export closure link_01.main_closure = main_proc main_env; entry link_01.main_closure; ================================================ FILE: tests-old/pzt/link_02.exp ================================================ Hello goodbye ================================================ FILE: tests-old/pzt/link_02.pzt ================================================ module link_02; data hello_string = string { 72 101 108 108 111 10 }; import Builtin.print (ptr - ); import link_target_01.goodbye_closure ( - ); proc main_proc (- w) { get_env load main_env_struct 2:ptr load main_env_struct 1:ptr drop call_ind get_env load main_env_struct 3:ptr drop call_ind 0 ret }; struct main_env_struct { ptr ptr ptr }; data main_env = main_env_struct { Builtin.print hello_string link_target_01.goodbye_closure }; // Build a closure. export closure link_02.main_closure = main_proc main_env; entry link_02.main_closure; ================================================ FILE: tests-old/pzt/link_03.exp ================================================ Hello Paul goodbye ================================================ FILE: tests-old/pzt/link_03.pzt ================================================ module link_03; data hello_string = string { 72 101 108 108 111 10 }; data name_string = string { 80 97 117 108 10 }; import Builtin.print (ptr - ); import link_target_02.goodbye_closure ( - ); proc main_proc (- w) { get_env load main_env_struct 2:ptr load main_env_struct 1:ptr drop call_ind get_env load main_env_struct 3:ptr drop call_ind 0 ret }; proc name_proc (- w) { get_env load main_env_struct 4:ptr drop ret }; struct main_env_struct { ptr ptr ptr ptr }; data main_env = main_env_struct { Builtin.print hello_string link_target_02.goodbye_closure name_string }; // Build a closure. export closure link_03.main_closure = main_proc main_env; entry link_03.main_closure; export closure link_03.name_closure = name_proc main_env; ================================================ FILE: tests-old/pzt/link_target_01.pzt ================================================ module link_target_01; data goodbye_string = string { 103 111 111 100 98 121 101 10 }; import Builtin.print (ptr - ); proc goodbye_proc (-) { get_env load goodbye_env_struct 2:ptr load goodbye_env_struct 1:ptr drop call_ind ret }; struct goodbye_env_struct { ptr ptr }; data goodbye_env = goodbye_env_struct { Builtin.print goodbye_string }; // Build a closure. export closure link_target_01.goodbye_closure = goodbye_proc goodbye_env; ================================================ FILE: tests-old/pzt/link_target_02.pzt ================================================ module link_target_02; data goodbye_string = string { 103 111 111 100 98 121 101 10 }; import Builtin.print (ptr - ); import link_03.name_closure (- ptr); proc goodbye_proc (-) { get_env load goodbye_env_struct 3:ptr drop call_ind get_env load goodbye_env_struct 1:ptr drop call_ind get_env load goodbye_env_struct 2:ptr load goodbye_env_struct 1:ptr drop call_ind ret }; struct goodbye_env_struct { ptr ptr ptr }; data goodbye_env = goodbye_env_struct { Builtin.print goodbye_string link_03.name_closure }; // Build a closure. export closure link_target_02.goodbye_closure = goodbye_proc goodbye_env; ================================================ FILE: tests-old/pzt/memory.exp ================================================ 15 120 ================================================ FILE: tests-old/pzt/memory.pzt ================================================ // Test memory operations // This is free and unencumbered software released into the public domain. // See ../LICENSE.unlicense module memory; struct cons { w ptr }; import Builtin.print (ptr - ); import Builtin.int_to_string (w - ptr); import Builtin.string_concat (ptr ptr - ptr); proc print_int_nl(w -) { call Builtin.int_to_string get_env load main_s 1:ptr drop call Builtin.string_concat call Builtin.print ret }; proc make_list(w - ptr) { block entry_ { dup 0 eq cjmp base jmp rec } block base { drop 0 ze:w:ptr ret } block rec { dup 1 sub call make_list alloc cons // On the stack are: word1 word2 ptr, store returns the ptr so we // can chain these. store cons 2:ptr store cons 1:ptr ret } }; proc sum_list(w ptr - w) { block entry_ { dup 0 ze:w:ptr eq cjmp base jmp rec } block base { drop ret } block rec { // acc0 ptr0 load cons 1:ptr // acc0 val ptr0 swap roll 3 add swap // acc ptr0 load cons 2:ptr drop // acc ptr tcall sum_list } }; proc mul_list(ptr - w) { block entry_ { dup 0 ze:w:ptr eq cjmp base jmp rec } block base { drop ret } block rec { // acc0 ptr0 load cons 1:ptr // acc0 ptr0 val swap roll 3 mul swap // acc ptr0 load cons 2:ptr drop // acc ptr tcall mul_list } }; proc main_p (- w) { 5 call make_list dup 0 swap call sum_list call print_int_nl 1 swap call mul_list call print_int_nl 0 ret }; data nl_string = string { 10 }; struct main_s { ptr }; data main_d = main_s { nl_string }; export closure main = main_p main_d; entry main; ================================================ FILE: tests-old/pzt/mutual.exp ================================================ 35 is odd ================================================ FILE: tests-old/pzt/mutual.pzt ================================================ // This is free and unencumbered software released into the public domain. // See ../LICENSE.unlicense module mutual; import Builtin.print (ptr - ); import Builtin.int_to_string (w - ptr); proc neq (w w - w) { eq not ret }; proc is_odd (w - w) { block entry_ { // If the input doesn't equal 0 then make a recursive call dup 0 call neq cjmp reccall // Otherwise return false drop 0 ret } block reccall { 1 sub tcall is_even } }; proc is_even (w - w) { block entry_ { // If the input doesn't equal 0 then make a recursive call dup 0 call neq cjmp reccall // Otherwise return true drop 1 ret } block reccall { 1 sub tcall is_odd } }; proc main_p ( - w) { block entry_ { 35 call is_odd 0 eq cjmp even_block get_env load main_s 2:ptr drop call Builtin.print 0 ret } block even_block { get_env load main_s 1:ptr drop call Builtin.print 0 ret } }; data is_even_label = string { 51 53 32 105 115 32 101 118 101 110 10 }; data is_odd_label = string { 51 53 32 105 115 32 111 100 100 10 }; struct main_s { ptr ptr }; data main_d = main_s { is_even_label is_odd_label }; export closure main = main_p main_d; entry main; ================================================ FILE: tests-old/pzt/stack.exp ================================================ dup 4 4 3 2 1 drop 3 2 1 swap 3 4 2 1 roll(3) 2 4 3 1 roll(4) 1 4 3 2 pick(3) 2 4 3 2 1 pick(4) 1 4 3 2 1 ================================================ FILE: tests-old/pzt/stack.pzt ================================================ // Stack manipulations // This is free and unencumbered software released into the public domain. // See ../LICENSE.unlicense module stack; import Builtin.print (ptr - ); import Builtin.int_to_string (w - ptr); proc print_int (w -) { call Builtin.int_to_string call Builtin.print get_env load main_s 1:ptr drop call Builtin.print ret }; proc print_int_n (w -) { block entry_ { dup 0 eq not cjmp rec drop ret } block rec { swap call print_int 1 sub tcall print_int_n } }; proc print_nl (-) { get_env load main_s 2:ptr drop call Builtin.print ret }; proc values (- w w w w) { 1 2 3 4 ret }; proc main_p (- w) { // 0 goes on the stack now as the program's return code, and to show // that it is undisturbed doring the test. 0 get_env load main_s 3:ptr swap call Builtin.print call values dup 5 call print_int_n call print_nl load main_s 4:ptr swap call Builtin.print call values drop 3 call print_int_n call print_nl load main_s 5:ptr swap call Builtin.print call values swap 4 call print_int_n call print_nl load main_s 6:ptr swap call Builtin.print call values roll 3 4 call print_int_n call print_nl load main_s 7:ptr swap call Builtin.print call values roll 4 4 call print_int_n call print_nl load main_s 8:ptr swap call Builtin.print call values pick 3 5 call print_int_n call print_nl load main_s 9:ptr swap call Builtin.print call values pick 4 5 call print_int_n call print_nl drop // env ret // 0 }; data space = string {32}; data nl = string {10}; data dup_str = string {100 117 112 32}; data drop_str = string {100 114 111 112 32}; data swap_str = string {115 119 97 112 32}; data roll3_str = string {114 111 108 108 40 51 41 32}; data roll4_str = string {114 111 108 108 40 52 41 32}; data pick3_str = string {112 105 99 107 40 51 41 32}; data pick4_str = string {112 105 99 107 40 52 41 32}; struct main_s { ptr ptr ptr ptr ptr ptr ptr ptr ptr }; data main_d = main_s { space nl dup_str drop_str swap_str roll3_str roll4_str pick3_str pick4_str }; export closure main = main_p main_d; entry main; ================================================ FILE: tests-old/pzt/struct.exp ================================================ Hello 3 9 27 ================================================ FILE: tests-old/pzt/struct.pzt ================================================ // Structs example // This is free and unencumbered software released into the public domain. // See ../LICENSE.unlicense module struct_; data hello_string = string { 72 101 108 108 111 10 }; struct test_struct { ptr w16 w16 w }; // Test that a data item can create a struct. data test_data = test_struct { hello_string 3 9 27 }; import Builtin.print (ptr - ); import Builtin.int_to_string (w - ptr); import Builtin.string_concat (ptr ptr - ptr); proc main_p (- w) { get_env load main_s 1:ptr drop load test_struct 1 :ptr swap call Builtin.print load test_struct 2 :w16 swap ze:w16:w call print_int load test_struct 3 :w16 swap ze:w16:w call print_int load test_struct 4 :w drop call print_int 0 ret }; data nl = string { 10 0 }; proc print_int(w -) { call Builtin.int_to_string get_env load main_s 2:ptr drop call Builtin.string_concat call Builtin.print ret }; struct main_s { ptr ptr }; data main_d = main_s { test_data nl }; export closure main = main_p main_d; entry main; ================================================ FILE: tests-old/pzt/tags.exp ================================================ 12 13 38 39 256 0 256 1 256 2 256 3 64 0 64 1 64 2 64 3 ================================================ FILE: tests-old/pzt/tags.pzt ================================================ // Hello world example // This is free and unencumbered software released into the public domain. // See ../LICENSE.unlicense module tags; data nl_string = string { 10 }; data spc_string = string { 32 }; import Builtin.print (ptr - ); import Builtin.int_to_string (w - ptr); import Builtin.string_concat (ptr ptr - ptr); import Builtin.make_tag (ptr ptr - ptr); import Builtin.shift_make_tag (ptr ptr - ptr); import Builtin.break_tag (ptr - ptr ptr); import Builtin.break_shift_tag (ptr - ptr ptr); proc print_int_nl(w -) { call Builtin.int_to_string get_env load main_s 1:ptr drop call Builtin.string_concat call Builtin.print ret }; proc print_2_int_nl(w w -) { swap call Builtin.int_to_string swap call Builtin.int_to_string // spc get_env load main_s 2:ptr drop swap // nl get_env load main_s 1:ptr drop call Builtin.string_concat call Builtin.string_concat call Builtin.string_concat call Builtin.print ret }; proc main_p (- w) { 12 ze:w32:ptr 0 ze:w32:ptr call Builtin.make_tag call print_int_nl 12 ze:w32:ptr 1 ze:w32:ptr call Builtin.make_tag call print_int_nl 9 ze:w32:ptr 2 ze:w32:ptr call Builtin.shift_make_tag call print_int_nl 9 ze:w32:ptr 3 ze:w32:ptr call Builtin.shift_make_tag call print_int_nl 256 ze:w32:ptr call Builtin.break_tag call print_2_int_nl 257 ze:w32:ptr call Builtin.break_tag call print_2_int_nl 258 ze:w32:ptr call Builtin.break_tag call print_2_int_nl 259 ze:w32:ptr call Builtin.break_tag call print_2_int_nl 256 ze:w32:ptr call Builtin.break_shift_tag call print_2_int_nl 257 ze:w32:ptr call Builtin.break_shift_tag call print_2_int_nl 258 ze:w32:ptr call Builtin.break_shift_tag call print_2_int_nl 259 ze:w32:ptr call Builtin.break_shift_tag call print_2_int_nl 0 ret }; struct main_s { ptr ptr }; data main_d = main_s { nl_string spc_string }; export closure main = main_p main_d; entry main; ================================================ FILE: tests-old/pzt/temperature.exp ================================================ 0 degrees celcius is 32 degrees farrenheit. -40 degrees celcius is -40 degrees farrenheit. 37 degrees celcius is 98 degrees farrenheit. ================================================ FILE: tests-old/pzt/temperature.pzt ================================================ // Temperature conversion example // This example demonstrates some arithmatic. // This is free and unencumbered software released into the public domain. // See ../LICENSE.unlicense module temperature; import Builtin.print (ptr - ); import Builtin.int_to_string (w - ptr); proc c_to_f (w - w) { 9 mul 5 div 32 add ret }; proc print_int (w -) { call Builtin.int_to_string call Builtin.print ret }; proc print_c_to_f (w w -) { // do this with swap to Builtin.print C first swap call print_int get_env load main_s 1:ptr drop call Builtin.print call print_int get_env load main_s 2:ptr drop call Builtin.print ret }; proc do_c_to_f (w -) { dup call c_to_f tcall print_c_to_f }; proc main_p (- w) { 0 call do_c_to_f -40 call do_c_to_f 37 call do_c_to_f 0 ret }; data c_is_string = string {32 100 101 103 114 101 101 115 32 99 101 108 99 105 117 115 32 105 115 32}; data f_string = string {32 100 101 103 114 101 101 115 32 102 97 114 114 101 110 104 101 105 116 46 10}; struct main_s { ptr ptr }; data main_d = main_s { c_is_string f_string }; export closure main = main_p main_d; entry main; ================================================ FILE: tests-old/pzt/trunc_ze_se.exp ================================================ 1130 106 255 -1 -1 65535 18 ================================================ FILE: tests-old/pzt/trunc_ze_se.pzt ================================================ // This is free and unencumbered software released into the public domain. // See ../LICENSE.unlicense module trunc_ze_se; import Builtin.print (ptr - ); import Builtin.int_to_string (w - ptr); proc print_int (w -) { call Builtin.int_to_string call Builtin.print get_env load main_s 1:ptr drop call Builtin.print ret }; proc main_p ( - w) { 66666 trunc:w:w16 ze:w16:w call print_int 66666 trunc:w:w8 ze:w8:w call print_int 255:w8 ze:w8:w call print_int 255:w8 se:w8:w call print_int 255:w8 se:w8:w16 se:w16:w call print_int 255:w8 se:w8:w16 ze:w16:w call print_int 254:w8 20:w8 add:w8 ze:w8:w call print_int 0 ret }; data nl = string { 10 0 }; struct main_s { ptr }; data main_d = main_s { nl }; export closure main = main_p main_d; entry main; ================================================ FILE: tests-old/run_tests.sh ================================================ #!/bin/sh # # This is free and unencumbered software released into the public domain. # See ../LICENSE.unlicense # # vim: noet sw=4 ts=4 # set -e NUM_TESTS=0 NUM_SUCCESSES=0 FAILURE=0 TESTS="" FAILING_TESTS="" WORKING_DIR=$(pwd) TEST_GROUP=$1 if [ "$CI" = "true" ]; then LONG_OUTPUT=1 else LONG_OUTPUT=0 fi which tput > /dev/null if [ $? -a "$TERM" != "" ]; then if [ 8 -le "$(tput colors)" ]; then TTY_TEST_SUCC=$(tput setaf 2)$(tput bold) TTY_TEST_FAIL=$(tput setaf 1)$(tput bold) TTY_RST=$(tput sgr0) fi fi for EXPFILE in pzt/*.exp; do if [ -f "$EXPFILE" ]; then TESTS="$TESTS ${EXPFILE%.exp}" fi done # plzbuild/ninja won't rebuild things if the compiler binaries change, so # make sure it rebuilds things and regenerates the ninja files # # However touching the build files won't update ninja.rules, instead remove # all the _build directories. STALE_BUILD_DIRS=$(find . -name _build -type d) if [ -n "$STALE_BUILD_DIRS" ]; then rm -r $STALE_BUILD_DIRS fi DIRS="modules-invalid" for DIR in $DIRS; do for EXPFILE in $DIR/*.exp; do if [ -f "$EXPFILE" ]; then TESTS="$TESTS ${EXPFILE%.exp}" fi done for EXPFILE in $DIR/*.expish; do if [ -f "$EXPFILE" ]; then TESTS="$TESTS ${EXPFILE%.expish}" fi done done for TEST in $TESTS; do NAME=$(basename $TEST .test) DIR=$(dirname $TEST) # Wrapping this up in a test and negating it is a bit annoying, but it # was the easy way I could redirect the output and errors successfully. case "$TEST_GROUP" in rel) if [ $TEST = valid/allocateLots ]; then continue fi ;; gc) case "$TEST" in valid/die|valid/noentry) continue ;; *invalid/*|../examples/*) continue ;; esac ;; esac cd $DIR if [ "$LONG_OUTPUT" = "1" ]; then echo -n "$DIR/$NAME..." fi if [ "$TEST_GROUP" = "gc" ]; then TARGET_TYPE=gctest else TARGET_TYPE=test fi trap 'echo; echo Interrupted $DIR/$NAME; exit 1' INT if make "$NAME.$TARGET_TYPE" >"$NAME.log" 2>&1; then if [ "$LONG_OUTPUT" = "1" ]; then printf "%s pass%s" "$TTY_TEST_SUCC" "$TTY_RST" else printf '%s.%s' "$TTY_TEST_SUCC" "$TTY_RST" fi NUM_SUCCESSES=$(($NUM_SUCCESSES + 1)) else if [ "$LONG_OUTPUT" = "1" ]; then printf "%s fail%s" "$TTY_TEST_FAIL" "$TTY_RST" else printf '%s*%s' "$TTY_TEST_FAIL" "$TTY_RST" fi FAILURE=1 FAILING_TESTS="$FAILING_TESTS $TEST" fi trap - INT if [ "$LONG_OUTPUT" = "1" ]; then printf '\n' fi cd $WORKING_DIR NUM_TESTS=$(($NUM_TESTS + 1)) done printf '\n' if [ $FAILURE -eq 0 ]; then printf '%sAll %d tests passed %s\n' "$TTY_TEST_SUCC" "$NUM_TESTS" "$TTY_RST" else NUM_FAILED=$(( $NUM_TESTS - $NUM_SUCCESSES )) printf '%d out of %d passed, ' "$NUM_SUCCESSES" "$NUM_TESTS" printf '%s%d failed%s\n' "$TTY_TEST_FAIL" "$NUM_FAILED" "$TTY_RST" printf 'Failing tests: \n\t%s\n' "$(echo $FAILING_TESTS | sed -e 's/ /\n\t/g')" fi exit $FAILURE