From 0c32c7f03ad1f8f0db54b623dc407713bbf8cacd Mon Sep 17 00:00:00 2001 From: Eduardo Julian Date: Wed, 6 Jul 2022 12:05:43 -0400 Subject: Moved compiler machinery under lux/meta. --- stdlib/source/documentation/lux/extension.lux | 3 +- stdlib/source/experiment/compiler.lux | 2 +- stdlib/source/experiment/tool/interpreter.lux | 227 ++ stdlib/source/experiment/tool/mediator.lux | 20 + stdlib/source/library/lux/documentation.lux | 3 +- stdlib/source/library/lux/extension.lux | 3 +- stdlib/source/library/lux/ffi/export.js.lux | 3 +- stdlib/source/library/lux/ffi/export.lua.lux | 3 +- stdlib/source/library/lux/ffi/export.py.lux | 3 +- stdlib/source/library/lux/ffi/export.rb.lux | 3 +- stdlib/source/library/lux/math.lux | 3 +- stdlib/source/library/lux/meta/compiler.lux | 59 + stdlib/source/library/lux/meta/compiler/arity.lux | 17 + .../library/lux/meta/compiler/default/init.lux | 291 +++ .../library/lux/meta/compiler/default/platform.lux | 888 +++++++ .../library/lux/meta/compiler/language/lux.lux | 105 + .../lux/meta/compiler/language/lux/analysis.lux | 387 +++ .../compiler/language/lux/analysis/complex.lux | 98 + .../compiler/language/lux/analysis/coverage.lux | 423 +++ .../compiler/language/lux/analysis/evaluation.lux | 77 + .../compiler/language/lux/analysis/inference.lux | 282 ++ .../meta/compiler/language/lux/analysis/macro.lux | 56 + .../meta/compiler/language/lux/analysis/module.lux | 216 ++ .../compiler/language/lux/analysis/pattern.lux | 85 + .../meta/compiler/language/lux/analysis/scope.lux | 193 ++ .../meta/compiler/language/lux/analysis/simple.lux | 65 + .../meta/compiler/language/lux/analysis/type.lux | 133 + .../lux/meta/compiler/language/lux/declaration.lux | 102 + .../lux/meta/compiler/language/lux/generation.lux | 398 +++ .../meta/compiler/language/lux/phase/analysis.lux | 136 + .../compiler/language/lux/phase/analysis/case.lux | 364 +++ .../language/lux/phase/analysis/complex.lux | 433 +++ .../language/lux/phase/analysis/function.lux | 141 + .../language/lux/phase/analysis/reference.lux | 115 + .../language/lux/phase/analysis/simple.lux | 33 + .../compiler/language/lux/phase/declaration.lux | 125 + .../meta/compiler/language/lux/phase/extension.lux | 196 ++ .../language/lux/phase/extension/analysis.lux | 16 + .../lux/phase/extension/analysis/common_lisp.lux | 13 + .../language/lux/phase/extension/analysis/js.lux | 233 ++ .../language/lux/phase/extension/analysis/jvm.lux | 2754 ++++++++++++++++++++ .../language/lux/phase/extension/analysis/lua.lux | 267 ++ .../language/lux/phase/extension/analysis/lux.lux | 313 +++ .../language/lux/phase/extension/analysis/php.lux | 221 ++ .../lux/phase/extension/analysis/python.lux | 245 ++ .../language/lux/phase/extension/analysis/r.lux | 37 + .../language/lux/phase/extension/analysis/ruby.lux | 214 ++ .../lux/phase/extension/analysis/scheme.lux | 164 ++ .../language/lux/phase/extension/bundle.lux | 29 + .../lux/phase/extension/declaration/jvm.lux | 984 +++++++ .../lux/phase/extension/declaration/lux.lux | 570 ++++ .../lux/phase/extension/generation/common_lisp.lux | 18 + .../extension/generation/common_lisp/common.lux | 182 ++ .../extension/generation/common_lisp/host.lux | 15 + .../language/lux/phase/extension/generation/js.lux | 18 + .../lux/phase/extension/generation/js/common.lux | 253 ++ .../lux/phase/extension/generation/js/host.lux | 162 ++ .../lux/phase/extension/generation/jvm.lux | 20 + .../lux/phase/extension/generation/jvm/common.lux | 414 +++ .../lux/phase/extension/generation/jvm/host.lux | 1390 ++++++++++ .../lux/phase/extension/generation/lua.lux | 18 + .../lux/phase/extension/generation/lua/common.lux | 239 ++ .../lux/phase/extension/generation/lua/host.lux | 202 ++ .../lux/phase/extension/generation/php.lux | 18 + .../lux/phase/extension/generation/php/common.lux | 194 ++ .../lux/phase/extension/generation/php/host.lux | 145 ++ .../lux/phase/extension/generation/python.lux | 18 + .../phase/extension/generation/python/common.lux | 246 ++ .../lux/phase/extension/generation/python/host.lux | 169 ++ .../language/lux/phase/extension/generation/r.lux | 18 + .../lux/phase/extension/generation/r/common.lux | 181 ++ .../lux/phase/extension/generation/r/host.lux | 42 + .../lux/phase/extension/generation/ruby.lux | 18 + .../lux/phase/extension/generation/ruby/common.lux | 243 ++ .../lux/phase/extension/generation/ruby/host.lux | 138 + .../lux/phase/extension/generation/scheme.lux | 18 + .../phase/extension/generation/scheme/common.lux | 177 ++ .../lux/phase/extension/generation/scheme/host.lux | 111 + .../language/lux/phase/extension/synthesis.lux | 11 + .../language/lux/phase/generation/common_lisp.lux | 60 + .../lux/phase/generation/common_lisp/case.lux | 263 ++ .../lux/phase/generation/common_lisp/extension.lux | 14 + .../generation/common_lisp/extension/common.lux | 138 + .../lux/phase/generation/common_lisp/function.lux | 104 + .../lux/phase/generation/common_lisp/loop.lux | 72 + .../lux/phase/generation/common_lisp/primitive.lux | 22 + .../lux/phase/generation/common_lisp/reference.lux | 14 + .../lux/phase/generation/common_lisp/runtime.lux | 305 +++ .../lux/phase/generation/common_lisp/structure.lux | 38 + .../language/lux/phase/generation/extension.lux | 78 + .../compiler/language/lux/phase/generation/js.lux | 90 + .../language/lux/phase/generation/js/case.lux | 346 +++ .../language/lux/phase/generation/js/function.lux | 131 + .../language/lux/phase/generation/js/loop.lux | 116 + .../language/lux/phase/generation/js/primitive.lux | 22 + .../language/lux/phase/generation/js/reference.lux | 14 + .../language/lux/phase/generation/js/runtime.lux | 826 ++++++ .../language/lux/phase/generation/js/structure.lux | 37 + .../compiler/language/lux/phase/generation/jvm.lux | 79 + .../language/lux/phase/generation/jvm/case.lux | 327 +++ .../language/lux/phase/generation/jvm/debug.lux | 31 + .../language/lux/phase/generation/jvm/function.lux | 193 ++ .../lux/phase/generation/jvm/function/abstract.lux | 26 + .../generation/jvm/function/field/constant.lux | 27 + .../jvm/function/field/constant/arity.lux | 17 + .../generation/jvm/function/field/variable.lux | 57 + .../jvm/function/field/variable/count.lux | 35 + .../jvm/function/field/variable/foreign.lux | 40 + .../jvm/function/field/variable/partial.lux | 59 + .../lux/phase/generation/jvm/function/method.lux | 15 + .../phase/generation/jvm/function/method/apply.lux | 159 ++ .../jvm/function/method/implementation.lux | 59 + .../phase/generation/jvm/function/method/init.lux | 105 + .../phase/generation/jvm/function/method/new.lux | 82 + .../phase/generation/jvm/function/method/reset.lux | 51 + .../language/lux/phase/generation/jvm/host.lux | 194 ++ .../language/lux/phase/generation/jvm/loop.lux | 95 + .../lux/phase/generation/jvm/primitive.lux | 134 + .../language/lux/phase/generation/jvm/program.lux | 168 ++ .../lux/phase/generation/jvm/reference.lux | 74 + .../language/lux/phase/generation/jvm/runtime.lux | 659 +++++ .../lux/phase/generation/jvm/structure.lux | 97 + .../language/lux/phase/generation/jvm/type.lux | 24 + .../language/lux/phase/generation/jvm/value.lux | 50 + .../compiler/language/lux/phase/generation/lua.lux | 90 + .../language/lux/phase/generation/lua/case.lux | 304 +++ .../language/lux/phase/generation/lua/function.lux | 144 + .../language/lux/phase/generation/lua/loop.lux | 124 + .../lux/phase/generation/lua/primitive.lux | 17 + .../lux/phase/generation/lua/reference.lux | 14 + .../language/lux/phase/generation/lua/runtime.lux | 452 ++++ .../lux/phase/generation/lua/structure.lux | 36 + .../compiler/language/lux/phase/generation/php.lux | 110 + .../language/lux/phase/generation/php/case.lux | 297 +++ .../lux/phase/generation/php/extension.lux | 14 + .../lux/phase/generation/php/extension/common.lux | 113 + .../language/lux/phase/generation/php/function.lux | 117 + .../language/lux/phase/generation/php/loop.lux | 125 + .../lux/phase/generation/php/primitive.lux | 31 + .../lux/phase/generation/php/reference.lux | 14 + .../language/lux/phase/generation/php/runtime.lux | 635 +++++ .../lux/phase/generation/php/structure.lux | 42 + .../language/lux/phase/generation/python.lux | 80 + .../language/lux/phase/generation/python/case.lux | 362 +++ .../lux/phase/generation/python/function.lux | 117 + .../language/lux/phase/generation/python/loop.lux | 127 + .../lux/phase/generation/python/primitive.lux | 19 + .../lux/phase/generation/python/reference.lux | 14 + .../lux/phase/generation/python/runtime.lux | 486 ++++ .../lux/phase/generation/python/structure.lux | 36 + .../compiler/language/lux/phase/generation/r.lux | 62 + .../language/lux/phase/generation/r/case.lux | 242 ++ .../language/lux/phase/generation/r/function.lux | 118 + .../language/lux/phase/generation/r/loop.lux | 66 + .../language/lux/phase/generation/r/primitive.lux | 19 + .../lux/phase/generation/r/procedure/common.lux | 291 +++ .../lux/phase/generation/r/procedure/host.lux | 90 + .../language/lux/phase/generation/r/reference.lux | 14 + .../language/lux/phase/generation/r/runtime.lux | 882 +++++++ .../language/lux/phase/generation/r/structure.lux | 41 + .../language/lux/phase/generation/reference.lux | 99 + .../language/lux/phase/generation/ruby.lux | 80 + .../language/lux/phase/generation/ruby/case.lux | 382 +++ .../lux/phase/generation/ruby/function.lux | 123 + .../language/lux/phase/generation/ruby/loop.lux | 96 + .../lux/phase/generation/ruby/primitive.lux | 17 + .../lux/phase/generation/ruby/reference.lux | 14 + .../language/lux/phase/generation/ruby/runtime.lux | 629 +++++ .../lux/phase/generation/ruby/structure.lux | 36 + .../language/lux/phase/generation/scheme.lux | 62 + .../language/lux/phase/generation/scheme/case.lux | 225 ++ .../lux/phase/generation/scheme/extension.lux | 14 + .../phase/generation/scheme/extension/common.lux | 179 ++ .../lux/phase/generation/scheme/function.lux | 102 + .../language/lux/phase/generation/scheme/loop.lux | 65 + .../lux/phase/generation/scheme/primitive.lux | 17 + .../lux/phase/generation/scheme/reference.lux | 14 + .../lux/phase/generation/scheme/runtime.lux | 389 +++ .../lux/phase/generation/scheme/structure.lux | 41 + .../meta/compiler/language/lux/phase/synthesis.lux | 110 + .../compiler/language/lux/phase/synthesis/case.lux | 467 ++++ .../language/lux/phase/synthesis/function.lux | 291 +++ .../compiler/language/lux/phase/synthesis/loop.lux | 219 ++ .../language/lux/phase/synthesis/variable.lux | 457 ++++ .../lux/meta/compiler/language/lux/program.lux | 57 + .../lux/meta/compiler/language/lux/syntax.lux | 621 +++++ .../lux/meta/compiler/language/lux/synthesis.lux | 755 ++++++ .../compiler/language/lux/synthesis/access.lux | 38 + .../language/lux/synthesis/access/member.lux | 34 + .../language/lux/synthesis/access/side.lux | 34 + .../compiler/language/lux/synthesis/simple.lux | 74 + stdlib/source/library/lux/meta/compiler/meta.lux | 9 + .../library/lux/meta/compiler/meta/archive.lux | 267 ++ .../lux/meta/compiler/meta/archive/artifact.lux | 32 + .../compiler/meta/archive/artifact/category.lux | 65 + .../library/lux/meta/compiler/meta/archive/key.lux | 20 + .../lux/meta/compiler/meta/archive/module.lux | 19 + .../compiler/meta/archive/module/descriptor.lux | 83 + .../meta/compiler/meta/archive/module/document.lux | 80 + .../lux/meta/compiler/meta/archive/registry.lux | 203 ++ .../lux/meta/compiler/meta/archive/signature.lux | 48 + .../lux/meta/compiler/meta/archive/unit.lux | 43 + .../library/lux/meta/compiler/meta/cache.lux | 35 + .../lux/meta/compiler/meta/cache/archive.lux | 24 + .../lux/meta/compiler/meta/cache/artifact.lux | 40 + .../compiler/meta/cache/dependency/artifact.lux | 233 ++ .../meta/compiler/meta/cache/dependency/module.lux | 99 + .../lux/meta/compiler/meta/cache/module.lux | 103 + .../library/lux/meta/compiler/meta/cache/purge.lux | 83 + .../source/library/lux/meta/compiler/meta/cli.lux | 115 + .../lux/meta/compiler/meta/cli/compiler.lux | 61 + .../library/lux/meta/compiler/meta/context.lux | 32 + .../library/lux/meta/compiler/meta/export.lux | 75 + .../library/lux/meta/compiler/meta/import.lux | 74 + .../source/library/lux/meta/compiler/meta/io.lux | 21 + .../library/lux/meta/compiler/meta/io/archive.lux | 392 +++ .../library/lux/meta/compiler/meta/io/context.lux | 190 ++ .../library/lux/meta/compiler/meta/packager.lux | 44 + .../lux/meta/compiler/meta/packager/jvm.lux | 294 +++ .../lux/meta/compiler/meta/packager/ruby.lux | 140 + .../lux/meta/compiler/meta/packager/scheme.lux | 132 + .../lux/meta/compiler/meta/packager/script.lux | 79 + stdlib/source/library/lux/meta/compiler/phase.lux | 129 + .../source/library/lux/meta/compiler/reference.lux | 93 + .../lux/meta/compiler/reference/variable.lux | 77 + .../source/library/lux/meta/compiler/version.lux | 49 + stdlib/source/library/lux/meta/version.lux | 3 +- stdlib/source/library/lux/tool/compiler.lux | 59 - stdlib/source/library/lux/tool/compiler/arity.lux | 17 - .../library/lux/tool/compiler/default/init.lux | 291 --- .../library/lux/tool/compiler/default/platform.lux | 888 ------- .../library/lux/tool/compiler/language/lux.lux | 105 - .../lux/tool/compiler/language/lux/analysis.lux | 387 --- .../compiler/language/lux/analysis/complex.lux | 98 - .../compiler/language/lux/analysis/coverage.lux | 423 --- .../compiler/language/lux/analysis/evaluation.lux | 77 - .../compiler/language/lux/analysis/inference.lux | 282 -- .../tool/compiler/language/lux/analysis/macro.lux | 56 - .../tool/compiler/language/lux/analysis/module.lux | 216 -- .../compiler/language/lux/analysis/pattern.lux | 85 - .../tool/compiler/language/lux/analysis/scope.lux | 193 -- .../tool/compiler/language/lux/analysis/simple.lux | 65 - .../tool/compiler/language/lux/analysis/type.lux | 133 - .../lux/tool/compiler/language/lux/declaration.lux | 102 - .../lux/tool/compiler/language/lux/generation.lux | 398 --- .../tool/compiler/language/lux/phase/analysis.lux | 136 - .../compiler/language/lux/phase/analysis/case.lux | 364 --- .../language/lux/phase/analysis/complex.lux | 433 --- .../language/lux/phase/analysis/function.lux | 141 - .../language/lux/phase/analysis/reference.lux | 115 - .../language/lux/phase/analysis/simple.lux | 33 - .../compiler/language/lux/phase/declaration.lux | 125 - .../tool/compiler/language/lux/phase/extension.lux | 196 -- .../language/lux/phase/extension/analysis.lux | 16 - .../lux/phase/extension/analysis/common_lisp.lux | 13 - .../language/lux/phase/extension/analysis/js.lux | 233 -- .../language/lux/phase/extension/analysis/jvm.lux | 2754 -------------------- .../language/lux/phase/extension/analysis/lua.lux | 267 -- .../language/lux/phase/extension/analysis/lux.lux | 313 --- .../language/lux/phase/extension/analysis/php.lux | 221 -- .../lux/phase/extension/analysis/python.lux | 245 -- .../language/lux/phase/extension/analysis/r.lux | 37 - .../language/lux/phase/extension/analysis/ruby.lux | 214 -- .../lux/phase/extension/analysis/scheme.lux | 164 -- .../language/lux/phase/extension/bundle.lux | 29 - .../lux/phase/extension/declaration/jvm.lux | 985 ------- .../lux/phase/extension/declaration/lux.lux | 570 ---- .../lux/phase/extension/generation/common_lisp.lux | 18 - .../extension/generation/common_lisp/common.lux | 182 -- .../extension/generation/common_lisp/host.lux | 15 - .../language/lux/phase/extension/generation/js.lux | 18 - .../lux/phase/extension/generation/js/common.lux | 253 -- .../lux/phase/extension/generation/js/host.lux | 162 -- .../lux/phase/extension/generation/jvm.lux | 20 - .../lux/phase/extension/generation/jvm/common.lux | 414 --- .../lux/phase/extension/generation/jvm/host.lux | 1390 ---------- .../lux/phase/extension/generation/lua.lux | 18 - .../lux/phase/extension/generation/lua/common.lux | 239 -- .../lux/phase/extension/generation/lua/host.lux | 202 -- .../lux/phase/extension/generation/php.lux | 18 - .../lux/phase/extension/generation/php/common.lux | 194 -- .../lux/phase/extension/generation/php/host.lux | 145 -- .../lux/phase/extension/generation/python.lux | 18 - .../phase/extension/generation/python/common.lux | 246 -- .../lux/phase/extension/generation/python/host.lux | 169 -- .../language/lux/phase/extension/generation/r.lux | 18 - .../lux/phase/extension/generation/r/common.lux | 181 -- .../lux/phase/extension/generation/r/host.lux | 42 - .../lux/phase/extension/generation/ruby.lux | 18 - .../lux/phase/extension/generation/ruby/common.lux | 243 -- .../lux/phase/extension/generation/ruby/host.lux | 138 - .../lux/phase/extension/generation/scheme.lux | 18 - .../phase/extension/generation/scheme/common.lux | 177 -- .../lux/phase/extension/generation/scheme/host.lux | 111 - .../language/lux/phase/extension/synthesis.lux | 11 - .../language/lux/phase/generation/common_lisp.lux | 60 - .../lux/phase/generation/common_lisp/case.lux | 263 -- .../lux/phase/generation/common_lisp/extension.lux | 14 - .../generation/common_lisp/extension/common.lux | 138 - .../lux/phase/generation/common_lisp/function.lux | 104 - .../lux/phase/generation/common_lisp/loop.lux | 72 - .../lux/phase/generation/common_lisp/primitive.lux | 22 - .../lux/phase/generation/common_lisp/reference.lux | 14 - .../lux/phase/generation/common_lisp/runtime.lux | 305 --- .../lux/phase/generation/common_lisp/structure.lux | 38 - .../language/lux/phase/generation/extension.lux | 78 - .../compiler/language/lux/phase/generation/js.lux | 90 - .../language/lux/phase/generation/js/case.lux | 346 --- .../language/lux/phase/generation/js/function.lux | 131 - .../language/lux/phase/generation/js/loop.lux | 116 - .../language/lux/phase/generation/js/primitive.lux | 22 - .../language/lux/phase/generation/js/reference.lux | 14 - .../language/lux/phase/generation/js/runtime.lux | 826 ------ .../language/lux/phase/generation/js/structure.lux | 37 - .../compiler/language/lux/phase/generation/jvm.lux | 79 - .../language/lux/phase/generation/jvm/case.lux | 327 --- .../language/lux/phase/generation/jvm/debug.lux | 31 - .../language/lux/phase/generation/jvm/function.lux | 194 -- .../lux/phase/generation/jvm/function/abstract.lux | 26 - .../generation/jvm/function/field/constant.lux | 27 - .../jvm/function/field/constant/arity.lux | 17 - .../generation/jvm/function/field/variable.lux | 57 - .../jvm/function/field/variable/count.lux | 35 - .../jvm/function/field/variable/foreign.lux | 40 - .../jvm/function/field/variable/partial.lux | 59 - .../lux/phase/generation/jvm/function/method.lux | 15 - .../phase/generation/jvm/function/method/apply.lux | 159 -- .../jvm/function/method/implementation.lux | 59 - .../phase/generation/jvm/function/method/init.lux | 105 - .../phase/generation/jvm/function/method/new.lux | 83 - .../phase/generation/jvm/function/method/reset.lux | 51 - .../language/lux/phase/generation/jvm/host.lux | 195 -- .../language/lux/phase/generation/jvm/loop.lux | 95 - .../lux/phase/generation/jvm/primitive.lux | 134 - .../language/lux/phase/generation/jvm/program.lux | 169 -- .../lux/phase/generation/jvm/reference.lux | 74 - .../language/lux/phase/generation/jvm/runtime.lux | 659 ----- .../lux/phase/generation/jvm/structure.lux | 97 - .../language/lux/phase/generation/jvm/type.lux | 24 - .../language/lux/phase/generation/jvm/value.lux | 50 - .../compiler/language/lux/phase/generation/lua.lux | 90 - .../language/lux/phase/generation/lua/case.lux | 304 --- .../language/lux/phase/generation/lua/function.lux | 144 - .../language/lux/phase/generation/lua/loop.lux | 124 - .../lux/phase/generation/lua/primitive.lux | 17 - .../lux/phase/generation/lua/reference.lux | 14 - .../language/lux/phase/generation/lua/runtime.lux | 452 ---- .../lux/phase/generation/lua/structure.lux | 36 - .../compiler/language/lux/phase/generation/php.lux | 110 - .../language/lux/phase/generation/php/case.lux | 297 --- .../lux/phase/generation/php/extension.lux | 14 - .../lux/phase/generation/php/extension/common.lux | 113 - .../language/lux/phase/generation/php/function.lux | 117 - .../language/lux/phase/generation/php/loop.lux | 125 - .../lux/phase/generation/php/primitive.lux | 31 - .../lux/phase/generation/php/reference.lux | 14 - .../language/lux/phase/generation/php/runtime.lux | 635 ----- .../lux/phase/generation/php/structure.lux | 42 - .../language/lux/phase/generation/python.lux | 80 - .../language/lux/phase/generation/python/case.lux | 362 --- .../lux/phase/generation/python/function.lux | 117 - .../language/lux/phase/generation/python/loop.lux | 127 - .../lux/phase/generation/python/primitive.lux | 19 - .../lux/phase/generation/python/reference.lux | 14 - .../lux/phase/generation/python/runtime.lux | 486 ---- .../lux/phase/generation/python/structure.lux | 36 - .../compiler/language/lux/phase/generation/r.lux | 62 - .../language/lux/phase/generation/r/case.lux | 242 -- .../language/lux/phase/generation/r/function.lux | 118 - .../language/lux/phase/generation/r/loop.lux | 66 - .../language/lux/phase/generation/r/primitive.lux | 19 - .../lux/phase/generation/r/procedure/common.lux | 291 --- .../lux/phase/generation/r/procedure/host.lux | 90 - .../language/lux/phase/generation/r/reference.lux | 14 - .../language/lux/phase/generation/r/runtime.lux | 882 ------- .../language/lux/phase/generation/r/structure.lux | 41 - .../language/lux/phase/generation/reference.lux | 99 - .../language/lux/phase/generation/ruby.lux | 80 - .../language/lux/phase/generation/ruby/case.lux | 382 --- .../lux/phase/generation/ruby/function.lux | 123 - .../language/lux/phase/generation/ruby/loop.lux | 96 - .../lux/phase/generation/ruby/primitive.lux | 17 - .../lux/phase/generation/ruby/reference.lux | 14 - .../language/lux/phase/generation/ruby/runtime.lux | 629 ----- .../lux/phase/generation/ruby/structure.lux | 36 - .../language/lux/phase/generation/scheme.lux | 62 - .../language/lux/phase/generation/scheme/case.lux | 225 -- .../lux/phase/generation/scheme/extension.lux | 14 - .../phase/generation/scheme/extension/common.lux | 179 -- .../lux/phase/generation/scheme/function.lux | 102 - .../language/lux/phase/generation/scheme/loop.lux | 65 - .../lux/phase/generation/scheme/primitive.lux | 17 - .../lux/phase/generation/scheme/reference.lux | 14 - .../lux/phase/generation/scheme/runtime.lux | 389 --- .../lux/phase/generation/scheme/structure.lux | 41 - .../tool/compiler/language/lux/phase/synthesis.lux | 110 - .../compiler/language/lux/phase/synthesis/case.lux | 467 ---- .../language/lux/phase/synthesis/function.lux | 291 --- .../compiler/language/lux/phase/synthesis/loop.lux | 219 -- .../language/lux/phase/synthesis/variable.lux | 457 ---- .../lux/tool/compiler/language/lux/program.lux | 57 - .../lux/tool/compiler/language/lux/syntax.lux | 621 ----- .../lux/tool/compiler/language/lux/synthesis.lux | 755 ------ .../compiler/language/lux/synthesis/access.lux | 38 - .../language/lux/synthesis/access/member.lux | 34 - .../language/lux/synthesis/access/side.lux | 34 - .../compiler/language/lux/synthesis/simple.lux | 74 - stdlib/source/library/lux/tool/compiler/meta.lux | 9 - .../library/lux/tool/compiler/meta/archive.lux | 267 -- .../lux/tool/compiler/meta/archive/artifact.lux | 32 - .../compiler/meta/archive/artifact/category.lux | 65 - .../library/lux/tool/compiler/meta/archive/key.lux | 20 - .../lux/tool/compiler/meta/archive/module.lux | 19 - .../compiler/meta/archive/module/descriptor.lux | 83 - .../tool/compiler/meta/archive/module/document.lux | 80 - .../lux/tool/compiler/meta/archive/registry.lux | 203 -- .../lux/tool/compiler/meta/archive/signature.lux | 48 - .../lux/tool/compiler/meta/archive/unit.lux | 43 - .../library/lux/tool/compiler/meta/cache.lux | 35 - .../lux/tool/compiler/meta/cache/archive.lux | 24 - .../lux/tool/compiler/meta/cache/artifact.lux | 40 - .../compiler/meta/cache/dependency/artifact.lux | 234 -- .../tool/compiler/meta/cache/dependency/module.lux | 99 - .../lux/tool/compiler/meta/cache/module.lux | 103 - .../library/lux/tool/compiler/meta/cache/purge.lux | 83 - .../source/library/lux/tool/compiler/meta/cli.lux | 116 - .../lux/tool/compiler/meta/cli/compiler.lux | 61 - .../library/lux/tool/compiler/meta/context.lux | 32 - .../library/lux/tool/compiler/meta/export.lux | 75 - .../library/lux/tool/compiler/meta/import.lux | 74 - .../source/library/lux/tool/compiler/meta/io.lux | 21 - .../library/lux/tool/compiler/meta/io/archive.lux | 392 --- .../library/lux/tool/compiler/meta/io/context.lux | 190 -- .../library/lux/tool/compiler/meta/packager.lux | 44 - .../lux/tool/compiler/meta/packager/jvm.lux | 294 --- .../lux/tool/compiler/meta/packager/ruby.lux | 140 - .../lux/tool/compiler/meta/packager/scheme.lux | 132 - .../lux/tool/compiler/meta/packager/script.lux | 79 - stdlib/source/library/lux/tool/compiler/phase.lux | 129 - .../source/library/lux/tool/compiler/reference.lux | 93 - .../lux/tool/compiler/reference/variable.lux | 77 - .../source/library/lux/tool/compiler/version.lux | 49 - stdlib/source/library/lux/tool/interpreter.lux | 227 -- stdlib/source/library/lux/tool/mediator.lux | 20 - .../lux/meta/compiler/language/lux/analysis.lux | 132 + .../lux/meta/compiler/language/lux/synthesis.lux | 161 ++ .../lux/tool/compiler/language/lux/analysis.lux | 133 - .../lux/tool/compiler/language/lux/synthesis.lux | 162 -- stdlib/source/program/aedifex.lux | 2 +- stdlib/source/program/aedifex/command/build.lux | 3 +- .../program/aedifex/command/deploy/release.lux | 2 +- .../program/aedifex/command/deploy/snapshot.lux | 2 +- stdlib/source/program/aedifex/command/install.lux | 2 +- stdlib/source/program/aedifex/command/version.lux | 3 +- stdlib/source/program/aedifex/format.lux | 3 +- stdlib/source/program/aedifex/input.lux | 3 +- stdlib/source/program/aedifex/parser.lux | 3 +- stdlib/source/program/aedifex/profile.lux | 11 +- .../source/program/aedifex/repository/remote.lux | 3 +- stdlib/source/program/compositor.lux | 17 +- stdlib/source/specification/compositor.lux | 2 +- .../specification/compositor/analysis/type.lux | 3 +- stdlib/source/specification/compositor/common.lux | 2 +- .../specification/compositor/generation/case.lux | 2 +- .../specification/compositor/generation/common.lux | 3 +- .../compositor/generation/function.lux | 2 +- .../compositor/generation/primitive.lux | 2 +- .../compositor/generation/reference.lux | 2 +- .../compositor/generation/structure.lux | 2 +- stdlib/source/test/aedifex/command/deploy.lux | 2 +- stdlib/source/test/aedifex/command/version.lux | 3 +- stdlib/source/test/aedifex/profile.lux | 2 +- stdlib/source/test/lux.lux | 2 - stdlib/source/test/lux/extension.lux | 3 +- stdlib/source/test/lux/meta.lux | 41 +- stdlib/source/test/lux/meta/code.lux | 3 +- stdlib/source/test/lux/meta/compiler/arity.lux | 29 + .../lux/meta/compiler/language/lux/analysis.lux | 627 +++++ .../compiler/language/lux/analysis/complex.lux | 76 + .../compiler/language/lux/analysis/coverage.lux | 468 ++++ .../compiler/language/lux/analysis/inference.lux | 423 +++ .../meta/compiler/language/lux/analysis/macro.lux | 110 + .../meta/compiler/language/lux/analysis/module.lux | 354 +++ .../compiler/language/lux/analysis/pattern.lux | 112 + .../meta/compiler/language/lux/analysis/scope.lux | 205 ++ .../meta/compiler/language/lux/analysis/simple.lux | 45 + .../meta/compiler/language/lux/analysis/type.lux | 135 + .../meta/compiler/language/lux/phase/analysis.lux | 967 +++++++ .../compiler/language/lux/phase/analysis/case.lux | 636 +++++ .../language/lux/phase/analysis/complex.lux | 659 +++++ .../language/lux/phase/analysis/function.lux | 258 ++ .../language/lux/phase/analysis/reference.lux | 224 ++ .../language/lux/phase/analysis/simple.lux | 111 + .../meta/compiler/language/lux/phase/extension.lux | 280 ++ .../language/lux/phase/extension/analysis/lux.lux | 205 ++ .../meta/compiler/language/lux/phase/synthesis.lux | 21 + .../compiler/language/lux/phase/synthesis/case.lux | 358 +++ .../language/lux/phase/synthesis/function.lux | 468 ++++ .../compiler/language/lux/phase/synthesis/loop.lux | 293 +++ .../language/lux/phase/synthesis/primitive.lux | 98 + .../language/lux/phase/synthesis/structure.lux | 85 + .../language/lux/phase/synthesis/variable.lux | 338 +++ .../test/lux/meta/compiler/language/lux/syntax.lux | 145 ++ .../lux/meta/compiler/language/lux/synthesis.lux | 215 ++ .../compiler/language/lux/synthesis/access.lux | 14 + .../language/lux/synthesis/access/member.lux | 41 + .../language/lux/synthesis/access/side.lux | 41 + .../compiler/language/lux/synthesis/simple.lux | 45 + .../source/test/lux/meta/compiler/meta/archive.lux | 254 ++ .../lux/meta/compiler/meta/archive/artifact.lux | 32 + .../compiler/meta/archive/artifact/category.lux | 44 + .../test/lux/meta/compiler/meta/archive/key.lux | 27 + .../test/lux/meta/compiler/meta/archive/module.lux | 43 + .../compiler/meta/archive/module/descriptor.lux | 58 + .../meta/compiler/meta/archive/module/document.lux | 97 + .../lux/meta/compiler/meta/archive/registry.lux | 180 ++ .../lux/meta/compiler/meta/archive/signature.lux | 55 + .../test/lux/meta/compiler/meta/archive/unit.lux | 36 + .../source/test/lux/meta/compiler/meta/cache.lux | 54 + .../test/lux/meta/compiler/meta/cache/archive.lux | 84 + .../test/lux/meta/compiler/meta/cache/artifact.lux | 53 + .../test/lux/meta/compiler/meta/cache/module.lux | 94 + .../test/lux/meta/compiler/meta/cache/purge.lux | 141 + stdlib/source/test/lux/meta/compiler/meta/cli.lux | 143 + .../test/lux/meta/compiler/meta/cli/compiler.lux | 49 + .../source/test/lux/meta/compiler/meta/context.lux | 56 + .../source/test/lux/meta/compiler/meta/export.lux | 120 + .../source/test/lux/meta/compiler/meta/import.lux | 156 ++ stdlib/source/test/lux/meta/compiler/phase.lux | 206 ++ stdlib/source/test/lux/meta/compiler/reference.lux | 95 + .../test/lux/meta/compiler/reference/variable.lux | 45 + stdlib/source/test/lux/meta/compiler/version.lux | 41 + stdlib/source/test/lux/meta/target/ruby.lux | 2 +- stdlib/source/test/lux/tool.lux | 49 - stdlib/source/test/lux/tool/compiler/arity.lux | 29 - .../lux/tool/compiler/language/lux/analysis.lux | 628 ----- .../compiler/language/lux/analysis/complex.lux | 76 - .../compiler/language/lux/analysis/coverage.lux | 468 ---- .../compiler/language/lux/analysis/inference.lux | 423 --- .../tool/compiler/language/lux/analysis/macro.lux | 110 - .../tool/compiler/language/lux/analysis/module.lux | 354 --- .../compiler/language/lux/analysis/pattern.lux | 112 - .../tool/compiler/language/lux/analysis/scope.lux | 205 -- .../tool/compiler/language/lux/analysis/simple.lux | 45 - .../tool/compiler/language/lux/analysis/type.lux | 135 - .../tool/compiler/language/lux/phase/analysis.lux | 967 ------- .../compiler/language/lux/phase/analysis/case.lux | 636 ----- .../language/lux/phase/analysis/complex.lux | 659 ----- .../language/lux/phase/analysis/function.lux | 258 -- .../language/lux/phase/analysis/reference.lux | 224 -- .../language/lux/phase/analysis/simple.lux | 111 - .../tool/compiler/language/lux/phase/extension.lux | 280 -- .../language/lux/phase/extension/analysis/lux.lux | 205 -- .../tool/compiler/language/lux/phase/synthesis.lux | 21 - .../compiler/language/lux/phase/synthesis/case.lux | 358 --- .../language/lux/phase/synthesis/function.lux | 468 ---- .../compiler/language/lux/phase/synthesis/loop.lux | 293 --- .../language/lux/phase/synthesis/primitive.lux | 98 - .../language/lux/phase/synthesis/structure.lux | 85 - .../language/lux/phase/synthesis/variable.lux | 338 --- .../test/lux/tool/compiler/language/lux/syntax.lux | 145 -- .../lux/tool/compiler/language/lux/synthesis.lux | 216 -- .../compiler/language/lux/synthesis/access.lux | 14 - .../language/lux/synthesis/access/member.lux | 41 - .../language/lux/synthesis/access/side.lux | 41 - .../compiler/language/lux/synthesis/simple.lux | 45 - .../source/test/lux/tool/compiler/meta/archive.lux | 254 -- .../lux/tool/compiler/meta/archive/artifact.lux | 32 - .../compiler/meta/archive/artifact/category.lux | 44 - .../test/lux/tool/compiler/meta/archive/key.lux | 27 - .../test/lux/tool/compiler/meta/archive/module.lux | 43 - .../compiler/meta/archive/module/descriptor.lux | 58 - .../tool/compiler/meta/archive/module/document.lux | 97 - .../lux/tool/compiler/meta/archive/registry.lux | 180 -- .../lux/tool/compiler/meta/archive/signature.lux | 55 - .../test/lux/tool/compiler/meta/archive/unit.lux | 36 - .../source/test/lux/tool/compiler/meta/cache.lux | 54 - .../test/lux/tool/compiler/meta/cache/archive.lux | 84 - .../test/lux/tool/compiler/meta/cache/artifact.lux | 53 - .../test/lux/tool/compiler/meta/cache/module.lux | 94 - .../test/lux/tool/compiler/meta/cache/purge.lux | 141 - stdlib/source/test/lux/tool/compiler/meta/cli.lux | 143 - .../test/lux/tool/compiler/meta/cli/compiler.lux | 49 - .../source/test/lux/tool/compiler/meta/context.lux | 56 - .../source/test/lux/tool/compiler/meta/export.lux | 120 - .../source/test/lux/tool/compiler/meta/import.lux | 156 -- stdlib/source/test/lux/tool/compiler/phase.lux | 206 -- stdlib/source/test/lux/tool/compiler/reference.lux | 95 - .../test/lux/tool/compiler/reference/variable.lux | 45 - stdlib/source/test/lux/tool/compiler/version.lux | 41 - 590 files changed, 47549 insertions(+), 47594 deletions(-) create mode 100644 stdlib/source/experiment/tool/interpreter.lux create mode 100644 stdlib/source/experiment/tool/mediator.lux create mode 100644 stdlib/source/library/lux/meta/compiler.lux create mode 100644 stdlib/source/library/lux/meta/compiler/arity.lux create mode 100644 stdlib/source/library/lux/meta/compiler/default/init.lux create mode 100644 stdlib/source/library/lux/meta/compiler/default/platform.lux create mode 100644 stdlib/source/library/lux/meta/compiler/language/lux.lux create mode 100644 stdlib/source/library/lux/meta/compiler/language/lux/analysis.lux create mode 100644 stdlib/source/library/lux/meta/compiler/language/lux/analysis/complex.lux create mode 100644 stdlib/source/library/lux/meta/compiler/language/lux/analysis/coverage.lux create mode 100644 stdlib/source/library/lux/meta/compiler/language/lux/analysis/evaluation.lux create mode 100644 stdlib/source/library/lux/meta/compiler/language/lux/analysis/inference.lux create mode 100644 stdlib/source/library/lux/meta/compiler/language/lux/analysis/macro.lux create mode 100644 stdlib/source/library/lux/meta/compiler/language/lux/analysis/module.lux create mode 100644 stdlib/source/library/lux/meta/compiler/language/lux/analysis/pattern.lux create mode 100644 stdlib/source/library/lux/meta/compiler/language/lux/analysis/scope.lux create mode 100644 stdlib/source/library/lux/meta/compiler/language/lux/analysis/simple.lux create mode 100644 stdlib/source/library/lux/meta/compiler/language/lux/analysis/type.lux create mode 100644 stdlib/source/library/lux/meta/compiler/language/lux/declaration.lux create mode 100644 stdlib/source/library/lux/meta/compiler/language/lux/generation.lux create mode 100644 stdlib/source/library/lux/meta/compiler/language/lux/phase/analysis.lux create mode 100644 stdlib/source/library/lux/meta/compiler/language/lux/phase/analysis/case.lux create mode 100644 stdlib/source/library/lux/meta/compiler/language/lux/phase/analysis/complex.lux create mode 100644 stdlib/source/library/lux/meta/compiler/language/lux/phase/analysis/function.lux create mode 100644 stdlib/source/library/lux/meta/compiler/language/lux/phase/analysis/reference.lux create mode 100644 stdlib/source/library/lux/meta/compiler/language/lux/phase/analysis/simple.lux create mode 100644 stdlib/source/library/lux/meta/compiler/language/lux/phase/declaration.lux create mode 100644 stdlib/source/library/lux/meta/compiler/language/lux/phase/extension.lux create mode 100644 stdlib/source/library/lux/meta/compiler/language/lux/phase/extension/analysis.lux create mode 100644 stdlib/source/library/lux/meta/compiler/language/lux/phase/extension/analysis/common_lisp.lux create mode 100644 stdlib/source/library/lux/meta/compiler/language/lux/phase/extension/analysis/js.lux create mode 100644 stdlib/source/library/lux/meta/compiler/language/lux/phase/extension/analysis/jvm.lux create mode 100644 stdlib/source/library/lux/meta/compiler/language/lux/phase/extension/analysis/lua.lux create mode 100644 stdlib/source/library/lux/meta/compiler/language/lux/phase/extension/analysis/lux.lux create mode 100644 stdlib/source/library/lux/meta/compiler/language/lux/phase/extension/analysis/php.lux create mode 100644 stdlib/source/library/lux/meta/compiler/language/lux/phase/extension/analysis/python.lux create mode 100644 stdlib/source/library/lux/meta/compiler/language/lux/phase/extension/analysis/r.lux create mode 100644 stdlib/source/library/lux/meta/compiler/language/lux/phase/extension/analysis/ruby.lux create mode 100644 stdlib/source/library/lux/meta/compiler/language/lux/phase/extension/analysis/scheme.lux create mode 100644 stdlib/source/library/lux/meta/compiler/language/lux/phase/extension/bundle.lux create mode 100644 stdlib/source/library/lux/meta/compiler/language/lux/phase/extension/declaration/jvm.lux create mode 100644 stdlib/source/library/lux/meta/compiler/language/lux/phase/extension/declaration/lux.lux create mode 100644 stdlib/source/library/lux/meta/compiler/language/lux/phase/extension/generation/common_lisp.lux create mode 100644 stdlib/source/library/lux/meta/compiler/language/lux/phase/extension/generation/common_lisp/common.lux create mode 100644 stdlib/source/library/lux/meta/compiler/language/lux/phase/extension/generation/common_lisp/host.lux create mode 100644 stdlib/source/library/lux/meta/compiler/language/lux/phase/extension/generation/js.lux create mode 100644 stdlib/source/library/lux/meta/compiler/language/lux/phase/extension/generation/js/common.lux create mode 100644 stdlib/source/library/lux/meta/compiler/language/lux/phase/extension/generation/js/host.lux create mode 100644 stdlib/source/library/lux/meta/compiler/language/lux/phase/extension/generation/jvm.lux create mode 100644 stdlib/source/library/lux/meta/compiler/language/lux/phase/extension/generation/jvm/common.lux create mode 100644 stdlib/source/library/lux/meta/compiler/language/lux/phase/extension/generation/jvm/host.lux create mode 100644 stdlib/source/library/lux/meta/compiler/language/lux/phase/extension/generation/lua.lux create mode 100644 stdlib/source/library/lux/meta/compiler/language/lux/phase/extension/generation/lua/common.lux create mode 100644 stdlib/source/library/lux/meta/compiler/language/lux/phase/extension/generation/lua/host.lux create mode 100644 stdlib/source/library/lux/meta/compiler/language/lux/phase/extension/generation/php.lux create mode 100644 stdlib/source/library/lux/meta/compiler/language/lux/phase/extension/generation/php/common.lux create mode 100644 stdlib/source/library/lux/meta/compiler/language/lux/phase/extension/generation/php/host.lux create mode 100644 stdlib/source/library/lux/meta/compiler/language/lux/phase/extension/generation/python.lux create mode 100644 stdlib/source/library/lux/meta/compiler/language/lux/phase/extension/generation/python/common.lux create mode 100644 stdlib/source/library/lux/meta/compiler/language/lux/phase/extension/generation/python/host.lux create mode 100644 stdlib/source/library/lux/meta/compiler/language/lux/phase/extension/generation/r.lux create mode 100644 stdlib/source/library/lux/meta/compiler/language/lux/phase/extension/generation/r/common.lux create mode 100644 stdlib/source/library/lux/meta/compiler/language/lux/phase/extension/generation/r/host.lux create mode 100644 stdlib/source/library/lux/meta/compiler/language/lux/phase/extension/generation/ruby.lux create mode 100644 stdlib/source/library/lux/meta/compiler/language/lux/phase/extension/generation/ruby/common.lux create mode 100644 stdlib/source/library/lux/meta/compiler/language/lux/phase/extension/generation/ruby/host.lux create mode 100644 stdlib/source/library/lux/meta/compiler/language/lux/phase/extension/generation/scheme.lux create mode 100644 stdlib/source/library/lux/meta/compiler/language/lux/phase/extension/generation/scheme/common.lux create mode 100644 stdlib/source/library/lux/meta/compiler/language/lux/phase/extension/generation/scheme/host.lux create mode 100644 stdlib/source/library/lux/meta/compiler/language/lux/phase/extension/synthesis.lux create mode 100644 stdlib/source/library/lux/meta/compiler/language/lux/phase/generation/common_lisp.lux create mode 100644 stdlib/source/library/lux/meta/compiler/language/lux/phase/generation/common_lisp/case.lux create mode 100644 stdlib/source/library/lux/meta/compiler/language/lux/phase/generation/common_lisp/extension.lux create mode 100644 stdlib/source/library/lux/meta/compiler/language/lux/phase/generation/common_lisp/extension/common.lux create mode 100644 stdlib/source/library/lux/meta/compiler/language/lux/phase/generation/common_lisp/function.lux create mode 100644 stdlib/source/library/lux/meta/compiler/language/lux/phase/generation/common_lisp/loop.lux create mode 100644 stdlib/source/library/lux/meta/compiler/language/lux/phase/generation/common_lisp/primitive.lux create mode 100644 stdlib/source/library/lux/meta/compiler/language/lux/phase/generation/common_lisp/reference.lux create mode 100644 stdlib/source/library/lux/meta/compiler/language/lux/phase/generation/common_lisp/runtime.lux create mode 100644 stdlib/source/library/lux/meta/compiler/language/lux/phase/generation/common_lisp/structure.lux create mode 100644 stdlib/source/library/lux/meta/compiler/language/lux/phase/generation/extension.lux create mode 100644 stdlib/source/library/lux/meta/compiler/language/lux/phase/generation/js.lux create mode 100644 stdlib/source/library/lux/meta/compiler/language/lux/phase/generation/js/case.lux create mode 100644 stdlib/source/library/lux/meta/compiler/language/lux/phase/generation/js/function.lux create mode 100644 stdlib/source/library/lux/meta/compiler/language/lux/phase/generation/js/loop.lux create mode 100644 stdlib/source/library/lux/meta/compiler/language/lux/phase/generation/js/primitive.lux create mode 100644 stdlib/source/library/lux/meta/compiler/language/lux/phase/generation/js/reference.lux create mode 100644 stdlib/source/library/lux/meta/compiler/language/lux/phase/generation/js/runtime.lux create mode 100644 stdlib/source/library/lux/meta/compiler/language/lux/phase/generation/js/structure.lux create mode 100644 stdlib/source/library/lux/meta/compiler/language/lux/phase/generation/jvm.lux create mode 100644 stdlib/source/library/lux/meta/compiler/language/lux/phase/generation/jvm/case.lux create mode 100644 stdlib/source/library/lux/meta/compiler/language/lux/phase/generation/jvm/debug.lux create mode 100644 stdlib/source/library/lux/meta/compiler/language/lux/phase/generation/jvm/function.lux create mode 100644 stdlib/source/library/lux/meta/compiler/language/lux/phase/generation/jvm/function/abstract.lux create mode 100644 stdlib/source/library/lux/meta/compiler/language/lux/phase/generation/jvm/function/field/constant.lux create mode 100644 stdlib/source/library/lux/meta/compiler/language/lux/phase/generation/jvm/function/field/constant/arity.lux create mode 100644 stdlib/source/library/lux/meta/compiler/language/lux/phase/generation/jvm/function/field/variable.lux create mode 100644 stdlib/source/library/lux/meta/compiler/language/lux/phase/generation/jvm/function/field/variable/count.lux create mode 100644 stdlib/source/library/lux/meta/compiler/language/lux/phase/generation/jvm/function/field/variable/foreign.lux create mode 100644 stdlib/source/library/lux/meta/compiler/language/lux/phase/generation/jvm/function/field/variable/partial.lux create mode 100644 stdlib/source/library/lux/meta/compiler/language/lux/phase/generation/jvm/function/method.lux create mode 100644 stdlib/source/library/lux/meta/compiler/language/lux/phase/generation/jvm/function/method/apply.lux create mode 100644 stdlib/source/library/lux/meta/compiler/language/lux/phase/generation/jvm/function/method/implementation.lux create mode 100644 stdlib/source/library/lux/meta/compiler/language/lux/phase/generation/jvm/function/method/init.lux create mode 100644 stdlib/source/library/lux/meta/compiler/language/lux/phase/generation/jvm/function/method/new.lux create mode 100644 stdlib/source/library/lux/meta/compiler/language/lux/phase/generation/jvm/function/method/reset.lux create mode 100644 stdlib/source/library/lux/meta/compiler/language/lux/phase/generation/jvm/host.lux create mode 100644 stdlib/source/library/lux/meta/compiler/language/lux/phase/generation/jvm/loop.lux create mode 100644 stdlib/source/library/lux/meta/compiler/language/lux/phase/generation/jvm/primitive.lux create mode 100644 stdlib/source/library/lux/meta/compiler/language/lux/phase/generation/jvm/program.lux create mode 100644 stdlib/source/library/lux/meta/compiler/language/lux/phase/generation/jvm/reference.lux create mode 100644 stdlib/source/library/lux/meta/compiler/language/lux/phase/generation/jvm/runtime.lux create mode 100644 stdlib/source/library/lux/meta/compiler/language/lux/phase/generation/jvm/structure.lux create mode 100644 stdlib/source/library/lux/meta/compiler/language/lux/phase/generation/jvm/type.lux create mode 100644 stdlib/source/library/lux/meta/compiler/language/lux/phase/generation/jvm/value.lux create mode 100644 stdlib/source/library/lux/meta/compiler/language/lux/phase/generation/lua.lux create mode 100644 stdlib/source/library/lux/meta/compiler/language/lux/phase/generation/lua/case.lux create mode 100644 stdlib/source/library/lux/meta/compiler/language/lux/phase/generation/lua/function.lux create mode 100644 stdlib/source/library/lux/meta/compiler/language/lux/phase/generation/lua/loop.lux create mode 100644 stdlib/source/library/lux/meta/compiler/language/lux/phase/generation/lua/primitive.lux create mode 100644 stdlib/source/library/lux/meta/compiler/language/lux/phase/generation/lua/reference.lux create mode 100644 stdlib/source/library/lux/meta/compiler/language/lux/phase/generation/lua/runtime.lux create mode 100644 stdlib/source/library/lux/meta/compiler/language/lux/phase/generation/lua/structure.lux create mode 100644 stdlib/source/library/lux/meta/compiler/language/lux/phase/generation/php.lux create mode 100644 stdlib/source/library/lux/meta/compiler/language/lux/phase/generation/php/case.lux create mode 100644 stdlib/source/library/lux/meta/compiler/language/lux/phase/generation/php/extension.lux create mode 100644 stdlib/source/library/lux/meta/compiler/language/lux/phase/generation/php/extension/common.lux create mode 100644 stdlib/source/library/lux/meta/compiler/language/lux/phase/generation/php/function.lux create mode 100644 stdlib/source/library/lux/meta/compiler/language/lux/phase/generation/php/loop.lux create mode 100644 stdlib/source/library/lux/meta/compiler/language/lux/phase/generation/php/primitive.lux create mode 100644 stdlib/source/library/lux/meta/compiler/language/lux/phase/generation/php/reference.lux create mode 100644 stdlib/source/library/lux/meta/compiler/language/lux/phase/generation/php/runtime.lux create mode 100644 stdlib/source/library/lux/meta/compiler/language/lux/phase/generation/php/structure.lux create mode 100644 stdlib/source/library/lux/meta/compiler/language/lux/phase/generation/python.lux create mode 100644 stdlib/source/library/lux/meta/compiler/language/lux/phase/generation/python/case.lux create mode 100644 stdlib/source/library/lux/meta/compiler/language/lux/phase/generation/python/function.lux create mode 100644 stdlib/source/library/lux/meta/compiler/language/lux/phase/generation/python/loop.lux create mode 100644 stdlib/source/library/lux/meta/compiler/language/lux/phase/generation/python/primitive.lux create mode 100644 stdlib/source/library/lux/meta/compiler/language/lux/phase/generation/python/reference.lux create mode 100644 stdlib/source/library/lux/meta/compiler/language/lux/phase/generation/python/runtime.lux create mode 100644 stdlib/source/library/lux/meta/compiler/language/lux/phase/generation/python/structure.lux create mode 100644 stdlib/source/library/lux/meta/compiler/language/lux/phase/generation/r.lux create mode 100644 stdlib/source/library/lux/meta/compiler/language/lux/phase/generation/r/case.lux create mode 100644 stdlib/source/library/lux/meta/compiler/language/lux/phase/generation/r/function.lux create mode 100644 stdlib/source/library/lux/meta/compiler/language/lux/phase/generation/r/loop.lux create mode 100644 stdlib/source/library/lux/meta/compiler/language/lux/phase/generation/r/primitive.lux create mode 100644 stdlib/source/library/lux/meta/compiler/language/lux/phase/generation/r/procedure/common.lux create mode 100644 stdlib/source/library/lux/meta/compiler/language/lux/phase/generation/r/procedure/host.lux create mode 100644 stdlib/source/library/lux/meta/compiler/language/lux/phase/generation/r/reference.lux create mode 100644 stdlib/source/library/lux/meta/compiler/language/lux/phase/generation/r/runtime.lux create mode 100644 stdlib/source/library/lux/meta/compiler/language/lux/phase/generation/r/structure.lux create mode 100644 stdlib/source/library/lux/meta/compiler/language/lux/phase/generation/reference.lux create mode 100644 stdlib/source/library/lux/meta/compiler/language/lux/phase/generation/ruby.lux create mode 100644 stdlib/source/library/lux/meta/compiler/language/lux/phase/generation/ruby/case.lux create mode 100644 stdlib/source/library/lux/meta/compiler/language/lux/phase/generation/ruby/function.lux create mode 100644 stdlib/source/library/lux/meta/compiler/language/lux/phase/generation/ruby/loop.lux create mode 100644 stdlib/source/library/lux/meta/compiler/language/lux/phase/generation/ruby/primitive.lux create mode 100644 stdlib/source/library/lux/meta/compiler/language/lux/phase/generation/ruby/reference.lux create mode 100644 stdlib/source/library/lux/meta/compiler/language/lux/phase/generation/ruby/runtime.lux create mode 100644 stdlib/source/library/lux/meta/compiler/language/lux/phase/generation/ruby/structure.lux create mode 100644 stdlib/source/library/lux/meta/compiler/language/lux/phase/generation/scheme.lux create mode 100644 stdlib/source/library/lux/meta/compiler/language/lux/phase/generation/scheme/case.lux create mode 100644 stdlib/source/library/lux/meta/compiler/language/lux/phase/generation/scheme/extension.lux create mode 100644 stdlib/source/library/lux/meta/compiler/language/lux/phase/generation/scheme/extension/common.lux create mode 100644 stdlib/source/library/lux/meta/compiler/language/lux/phase/generation/scheme/function.lux create mode 100644 stdlib/source/library/lux/meta/compiler/language/lux/phase/generation/scheme/loop.lux create mode 100644 stdlib/source/library/lux/meta/compiler/language/lux/phase/generation/scheme/primitive.lux create mode 100644 stdlib/source/library/lux/meta/compiler/language/lux/phase/generation/scheme/reference.lux create mode 100644 stdlib/source/library/lux/meta/compiler/language/lux/phase/generation/scheme/runtime.lux create mode 100644 stdlib/source/library/lux/meta/compiler/language/lux/phase/generation/scheme/structure.lux create mode 100644 stdlib/source/library/lux/meta/compiler/language/lux/phase/synthesis.lux create mode 100644 stdlib/source/library/lux/meta/compiler/language/lux/phase/synthesis/case.lux create mode 100644 stdlib/source/library/lux/meta/compiler/language/lux/phase/synthesis/function.lux create mode 100644 stdlib/source/library/lux/meta/compiler/language/lux/phase/synthesis/loop.lux create mode 100644 stdlib/source/library/lux/meta/compiler/language/lux/phase/synthesis/variable.lux create mode 100644 stdlib/source/library/lux/meta/compiler/language/lux/program.lux create mode 100644 stdlib/source/library/lux/meta/compiler/language/lux/syntax.lux create mode 100644 stdlib/source/library/lux/meta/compiler/language/lux/synthesis.lux create mode 100644 stdlib/source/library/lux/meta/compiler/language/lux/synthesis/access.lux create mode 100644 stdlib/source/library/lux/meta/compiler/language/lux/synthesis/access/member.lux create mode 100644 stdlib/source/library/lux/meta/compiler/language/lux/synthesis/access/side.lux create mode 100644 stdlib/source/library/lux/meta/compiler/language/lux/synthesis/simple.lux create mode 100644 stdlib/source/library/lux/meta/compiler/meta.lux create mode 100644 stdlib/source/library/lux/meta/compiler/meta/archive.lux create mode 100644 stdlib/source/library/lux/meta/compiler/meta/archive/artifact.lux create mode 100644 stdlib/source/library/lux/meta/compiler/meta/archive/artifact/category.lux create mode 100644 stdlib/source/library/lux/meta/compiler/meta/archive/key.lux create mode 100644 stdlib/source/library/lux/meta/compiler/meta/archive/module.lux create mode 100644 stdlib/source/library/lux/meta/compiler/meta/archive/module/descriptor.lux create mode 100644 stdlib/source/library/lux/meta/compiler/meta/archive/module/document.lux create mode 100644 stdlib/source/library/lux/meta/compiler/meta/archive/registry.lux create mode 100644 stdlib/source/library/lux/meta/compiler/meta/archive/signature.lux create mode 100644 stdlib/source/library/lux/meta/compiler/meta/archive/unit.lux create mode 100644 stdlib/source/library/lux/meta/compiler/meta/cache.lux create mode 100644 stdlib/source/library/lux/meta/compiler/meta/cache/archive.lux create mode 100644 stdlib/source/library/lux/meta/compiler/meta/cache/artifact.lux create mode 100644 stdlib/source/library/lux/meta/compiler/meta/cache/dependency/artifact.lux create mode 100644 stdlib/source/library/lux/meta/compiler/meta/cache/dependency/module.lux create mode 100644 stdlib/source/library/lux/meta/compiler/meta/cache/module.lux create mode 100644 stdlib/source/library/lux/meta/compiler/meta/cache/purge.lux create mode 100644 stdlib/source/library/lux/meta/compiler/meta/cli.lux create mode 100644 stdlib/source/library/lux/meta/compiler/meta/cli/compiler.lux create mode 100644 stdlib/source/library/lux/meta/compiler/meta/context.lux create mode 100644 stdlib/source/library/lux/meta/compiler/meta/export.lux create mode 100644 stdlib/source/library/lux/meta/compiler/meta/import.lux create mode 100644 stdlib/source/library/lux/meta/compiler/meta/io.lux create mode 100644 stdlib/source/library/lux/meta/compiler/meta/io/archive.lux create mode 100644 stdlib/source/library/lux/meta/compiler/meta/io/context.lux create mode 100644 stdlib/source/library/lux/meta/compiler/meta/packager.lux create mode 100644 stdlib/source/library/lux/meta/compiler/meta/packager/jvm.lux create mode 100644 stdlib/source/library/lux/meta/compiler/meta/packager/ruby.lux create mode 100644 stdlib/source/library/lux/meta/compiler/meta/packager/scheme.lux create mode 100644 stdlib/source/library/lux/meta/compiler/meta/packager/script.lux create mode 100644 stdlib/source/library/lux/meta/compiler/phase.lux create mode 100644 stdlib/source/library/lux/meta/compiler/reference.lux create mode 100644 stdlib/source/library/lux/meta/compiler/reference/variable.lux create mode 100644 stdlib/source/library/lux/meta/compiler/version.lux delete mode 100644 stdlib/source/library/lux/tool/compiler.lux delete mode 100644 stdlib/source/library/lux/tool/compiler/arity.lux delete mode 100644 stdlib/source/library/lux/tool/compiler/default/init.lux delete mode 100644 stdlib/source/library/lux/tool/compiler/default/platform.lux delete mode 100644 stdlib/source/library/lux/tool/compiler/language/lux.lux delete mode 100644 stdlib/source/library/lux/tool/compiler/language/lux/analysis.lux delete mode 100644 stdlib/source/library/lux/tool/compiler/language/lux/analysis/complex.lux delete mode 100644 stdlib/source/library/lux/tool/compiler/language/lux/analysis/coverage.lux delete mode 100644 stdlib/source/library/lux/tool/compiler/language/lux/analysis/evaluation.lux delete mode 100644 stdlib/source/library/lux/tool/compiler/language/lux/analysis/inference.lux delete mode 100644 stdlib/source/library/lux/tool/compiler/language/lux/analysis/macro.lux delete mode 100644 stdlib/source/library/lux/tool/compiler/language/lux/analysis/module.lux delete mode 100644 stdlib/source/library/lux/tool/compiler/language/lux/analysis/pattern.lux delete mode 100644 stdlib/source/library/lux/tool/compiler/language/lux/analysis/scope.lux delete mode 100644 stdlib/source/library/lux/tool/compiler/language/lux/analysis/simple.lux delete mode 100644 stdlib/source/library/lux/tool/compiler/language/lux/analysis/type.lux delete mode 100644 stdlib/source/library/lux/tool/compiler/language/lux/declaration.lux delete mode 100644 stdlib/source/library/lux/tool/compiler/language/lux/generation.lux delete mode 100644 stdlib/source/library/lux/tool/compiler/language/lux/phase/analysis.lux delete mode 100644 stdlib/source/library/lux/tool/compiler/language/lux/phase/analysis/case.lux delete mode 100644 stdlib/source/library/lux/tool/compiler/language/lux/phase/analysis/complex.lux delete mode 100644 stdlib/source/library/lux/tool/compiler/language/lux/phase/analysis/function.lux delete mode 100644 stdlib/source/library/lux/tool/compiler/language/lux/phase/analysis/reference.lux delete mode 100644 stdlib/source/library/lux/tool/compiler/language/lux/phase/analysis/simple.lux delete mode 100644 stdlib/source/library/lux/tool/compiler/language/lux/phase/declaration.lux delete mode 100644 stdlib/source/library/lux/tool/compiler/language/lux/phase/extension.lux delete mode 100644 stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/analysis.lux delete mode 100644 stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/analysis/common_lisp.lux delete mode 100644 stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/analysis/js.lux delete mode 100644 stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/analysis/jvm.lux delete mode 100644 stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/analysis/lua.lux delete mode 100644 stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/analysis/lux.lux delete mode 100644 stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/analysis/php.lux delete mode 100644 stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/analysis/python.lux delete mode 100644 stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/analysis/r.lux delete mode 100644 stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/analysis/ruby.lux delete mode 100644 stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/analysis/scheme.lux delete mode 100644 stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/bundle.lux delete mode 100644 stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/declaration/jvm.lux delete mode 100644 stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/declaration/lux.lux delete mode 100644 stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/generation/common_lisp.lux delete mode 100644 stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/generation/common_lisp/common.lux delete mode 100644 stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/generation/common_lisp/host.lux delete mode 100644 stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/generation/js.lux delete mode 100644 stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/generation/js/common.lux delete mode 100644 stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/generation/js/host.lux delete mode 100644 stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/generation/jvm.lux delete mode 100644 stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/generation/jvm/common.lux delete mode 100644 stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/generation/jvm/host.lux delete mode 100644 stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/generation/lua.lux delete mode 100644 stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/generation/lua/common.lux delete mode 100644 stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/generation/lua/host.lux delete mode 100644 stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/generation/php.lux delete mode 100644 stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/generation/php/common.lux delete mode 100644 stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/generation/php/host.lux delete mode 100644 stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/generation/python.lux delete mode 100644 stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/generation/python/common.lux delete mode 100644 stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/generation/python/host.lux delete mode 100644 stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/generation/r.lux delete mode 100644 stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/generation/r/common.lux delete mode 100644 stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/generation/r/host.lux delete mode 100644 stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/generation/ruby.lux delete mode 100644 stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/generation/ruby/common.lux delete mode 100644 stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/generation/ruby/host.lux delete mode 100644 stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/generation/scheme.lux delete mode 100644 stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/generation/scheme/common.lux delete mode 100644 stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/generation/scheme/host.lux delete mode 100644 stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/synthesis.lux delete mode 100644 stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/common_lisp.lux delete mode 100644 stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/common_lisp/case.lux delete mode 100644 stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/common_lisp/extension.lux delete mode 100644 stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/common_lisp/extension/common.lux delete mode 100644 stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/common_lisp/function.lux delete mode 100644 stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/common_lisp/loop.lux delete mode 100644 stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/common_lisp/primitive.lux delete mode 100644 stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/common_lisp/reference.lux delete mode 100644 stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/common_lisp/runtime.lux delete mode 100644 stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/common_lisp/structure.lux delete mode 100644 stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/extension.lux delete mode 100644 stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/js.lux delete mode 100644 stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/js/case.lux delete mode 100644 stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/js/function.lux delete mode 100644 stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/js/loop.lux delete mode 100644 stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/js/primitive.lux delete mode 100644 stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/js/reference.lux delete mode 100644 stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/js/runtime.lux delete mode 100644 stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/js/structure.lux delete mode 100644 stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/jvm.lux delete mode 100644 stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/jvm/case.lux delete mode 100644 stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/jvm/debug.lux delete mode 100644 stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/jvm/function.lux delete mode 100644 stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/jvm/function/abstract.lux delete mode 100644 stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/jvm/function/field/constant.lux delete mode 100644 stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/jvm/function/field/constant/arity.lux delete mode 100644 stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/jvm/function/field/variable.lux delete mode 100644 stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/jvm/function/field/variable/count.lux delete mode 100644 stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/jvm/function/field/variable/foreign.lux delete mode 100644 stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/jvm/function/field/variable/partial.lux delete mode 100644 stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/jvm/function/method.lux delete mode 100644 stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/jvm/function/method/apply.lux delete mode 100644 stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/jvm/function/method/implementation.lux delete mode 100644 stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/jvm/function/method/init.lux delete mode 100644 stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/jvm/function/method/new.lux delete mode 100644 stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/jvm/function/method/reset.lux delete mode 100644 stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/jvm/host.lux delete mode 100644 stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/jvm/loop.lux delete mode 100644 stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/jvm/primitive.lux delete mode 100644 stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/jvm/program.lux delete mode 100644 stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/jvm/reference.lux delete mode 100644 stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/jvm/runtime.lux delete mode 100644 stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/jvm/structure.lux delete mode 100644 stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/jvm/type.lux delete mode 100644 stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/jvm/value.lux delete mode 100644 stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/lua.lux delete mode 100644 stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/lua/case.lux delete mode 100644 stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/lua/function.lux delete mode 100644 stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/lua/loop.lux delete mode 100644 stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/lua/primitive.lux delete mode 100644 stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/lua/reference.lux delete mode 100644 stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/lua/runtime.lux delete mode 100644 stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/lua/structure.lux delete mode 100644 stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/php.lux delete mode 100644 stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/php/case.lux delete mode 100644 stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/php/extension.lux delete mode 100644 stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/php/extension/common.lux delete mode 100644 stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/php/function.lux delete mode 100644 stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/php/loop.lux delete mode 100644 stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/php/primitive.lux delete mode 100644 stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/php/reference.lux delete mode 100644 stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/php/runtime.lux delete mode 100644 stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/php/structure.lux delete mode 100644 stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/python.lux delete mode 100644 stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/python/case.lux delete mode 100644 stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/python/function.lux delete mode 100644 stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/python/loop.lux delete mode 100644 stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/python/primitive.lux delete mode 100644 stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/python/reference.lux delete mode 100644 stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/python/runtime.lux delete mode 100644 stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/python/structure.lux delete mode 100644 stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/r.lux delete mode 100644 stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/r/case.lux delete mode 100644 stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/r/function.lux delete mode 100644 stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/r/loop.lux delete mode 100644 stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/r/primitive.lux delete mode 100644 stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/r/procedure/common.lux delete mode 100644 stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/r/procedure/host.lux delete mode 100644 stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/r/reference.lux delete mode 100644 stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/r/runtime.lux delete mode 100644 stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/r/structure.lux delete mode 100644 stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/reference.lux delete mode 100644 stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/ruby.lux delete mode 100644 stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/ruby/case.lux delete mode 100644 stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/ruby/function.lux delete mode 100644 stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/ruby/loop.lux delete mode 100644 stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/ruby/primitive.lux delete mode 100644 stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/ruby/reference.lux delete mode 100644 stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/ruby/runtime.lux delete mode 100644 stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/ruby/structure.lux delete mode 100644 stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/scheme.lux delete mode 100644 stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/scheme/case.lux delete mode 100644 stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/scheme/extension.lux delete mode 100644 stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/scheme/extension/common.lux delete mode 100644 stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/scheme/function.lux delete mode 100644 stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/scheme/loop.lux delete mode 100644 stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/scheme/primitive.lux delete mode 100644 stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/scheme/reference.lux delete mode 100644 stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/scheme/runtime.lux delete mode 100644 stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/scheme/structure.lux delete mode 100644 stdlib/source/library/lux/tool/compiler/language/lux/phase/synthesis.lux delete mode 100644 stdlib/source/library/lux/tool/compiler/language/lux/phase/synthesis/case.lux delete mode 100644 stdlib/source/library/lux/tool/compiler/language/lux/phase/synthesis/function.lux delete mode 100644 stdlib/source/library/lux/tool/compiler/language/lux/phase/synthesis/loop.lux delete mode 100644 stdlib/source/library/lux/tool/compiler/language/lux/phase/synthesis/variable.lux delete mode 100644 stdlib/source/library/lux/tool/compiler/language/lux/program.lux delete mode 100644 stdlib/source/library/lux/tool/compiler/language/lux/syntax.lux delete mode 100644 stdlib/source/library/lux/tool/compiler/language/lux/synthesis.lux delete mode 100644 stdlib/source/library/lux/tool/compiler/language/lux/synthesis/access.lux delete mode 100644 stdlib/source/library/lux/tool/compiler/language/lux/synthesis/access/member.lux delete mode 100644 stdlib/source/library/lux/tool/compiler/language/lux/synthesis/access/side.lux delete mode 100644 stdlib/source/library/lux/tool/compiler/language/lux/synthesis/simple.lux delete mode 100644 stdlib/source/library/lux/tool/compiler/meta.lux delete mode 100644 stdlib/source/library/lux/tool/compiler/meta/archive.lux delete mode 100644 stdlib/source/library/lux/tool/compiler/meta/archive/artifact.lux delete mode 100644 stdlib/source/library/lux/tool/compiler/meta/archive/artifact/category.lux delete mode 100644 stdlib/source/library/lux/tool/compiler/meta/archive/key.lux delete mode 100644 stdlib/source/library/lux/tool/compiler/meta/archive/module.lux delete mode 100644 stdlib/source/library/lux/tool/compiler/meta/archive/module/descriptor.lux delete mode 100644 stdlib/source/library/lux/tool/compiler/meta/archive/module/document.lux delete mode 100644 stdlib/source/library/lux/tool/compiler/meta/archive/registry.lux delete mode 100644 stdlib/source/library/lux/tool/compiler/meta/archive/signature.lux delete mode 100644 stdlib/source/library/lux/tool/compiler/meta/archive/unit.lux delete mode 100644 stdlib/source/library/lux/tool/compiler/meta/cache.lux delete mode 100644 stdlib/source/library/lux/tool/compiler/meta/cache/archive.lux delete mode 100644 stdlib/source/library/lux/tool/compiler/meta/cache/artifact.lux delete mode 100644 stdlib/source/library/lux/tool/compiler/meta/cache/dependency/artifact.lux delete mode 100644 stdlib/source/library/lux/tool/compiler/meta/cache/dependency/module.lux delete mode 100644 stdlib/source/library/lux/tool/compiler/meta/cache/module.lux delete mode 100644 stdlib/source/library/lux/tool/compiler/meta/cache/purge.lux delete mode 100644 stdlib/source/library/lux/tool/compiler/meta/cli.lux delete mode 100644 stdlib/source/library/lux/tool/compiler/meta/cli/compiler.lux delete mode 100644 stdlib/source/library/lux/tool/compiler/meta/context.lux delete mode 100644 stdlib/source/library/lux/tool/compiler/meta/export.lux delete mode 100644 stdlib/source/library/lux/tool/compiler/meta/import.lux delete mode 100644 stdlib/source/library/lux/tool/compiler/meta/io.lux delete mode 100644 stdlib/source/library/lux/tool/compiler/meta/io/archive.lux delete mode 100644 stdlib/source/library/lux/tool/compiler/meta/io/context.lux delete mode 100644 stdlib/source/library/lux/tool/compiler/meta/packager.lux delete mode 100644 stdlib/source/library/lux/tool/compiler/meta/packager/jvm.lux delete mode 100644 stdlib/source/library/lux/tool/compiler/meta/packager/ruby.lux delete mode 100644 stdlib/source/library/lux/tool/compiler/meta/packager/scheme.lux delete mode 100644 stdlib/source/library/lux/tool/compiler/meta/packager/script.lux delete mode 100644 stdlib/source/library/lux/tool/compiler/phase.lux delete mode 100644 stdlib/source/library/lux/tool/compiler/reference.lux delete mode 100644 stdlib/source/library/lux/tool/compiler/reference/variable.lux delete mode 100644 stdlib/source/library/lux/tool/compiler/version.lux delete mode 100644 stdlib/source/library/lux/tool/interpreter.lux delete mode 100644 stdlib/source/library/lux/tool/mediator.lux create mode 100644 stdlib/source/parser/lux/meta/compiler/language/lux/analysis.lux create mode 100644 stdlib/source/parser/lux/meta/compiler/language/lux/synthesis.lux delete mode 100644 stdlib/source/parser/lux/tool/compiler/language/lux/analysis.lux delete mode 100644 stdlib/source/parser/lux/tool/compiler/language/lux/synthesis.lux create mode 100644 stdlib/source/test/lux/meta/compiler/arity.lux create mode 100644 stdlib/source/test/lux/meta/compiler/language/lux/analysis.lux create mode 100644 stdlib/source/test/lux/meta/compiler/language/lux/analysis/complex.lux create mode 100644 stdlib/source/test/lux/meta/compiler/language/lux/analysis/coverage.lux create mode 100644 stdlib/source/test/lux/meta/compiler/language/lux/analysis/inference.lux create mode 100644 stdlib/source/test/lux/meta/compiler/language/lux/analysis/macro.lux create mode 100644 stdlib/source/test/lux/meta/compiler/language/lux/analysis/module.lux create mode 100644 stdlib/source/test/lux/meta/compiler/language/lux/analysis/pattern.lux create mode 100644 stdlib/source/test/lux/meta/compiler/language/lux/analysis/scope.lux create mode 100644 stdlib/source/test/lux/meta/compiler/language/lux/analysis/simple.lux create mode 100644 stdlib/source/test/lux/meta/compiler/language/lux/analysis/type.lux create mode 100644 stdlib/source/test/lux/meta/compiler/language/lux/phase/analysis.lux create mode 100644 stdlib/source/test/lux/meta/compiler/language/lux/phase/analysis/case.lux create mode 100644 stdlib/source/test/lux/meta/compiler/language/lux/phase/analysis/complex.lux create mode 100644 stdlib/source/test/lux/meta/compiler/language/lux/phase/analysis/function.lux create mode 100644 stdlib/source/test/lux/meta/compiler/language/lux/phase/analysis/reference.lux create mode 100644 stdlib/source/test/lux/meta/compiler/language/lux/phase/analysis/simple.lux create mode 100644 stdlib/source/test/lux/meta/compiler/language/lux/phase/extension.lux create mode 100644 stdlib/source/test/lux/meta/compiler/language/lux/phase/extension/analysis/lux.lux create mode 100644 stdlib/source/test/lux/meta/compiler/language/lux/phase/synthesis.lux create mode 100644 stdlib/source/test/lux/meta/compiler/language/lux/phase/synthesis/case.lux create mode 100644 stdlib/source/test/lux/meta/compiler/language/lux/phase/synthesis/function.lux create mode 100644 stdlib/source/test/lux/meta/compiler/language/lux/phase/synthesis/loop.lux create mode 100644 stdlib/source/test/lux/meta/compiler/language/lux/phase/synthesis/primitive.lux create mode 100644 stdlib/source/test/lux/meta/compiler/language/lux/phase/synthesis/structure.lux create mode 100644 stdlib/source/test/lux/meta/compiler/language/lux/phase/synthesis/variable.lux create mode 100644 stdlib/source/test/lux/meta/compiler/language/lux/syntax.lux create mode 100644 stdlib/source/test/lux/meta/compiler/language/lux/synthesis.lux create mode 100644 stdlib/source/test/lux/meta/compiler/language/lux/synthesis/access.lux create mode 100644 stdlib/source/test/lux/meta/compiler/language/lux/synthesis/access/member.lux create mode 100644 stdlib/source/test/lux/meta/compiler/language/lux/synthesis/access/side.lux create mode 100644 stdlib/source/test/lux/meta/compiler/language/lux/synthesis/simple.lux create mode 100644 stdlib/source/test/lux/meta/compiler/meta/archive.lux create mode 100644 stdlib/source/test/lux/meta/compiler/meta/archive/artifact.lux create mode 100644 stdlib/source/test/lux/meta/compiler/meta/archive/artifact/category.lux create mode 100644 stdlib/source/test/lux/meta/compiler/meta/archive/key.lux create mode 100644 stdlib/source/test/lux/meta/compiler/meta/archive/module.lux create mode 100644 stdlib/source/test/lux/meta/compiler/meta/archive/module/descriptor.lux create mode 100644 stdlib/source/test/lux/meta/compiler/meta/archive/module/document.lux create mode 100644 stdlib/source/test/lux/meta/compiler/meta/archive/registry.lux create mode 100644 stdlib/source/test/lux/meta/compiler/meta/archive/signature.lux create mode 100644 stdlib/source/test/lux/meta/compiler/meta/archive/unit.lux create mode 100644 stdlib/source/test/lux/meta/compiler/meta/cache.lux create mode 100644 stdlib/source/test/lux/meta/compiler/meta/cache/archive.lux create mode 100644 stdlib/source/test/lux/meta/compiler/meta/cache/artifact.lux create mode 100644 stdlib/source/test/lux/meta/compiler/meta/cache/module.lux create mode 100644 stdlib/source/test/lux/meta/compiler/meta/cache/purge.lux create mode 100644 stdlib/source/test/lux/meta/compiler/meta/cli.lux create mode 100644 stdlib/source/test/lux/meta/compiler/meta/cli/compiler.lux create mode 100644 stdlib/source/test/lux/meta/compiler/meta/context.lux create mode 100644 stdlib/source/test/lux/meta/compiler/meta/export.lux create mode 100644 stdlib/source/test/lux/meta/compiler/meta/import.lux create mode 100644 stdlib/source/test/lux/meta/compiler/phase.lux create mode 100644 stdlib/source/test/lux/meta/compiler/reference.lux create mode 100644 stdlib/source/test/lux/meta/compiler/reference/variable.lux create mode 100644 stdlib/source/test/lux/meta/compiler/version.lux delete mode 100644 stdlib/source/test/lux/tool.lux delete mode 100644 stdlib/source/test/lux/tool/compiler/arity.lux delete mode 100644 stdlib/source/test/lux/tool/compiler/language/lux/analysis.lux delete mode 100644 stdlib/source/test/lux/tool/compiler/language/lux/analysis/complex.lux delete mode 100644 stdlib/source/test/lux/tool/compiler/language/lux/analysis/coverage.lux delete mode 100644 stdlib/source/test/lux/tool/compiler/language/lux/analysis/inference.lux delete mode 100644 stdlib/source/test/lux/tool/compiler/language/lux/analysis/macro.lux delete mode 100644 stdlib/source/test/lux/tool/compiler/language/lux/analysis/module.lux delete mode 100644 stdlib/source/test/lux/tool/compiler/language/lux/analysis/pattern.lux delete mode 100644 stdlib/source/test/lux/tool/compiler/language/lux/analysis/scope.lux delete mode 100644 stdlib/source/test/lux/tool/compiler/language/lux/analysis/simple.lux delete mode 100644 stdlib/source/test/lux/tool/compiler/language/lux/analysis/type.lux delete mode 100644 stdlib/source/test/lux/tool/compiler/language/lux/phase/analysis.lux delete mode 100644 stdlib/source/test/lux/tool/compiler/language/lux/phase/analysis/case.lux delete mode 100644 stdlib/source/test/lux/tool/compiler/language/lux/phase/analysis/complex.lux delete mode 100644 stdlib/source/test/lux/tool/compiler/language/lux/phase/analysis/function.lux delete mode 100644 stdlib/source/test/lux/tool/compiler/language/lux/phase/analysis/reference.lux delete mode 100644 stdlib/source/test/lux/tool/compiler/language/lux/phase/analysis/simple.lux delete mode 100644 stdlib/source/test/lux/tool/compiler/language/lux/phase/extension.lux delete mode 100644 stdlib/source/test/lux/tool/compiler/language/lux/phase/extension/analysis/lux.lux delete mode 100644 stdlib/source/test/lux/tool/compiler/language/lux/phase/synthesis.lux delete mode 100644 stdlib/source/test/lux/tool/compiler/language/lux/phase/synthesis/case.lux delete mode 100644 stdlib/source/test/lux/tool/compiler/language/lux/phase/synthesis/function.lux delete mode 100644 stdlib/source/test/lux/tool/compiler/language/lux/phase/synthesis/loop.lux delete mode 100644 stdlib/source/test/lux/tool/compiler/language/lux/phase/synthesis/primitive.lux delete mode 100644 stdlib/source/test/lux/tool/compiler/language/lux/phase/synthesis/structure.lux delete mode 100644 stdlib/source/test/lux/tool/compiler/language/lux/phase/synthesis/variable.lux delete mode 100644 stdlib/source/test/lux/tool/compiler/language/lux/syntax.lux delete mode 100644 stdlib/source/test/lux/tool/compiler/language/lux/synthesis.lux delete mode 100644 stdlib/source/test/lux/tool/compiler/language/lux/synthesis/access.lux delete mode 100644 stdlib/source/test/lux/tool/compiler/language/lux/synthesis/access/member.lux delete mode 100644 stdlib/source/test/lux/tool/compiler/language/lux/synthesis/access/side.lux delete mode 100644 stdlib/source/test/lux/tool/compiler/language/lux/synthesis/simple.lux delete mode 100644 stdlib/source/test/lux/tool/compiler/meta/archive.lux delete mode 100644 stdlib/source/test/lux/tool/compiler/meta/archive/artifact.lux delete mode 100644 stdlib/source/test/lux/tool/compiler/meta/archive/artifact/category.lux delete mode 100644 stdlib/source/test/lux/tool/compiler/meta/archive/key.lux delete mode 100644 stdlib/source/test/lux/tool/compiler/meta/archive/module.lux delete mode 100644 stdlib/source/test/lux/tool/compiler/meta/archive/module/descriptor.lux delete mode 100644 stdlib/source/test/lux/tool/compiler/meta/archive/module/document.lux delete mode 100644 stdlib/source/test/lux/tool/compiler/meta/archive/registry.lux delete mode 100644 stdlib/source/test/lux/tool/compiler/meta/archive/signature.lux delete mode 100644 stdlib/source/test/lux/tool/compiler/meta/archive/unit.lux delete mode 100644 stdlib/source/test/lux/tool/compiler/meta/cache.lux delete mode 100644 stdlib/source/test/lux/tool/compiler/meta/cache/archive.lux delete mode 100644 stdlib/source/test/lux/tool/compiler/meta/cache/artifact.lux delete mode 100644 stdlib/source/test/lux/tool/compiler/meta/cache/module.lux delete mode 100644 stdlib/source/test/lux/tool/compiler/meta/cache/purge.lux delete mode 100644 stdlib/source/test/lux/tool/compiler/meta/cli.lux delete mode 100644 stdlib/source/test/lux/tool/compiler/meta/cli/compiler.lux delete mode 100644 stdlib/source/test/lux/tool/compiler/meta/context.lux delete mode 100644 stdlib/source/test/lux/tool/compiler/meta/export.lux delete mode 100644 stdlib/source/test/lux/tool/compiler/meta/import.lux delete mode 100644 stdlib/source/test/lux/tool/compiler/phase.lux delete mode 100644 stdlib/source/test/lux/tool/compiler/reference.lux delete mode 100644 stdlib/source/test/lux/tool/compiler/reference/variable.lux delete mode 100644 stdlib/source/test/lux/tool/compiler/version.lux (limited to 'stdlib') diff --git a/stdlib/source/documentation/lux/extension.lux b/stdlib/source/documentation/lux/extension.lux index 1ca48bc21..702d82bd3 100644 --- a/stdlib/source/documentation/lux/extension.lux +++ b/stdlib/source/documentation/lux/extension.lux @@ -12,8 +12,7 @@ ["[0]" code ["<[1]>" \\parser]] [macro - ["[0]" template]]] - [tool + ["[0]" template]] [compiler ["[0]" phase] [language diff --git a/stdlib/source/experiment/compiler.lux b/stdlib/source/experiment/compiler.lux index 8819847e6..1ee041523 100644 --- a/stdlib/source/experiment/compiler.lux +++ b/stdlib/source/experiment/compiler.lux @@ -3,7 +3,7 @@ [lux (.except) [control ["[0]" try]] - [tool + [meta ["[0]" compiler (.only Custom)]]]]) (def .public (dummy parameters) diff --git a/stdlib/source/experiment/tool/interpreter.lux b/stdlib/source/experiment/tool/interpreter.lux new file mode 100644 index 000000000..c6e9c5de3 --- /dev/null +++ b/stdlib/source/experiment/tool/interpreter.lux @@ -0,0 +1,227 @@ +(.require + [library + [lux (.except) + [control + [monad (.only Monad do)] + ["[0]" try (.only Try)] + ["ex" exception (.only exception)]] + [data + ["[0]" text (.use "[1]#[0]" equivalence) + ["%" \\format (.only format)]]] + [type (.only sharing) + ["[0]" check]] + [compiler + ["[0]" phase + ["[0]" analysis + ["[0]" module] + ["[0]" type]] + ["[0]" generation] + ["[0]" declaration (.only State+ Operation) + ["[0]" total]] + ["[0]" extension]] + ["[0]" default + ["[0]" syntax] + ["[0]" platform (.only Platform)] + ["[0]" init]] + ["[0]" cli (.only Configuration)]] + [world + ["[0]" file (.only File)] + ["[0]" console (.only Console)]]]] + ["[0]" /type]) + +(exception .public (error [message Text]) + message) + +(def .public module "") + +(def fresh_source + Source + [[..module 1 0] 0 ""]) + +(def (add_line line [where offset input]) + (-> Text Source Source) + [where offset (format input text.new_line line)]) + +(def exit_command + Text + "exit") + +(def welcome_message + Text + (format text.new_line + "Welcome to the interpreter!" text.new_line + "Type '" ..exit_command "' to leave." text.new_line + text.new_line)) + +(def farewell_message + Text + "Till next time...") + +(def enter_module + (All (_ anchor expression declaration) + (Operation anchor expression declaration Any)) + (declaration.lifted_analysis + (do phase.monad + [_ (module.create 0 ..module)] + (analysis.set_current_module ..module)))) + +(def (initialize Monad Console platform configuration generation_bundle) + (All (_ ! anchor expression declaration) + (-> (Monad !) + (Console !) (Platform ! anchor expression declaration) + Configuration + (generation.Bundle anchor expression declaration) + (! (State+ anchor expression declaration)))) + (do Monad + [state (platform.initialize platform generation_bundle) + state (platform.compile platform + (has cli.#module syntax.prelude configuration) + (has [extension.#state + declaration.#analysis declaration.#state + extension.#state + .#info .#mode] + {.#Interpreter} + state)) + [state _] (at (the platform.#file_system platform) + lift (phase.result' state enter_module)) + _ (at Console write ..welcome_message)] + (in state))) + +(with_expansions [ (these (Operation anchor expression declaration [Type Any]))] + + (def (interpret_declaration code) + (All (_ anchor expression declaration) + (-> Code )) + (do phase.monad + [_ (total.phase code) + _ init.refresh] + (in [Any []]))) + + (def (interpret_expression code) + (All (_ anchor expression declaration) + (-> Code )) + (do [! phase.monad] + [state (extension.lifted phase.state) + .let [analyse (the [declaration.#analysis declaration.#phase] state) + synthesize (the [declaration.#synthesis declaration.#phase] state) + generate (the [declaration.#generation declaration.#phase] state)] + [_ codeT codeA] (declaration.lifted_analysis + (analysis.with_scope + (type.with_fresh_env + (do ! + [[codeT codeA] (type.with_inference + (analyse code)) + codeT (type.with_env + (check.clean codeT))] + (in [codeT codeA]))))) + codeS (declaration.lifted_synthesis + (synthesize codeA))] + (declaration.lifted_generation + (generation.with_buffer + (do ! + [codeH (generate codeS) + count generation.next + codeV (generation.evaluate! (format "interpretation_" (%.nat count)) codeH)] + (in [codeT codeV])))))) + + (def (interpret configuration code) + (All (_ anchor expression declaration) + (-> Configuration Code )) + (function (_ state) + (case (<| (phase.result' state) + (sharing [anchor expression declaration] + (is (State+ anchor expression declaration) + state) + (is + (interpret_declaration code)))) + {try.#Success [state' output]} + {try.#Success [state' output]} + + {try.#Failure error} + (if (ex.match? total.not_a_declaration error) + (<| (phase.result' state) + (sharing [anchor expression declaration] + (is (State+ anchor expression declaration) + state) + (is + (interpret_expression code)))) + {try.#Failure error})))) + ) + +(def (execute configuration code) + (All (_ anchor expression declaration) + (-> Configuration Code (Operation anchor expression declaration Text))) + (do phase.monad + [[codeT codeV] (interpret configuration code) + state phase.state] + (in (/type.represent (the [extension.#state + declaration.#analysis declaration.#state + extension.#state] + state) + codeT + codeV)))) + +(type (Context anchor expression declaration) + (Record + [#configuration Configuration + #state (State+ anchor expression declaration) + #source Source])) + +(with_expansions [ (these (Context anchor expression declaration))] + (def (read_eval_print context) + (All (_ anchor expression declaration) + (-> (Try [ Text]))) + (do try.monad + [.let [[_where _offset _code] (the #source context)] + [source' input] (syntax.parse ..module syntax.no_aliases (text.size _code) (the #source context)) + [state' representation] (let [... TODO: Simplify ASAP + state (sharing [anchor expression declaration] + (is + context) + (is (State+ anchor expression declaration) + (the #state context)))] + (<| (phase.result' state) + ... TODO: Simplify ASAP + (sharing [anchor expression declaration] + (is + context) + (is (Operation anchor expression declaration Text) + (execute (the #configuration context) input)))))] + (in [(|> context + (has #state state') + (has #source source')) + representation])))) + +(def .public (run! Monad Console platform configuration generation_bundle) + (All (_ ! anchor expression declaration) + (-> (Monad !) + (Console !) (Platform ! anchor expression declaration) + Configuration + (generation.Bundle anchor expression declaration) + (! Any))) + (do [! Monad] + [state (initialize Monad Console platform configuration)] + (loop (again [context [#configuration configuration + #state state + #source ..fresh_source] + multi_line? #0]) + (do ! + [_ (if multi_line? + (at Console write " ") + (at Console write "> ")) + line (at Console read_line)] + (if (and (not multi_line?) + (text#= ..exit_command line)) + (at Console write ..farewell_message) + (case (read_eval_print (revised #source (add_line line) context)) + {try.#Success [context' representation]} + (do ! + [_ (at Console write representation)] + (again context' #0)) + + {try.#Failure error} + (if (ex.match? syntax.end_of_file error) + (again context #1) + (exec (log! (ex.error ..error error)) + (again (has #source ..fresh_source context) #0)))))) + ))) diff --git a/stdlib/source/experiment/tool/mediator.lux b/stdlib/source/experiment/tool/mediator.lux new file mode 100644 index 000000000..a397a4396 --- /dev/null +++ b/stdlib/source/experiment/tool/mediator.lux @@ -0,0 +1,20 @@ +(.require + [library + [lux (.except Source Module) + [world + ["[0]" binary (.only Binary)] + ["[0]" file (.only Path)]]]] + [// + [compiler (.only Compiler) + [meta + ["[0]" archive (.only Archive) + [descriptor (.only Module)]]]]]) + +(type .public Source + Path) + +(type .public (Mediator !) + (-> Archive Module (! Archive))) + +(type .public (Instancer ! d o) + (-> (file.System !) (List Source) (Compiler d o) (Mediator !))) diff --git a/stdlib/source/library/lux/documentation.lux b/stdlib/source/library/lux/documentation.lux index 8159c5ed4..a5e50669c 100644 --- a/stdlib/source/library/lux/documentation.lux +++ b/stdlib/source/library/lux/documentation.lux @@ -28,8 +28,7 @@ ["[0]" macro (.only) [syntax (.only syntax)] ["^" pattern] - ["[0]" template]]] - [tool + ["[0]" template]] [compiler [language [lux diff --git a/stdlib/source/library/lux/extension.lux b/stdlib/source/library/lux/extension.lux index 8fcfd5a96..3ab53a44a 100644 --- a/stdlib/source/library/lux/extension.lux +++ b/stdlib/source/library/lux/extension.lux @@ -13,8 +13,7 @@ ["[0]" code (.only) ["" \\parser (.only Parser)]] [macro (.only with_symbols) - [syntax (.only syntax)]]] - [tool + [syntax (.only syntax)]] [compiler ["[0]" phase] [language diff --git a/stdlib/source/library/lux/ffi/export.js.lux b/stdlib/source/library/lux/ffi/export.js.lux index d8f26b60d..a661027ab 100644 --- a/stdlib/source/library/lux/ffi/export.js.lux +++ b/stdlib/source/library/lux/ffi/export.js.lux @@ -21,8 +21,7 @@ ["[0]" macro (.only) [syntax (.only syntax)]] [target - ["/" js]]] - [tool + ["/" js]] [compiler ["[0]" phase] [meta diff --git a/stdlib/source/library/lux/ffi/export.lua.lux b/stdlib/source/library/lux/ffi/export.lua.lux index 7f527112f..b485934c5 100644 --- a/stdlib/source/library/lux/ffi/export.lua.lux +++ b/stdlib/source/library/lux/ffi/export.lua.lux @@ -21,8 +21,7 @@ ["[0]" macro (.only) [syntax (.only syntax)]] [target - ["/" lua]]] - [tool + ["/" lua]] [compiler ["[0]" phase] [meta diff --git a/stdlib/source/library/lux/ffi/export.py.lux b/stdlib/source/library/lux/ffi/export.py.lux index 1ec506690..63cc2c471 100644 --- a/stdlib/source/library/lux/ffi/export.py.lux +++ b/stdlib/source/library/lux/ffi/export.py.lux @@ -21,8 +21,7 @@ ["[0]" macro (.only) [syntax (.only syntax)]] [target - ["/" python]]] - [tool + ["/" python]] [compiler ["[0]" phase] [meta diff --git a/stdlib/source/library/lux/ffi/export.rb.lux b/stdlib/source/library/lux/ffi/export.rb.lux index 674482154..aa1ade262 100644 --- a/stdlib/source/library/lux/ffi/export.rb.lux +++ b/stdlib/source/library/lux/ffi/export.rb.lux @@ -23,8 +23,7 @@ ["[0]" macro (.only) [syntax (.only syntax)]] [target - ["/" ruby]]] - [tool + ["/" ruby]] [compiler ["[0]" phase] [meta diff --git a/stdlib/source/library/lux/math.lux b/stdlib/source/library/lux/math.lux index c01471596..fdc9ea946 100644 --- a/stdlib/source/library/lux/math.lux +++ b/stdlib/source/library/lux/math.lux @@ -22,8 +22,7 @@ [syntax (.only syntax)] ["[0]" template]] [type - ["[0]" check]]] - [tool + ["[0]" check]] [compiler ["[0]" phase (.use "[1]#[0]" monad)] [language diff --git a/stdlib/source/library/lux/meta/compiler.lux b/stdlib/source/library/lux/meta/compiler.lux new file mode 100644 index 000000000..1d46450a2 --- /dev/null +++ b/stdlib/source/library/lux/meta/compiler.lux @@ -0,0 +1,59 @@ +(.require + [library + [lux (.except Module Code) + [control + ["<>" parser (.only)] + ["[0]" try (.only Try)] + ["[0]" exception (.only exception)]] + [data + ["[0]" text] + ["[0]" binary (.only Binary) + [\\format (.only Format)] + ["<[1]>" \\parser (.only Parser)]]] + [world + ["[0]" file (.only Path)]]]] + [/ + [meta + ["[0]" archive (.only Output Archive) + [key (.only Key)] + [module + [descriptor (.only Descriptor Module)] + [document (.only Document)]]]]]) + +(type .public Code + Text) + +(type .public Parameter + Text) + +(type .public Input + (Record + [#module Module + #file Path + #hash Nat + #code Code])) + +(type .public (Compilation s d o) + (Record + [#dependencies (List Module) + #process (-> s Archive + (Try [s (Either (Compilation s d o) + (archive.Entry d))]))])) + +(type .public (Compiler s d o) + (-> Input (Compilation s d o))) + +(type .public Custom + (Ex (_ state document object) + [state + (Key document) + (Format document) + (Parser document) + (-> Input (Try (Compilation state document object)))])) + +(type .public (Instancer s d o) + (-> (Key d) (List Parameter) (Compiler s d o))) + +(exception .public (cannot_compile [module Module]) + (exception.report + "Module" module)) diff --git a/stdlib/source/library/lux/meta/compiler/arity.lux b/stdlib/source/library/lux/meta/compiler/arity.lux new file mode 100644 index 000000000..9d88e1d0f --- /dev/null +++ b/stdlib/source/library/lux/meta/compiler/arity.lux @@ -0,0 +1,17 @@ +(.require + [library + [lux (.except) + [math + [number + ["n" nat]]]]]) + +(type .public Arity + Nat) + +(with_template [ ] + [(def .public (-> Arity Bit) ( 1))] + + [n.< nullary?] + [n.= unary?] + [n.> multiary?] + ) diff --git a/stdlib/source/library/lux/meta/compiler/default/init.lux b/stdlib/source/library/lux/meta/compiler/default/init.lux new file mode 100644 index 000000000..6d6704655 --- /dev/null +++ b/stdlib/source/library/lux/meta/compiler/default/init.lux @@ -0,0 +1,291 @@ +(.require + [library + [lux (.except) + [abstract + ["[0]" monad (.only do)]] + [control + ["[0]" try (.only Try)] + ["[0]" exception]] + [data + [binary (.only Binary)] + ["[0]" product] + ["[0]" text (.use "[1]#[0]" hash) + ["%" \\format (.only format)]] + [collection + ["[0]" list (.use "[1]#[0]" functor)] + ["[0]" dictionary] + ["[0]" set] + ["[0]" sequence (.use "[1]#[0]" functor)]]] + ["[0]" meta (.only) + ["@" target (.only Target)] + ["[0]" configuration (.only Configuration)] + ["[0]" version]] + [world + ["[0]" file]]]] + ["[0]" // + ["/[1]" // (.only Instancer) + ["[1][0]" phase] + [language + [lux + [program (.only Program)] + ["[1][0]" syntax (.only Aliases)] + ["[1][0]" synthesis] + ["[1][0]" declaration (.only Requirements)] + ["[1][0]" generation] + ["[1][0]" analysis (.only) + [macro (.only Expander)] + ["[1]/[0]" evaluation] + ["[0]A" module]] + [phase + ["[0]P" analysis] + ["[0]P" synthesis] + ["[0]P" declaration] + ["[0]" extension (.only Extender) + ["[0]E" analysis] + ["[0]E" synthesis] + [declaration + ["[0]D" lux]]]]]] + [meta + ["[0]" archive (.only Archive) + ["[0]" registry (.only Registry)] + ["[0]" module (.only) + ["[0]" descriptor] + ["[0]" document]]]]]]) + +(def .public (state target module configuration expander host_analysis host generate generation_bundle) + (All (_ anchor expression declaration) + (-> Target + descriptor.Module + Configuration + Expander + ///analysis.Bundle + (///generation.Host expression declaration) + (///generation.Phase anchor expression declaration) + (///generation.Bundle anchor expression declaration) + (///declaration.State+ anchor expression declaration))) + (let [synthesis_state [synthesisE.bundle ///synthesis.init] + generation_state [generation_bundle (///generation.state host module)] + eval (///analysis/evaluation.evaluator expander synthesis_state generation_state generate) + analysis_state [(analysisE.bundle eval host_analysis) + (///analysis.state (///analysis.info version.latest target configuration))]] + [extension.empty + [///declaration.#analysis [///declaration.#state analysis_state + ///declaration.#phase (analysisP.phase expander)] + ///declaration.#synthesis [///declaration.#state synthesis_state + ///declaration.#phase synthesisP.phase] + ///declaration.#generation [///declaration.#state generation_state + ///declaration.#phase generate]]])) + +(def .public (with_default_declarations expander host_analysis program anchorT,expressionT,declarationT extender) + (All (_ anchor expression declaration) + (-> Expander + ///analysis.Bundle + (Program expression declaration) + [Type Type Type] + Extender + (-> (///declaration.State+ anchor expression declaration) + (///declaration.State+ anchor expression declaration)))) + (function (_ [declaration_extensions sub_state]) + [(dictionary.composite declaration_extensions + (luxD.bundle expander host_analysis program anchorT,expressionT,declarationT extender)) + sub_state])) + +(type Reader + (-> Source (Either [Source Text] [Source Code]))) + +(def (reader current_module aliases [location offset source_code]) + (-> descriptor.Module Aliases Source (///analysis.Operation Reader)) + (function (_ [bundle state]) + {try.#Success [[bundle state] + (///syntax.parse current_module aliases ("lux text size" source_code))]})) + +(def (read source reader) + (-> Source Reader (///analysis.Operation [Source Code])) + (function (_ [bundle compiler]) + (case (reader source) + {.#Left [source' error]} + {try.#Failure error} + + {.#Right [source' output]} + (let [[location _] output] + {try.#Success [[bundle (|> compiler + (has .#source source') + (has .#location location))] + [source' output]]})))) + +(type (Operation a) + (All (_ anchor expression declaration) + (///declaration.Operation anchor expression declaration a))) + +(type (Payload declaration) + [(///generation.Buffer declaration) + Registry]) + +(def (begin dependencies hash input) + (-> (List descriptor.Module) Nat ///.Input + (All (_ anchor expression declaration) + (///declaration.Operation anchor expression declaration + [Source (Payload declaration)]))) + (do ///phase.monad + [.let [module (the ///.#module input)] + _ (///declaration.set_current_module module)] + (///declaration.lifted_analysis + (do [! ///phase.monad] + [_ (moduleA.create hash module) + _ (monad.each ! moduleA.import dependencies) + .let [source (///analysis.source (the ///.#module input) (the ///.#code input))] + _ (///analysis.set_source_code source)] + (in [source [///generation.empty_buffer + registry.empty]]))))) + +(def (end module) + (-> descriptor.Module + (All (_ anchor expression declaration) + (///declaration.Operation anchor expression declaration [.Module (Payload declaration)]))) + (do ///phase.monad + [_ (///declaration.lifted_analysis + (moduleA.set_compiled module)) + analysis_module (<| (is (Operation .Module)) + ///declaration.lifted_analysis + extension.lifted + meta.current_module) + final_buffer (///declaration.lifted_generation + ///generation.buffer) + final_registry (///declaration.lifted_generation + ///generation.get_registry)] + (in [analysis_module [final_buffer + final_registry]]))) + +... TODO: Inline ASAP +(def (get_current_payload _) + (All (_ declaration) + (-> (Payload declaration) + (All (_ anchor expression) + (///declaration.Operation anchor expression declaration + (Payload declaration))))) + (do ///phase.monad + [buffer (///declaration.lifted_generation + ///generation.buffer) + registry (///declaration.lifted_generation + ///generation.get_registry)] + (in [buffer registry]))) + +... TODO: Inline ASAP +(def (process_declaration wrapper archive expander pre_payoad code) + (All (_ declaration) + (-> ///phase.Wrapper Archive Expander (Payload declaration) Code + (All (_ anchor expression) + (///declaration.Operation anchor expression declaration + [Requirements (Payload declaration)])))) + (do ///phase.monad + [.let [[pre_buffer pre_registry] pre_payoad] + _ (///declaration.lifted_generation + (///generation.set_buffer pre_buffer)) + _ (///declaration.lifted_generation + (///generation.set_registry pre_registry)) + requirements (let [execute! (declarationP.phase wrapper expander)] + (execute! archive code)) + post_payload (..get_current_payload pre_payoad)] + (in [requirements post_payload]))) + +(def (iteration' wrapper archive expander reader source pre_payload) + (All (_ declaration) + (-> ///phase.Wrapper Archive Expander Reader Source (Payload declaration) + (All (_ anchor expression) + (///declaration.Operation anchor expression declaration + [Source Requirements (Payload declaration)])))) + (do ///phase.monad + [[source code] (///declaration.lifted_analysis + (..read source reader)) + [requirements post_payload] (process_declaration wrapper archive expander pre_payload code)] + (in [source requirements post_payload]))) + +(def (iteration wrapper archive expander module source pre_payload aliases) + (All (_ declaration) + (-> ///phase.Wrapper Archive Expander descriptor.Module Source (Payload declaration) Aliases + (All (_ anchor expression) + (///declaration.Operation anchor expression declaration + (Maybe [Source Requirements (Payload declaration)]))))) + (do ///phase.monad + [reader (///declaration.lifted_analysis + (..reader module aliases source))] + (function (_ state) + (case (///phase.result' state (..iteration' wrapper archive expander reader source pre_payload)) + {try.#Success [state source&requirements&buffer]} + {try.#Success [state {.#Some source&requirements&buffer}]} + + {try.#Failure error} + (if (exception.match? ///syntax.end_of_file error) + {try.#Success [state {.#None}]} + (exception.with ///.cannot_compile module {try.#Failure error})))))) + +(def (default_dependencies prelude input) + (-> descriptor.Module ///.Input (List descriptor.Module)) + (list.partial descriptor.runtime + (if (text#= prelude (the ///.#module input)) + (list) + (list prelude)))) + +(def module_aliases + (-> .Module Aliases) + (|>> (the .#module_aliases) (dictionary.of_list text.hash))) + +(def .public (compiler wrapper expander prelude write_declaration) + (All (_ anchor expression declaration) + (-> ///phase.Wrapper Expander descriptor.Module (-> declaration Binary) + (Instancer (///declaration.State+ anchor expression declaration) .Module))) + (let [execute! (declarationP.phase wrapper expander)] + (function (_ key parameters input) + (let [dependencies (default_dependencies prelude input)] + [///.#dependencies dependencies + ///.#process (function (_ state archive) + (do [! try.monad] + [.let [hash (text#hash (the ///.#code input))] + [state [source buffer]] (<| (///phase.result' state) + (..begin dependencies hash input)) + .let [module (the ///.#module input)]] + (loop (again [iteration (<| (///phase.result' state) + (..iteration wrapper archive expander module source buffer ///syntax.no_aliases))]) + (do ! + [[state ?source&requirements&temporary_payload] iteration] + (case ?source&requirements&temporary_payload + {.#None} + (do ! + [[state [analysis_module [final_buffer final_registry]]] (///phase.result' state (..end module)) + .let [descriptor [descriptor.#hash hash + descriptor.#name module + descriptor.#file (the ///.#file input) + descriptor.#references (set.of_list text.hash dependencies) + descriptor.#state {.#Compiled}]]] + (in [state + {.#Right [[module.#id (try.else module.runtime (archive.id module archive)) + module.#descriptor descriptor + module.#document (document.document key analysis_module)] + (sequence#each (function (_ [artifact_id custom declaration]) + [artifact_id custom (write_declaration declaration)]) + final_buffer) + final_registry]}])) + + {.#Some [source requirements temporary_payload]} + (let [[temporary_buffer temporary_registry] temporary_payload] + (in [state + {.#Left [///.#dependencies (|> requirements + (the ///declaration.#imports) + (list#each product.left)) + ///.#process (function (_ state archive) + (again (<| (///phase.result' state) + (do [! ///phase.monad] + [analysis_module (<| (is (Operation .Module)) + ///declaration.lifted_analysis + extension.lifted + meta.current_module) + _ (///declaration.lifted_generation + (///generation.set_buffer temporary_buffer)) + _ (///declaration.lifted_generation + (///generation.set_registry temporary_registry)) + _ (|> requirements + (the ///declaration.#referrals) + (monad.each ! (execute! archive))) + temporary_payload (..get_current_payload temporary_payload)] + (..iteration wrapper archive expander module source temporary_payload (..module_aliases analysis_module))))))]}])) + )))))])))) diff --git a/stdlib/source/library/lux/meta/compiler/default/platform.lux b/stdlib/source/library/lux/meta/compiler/default/platform.lux new file mode 100644 index 000000000..cdea7252d --- /dev/null +++ b/stdlib/source/library/lux/meta/compiler/default/platform.lux @@ -0,0 +1,888 @@ +(.require + [library + [lux (.except) + ["[0]" debug] + ["[0]" static] + [abstract + ["[0]" monad (.only Monad do)]] + [control + ["[0]" function] + ["[0]" maybe] + ["[0]" try (.only Try) (.use "[1]#[0]" monad)] + ["[0]" exception (.only exception)] + [concurrency + ["[0]" async (.only Async Resolver) (.use "[1]#[0]" monad)] + ["[0]" stm (.only Var STM)]]] + [data + ["[0]" bit] + ["[0]" product] + ["[0]" binary (.only Binary) + ["_" \\format (.only Format)]] + ["[0]" text (.use "[1]#[0]" equivalence) + ["%" \\format]] + [collection + ["[0]" dictionary (.only Dictionary)] + ["[0]" sequence (.only Sequence) (.use "[1]#[0]" mix)] + ["[0]" set (.only Set)] + ["[0]" list (.use "[1]#[0]" monoid functor mix)]]] + ["[0]" meta (.only) + ["@" target] + ["[0]" configuration (.only Configuration)] + [type (.only sharing) + ["[0]" check]]] + [world + ["[0]" file (.only Path)] + ["[0]" console]]]] + ["[0]" // + ["[1][0]" init] + ["/[1]" // (.only) + ["[1][0]" phase (.only Phase)] + [language + [lux + [program (.only Program)] + ["$" /] + ["[0]" syntax] + ["[1][0]" synthesis] + ["[1][0]" generation (.only Buffer)] + ["[1][0]" declaration] + ["[1][0]" analysis (.only) + [macro (.only Expander)] + ["[0]A" module]] + [phase + ["[0]" extension (.only Extender)]]]] + [meta + [import (.only Import)] + ["[0]" context] + ["[0]" cache (.only) + ["[1]/[0]" archive] + ["[1]/[0]" module] + ["[1]/[0]" artifact]] + [cli (.only Compilation Library) + ["[0]" compiler]] + ["[0]" archive (.only Output Archive) + [key (.only Key)] + ["[0]" registry (.only Registry)] + ["[0]" artifact] + ["[0]" module (.only) + ["[0]" descriptor (.only Descriptor)] + ["[0]" document (.only Document)]]] + ["[0]" io + ["_[1]" /] + ["[1]" context] + ["ioW" archive]]]]]) + +(with_expansions [ (these anchor expression declaration) + (these ///generation.Operation )] + (type .public (Platform ) + (Record + [#file_system (file.System Async) + #host (///generation.Host expression declaration) + #phase (///generation.Phase ) + #runtime ( [Registry Output]) + #phase_wrapper (-> Archive ( ///phase.Wrapper)) + #write (-> declaration Binary)])) + + ... TODO: Get rid of this + (type (Action a) + (Async (Try a))) + + ... TODO: Get rid of this + (def monad + (as (Monad Action) + (try.with async.monad))) + + (with_expansions [ (these (Platform )) + (these (///declaration.State+ )) + (these (///generation.Bundle ))] + + (def (format //) + (All (_ a) + (-> (Format a) + (Format [(module.Module a) Registry]))) + (all _.and + (all _.and + _.nat + descriptor.format + (document.format //)) + registry.format + )) + + (def (cache_module context platform @module key format entry) + (All (_ document) + (-> context.Context module.ID (Key document) (Format document) (archive.Entry document) + (Async (Try Any)))) + (let [system (the #file_system platform) + write_artifact! (is (-> [artifact.ID (Maybe Text) Binary] (Action Any)) + (function (_ [artifact_id custom content]) + (is (Async (Try Any)) + (cache/artifact.cache! system context @module artifact_id content))))] + (do [! ..monad] + [_ (is (Async (Try Any)) + (cache/module.enable! async.monad system context @module)) + _ (for @.python (|> entry + (the archive.#output) + sequence.list + (list.sub 128) + (monad.each ! (monad.each ! write_artifact!)) + (is (Action (List (List Any))))) + (|> entry + (the archive.#output) + sequence.list + (monad.each ..monad write_artifact!) + (is (Action (List Any))))) + document (at async.monad in + (document.marked? key (the [archive.#module module.#document] entry)))] + (is (Async (Try Any)) + (|> [(|> entry + (the archive.#module) + (has module.#document document)) + (the archive.#registry entry)] + (_.result (..format format)) + (cache/module.cache! system context @module)))))) + + ... TODO: Inline ASAP + (def initialize_buffer! + (All (_ ) + (///generation.Operation Any)) + (///generation.set_buffer ///generation.empty_buffer)) + + ... TODO: Inline ASAP + (def (compile_runtime! platform) + (All (_ ) + (-> (///generation.Operation [Registry Output]))) + (do ///phase.monad + [_ ..initialize_buffer!] + (the #runtime platform))) + + (def runtime_descriptor + Descriptor + [descriptor.#hash 0 + descriptor.#name descriptor.runtime + descriptor.#file "" + descriptor.#references (set.empty text.hash) + descriptor.#state {.#Compiled}]) + + (def runtime_document + (Document .Module) + (document.document $.key (moduleA.empty 0))) + + (def runtime_module + (module.Module .Module) + [module.#id module.runtime + module.#descriptor runtime_descriptor + module.#document runtime_document]) + + (def (process_runtime archive platform) + (All (_ ) + (-> Archive + (///declaration.Operation + [Archive (archive.Entry .Module)]))) + (do ///phase.monad + [[registry payload] (///declaration.lifted_generation + (..compile_runtime! platform)) + .let [entry [..runtime_module payload registry]] + archive (///phase.lifted (if (archive.reserved? archive descriptor.runtime) + (archive.has descriptor.runtime entry archive) + (do try.monad + [[_ archive] (archive.reserve descriptor.runtime archive)] + (archive.has descriptor.runtime entry archive))))] + (in [archive entry]))) + + (def (initialize_state extender + [analysers + synthesizers + generators + declarations] + analysis_state + state) + (All (_ ) + (-> Extender + [(Dictionary Text ///analysis.Handler) + (Dictionary Text ///synthesis.Handler) + (Dictionary Text (///generation.Handler )) + (Dictionary Text (///declaration.Handler ))] + .Lux + + (Try ))) + (|> (sharing [] + (is + state) + (is (///declaration.Operation Any) + (do [! ///phase.monad] + [_ (///declaration.lifted_analysis + (do ! + [_ (///analysis.set_state analysis_state)] + (extension.with extender analysers))) + _ (///declaration.lifted_synthesis + (extension.with extender synthesizers)) + _ (///declaration.lifted_generation + (extension.with extender (as_expected generators))) + _ (extension.with extender (as_expected declarations))] + (in [])))) + (///phase.result' state) + (at try.monad each product.left))) + + (def (phase_wrapper archive platform state) + (All (_ ) + (-> Archive (Try [ ///phase.Wrapper]))) + (|> archive + ((the #phase_wrapper platform)) + ///declaration.lifted_generation + (///phase.result' state))) + + (def (complete_extensions host_declaration_bundle phase_wrapper [analysers synthesizers generators declarations]) + (All (_ ) + (-> (-> ///phase.Wrapper (///declaration.Bundle )) + ///phase.Wrapper + [(Dictionary Text ///analysis.Handler) + (Dictionary Text ///synthesis.Handler) + (Dictionary Text (///generation.Handler )) + (Dictionary Text (///declaration.Handler ))] + [(Dictionary Text ///analysis.Handler) + (Dictionary Text ///synthesis.Handler) + (Dictionary Text (///generation.Handler )) + (Dictionary Text (///declaration.Handler ))])) + [analysers + synthesizers + generators + (dictionary.composite declarations (host_declaration_bundle phase_wrapper))]) + + (def .public (initialize context module expander host_analysis platform generation_bundle host_declaration_bundle program anchorT,expressionT,declarationT extender + import compilation_sources compilation_configuration) + (All (_ ) + (-> context.Context + descriptor.Module + Expander + ///analysis.Bundle + + + (-> ///phase.Wrapper (///declaration.Bundle )) + (Program expression declaration) + [Type Type Type] (-> ///phase.Wrapper Extender) + Import (List _io.Context) Configuration + (Async (Try [ Archive ///phase.Wrapper])))) + (do [! (try.with async.monad)] + [.let [state (//init.state (the context.#host context) + module + compilation_configuration + expander + host_analysis + (the #host platform) + (the #phase platform) + generation_bundle)] + _ (is (Async (Try Any)) + (cache.enable! async.monad (the #file_system platform) context)) + [archive analysis_state bundles] (ioW.thaw (list) compilation_configuration (the #host platform) (the #file_system platform) context import compilation_sources) + .let [with_missing_extensions + (is (All (_ ) + (-> (Program expression declaration) + (Async (Try [///phase.Wrapper ])))) + (function (_ platform program state) + (async#in + (do try.monad + [[state phase_wrapper] (..phase_wrapper archive platform state)] + (|> state + (initialize_state (extender phase_wrapper) + (as_expected (..complete_extensions host_declaration_bundle phase_wrapper (as_expected bundles))) + analysis_state) + (try#each (|>> (//init.with_default_declarations expander host_analysis program anchorT,expressionT,declarationT (extender phase_wrapper)) + [phase_wrapper])))))))]] + (if (archive.archived? archive descriptor.runtime) + (do ! + [[phase_wrapper state] (with_missing_extensions platform program state)] + (in [state archive phase_wrapper])) + (do ! + [[state [archive payload]] (|> (..process_runtime archive platform) + (///phase.result' state) + async#in) + _ (..cache_module context platform 0 $.key $.format payload) + + [phase_wrapper state] (with_missing_extensions platform program state)] + (in [state archive phase_wrapper]))))) + + (def compilation_log_separator + (%.format text.new_line text.tab)) + + (def (module_compilation_log module) + (All (_ ) + (-> descriptor.Module Text)) + (|>> (the [extension.#state + ///declaration.#generation + ///declaration.#state + extension.#state + ///generation.#log]) + (sequence#mix (function (_ right left) + (%.format left ..compilation_log_separator right)) + module))) + + (def with_reset_log + (All (_ ) + (-> )) + (has [extension.#state + ///declaration.#generation + ///declaration.#state + extension.#state + ///generation.#log] + sequence.empty)) + + (def empty + (Set descriptor.Module) + (set.empty text.hash)) + + (type Mapping + (Dictionary descriptor.Module (Set descriptor.Module))) + + (type Dependence + (Record + [#depends_on Mapping + #depended_by Mapping])) + + (def independence + Dependence + (let [empty (dictionary.empty text.hash)] + [#depends_on empty + #depended_by empty])) + + (def (depend module import dependence) + (-> descriptor.Module descriptor.Module Dependence Dependence) + (let [transitive_dependency (is (-> (-> Dependence Mapping) descriptor.Module (Set descriptor.Module)) + (function (_ lens module) + (|> dependence + lens + (dictionary.value module) + (maybe.else ..empty)))) + transitive_depends_on (transitive_dependency (the #depends_on) import) + transitive_depended_by (transitive_dependency (the #depended_by) module) + update_dependence (is (-> [descriptor.Module (Set descriptor.Module)] [descriptor.Module (Set descriptor.Module)] + (-> Mapping Mapping)) + (function (_ [source forward] [target backward]) + (function (_ mapping) + (let [with_dependence+transitives + (|> mapping + (dictionary.revised' source ..empty (set.has target)) + (dictionary.revised source (set.union forward)))] + (list#mix (function (_ previous) + (dictionary.revised' previous ..empty (set.has target))) + with_dependence+transitives + (set.list backward))))))] + (|> dependence + (revised #depends_on + (update_dependence + [module transitive_depends_on] + [import transitive_depended_by])) + (revised #depended_by + ((function.flipped update_dependence) + [module transitive_depends_on] + [import transitive_depended_by]))))) + + (def (circular_dependency? module import dependence) + (-> descriptor.Module descriptor.Module Dependence Bit) + (let [dependence? (is (-> descriptor.Module (-> Dependence Mapping) descriptor.Module Bit) + (function (_ from relationship to) + (let [targets (|> dependence + relationship + (dictionary.value from) + (maybe.else ..empty))] + (set.member? targets to))))] + (or (dependence? import (the #depends_on) module) + (dependence? module (the #depended_by) import)))) + + (exception .public (module_cannot_import_itself [module descriptor.Module]) + (exception.report + "Module" (%.text module))) + + (exception .public (cannot_import_circular_dependency [importer descriptor.Module + importee descriptor.Module]) + (exception.report + "Importer" (%.text importer) + "importee" (%.text importee))) + + (exception .public (cannot_import_twice [importer descriptor.Module + duplicates (Set descriptor.Module)]) + (exception.report + "Importer" (%.text importer) + "Duplicates" (%.list %.text (set.list duplicates)))) + + (def (verify_dependencies importer importee dependence) + (-> descriptor.Module descriptor.Module Dependence (Try Any)) + (cond (text#= importer importee) + (exception.except ..module_cannot_import_itself [importer]) + + (..circular_dependency? importer importee dependence) + (exception.except ..cannot_import_circular_dependency [importer importee]) + + ... else + {try.#Success []})) + + (exception .public (cannot_overwrite_extension [extension extension.Name]) + (exception.report + "Extension" (%.text extension))) + + (def (with_extensions from to) + (All (_ state input output) + (-> (extension.Bundle state input output) + (extension.Bundle state input output) + (Try (extension.Bundle state input output)))) + (monad.mix try.monad + (function (_ [extension expected] output) + (with_expansions [ (dictionary.has extension expected output)] + (case (dictionary.value extension output) + {.#None} + {try.#Success } + + {.#Some actual} + (if (same? expected actual) + {try.#Success } + (exception.except ..cannot_overwrite_extension [extension]))))) + to + ... TODO: Come up with something better. This is not an ideal solution because it can mask overwrites happening across multiple imported modules. + (list.only (|>> product.left (dictionary.key? to) not) + (dictionary.entries from)))) + + (with_template [ ] + [(def ( from state) + (All (_ ) + (-> (Try ))) + (do try.monad + [inherited (with_extensions (the from) (the state))] + (in (has inherited state))))] + + [with_analysis_extensions [extension.#state ///declaration.#analysis ///declaration.#state extension.#bundle]] + [with_synthesis_extensions [extension.#state ///declaration.#synthesis ///declaration.#state extension.#bundle]] + [with_generation_extensions [extension.#state ///declaration.#generation ///declaration.#state extension.#bundle]] + [with_declaration_extensions [extension.#bundle]] + ) + + (def (with_all_extensions from state) + (All (_ ) + (-> (Try ))) + (do try.monad + [state (with_analysis_extensions from state) + state (with_synthesis_extensions from state) + state (with_generation_extensions from state)] + (with_declaration_extensions from state))) + + (type (Context state) + [Archive state]) + + (type (Result state) + (Try (Context state))) + + (type (Return state) + (Async (Result state))) + + (type (Signal state) + (Resolver (Result state))) + + (type (Pending state) + [(Return state) + (Signal state)]) + + (type (Importer state) + (-> (List ///.Custom) descriptor.Module descriptor.Module (Return state))) + + (type (Compiler state) + (-> (List ///.Custom) descriptor.Module (Importer state) module.ID (Context state) descriptor.Module (Return state))) + + (with_expansions [Lux_Context (..Context ) + Lux_Return (..Return ) + Lux_Signal (..Signal ) + Lux_Pending (..Pending ) + Lux_Importer (..Importer ) + Lux_Compiler (..Compiler )] + (def (parallel initial) + (All (_ ) + (-> Lux_Context + (-> Lux_Compiler Lux_Importer))) + (let [current (stm.var initial) + pending (sharing [] + (is Lux_Context + initial) + (is (Var (Dictionary descriptor.Module Lux_Pending)) + (as_expected (stm.var (dictionary.empty text.hash))))) + dependence (is (Var Dependence) + (stm.var ..independence))] + (function (_ compile) + (function (import! customs importer module) + (do [! async.monad] + [[return signal] (sharing [] + (is Lux_Context + initial) + (is (Async [Lux_Return (Maybe [Lux_Context + module.ID + Lux_Signal])]) + (as_expected + (stm.commit! + (do [! stm.monad] + [dependence (if (text#= descriptor.runtime importer) + (stm.read dependence) + (do ! + [[_ dependence] (stm.update (..depend importer module) dependence)] + (in dependence)))] + (case (..verify_dependencies importer module dependence) + {try.#Failure error} + (in [(async.resolved {try.#Failure error}) + {.#None}]) + + {try.#Success _} + (do ! + [[archive state] (stm.read current)] + (if (archive.archived? archive module) + (in [(async#in {try.#Success [archive state]}) + {.#None}]) + (do ! + [@pending (stm.read pending)] + (case (dictionary.value module @pending) + {.#Some [return signal]} + (in [return + {.#None}]) + + {.#None} + (case (if (archive.reserved? archive module) + (do try.monad + [@module (archive.id module archive)] + (in [@module archive])) + (archive.reserve module archive)) + {try.#Success [@module archive]} + (do ! + [_ (stm.write [archive state] current) + .let [[return signal] (sharing [] + (is Lux_Context + initial) + (is Lux_Pending + (async.async [])))] + _ (stm.update (dictionary.has module [return signal]) pending)] + (in [return + {.#Some [[archive state] + @module + signal]}])) + + {try.#Failure error} + (in [(async#in {try.#Failure error}) + {.#None}])))))))))))) + _ (case signal + {.#None} + (in []) + + {.#Some [context @module resolver]} + (do ! + [result (compile customs importer import! @module context module) + result (case result + {try.#Failure error} + (in result) + + {try.#Success [resulting_archive resulting_state]} + (stm.commit! (do stm.monad + [[_ [merged_archive _]] (stm.update (function (_ [archive state]) + [(archive.composite resulting_archive archive) + state]) + current)] + (in {try.#Success [merged_archive resulting_state]}))))] + (async.future (resolver result))))] + return))))) + + ... TODO: Find a better way, as this only works for the Lux compiler. + (def (updated_state archive extended_states state) + (All (_ ) + (-> Archive (List ) (Try ))) + (do [! try.monad] + [modules (monad.each ! (function (_ module) + (do ! + [entry (archive.find module archive) + lux_module (|> entry + (the [archive.#module module.#document]) + (document.content $.key))] + (in [module lux_module]))) + (archive.archived archive)) + .let [additions (|> modules + (list#each product.left) + (set.of_list text.hash)) + with_modules (is (All (_ ) + (-> )) + (revised [extension.#state + ///declaration.#analysis + ///declaration.#state + extension.#state] + (is (All (_ a) (-> a a)) + (function (_ analysis_state) + (|> analysis_state + (as .Lux) + (revised .#modules (function (_ current) + (list#composite (list.only (|>> product.left + (set.member? additions) + not) + current) + modules))) + as_expected)))))] + state (monad.mix ! with_all_extensions state extended_states)] + (in (with_modules state)))) + + (def (set_current_module module state) + (All (_ ) + (-> descriptor.Module )) + (|> (///declaration.set_current_module module) + (///phase.result' state) + try.trusted + product.left)) + + ... TODO: Come up with a less hacky way to prevent duplicate imports. + ... This currently assumes that all imports will be specified once in a single .require form. + ... This might not be the case in the future. + (def (with_new_dependencies new_dependencies all_dependencies) + (-> (List descriptor.Module) (Set descriptor.Module) [(Set descriptor.Module) (Set descriptor.Module)]) + (let [[all_dependencies duplicates _] (is [(Set descriptor.Module) (Set descriptor.Module) Bit] + (list#mix (function (_ new [all duplicates seen_prelude?]) + (if (set.member? all new) + (if (text#= .prelude new) + (if seen_prelude? + [all (set.has new duplicates) seen_prelude?] + [all duplicates true]) + [all (set.has new duplicates) seen_prelude?]) + [(set.has new all) duplicates seen_prelude?])) + (is [(Set descriptor.Module) (Set descriptor.Module) Bit] + [all_dependencies ..empty (set.empty? all_dependencies)]) + new_dependencies))] + [all_dependencies duplicates])) + + (def (any|after_imports customs import! module duplicates new_dependencies archive) + (All (_ + state document object) + (-> (List ///.Custom) (..Importer state) descriptor.Module (Set descriptor.Module) (List descriptor.Module) Archive + (Async (Try [Archive (List state)])))) + (do [! (try.with async.monad)] + [] + (if (set.empty? duplicates) + (case new_dependencies + {.#End} + (in [archive (list)]) + + {.#Item _} + (do ! + [archive,state/* (|> new_dependencies + (list#each (import! customs module)) + (monad.all ..monad))] + (in [(|> archive,state/* + (list#each product.left) + (list#mix archive.composite archive)) + (list#each product.right archive,state/*)]))) + (async#in (exception.except ..cannot_import_twice [module duplicates]))))) + + (def (lux|after_imports customs import! module duplicates new_dependencies [archive state]) + (All (_ ) + (-> (List ///.Custom) Lux_Importer descriptor.Module (Set descriptor.Module) (List descriptor.Module) Lux_Context Lux_Return)) + (do (try.with async.monad) + [[archive state/*] (any|after_imports customs import! module duplicates new_dependencies archive)] + (in [archive (case state/* + {.#End} + state + + {.#Item _} + (try.trusted (..updated_state archive state/* state)))]))) + + (def (next_compilation module [archive state] compilation) + (All (_ ) + (-> descriptor.Module Lux_Context (///.Compilation .Module Any) + (Try [ (Either (///.Compilation .Module Any) + (archive.Entry Any))]))) + ((the ///.#process compilation) + ... TODO: The "///declaration.set_current_module" below shouldn't be necessary. Remove it ASAP. + ... TODO: The context shouldn't need to be re-set either. + (|> (///declaration.set_current_module module) + (///phase.result' state) + try.trusted + product.left) + archive)) + + (def (compiler phase_wrapper expander platform) + (All (_ ) + (-> ///phase.Wrapper Expander + (///.Compiler .Module Any))) + (let [instancer (//init.compiler phase_wrapper expander syntax.prelude (the #write platform))] + (instancer $.key (list)))) + + (def (custom_compiler import context platform compilation_sources compiler + custom_key custom_format custom_compilation) + (All (_ + state document object) + (-> Import context.Context (List _io.Context) (///.Compiler .Module Any) + (Key document) (Format document) (///.Compilation state document object) + (-> (List ///.Custom) descriptor.Module Lux_Importer module.ID (..Context state) descriptor.Module (..Return state)))) + (function (_ customs importer import! @module [archive state] module) + (loop (again [[archive state] [archive state] + compilation custom_compilation + all_dependencies (is (Set descriptor.Module) + (set.of_list text.hash (list)))]) + (do [! (try.with async.monad)] + [.let [new_dependencies (the ///.#dependencies compilation) + [all_dependencies duplicates] (with_new_dependencies new_dependencies all_dependencies)] + [archive _] (any|after_imports customs import! module duplicates new_dependencies archive)] + (case ((the ///.#process compilation) state archive) + {try.#Success [state more|done]} + (case more|done + {.#Left more} + (let [continue! (sharing [state document object] + (is (///.Compilation state document object) + custom_compilation) + (is (-> (..Context state) (///.Compilation state document object) (Set descriptor.Module) + (..Return state)) + (as_expected again)))] + (continue! [archive state] more all_dependencies)) + + {.#Right entry} + (do ! + [.let [entry (has [archive.#module module.#descriptor descriptor.#references] all_dependencies entry)] + _ (..cache_module context platform @module custom_key custom_format entry)] + (async#in (do try.monad + [archive (archive.has module entry archive)] + (in [archive state]))))) + + {try.#Failure error} + (do ! + [_ (cache/archive.cache! (the #file_system platform) context archive)] + (async#in {try.#Failure error}))))))) + + (def (lux_compiler import context platform compilation_sources compiler compilation) + (All (_ ) + (-> Import context.Context (List _io.Context) (///.Compiler .Module Any) + (///.Compilation .Module Any) + Lux_Compiler)) + (function (_ customs importer import! @module [archive state] module) + (loop (again [[archive state] [archive (..set_current_module module state)] + compilation compilation + all_dependencies (is (Set descriptor.Module) + (set.of_list text.hash (list)))]) + (do [! (try.with async.monad)] + [.let [new_dependencies (the ///.#dependencies compilation) + [all_dependencies duplicates] (with_new_dependencies new_dependencies all_dependencies)] + [archive state] (lux|after_imports customs import! module duplicates new_dependencies [archive state])] + (case (next_compilation module [archive state] compilation) + {try.#Success [state more|done]} + (case more|done + {.#Left more} + (let [continue! (sharing [] + (is + platform) + (is (-> Lux_Context (///.Compilation .Module Any) (Set descriptor.Module) + (Action [Archive ])) + (as_expected again)))] + (continue! [archive state] more all_dependencies)) + + {.#Right entry} + (do ! + [_ (let [report (..module_compilation_log module state)] + (with_expansions [ (in (debug.log! report))] + (for @.js (is (Async (Try Any)) + (case console.default + {.#None} + + + {.#Some console} + (console.write_line report console))) + ))) + .let [entry (has [archive.#module module.#descriptor descriptor.#references] all_dependencies entry)] + _ (..cache_module context platform @module $.key $.format (as (archive.Entry .Module) entry))] + (async#in (do try.monad + [archive (archive.has module entry archive)] + (in [archive + (..with_reset_log state)]))))) + + {try.#Failure error} + (do ! + [_ (cache/archive.cache! (the #file_system platform) context archive)] + (async#in {try.#Failure error}))))))) + + (for @.old (these (def Fake_State + Type + {.#Primitive (%.nat (static.random_nat)) (list)}) + + (def Fake_Document + Type + {.#Primitive (%.nat (static.random_nat)) (list)}) + + (def Fake_Object + Type + {.#Primitive (%.nat (static.random_nat)) (list)})) + (these)) + + (def (serial_compiler import context platform compilation_sources compiler) + (All (_ ) + (-> Import context.Context (List _io.Context) (///.Compiler .Module Any) + Lux_Compiler)) + (function (_ all_customs importer import! @module [archive lux_state] module) + (do [! (try.with async.monad)] + [input (io.read (the #file_system platform) + importer + import + compilation_sources + (the context.#host_module_extension context) + module)] + (loop (again [customs (for @.old (as (List (///.Custom Fake_State Fake_Document Fake_Object)) + all_customs) + all_customs)]) + (case customs + {.#End} + ((..lux_compiler import context platform compilation_sources compiler (compiler input)) + all_customs importer import! @module [archive lux_state] module) + + {.#Item [custom_state custom_key custom_format custom_parser custom_compiler] tail} + (case (custom_compiler input) + {try.#Failure _} + (again tail) + + {try.#Success custom_compilation} + (do ! + [[archive' custom_state'] ((..custom_compiler import context platform compilation_sources compiler + custom_key custom_format custom_compilation) + all_customs importer import! @module [archive custom_state] module)] + (in [archive' lux_state])))))))) + + (def .public Custom + Type + (type_literal (-> (List Text) (Try ///.Custom)))) + + (exception .public (invalid_custom_compiler [definition Symbol + type Type]) + (exception.report + "Definition" (%.symbol definition) + "Expected Type" (%.type ..Custom) + "Actual Type" (%.type type))) + + (def (custom import! it) + (All (_ ) + (-> Lux_Importer compiler.Compiler (Async (Try [Lux_Context (List Text) Any])))) + (let [/#definition (the compiler.#definition it) + [/#module /#name] /#definition] + (do ..monad + [context (import! (list) descriptor.runtime /#module) + .let [[archive state] context + meta_state (the [extension.#state + ///declaration.#analysis + ///declaration.#state + extension.#state] + state)] + [_ /#type /#value] (|> /#definition + meta.export + (meta.result meta_state) + async#in)] + (async#in (if (check.subsumes? ..Custom /#type) + {try.#Success [context (the compiler.#parameters it) /#value]} + (exception.except ..invalid_custom_compiler [/#definition /#type])))))) + + (def .public (compile lux_compiler phase_wrapper import file_context expander platform compilation context) + (All (_ ) + (-> (-> Any ..Custom) ///phase.Wrapper Import context.Context Expander Compilation Lux_Context Lux_Return)) + (let [[host_dependencies libraries compilers sources target module configuration] compilation + import! (|> (..compiler phase_wrapper expander platform) + (serial_compiler import file_context platform sources) + (..parallel context))] + (do [! ..monad] + [customs (|> compilers + (list#each (function (_ it) + (do ! + [[context parameters custom] (..custom import! it)] + (async#in (|> custom + lux_compiler + (function.on parameters)))))) + (monad.all !))] + (import! customs descriptor.runtime module)))) + ))) diff --git a/stdlib/source/library/lux/meta/compiler/language/lux.lux b/stdlib/source/library/lux/meta/compiler/language/lux.lux new file mode 100644 index 000000000..14adeb6d6 --- /dev/null +++ b/stdlib/source/library/lux/meta/compiler/language/lux.lux @@ -0,0 +1,105 @@ +(.require + [library + [lux (.except) + [control + ["<>" parser]] + [data + ["[0]" binary + ["_" \\format (.only Format)] + ["<[1]>" \\parser (.only Parser)]]] + [meta + ["[0]" version]]]] + ["[0]" / + [analysis + ["[0]" module]] + [/// + [meta + [archive + ["[0]" signature] + ["[0]" key (.only Key)]]]]]) + +... TODO: Remove #module_hash, #imports & #module_state ASAP. +... TODO: Not just from this parser, but from the lux.Module type. +(def .public format + (Format .Module) + (let [definition (is (Format Definition) + (all _.and _.bit _.type _.any)) + labels (is (Format [Text (List Text)]) + (_.and _.text (_.list _.text))) + global_type (is (Format [Bit Type (Either [Text (List Text)] + [Text (List Text)])]) + (all _.and _.bit _.type (_.or labels labels))) + global_label (is (Format .Label) + (all _.and _.bit _.type (_.list _.text) _.nat)) + alias (is (Format Alias) + (_.and _.text _.text)) + global (is (Format Global) + (all _.or + definition + global_type + global_label + global_label + alias))] + (all _.and + ... #module_hash + _.nat + ... #module_aliases + (_.list alias) + ... #definitions + (_.list (_.and _.text global)) + ... #imports + (_.list _.text) + ... #module_state + _.any))) + +(def .public parser + (Parser .Module) + (let [definition (is (Parser Definition) + (all <>.and + .bit + .type + .any)) + labels (is (Parser [Text (List Text)]) + (all <>.and + .text + (.list .text))) + global_type (is (Parser [Bit Type (Either [Text (List Text)] + [Text (List Text)])]) + (all <>.and + .bit + .type + (.or labels labels))) + global_label (is (Parser .Label) + (all <>.and + .bit + .type + (.list .text) + .nat)) + alias (is (Parser Alias) + (all <>.and + .text + .text)) + global (is (Parser Global) + (all .or + definition + global_type + global_label + global_label + alias))] + (all <>.and + ... #module_hash + .nat + ... #module_aliases + (.list alias) + ... #definitions + (.list (<>.and .text global)) + ... #imports + (.list .text) + ... #module_state + (at <>.monad in {.#Cached})))) + +(def .public key + (Key .Module) + (key.key [signature.#name (symbol ..compiler) + signature.#version version.latest] + (module.empty 0))) diff --git a/stdlib/source/library/lux/meta/compiler/language/lux/analysis.lux b/stdlib/source/library/lux/meta/compiler/language/lux/analysis.lux new file mode 100644 index 000000000..b975614df --- /dev/null +++ b/stdlib/source/library/lux/meta/compiler/language/lux/analysis.lux @@ -0,0 +1,387 @@ +(.require + [library + [lux (.except Tuple Variant Pattern nat int rev case local except) + [abstract + [equivalence (.only Equivalence)] + [hash (.only Hash)] + [monad (.only do)]] + [control + ["[0]" function] + ["[0]" maybe] + ["[0]" try (.only Try)] + ["[0]" exception (.only Exception)]] + [data + ["[0]" product] + ["[0]" bit (.use "[1]#[0]" equivalence)] + ["[0]" text (.use "[1]#[0]" equivalence) + ["%" \\format (.only Format)]] + [collection + ["[0]" list (.use "[1]#[0]" functor mix)]]] + [math + [number + ["n" nat] + ["i" int] + ["r" rev] + ["f" frac]]] + [meta + ["[0]" location] + ["[0]" configuration (.only Configuration)] + ["[0]" code + ["<[1]>" \\parser]] + [macro + [syntax (.only syntax)]]]]] + ["[0]" / + ["[1][0]" simple (.only Simple)] + ["[1][0]" complex (.only Tuple Variant Complex)] + ["[1][0]" pattern (.only Pattern)] + [// + [phase + ["[0]" extension (.only Extension)]] + [/// + [arity (.only Arity)] + ["[0]" version (.only Version)] + ["[0]" phase] + ["[0]" reference (.only Reference) + ["[0]" variable (.only Register Variable)]]]]]) + +(type .public (Branch' e) + (Record + [#when Pattern + #then e])) + +(type .public (Match' e) + [(Branch' e) (List (Branch' e))]) + +(type .public (Environment a) + (List a)) + +(type .public Analysis + (Rec Analysis + (.Variant + {#Simple Simple} + {#Structure (Complex Analysis)} + {#Reference Reference} + {#Case Analysis (Match' Analysis)} + {#Function (Environment Analysis) Analysis} + {#Apply Analysis Analysis} + {#Extension (Extension Analysis)}))) + +(type .public Branch + (Branch' Analysis)) + +(type .public Match + (Match' Analysis)) + +(def (branch_equivalence equivalence) + (-> (Equivalence Analysis) (Equivalence Branch)) + (implementation + (def (= [reference_pattern reference_body] [sample_pattern sample_body]) + (and (at /pattern.equivalence = reference_pattern sample_pattern) + (at equivalence = reference_body sample_body))))) + +(def .public equivalence + (Equivalence Analysis) + (implementation + (def (= reference sample) + (.case [reference sample] + [{#Simple reference} {#Simple sample}] + (at /simple.equivalence = reference sample) + + [{#Structure reference} {#Structure sample}] + (at (/complex.equivalence =) = reference sample) + + [{#Reference reference} {#Reference sample}] + (at reference.equivalence = reference sample) + + [{#Case [reference_analysis reference_match]} + {#Case [sample_analysis sample_match]}] + (and (= reference_analysis sample_analysis) + (at (list.equivalence (branch_equivalence =)) = {.#Item reference_match} {.#Item sample_match})) + + [{#Function [reference_environment reference_analysis]} + {#Function [sample_environment sample_analysis]}] + (and (= reference_analysis sample_analysis) + (at (list.equivalence =) = reference_environment sample_environment)) + + [{#Apply [reference_input reference_abstraction]} + {#Apply [sample_input sample_abstraction]}] + (and (= reference_input sample_input) + (= reference_abstraction sample_abstraction)) + + [{#Extension reference} {#Extension sample}] + (at (extension.equivalence =) = reference sample) + + _ + false)))) + +(with_template [ ] + [(def .public + (template ( content) + [{ content}]))] + + [case ..#Case] + ) + +(def .public unit + (template (unit) + [{..#Simple {/simple.#Unit}}])) + +(with_template [ ] + [(def .public + (template ( value) + [{..#Simple { value}}]))] + + [bit /simple.#Bit] + [nat /simple.#Nat] + [int /simple.#Int] + [rev /simple.#Rev] + [frac /simple.#Frac] + [text /simple.#Text] + ) + +(type .public (Abstraction c) + [(Environment c) Arity c]) + +(type .public (Reification c) + [c (List c)]) + +(def .public no_op + (template (no_op value) + [(|> 1 + {variable.#Local} + {reference.#Variable} + {..#Reference} + {..#Function (list)} + {..#Apply value})])) + +(def .public (reified [abstraction inputs]) + (-> (Reification Analysis) Analysis) + (list#mix (function (_ input abstraction') + {#Apply input abstraction'}) + abstraction + inputs)) + +(def .public (reification analysis) + (-> Analysis (Reification Analysis)) + (loop (again [abstraction analysis + inputs (is (List Analysis) + (list))]) + (.case abstraction + {#Apply input next} + (again next {.#Item input inputs}) + + _ + [abstraction inputs]))) + +(with_template [ ] + [(def .public + (syntax (_ [content .any]) + (in (list (` (.<| {..#Reference} + + (, content)))))))] + + [variable {reference.#Variable}] + [constant {reference.#Constant}] + + [local ((,! reference.local))] + [foreign ((,! reference.foreign))] + ) + +(with_template [ ] + [(def .public + (template ( content) + [(.<| {..#Structure} + {} + content)]))] + + [variant /complex.#Variant] + [tuple /complex.#Tuple] + ) + +(def .public (format analysis) + (Format Analysis) + (.case analysis + {#Simple it} + (/simple.format it) + + {#Structure it} + (/complex.format format it) + + {#Reference reference} + (reference.format reference) + + {#Case analysis match} + (%.format "({" + (|> {.#Item match} + (list#each (function (_ [when then]) + (%.format (/pattern.format when) " " (format then)))) + (text.interposed " ")) + "} " + (format analysis) + ")") + + {#Function environment body} + (|> (format body) + (%.format " ") + (%.format (|> environment + (list#each format) + (text.interposed " ") + (text.enclosed ["[" "]"]))) + (text.enclosed ["(" ")"])) + + {#Apply _} + (|> analysis + ..reification + {.#Item} + (list#each format) + (text.interposed " ") + (text.enclosed ["(" ")"])) + + {#Extension name parameters} + (|> parameters + (list#each format) + (text.interposed " ") + (%.format (%.text name) " ") + (text.enclosed ["(" ")"])))) + +(with_template [ ] + [(type .public + ( .Lux Code Analysis))] + + [State+ extension.State] + [Operation extension.Operation] + [Phase extension.Phase] + [Handler extension.Handler] + [Bundle extension.Bundle] + ) + +(def .public (with_source_code source action) + (All (_ a) (-> Source (Operation a) (Operation a))) + (function (_ [bundle state]) + (let [old_source (the .#source state)] + (.case (action [bundle (has .#source source state)]) + {try.#Success [[bundle' state'] output]} + {try.#Success [[bundle' (has .#source old_source state')] + output]} + + failure + failure)))) + +(def .public (with_current_module name) + (All (_ a) (-> Text (Operation a) (Operation a))) + (extension.localized (the .#current_module) + (has .#current_module) + (function.constant {.#Some name}))) + +(def .public (with_location location action) + (All (_ a) (-> Location (Operation a) (Operation a))) + (if (text#= "" (product.left location)) + action + (function (_ [bundle state]) + (let [old_location (the .#location state)] + (.case (action [bundle (has .#location location state)]) + {try.#Success [[bundle' state'] output]} + {try.#Success [[bundle' (has .#location old_location state')] + output]} + + failure + failure))))) + +(def (located location error) + (-> Location Text Text) + (%.format (%.location location) text.new_line + error)) + +(def .public (failure error) + (-> Text Operation) + (function (_ [bundle state]) + {try.#Failure (located (the .#location state) error)})) + +(def .public (of_try it) + (All (_ a) (-> (Try a) (Operation a))) + (function (_ [bundle state]) + (.case it + {try.#Failure error} + {try.#Failure (located (the .#location state) error)} + + {try.#Success it} + {try.#Success [[bundle state] it]}))) + +(def .public (except exception parameters) + (All (_ e) (-> (Exception e) e Operation)) + (..failure (exception.error exception parameters))) + +(def .public (assertion exception parameters condition) + (All (_ e) (-> (Exception e) e Bit (Operation Any))) + (if condition + (at phase.monad in []) + (..except exception parameters))) + +(def .public (with_exception exception message action) + (All (_ e o) (-> (Exception e) e (Operation o) (Operation o))) + (function (_ bundle,state) + (.case (exception.with exception message + (action bundle,state)) + {try.#Failure error} + (let [[bundle state] bundle,state] + {try.#Failure (located (the .#location state) error)}) + + success + success))) + +(def .public (set_state state) + (-> .Lux (Operation Any)) + (function (_ [bundle _]) + {try.#Success [[bundle state] + []]})) + +(with_template [ ] + [(def .public ( value) + (-> (Operation Any)) + (extension.update (has )))] + + [set_source_code Source .#source value] + [set_current_module Text .#current_module {.#Some value}] + [set_location Location .#location value] + ) + +(def .public (location file) + (-> Text Location) + [file 1 0]) + +(def .public (source file code) + (-> Text Text Source) + [(location file) 0 code]) + +(def dummy_source + Source + [location.dummy 0 ""]) + +(def type_context + Type_Context + [.#ex_counter 0 + .#var_counter 0 + .#var_bindings (list)]) + +(def .public (info version host configuration) + (-> Version Text Configuration Info) + [.#target host + .#version (version.format version) + .#mode {.#Build} + .#configuration configuration]) + +(def .public (state info) + (-> Info Lux) + [.#info info + .#source ..dummy_source + .#location location.dummy + .#current_module {.#None} + .#modules (list) + .#scopes (list) + .#type_context ..type_context + .#expected {.#None} + .#seed 0 + .#scope_type_vars (list) + .#extensions [] + .#eval (as (-> Type Code (Meta Any)) []) + .#host []]) diff --git a/stdlib/source/library/lux/meta/compiler/language/lux/analysis/complex.lux b/stdlib/source/library/lux/meta/compiler/language/lux/analysis/complex.lux new file mode 100644 index 000000000..0d00367b9 --- /dev/null +++ b/stdlib/source/library/lux/meta/compiler/language/lux/analysis/complex.lux @@ -0,0 +1,98 @@ +(.require + [library + [lux (.except Tuple Variant) + [abstract + [equivalence (.only Equivalence)] + [hash (.only Hash)]] + [data + ["[0]" bit (.use "[1]#[0]" equivalence)] + ["[0]" text (.only) + ["%" \\format (.only Format)]] + [collection + ["[0]" list (.use "[1]#[0]" functor)]]] + [math + [number + ["n" nat]]]]]) + +(type .public (Variant a) + (Record + [#lefts Nat + #right? Bit + #value a])) + +(type .public (Tuple a) + (List a)) + +(type .public (Complex a) + (.Variant + {#Variant (Variant a)} + {#Tuple (Tuple a)})) + +(type .public Tag + Nat) + +(def .public (tag right? lefts) + (-> Bit Nat Tag) + (if right? + (++ lefts) + lefts)) + +(def .public (lefts right? tag) + (-> Bit Tag Nat) + (if right? + (-- tag) + tag)) + +(def .public (choice multiplicity pick) + (-> Nat Tag [Nat Bit]) + (let [right? (n.= (-- multiplicity) pick)] + [(..lefts right? pick) + right?])) + +(def .public (equivalence (open "/#[0]")) + (All (_ a) (-> (Equivalence a) (Equivalence (Complex a)))) + (implementation + (def (= reference sample) + (case [reference sample] + [{#Variant [reference_lefts reference_right? reference_value]} + {#Variant [sample_lefts sample_right? sample_value]}] + (and (n.= reference_lefts sample_lefts) + (bit#= reference_right? sample_right?) + (/#= reference_value sample_value)) + + [{#Tuple reference} {#Tuple sample}] + (at (list.equivalence /#=) = reference sample) + + _ + false)))) + +(def .public (hash super) + (All (_ a) (-> (Hash a) (Hash (Complex a)))) + (implementation + (def equivalence + (..equivalence (at super equivalence))) + + (def (hash value) + (case value + {#Variant [lefts right? value]} + (all n.* 2 + (at n.hash hash lefts) + (at bit.hash hash right?) + (at super hash value)) + + {#Tuple members} + (all n.* 3 + (at (list.hash super) hash members)) + )))) + +(def .public (format %it it) + (All (_ a) (-> (Format a) (Format (Complex a)))) + (case it + {#Variant [lefts right? it]} + (%.format "{" (%.nat lefts) " " (%.bit right?) " " (%it it) "}") + + {#Tuple it} + (|> it + (list#each %it) + (text.interposed " ") + (text.enclosed ["[" "]"])))) diff --git a/stdlib/source/library/lux/meta/compiler/language/lux/analysis/coverage.lux b/stdlib/source/library/lux/meta/compiler/language/lux/analysis/coverage.lux new file mode 100644 index 000000000..dd5fde4f2 --- /dev/null +++ b/stdlib/source/library/lux/meta/compiler/language/lux/analysis/coverage.lux @@ -0,0 +1,423 @@ +(.require + [library + [lux (.except Variant Pattern) + [abstract + [equivalence (.except)] + ["[0]" monad (.only do)]] + [control + ["[0]" maybe (.use "[1]#[0]" monoid monad)] + ["[0]" try (.only Try)] + ["[0]" exception (.only exception)]] + [data + ["[0]" bit (.use "[1]#[0]" equivalence)] + ["[0]" text (.only) + ["%" \\format]] + [collection + ["[0]" list (.use "[1]#[0]" functor mix)] + ["[0]" dictionary (.only Dictionary)] + ["[0]" set (.only Set) (.use "[1]#[0]" equivalence)]]] + [math + [number + ["n" nat (.use "[1]#[0]" interval)] + ["i" int] + ["r" rev] + ["f" frac]]] + [meta + [macro + ["^" pattern] + ["[0]" template]]]]] + ["[0]" // + ["[1][0]" simple] + ["[1][0]" complex] + ["[1][0]" pattern (.only Pattern)]]) + +... The coverage of a pattern-matching expression summarizes how well +... all the possible values of an input are being covered by the +... different patterns involved. +... Ideally, the pattern-matching has "exhaustive" coverage, which just +... means that every possible value can be matched by at least 1 +... pattern. +... Every other coverage is considered partial, and it would be valued +... as insuficient (since it could lead to runtime errors due to values +... not being handled by any pattern). +(template.let [(Variant' @) + [[(Maybe Nat) (Dictionary Nat @)]]] + (these (type .public Coverage + (Rec @ + (.Variant + {#Exhaustive} + {#Bit Bit} + {#Nat (Set Nat)} + {#Int (Set Int)} + {#Rev (Set Rev)} + {#Frac (Set Frac)} + {#Text (Set Text)} + {#Variant (Variant' @)} + {#Seq @ @} + {#Alt @ @}))) + + (type .public Variant + (Variant' Coverage)))) + +(def .public (minimum [max cases]) + (-> Variant Nat) + (maybe.else (|> cases + dictionary.keys + (list#mix n.max 0) + ++) + max)) + +(def .public (maximum [max cases]) + (-> Variant Nat) + (maybe.else n#top max)) + +(def (alternatives coverage) + (-> Coverage (List Coverage)) + (case coverage + {#Alt left right} + (list.partial left (alternatives right)) + + _ + (list coverage))) + +(def .public equivalence + (Equivalence Coverage) + (implementation + (def (= reference sample) + (case [reference sample] + [{#Exhaustive} {#Exhaustive}] + #1 + + [{#Bit sideR} {#Bit sideS}] + (bit#= sideR sideS) + + (^.with_template [] + [[{ partialR} { partialS}] + (set#= partialR partialS)]) + ([#Nat] + [#Int] + [#Rev] + [#Frac] + [#Text]) + + [{#Variant allR casesR} {#Variant allS casesS}] + (and (at (maybe.equivalence n.equivalence) = allR allS) + (at (dictionary.equivalence =) = casesR casesS)) + + [{#Seq leftR rightR} {#Seq leftS rightS}] + (and (= leftR leftS) + (= rightR rightS)) + + [{#Alt _} {#Alt _}] + (let [flatR (alternatives reference) + flatS (alternatives sample)] + (and (n.= (list.size flatR) (list.size flatS)) + (list.every? (function (_ [coverageR coverageS]) + (= coverageR coverageS)) + (list.zipped_2 flatR flatS)))) + + _ + #0)))) + +(use "/#[0]" ..equivalence) + +(def .public (format value) + (%.Format Coverage) + (case value + {#Bit it} + (%.bit it) + + (^.with_template [ ] + [{ it} + (|> it + set.list + (list#each ) + (text.interposed " ") + (text.enclosed ["[" "]"]))]) + ([#Nat %.nat] + [#Int %.int] + [#Rev %.rev] + [#Frac %.frac] + [#Text %.text]) + + {#Variant ?max_cases cases} + (|> cases + dictionary.entries + (list#each (function (_ [tag it]) + (%.format (%.nat tag) " " (format it)))) + (text.interposed " ") + (%.format (maybe.else "?" (maybe#each %.nat ?max_cases)) " ") + (text.enclosed ["{" "}"])) + + {#Seq left right} + (%.format "(& " (format left) " " (format right) ")") + + {#Alt left right} + (%.format "(| " (format left) " " (format right) ")") + + {#Exhaustive} + "*")) + +(exception .public (invalid_tuple [size Nat]) + (exception.report + "Expected size" ">= 2" + "Actual size" (%.nat size))) + +(def .public (coverage pattern) + (-> Pattern (Try Coverage)) + (case pattern + (^.or {//pattern.#Simple {//simple.#Unit}} + {//pattern.#Bind _}) + {try.#Success {#Exhaustive}} + + ... Simple patterns (other than unit/[]) always have partial coverage because there + ... are too many possibilities as far as values go. + (^.with_template [ ] + [{//pattern.#Simple { it}} + {try.#Success { (set.of_list (list it))}}]) + ([//simple.#Nat #Nat n.hash] + [//simple.#Int #Int i.hash] + [//simple.#Rev #Rev r.hash] + [//simple.#Frac #Frac f.hash] + [//simple.#Text #Text text.hash]) + + ... Bits are the exception, since there is only "#1" and + ... "#0", which means it is possible for bit + ... pattern-matching to become exhaustive if complementary parts meet. + {//pattern.#Simple {//simple.#Bit value}} + {try.#Success {#Bit value}} + + ... Tuple patterns can be exhaustive if there is exhaustiveness for all of + ... their sub-patterns. + {//pattern.#Complex {//complex.#Tuple membersP+}} + (case (list.reversed membersP+) + (^.or (list) + (list _)) + (exception.except ..invalid_tuple [(list.size membersP+)]) + + {.#Item lastP prevsP+} + (do [! try.monad] + [lastC (coverage lastP)] + (monad.mix ! + (function (_ leftP rightC) + (do ! + [leftC (coverage leftP)] + (case rightC + {#Exhaustive} + (in leftC) + + _ + (in {#Seq leftC rightC})))) + lastC prevsP+))) + + ... Variant patterns can be shown to be exhaustive if all the possible + ... cases are handled exhaustively. + {//pattern.#Complex {//complex.#Variant [lefts right? value]}} + (do try.monad + [value_coverage (coverage value) + .let [idx (if right? + (++ lefts) + lefts)]] + (in {#Variant (if right? + {.#Some (++ idx)} + {.#None}) + (|> (dictionary.empty n.hash) + (dictionary.has idx value_coverage))})))) + +(def (xor left right) + (-> Bit Bit Bit) + (or (and left (not right)) + (and (not left) right))) + +... The coverage checker not only verifies that pattern-matching is +... exhaustive, but also that there are no redundant patterns. +... Redundant patterns will never be executed, since there will +... always be a pattern prior to them that would match the input. +... Because of that, the presence of redundant patterns is assumed to +... be a bug, likely due to programmer carelessness. +(exception .public (redundancy [so_far Coverage + addition Coverage]) + (exception.report + "Coverage so-far" (format so_far) + "Additional coverage" (format addition))) + +(exception .public (variant_mismatch [expected Nat + mismatched Nat]) + (exception.report + "Expected cases" (%.nat expected) + "Mismatched cases" (%.nat mismatched))) + +(def .public (exhaustive? coverage) + (-> Coverage Bit) + (case coverage + {#Exhaustive} + #1 + + _ + #0)) + +... After determining the coverage of each individual pattern, it is +... necessary to merge them all to figure out if the entire +... pattern-matching expression is exhaustive and whether it contains +... redundant patterns. +(def .public (composite addition so_far) + (-> Coverage Coverage (Try Coverage)) + (with_expansions [ (exception.except ..redundancy [so_far addition]) + {try.#Success {#Alt addition so_far}} + (if (/#= so_far addition) + ... The addition cannot possibly improve the coverage. + + ... There are now 2 alternative paths. + )] + (case [addition so_far] + ... 2 bit coverages are exhaustive if they complement one another. + [{#Bit sideA} {#Bit sideSF}] + (if (xor sideA sideSF) + {try.#Success {#Exhaustive}} + ) + + (^.with_template [] + [[{ partialA} { partialSF}] + (if (set.empty? (set.intersection partialA partialSF)) + {try.#Success { (set.union partialA partialSF)}} + )]) + ([#Nat] + [#Int] + [#Rev] + [#Frac] + [#Text]) + + [{#Variant addition'} {#Variant so_far'}] + (let [[allA casesA] addition' + [allSF casesSF] so_far' + addition_cases (..maximum addition') + so_far_cases (..maximum so_far')] + (cond (template.let [(known_cases? it) + [(n.< n#top it)]] + (and (known_cases? so_far_cases) + (if (known_cases? addition_cases) + (not (n.= so_far_cases addition_cases)) + (n.> so_far_cases (..minimum addition'))))) + (exception.except ..variant_mismatch [so_far_cases addition_cases]) + + (at (dictionary.equivalence ..equivalence) = casesSF casesA) + + + ... else + (do [! try.monad] + [casesM (monad.mix ! + (function (_ [tagA coverageA] casesSF') + (case (dictionary.value tagA casesSF') + {.#Some coverageSF} + (do ! + [coverageM (composite coverageA coverageSF)] + (in (dictionary.has tagA coverageM casesSF'))) + + {.#None} + (in (dictionary.has tagA coverageA casesSF')))) + casesSF + (dictionary.entries casesA))] + (in (if (and (n.= (n.min addition_cases so_far_cases) + (dictionary.size casesM)) + (list.every? ..exhaustive? (dictionary.values casesM))) + {#Exhaustive} + {#Variant (maybe#composite allA allSF) casesM}))))) + + [{#Seq leftA rightA} {#Seq leftSF rightSF}] + (case [(/#= leftSF leftA) (/#= rightSF rightA)] + ... Same prefix + [#1 #0] + (do try.monad + [rightM (composite rightA rightSF)] + (in (if (..exhaustive? rightM) + ... If all that follows is exhaustive, then it can be safely dropped + ... (since only the "left" part would influence whether the + ... composite coverage is exhaustive or not). + leftSF + {#Seq leftSF rightM}))) + + ... Same suffix + [#0 #1] + (do try.monad + [leftM (composite leftA leftSF)] + (in {#Seq leftM rightA})) + + ... The 2 sequences cannot possibly be merged. + [#0 #0] + + + ... There is nothing the addition adds to the coverage. + [#1 #1] + ) + + ... The addition cannot possibly improve the coverage. + [_ {#Exhaustive}] + + + ... The addition completes the coverage. + [{#Exhaustive} _] + {try.#Success {#Exhaustive}} + + ... When merging a new coverage against one based on Alt, it may be + ... that one of the many coverages in the Alt is complementary to + ... the new one, so effort must be made to fuse carefully, to match + ... the right coverages together. + ... If one of the Alt sub-coverages matches the new one, the cycle + ... must be repeated, in case the resulting coverage can now match + ... other ones in the original Alt. + ... This process must be repeated until no further productive + ... merges can be done. + [_ {#Alt leftS rightS}] + (do [! try.monad] + [.let [fuse_once (is (-> Coverage (List Coverage) + (Try [(Maybe Coverage) + (List Coverage)])) + (function (_ coverageA possibilitiesSF) + (loop (again [altsSF possibilitiesSF]) + (case altsSF + {.#End} + (in [{.#None} (list coverageA)]) + + {.#Item altSF altsSF'} + (do ! + [altMSF (composite coverageA altSF)] + (case altMSF + {#Alt _} + (do ! + [[success altsSF+] (again altsSF')] + (in [success {.#Item altSF altsSF+}])) + + _ + (in [{.#Some altMSF} altsSF'])))))))]] + (loop (again [addition addition + possibilitiesSF (alternatives so_far)]) + (do ! + [[addition' possibilitiesSF'] (fuse_once addition possibilitiesSF)] + (case addition' + {.#Some addition'} + (again addition' possibilitiesSF') + + {.#None} + (case (list.reversed possibilitiesSF') + {.#Item last prevs} + (in (list#mix (function (_ left right) {#Alt left right}) + last + prevs)) + + {.#End} + (undefined)))))) + + ... The left part will always match, so the addition is redundant. + [{#Seq left right} single] + (if (/#= left single) + + ) + + ... The right part is not necessary, since it can always match the left. + [single {#Seq left right}] + (if (/#= left single) + {try.#Success single} + ) + + _ + ))) diff --git a/stdlib/source/library/lux/meta/compiler/language/lux/analysis/evaluation.lux b/stdlib/source/library/lux/meta/compiler/language/lux/analysis/evaluation.lux new file mode 100644 index 000000000..402cf563a --- /dev/null +++ b/stdlib/source/library/lux/meta/compiler/language/lux/analysis/evaluation.lux @@ -0,0 +1,77 @@ +(.require + [library + [lux (.except) + [abstract + [monad (.only do)]] + [control + ["[0]" maybe] + ["[0]" try] + ["[0]" io] + [concurrency + ["[0]" atom (.only Atom)]]] + [data + [collection + ["[0]" dictionary (.only Dictionary)]]] + [math + [number + ["n" nat]]] + ["[0]" meta (.only) + [type (.only sharing)]]]] + ["[0]" // (.only Operation) + [macro (.only Expander)] + ["[1][0]" type] + ["[1][0]" scope] + [// + [phase + ["[0]P" extension] + ["[0]P" synthesis] + ["[0]P" analysis] + [// + ["[0]" synthesis] + ["[0]" generation] + [/// + ["[0]" phase] + [meta + ["[0]" archive (.only Archive) + ["[0]" module]]]]]]]]) + +(type .public Eval + (-> Archive Type Code (Operation Any))) + +(def evals + (Atom (Dictionary module.ID Nat)) + (atom.atom (dictionary.empty n.hash))) + +(def .public (evaluator expander synthesis_state generation_state generate) + (All (_ anchor expression artifact) + (-> Expander + synthesis.State+ + (generation.State+ anchor expression artifact) + (generation.Phase anchor expression artifact) + Eval)) + (let [analyze (analysisP.phase expander)] + (function (eval archive type exprC) + (do phase.monad + [exprA (<| (//type.expecting type) + //scope.reset + (analyze archive exprC)) + module (extensionP.lifted + meta.current_module_name)] + (<| phase.lifted + (do try.monad + [exprS (|> exprA (synthesisP.phase archive) (phase.result synthesis_state))]) + (phase.result generation_state) + (do phase.monad + [@module (sharing [anchor expression artifact] + (is (generation.Phase anchor expression artifact) + generate) + (is (generation.Operation anchor expression artifact module.ID) + (generation.module_id module archive))) + .let [[evals _] (io.run! (atom.update! (dictionary.revised' @module 0 ++) ..evals)) + @eval (maybe.else 0 (dictionary.value @module evals))] + exprO (<| (generation.with_registry_shift (|> @module + ("lux i64 left-shift" 16) + ("lux i64 or" @eval) + ("lux i64 left-shift" 32))) + (generate archive exprS))] + (generation.evaluate! [@module @eval] [{.#None} exprO]))))))) diff --git a/stdlib/source/library/lux/meta/compiler/language/lux/analysis/inference.lux b/stdlib/source/library/lux/meta/compiler/language/lux/analysis/inference.lux new file mode 100644 index 000000000..4bfa2da6a --- /dev/null +++ b/stdlib/source/library/lux/meta/compiler/language/lux/analysis/inference.lux @@ -0,0 +1,282 @@ +(.require + [library + [lux (.except) + [abstract + ["[0]" monad (.only do)]] + [control + ["[0]" pipe] + ["[0]" maybe] + ["[0]" try] + ["[0]" exception (.only exception)]] + [data + ["[0]" text (.only) + ["%" \\format (.only format)]] + [collection + ["[0]" list (.use "[1]#[0]" functor monoid)]]] + [math + [number + ["n" nat]]] + ["[0]" meta (.only) + [macro + ["^" pattern] + ["[0]" template]] + ["[0]" type (.only) + ["[0]" check]]]]] + ["/" // (.only Analysis Operation Phase) + ["[1][0]" type] + [// + [phase + ["[0]" extension]] + [/// + ["[0]" phase (.use "[1]#[0]" monad)] + [meta + [archive (.only Archive)]]]]]) + +(exception .public (cannot_infer [type Type + arguments (List Code)]) + (exception.report + "Type" (%.type type) + "Arguments" (exception.listing %.code arguments))) + +(exception .public (cannot_infer_argument [type Type + argument Code]) + (exception.report + "Type" (%.type type) + "Argument" (%.code argument))) + +(with_template [] + [(exception .public ( [type Type]) + (exception.report + "Type" (%.type type)))] + + [not_a_variant] + [not_a_record] + [invalid_type_application] + ) + +(def .public (quantified @var @parameter :it:) + (-> check.Var Nat Type Type) + (case :it: + {.#Primitive name co_variant} + {.#Primitive name (list#each (quantified @var @parameter) co_variant)} + + (^.with_template [] + [{ left right} + { (quantified @var @parameter left) + (quantified @var @parameter right)}]) + ([.#Sum] + [.#Product] + [.#Function] + [.#Apply]) + + {.#Var @} + (if (n.= @var @) + {.#Parameter @parameter} + :it:) + + (^.with_template [] + [{ env body} + { (list#each (quantified @var @parameter) env) + (quantified @var (n.+ 2 @parameter) body)}]) + ([.#UnivQ] + [.#ExQ]) + + (^.or {.#Parameter _} + {.#Ex _} + {.#Named _}) + :it:)) + +... Type-inference works by applying some (potentially quantified) type +... to a sequence of values. +... Function types are used for this, although inference is not always +... done for function application (alternative uses may be records and +... tagged variants). +... But, so long as the type being used for the inference can be treated +... as a function type, this method of inference should work. +(def (general' vars archive analyse inferT args) + (-> (List check.Var) Archive Phase Type (List Code) (Operation [Type_Context (List check.Var) Type (List Analysis)])) + (case args + {.#End} + (do phase.monad + [just_before (/type.check check.context) + _ (/type.inference inferT)] + (in [just_before vars inferT (list)])) + + {.#Item argC args'} + (case inferT + {.#Named name unnamedT} + (general' vars archive analyse unnamedT args) + + {.#UnivQ _} + (do phase.monad + [[@var :var:] (/type.check check.var)] + (general' (list.partial @var vars) archive analyse (maybe.trusted (type.applied (list :var:) inferT)) args)) + + {.#ExQ _} + (do phase.monad + [:ex: /type.existential] + (general' vars archive analyse (maybe.trusted (type.applied (list :ex:) inferT)) args)) + + {.#Apply inputT transT} + (case (type.applied (list inputT) transT) + {.#Some outputT} + (general' vars archive analyse outputT args) + + {.#None} + (/.except ..invalid_type_application [inferT])) + + ... Arguments are inferred back-to-front because, by convention, + ... Lux functions take the most important arguments *last*, which + ... means that the most information for doing proper inference is + ... located in the last arguments to a function call. + ... By inferring back-to-front, a lot of type-annotations can be + ... avoided in Lux code, since the inference algorithm can piece + ... things together more easily. + {.#Function inputT outputT} + (do phase.monad + [[just_before vars outputT' args'A] (general' vars archive analyse outputT args') + argA (<| (/.with_exception ..cannot_infer_argument [inputT argC]) + (/type.expecting inputT) + (analyse archive argC))] + (in [just_before vars outputT' (list.partial argA args'A)])) + + {.#Var infer_id} + (do phase.monad + [?inferT' (/type.check (check.peek infer_id))] + (case ?inferT' + {.#Some inferT'} + (general' vars archive analyse inferT' args) + + _ + (/.except ..cannot_infer [inferT args]))) + + _ + (/.except ..cannot_infer [inferT args])) + )) + +(def .public (general archive analyse inferT args) + (-> Archive Phase Type (List Code) (Operation [Type (List Analysis)])) + (do [! phase.monad] + [[just_before vars :inference: terms] (general' (list) archive analyse inferT args)] + (in [:inference: terms]) + ... (case vars + ... (list) + ... (in [:inference: terms]) + + ... _ + ... (do ! + ... [:inference: (/type.check + ... (do [! check.monad] + ... [quantifications (monad.mix ! (function (_ @var level) + ... (do ! + ... [:var: (check.try (check.identity vars @var))] + ... (case :var: + ... {try.#Success _} + ... (in level) + + ... {try.#Failure _} + ... (do ! + ... [.let [:var: (|> level (n.* 2) ++ {.#Parameter})] + ... _ (check.bind :var: @var)] + ... (in (++ level)))))) + ... 0 + ... vars) + ... :inference:' (at ! each (type.univ_q quantifications) (check.clean vars :inference:)) + ... _ (check.with just_before)] + ... (in :inference:'))) + ... _ (/type.inference :inference:)] + ... (in [:inference: terms]))) + )) + +(def (with_recursion @self recursion) + (-> Nat Type Type Type) + (function (again it) + (case it + (^.or {.#Parameter index} + {.#Apply {.#Primitive "" {.#End}} + {.#Parameter index}}) + (if (n.= @self index) + recursion + it) + + (^.with_template [] + [{ left right} + { (again left) (again right)}]) + ([.#Sum] [.#Product] [.#Function] [.#Apply]) + + (^.with_template [] + [{ environment quantified} + { (list#each again environment) + (with_recursion (n.+ 2 @self) recursion quantified)}]) + ([.#UnivQ] [.#ExQ]) + + {.#Primitive name parameters} + {.#Primitive name (list#each again parameters)} + + _ + it))) + +(def parameters + (-> Nat (List Type)) + (|>> list.indices + (list#each (|>> (n.* 2) ++ {.#Parameter})) + list.reversed)) + +(with_template [ ] + [(`` (def .public ( (,, (template.spliced )) complex) + (-> (,, (template.spliced )) Type (Operation Type)) + (loop (again [depth 0 + it complex]) + (case it + {.#Named name it} + (again depth it) + + (^.with_template [] + [{ env it} + (phase#each (|>> { env}) + (again (++ depth) it))]) + ([.#UnivQ] + [.#ExQ]) + + {.#Apply parameter abstraction} + (case (type.applied (list parameter) abstraction) + {.#Some it} + (again depth it) + + {.#None} + (/.except ..invalid_type_application [it])) + + { _} + + + _ + (/.except [complex])))))] + + [record [Nat] [arity] ..not_a_record + .#Product + (let [[lefts right] (|> it + type.flat_tuple + (list.split_at (-- arity)))] + (phase#in (type.function + (list#each (..with_recursion (|> depth -- (n.* 2)) complex) + (list#composite lefts (list (type.tuple right)))) + (type.application (parameters depth) complex))))] + [variant [Nat Bit] [lefts right?] ..not_a_variant + .#Sum + (|> it + type.flat_variant + (list.after lefts) + (pipe.case + {.#Item [head tail]} + (let [case (if right? + (type.variant tail) + head)] + (-> (if (n.= 0 depth) + case + (..with_recursion (|> depth -- (n.* 2)) complex case)) + (type.application (parameters depth) complex))) + + {.#End} + (-> .Nothing complex)) + phase#in)] + ) diff --git a/stdlib/source/library/lux/meta/compiler/language/lux/analysis/macro.lux b/stdlib/source/library/lux/meta/compiler/language/lux/analysis/macro.lux new file mode 100644 index 000000000..9a5de364f --- /dev/null +++ b/stdlib/source/library/lux/meta/compiler/language/lux/analysis/macro.lux @@ -0,0 +1,56 @@ +(.require + [library + [lux (.except) + ["[0]" meta] + [abstract + [monad (.only do)]] + [control + ["[0]" try (.only Try)] + ["[0]" exception (.only exception)]] + [data + ["[0]" text + ["%" \\format (.only format)]]]]] + [///// + ["[0]" phase]]) + +(exception .public (expansion_failed [macro Symbol + inputs (List Code) + error Text]) + (exception.report + "Macro" (%.symbol macro) + "Inputs" (exception.listing %.code inputs) + "Error" error)) + +(exception .public (must_have_single_expansion [macro Symbol + inputs (List Code) + outputs (List Code)]) + (exception.report + "Macro" (%.symbol macro) + "Inputs" (exception.listing %.code inputs) + "Outputs" (exception.listing %.code outputs))) + +(type .public Expander + (-> Macro (List Code) Lux (Try (Try [Lux (List Code)])))) + +(def .public (expansion expander name macro inputs) + (-> Expander Symbol Macro (List Code) (Meta (List Code))) + (function (_ state) + (do try.monad + [output (expander macro inputs state)] + (case output + {try.#Failure error} + ((meta.failure (exception.error ..expansion_failed [name inputs error])) state) + + _ + output)))) + +(def .public (single_expansion expander name macro inputs) + (-> Expander Symbol Macro (List Code) (Meta Code)) + (do meta.monad + [expansion (..expansion expander name macro inputs)] + (case expansion + (list single) + (in single) + + _ + (meta.failure (exception.error ..must_have_single_expansion [name inputs expansion]))))) diff --git a/stdlib/source/library/lux/meta/compiler/language/lux/analysis/module.lux b/stdlib/source/library/lux/meta/compiler/language/lux/analysis/module.lux new file mode 100644 index 000000000..33e818a9e --- /dev/null +++ b/stdlib/source/library/lux/meta/compiler/language/lux/analysis/module.lux @@ -0,0 +1,216 @@ +(.require + [library + [lux (.except Label with) + ["[0]" meta] + [abstract + ["[0]" monad (.only do)]] + [control + ["[0]" pipe] + ["[0]" try] + ["[0]" exception (.only exception)]] + [data + ["[0]" text (.use "[1]#[0]" equivalence) + ["%" \\format (.only format)]] + [collection + ["[0]" list (.use "[1]#[0]" mix functor) + ["[0]" property]]]]]] + ["/" // (.only Operation) + ["//[1]" // + [phase + ["[1][0]" extension]] + [/// + ["[1]" phase]]]]) + +(type .public Label + Text) + +(exception .public (unknown_module [module Text]) + (exception.report + "Module" module)) + +(with_template [] + [(exception .public ( [labels (List Label) + owner Type]) + (exception.report + "Labels" (text.interposed " " labels) + "Type" (%.type owner)))] + + [cannot_declare_labels_for_anonymous_type] + [cannot_declare_labels_for_foreign_type] + ) + +(exception .public (cannot_define_more_than_once [name Symbol + already_existing Global]) + (exception.report + "Definition" (%.symbol name) + "Original" (case already_existing + {.#Alias alias} + (format "alias " (%.symbol alias)) + + {.#Definition definition} + (format "definition " (%.symbol name)) + + {.#Type _} + (format "type " (%.symbol name)) + + {.#Tag _} + (format "tag " (%.symbol name)) + + {.#Slot _} + (format "slot " (%.symbol name))))) + +(exception .public (can_only_change_state_of_active_module [module Text + state Module_State]) + (exception.report + "Module" module + "Desired state" (case state + {.#Active} "Active" + {.#Compiled} "Compiled" + {.#Cached} "Cached"))) + +(def .public (empty hash) + (-> Nat Module) + [.#module_hash hash + .#module_aliases (list) + .#definitions (list) + .#imports (list) + .#module_state {.#Active}]) + +(def .public (import module) + (-> Text (Operation Any)) + (///extension.lifted + (do ///.monad + [self_name meta.current_module_name] + (function (_ state) + {try.#Success [(revised .#modules + (property.revised self_name (revised .#imports (function (_ current) + (if (list.any? (text#= module) + current) + current + {.#Item module current})))) + state) + []]})))) + +(def .public (alias alias module) + (-> Text Text (Operation Any)) + (///extension.lifted + (do ///.monad + [self_name meta.current_module_name] + (function (_ state) + {try.#Success [(revised .#modules + (property.revised self_name (revised .#module_aliases (is (-> (List [Text Text]) (List [Text Text])) + (|>> {.#Item [alias module]})))) + state) + []]})))) + +(def .public (exists? module) + (-> Text (Operation Bit)) + (///extension.lifted + (function (_ state) + (|> state + (the .#modules) + (property.value module) + (pipe.case {.#Some _} #1 {.#None} #0) + [state] + {try.#Success})))) + +(def .public (define name definition) + (-> Text Global (Operation Any)) + (///extension.lifted + (do ///.monad + [self_name meta.current_module_name + self meta.current_module] + (function (_ state) + (case (property.value name (the .#definitions self)) + {.#None} + {try.#Success [(revised .#modules + (property.has self_name + (revised .#definitions + (is (-> (List [Text Global]) (List [Text Global])) + (|>> {.#Item [name definition]})) + self)) + state) + []]} + + {.#Some already_existing} + ((///extension.up (/.except ..cannot_define_more_than_once [[self_name name] already_existing])) + state)))))) + +(def .public (create hash name) + (-> Nat Text (Operation Any)) + (///extension.lifted + (function (_ state) + {try.#Success [(revised .#modules + (property.has name (..empty hash)) + state) + []]}))) + +(def .public (with hash name action) + (All (_ a) (-> Nat Text (Operation a) (Operation [Module a]))) + (do ///.monad + [_ (..create hash name) + output (/.with_current_module name + action) + module (///extension.lifted (meta.module name))] + (in [module output]))) + +(with_template [ ] + [(def .public ( module_name) + (-> Text (Operation Any)) + (///extension.lifted + (function (_ state) + (case (|> state (the .#modules) (property.value module_name)) + {.#Some module} + (let [active? (case (the .#module_state module) + {.#Active} #1 + _ #0)] + (if active? + {try.#Success [(revised .#modules + (property.has module_name (has .#module_state {} module)) + state) + []]} + ((///extension.up (/.except ..can_only_change_state_of_active_module [module_name {}])) + state))) + + {.#None} + ((///extension.up (/.except ..unknown_module module_name)) + state))))) + + (def .public ( module_name) + (-> Text (Operation Bit)) + (///extension.lifted + (function (_ state) + (case (|> state (the .#modules) (property.value module_name)) + {.#Some module} + {try.#Success [state + (case (the .#module_state module) + {} #1 + _ #0)]} + + {.#None} + ((///extension.up (/.except ..unknown_module module_name)) + state)))))] + + [set_active active? .#Active] + [set_compiled compiled? .#Compiled] + [set_cached cached? .#Cached] + ) + +(def .public (declare_labels record? labels exported? type) + (-> Bit (List Label) Bit Type (Operation Any)) + (do [! ///.monad] + [self_name (///extension.lifted meta.current_module_name) + [type_module type_name] (case type + {.#Named type_name _} + (in type_name) + + _ + (/.except ..cannot_declare_labels_for_anonymous_type [labels type])) + _ (///.assertion ..cannot_declare_labels_for_foreign_type [labels type] + (text#= self_name type_module))] + (monad.each ! (function (_ [index short]) + (..define short + (if record? + {.#Slot [exported? type labels index]} + {.#Tag [exported? type labels index]}))) + (list.enumeration labels)))) diff --git a/stdlib/source/library/lux/meta/compiler/language/lux/analysis/pattern.lux b/stdlib/source/library/lux/meta/compiler/language/lux/analysis/pattern.lux new file mode 100644 index 000000000..daf608222 --- /dev/null +++ b/stdlib/source/library/lux/meta/compiler/language/lux/analysis/pattern.lux @@ -0,0 +1,85 @@ +(.require + [library + [lux (.except Pattern nat int rev) + [abstract + [equivalence (.only Equivalence)]] + [data + [text + ["%" \\format]]] + [math + [number + ["n" nat]]]]] + ["[0]" // + ["[1][0]" simple (.only Simple)] + ["[1][0]" complex (.only Complex)] + [//// + [reference + ["[1][0]" variable (.only Register)]]]]) + +(type .public Pattern + (Rec Pattern + (.Variant + {#Simple Simple} + {#Complex (Complex Pattern)} + {#Bind Register}))) + +(def .public equivalence + (Equivalence Pattern) + (implementation + (def (= reference sample) + (case [reference sample] + [{#Simple reference} {#Simple sample}] + (at //simple.equivalence = reference sample) + + [{#Complex reference} {#Complex sample}] + (at (//complex.equivalence =) = reference sample) + + [{#Bind reference} {#Bind sample}] + (n.= reference sample) + + _ + false)))) + +(def .public (format it) + (%.Format Pattern) + (case it + {#Simple it} + (//simple.format it) + + {#Complex it} + (//complex.format format it) + + {#Bind it} + (//variable.format {//variable.#Local it}))) + +(with_template [ ] + [(def .public + (template ( content) + [(.<| {..#Complex} + + content)]))] + + [variant {//complex.#Variant}] + [tuple {//complex.#Tuple}] + ) + +(def .public unit + (template (unit) + [{..#Simple {//simple.#Unit}}])) + +(with_template [ ] + [(def .public + (template ( content) + [{..#Simple { content}}]))] + + [bit //simple.#Bit] + [nat //simple.#Nat] + [int //simple.#Int] + [rev //simple.#Rev] + [frac //simple.#Frac] + [text //simple.#Text] + ) + +(def .public bind + (template (bind register) + [{..#Bind register}])) diff --git a/stdlib/source/library/lux/meta/compiler/language/lux/analysis/scope.lux b/stdlib/source/library/lux/meta/compiler/language/lux/analysis/scope.lux new file mode 100644 index 000000000..538874881 --- /dev/null +++ b/stdlib/source/library/lux/meta/compiler/language/lux/analysis/scope.lux @@ -0,0 +1,193 @@ +(.require + [library + [lux (.except local with) + [abstract + [monad (.only do)]] + [control + ["[0]" maybe (.use "[1]#[0]" monad)] + ["[0]" try] + ["[0]" exception (.only exception)]] + [data + ["[0]" text (.use "[1]#[0]" equivalence)] + ["[0]" product] + [collection + ["[0]" list (.use "[1]#[0]" functor mix monoid) + ["[0]" property]]]]]] + ["/" // (.only Environment Operation Phase) + [// + [phase + ["[0]" extension]] + [/// + ["[0]" phase] + [reference + ["[0]" variable (.only Register Variable)]]]]]) + +(type Local + (Bindings Text [Type Register])) + +(type Foreign + (Bindings Text [Type Variable])) + +(def (local? name scope) + (-> Text Scope Bit) + (|> scope + (the [.#locals .#mappings]) + (property.contains? name))) + +(def (local name scope) + (-> Text Scope (Maybe [Type Variable])) + (|> scope + (the [.#locals .#mappings]) + (property.value name) + (maybe#each (function (_ [type value]) + [type {variable.#Local value}])))) + +(def (captured? name scope) + (-> Text Scope Bit) + (|> scope + (the [.#captured .#mappings]) + (property.contains? name))) + +(def (captured name scope) + (-> Text Scope (Maybe [Type Variable])) + (loop (again [idx 0 + mappings (the [.#captured .#mappings] scope)]) + (case mappings + {.#Item [_name [_source_type _source_ref]] mappings'} + (if (text#= name _name) + {.#Some [_source_type {variable.#Foreign idx}]} + (again (++ idx) mappings')) + + {.#End} + {.#None}))) + +(def (reference? name scope) + (-> Text Scope Bit) + (or (local? name scope) + (captured? name scope))) + +(def (reference name scope) + (-> Text Scope (Maybe [Type Variable])) + (case (..local name scope) + {.#Some type} + {.#Some type} + + _ + (..captured name scope))) + +(def .public (variable name) + (-> Text (Operation (Maybe [Type Variable]))) + (extension.lifted + (function (_ state) + (let [[inner outer] (|> state + (the .#scopes) + (list.split_when (|>> (reference? name))))] + (case outer + {.#End} + {.#Right [state {.#None}]} + + {.#Item top_outer _} + (let [[ref_type init_ref] (maybe.else (undefined) + (..reference name top_outer)) + [ref inner'] (list#mix (is (-> Scope [Variable (List Scope)] [Variable (List Scope)]) + (function (_ scope ref+inner) + [{variable.#Foreign (the [.#captured .#counter] scope)} + {.#Item (revised .#captured + (is (-> Foreign Foreign) + (|>> (revised .#counter ++) + (revised .#mappings (property.has name [ref_type (product.left ref+inner)])))) + scope) + (product.right ref+inner)}])) + [init_ref {.#End}] + (list.reversed inner)) + scopes (list#composite inner' outer)] + {.#Right [(has .#scopes scopes state) + {.#Some [ref_type ref]}]}) + ))))) + +(exception .public no_scope) +(exception .public drained) + +(def .public (with_local [name type] action) + (All (_ a) (-> [Text Type] (Operation a) (Operation a))) + (function (_ [bundle state]) + (case (the .#scopes state) + {.#Item head tail} + (let [old_mappings (the [.#locals .#mappings] head) + new_var_id (the [.#locals .#counter] head) + new_head (revised .#locals + (is (-> Local Local) + (|>> (revised .#counter ++) + (revised .#mappings (property.has name [type new_var_id])))) + head)] + (case (phase.result' [bundle (has .#scopes {.#Item new_head tail} state)] + action) + {try.#Success [[bundle' state'] output]} + (case (the .#scopes state') + {.#Item head' tail'} + (let [scopes' {.#Item (has .#locals (the .#locals head) head') + tail'}] + {try.#Success [[bundle' (has .#scopes scopes' state')] + output]}) + + _ + (exception.except ..drained [])) + + {try.#Failure error} + {try.#Failure error})) + + _ + (exception.except ..no_scope [])))) + +(def empty + Scope + (let [bindings (is Bindings + [.#counter 0 + .#mappings (list)])] + [.#name (list) + .#inner 0 + .#locals bindings + .#captured bindings])) + +(def .public (reset action) + (All (_ a) (-> (Operation a) (Operation a))) + (function (_ [bundle state]) + (case (action [bundle (has .#scopes (list ..empty) state)]) + {try.#Success [[bundle' state'] output]} + {try.#Success [[bundle' (has .#scopes (the .#scopes state) state')] + output]} + + failure + failure))) + +(def .public (with action) + (All (_ a) (-> (Operation a) (Operation [Scope a]))) + (function (_ [bundle state]) + (case (action [bundle (revised .#scopes (|>> {.#Item ..empty}) state)]) + {try.#Success [[bundle' state'] output]} + (case (the .#scopes state') + {.#Item head tail} + {try.#Success [[bundle' (has .#scopes tail state')] + [head output]]} + + {.#End} + (exception.except ..drained [])) + + {try.#Failure error} + {try.#Failure error}))) + +(def .public next + (Operation Register) + (extension.lifted + (function (_ state) + (case (the .#scopes state) + {.#Item top _} + {try.#Success [state (the [.#locals .#counter] top)]} + + {.#End} + (exception.except ..no_scope []))))) + +(def .public environment + (-> Scope (Environment Variable)) + (|>> (the [.#captured .#mappings]) + (list#each (function (_ [_ [_ ref]]) ref)))) diff --git a/stdlib/source/library/lux/meta/compiler/language/lux/analysis/simple.lux b/stdlib/source/library/lux/meta/compiler/language/lux/analysis/simple.lux new file mode 100644 index 000000000..4b092ad00 --- /dev/null +++ b/stdlib/source/library/lux/meta/compiler/language/lux/analysis/simple.lux @@ -0,0 +1,65 @@ +(.require + [library + [lux (.except) + [abstract + [equivalence (.only Equivalence)]] + [data + ["[0]" bit (.use "[1]#[0]" equivalence)] + ["[0]" text (.use "[1]#[0]" equivalence) + ["%" \\format (.only Format)]]] + [math + [number + ["n" nat] + ["i" int] + ["r" rev] + ["f" frac]]] + [meta + [macro + ["^" pattern]]]]]) + +(type .public Simple + (Variant + {#Unit} + {#Bit Bit} + {#Nat Nat} + {#Int Int} + {#Rev Rev} + {#Frac Frac} + {#Text Text})) + +(def .public equivalence + (Equivalence Simple) + (implementation + (def (= reference sample) + (case [reference sample] + [{#Unit} {#Unit}] + true + + (^.with_template [ <=>] + [[{ reference} { sample}] + (<=> reference sample)]) + ([#Bit bit#=] + [#Nat n.=] + [#Int i.=] + [#Rev r.=] + [#Frac f.=] + [#Text text#=]) + + _ + false)))) + +(def .public (format it) + (Format Simple) + (case it + {#Unit} + "[]" + + (^.with_template [ ] + [{ value} + ( value)]) + ([#Bit %.bit] + [#Nat %.nat] + [#Int %.int] + [#Rev %.rev] + [#Frac %.frac] + [#Text %.text]))) diff --git a/stdlib/source/library/lux/meta/compiler/language/lux/analysis/type.lux b/stdlib/source/library/lux/meta/compiler/language/lux/analysis/type.lux new file mode 100644 index 000000000..b534b616a --- /dev/null +++ b/stdlib/source/library/lux/meta/compiler/language/lux/analysis/type.lux @@ -0,0 +1,133 @@ +(.require + [library + [lux (.except) + [abstract + ["[0]" monad (.only do)]] + [control + ["[0]" function] + ["[0]" try]] + [data + ["[0]" text (.only) + ["%" \\format (.only format)]] + [collection + ["[0]" list]]] + [math + [number + ["n" nat]]] + ["[0]" meta (.only) + [macro + ["^" pattern]] + [type + ["[0]" check (.only Check)]]]]] + ["/" // (.only Operation) + [// + [phase + ["[0]" extension]] + [/// + ["[0]" phase]]]]) + +(def .public (check action) + (All (_ a) (-> (Check a) (Operation a))) + (function (_ (^.let stateE [bundle state])) + (case (action (the .#type_context state)) + {try.#Success [context' output]} + {try.#Success [[bundle (has .#type_context context' state)] + output]} + + {try.#Failure error} + ((/.failure error) stateE)))) + +(def prefix + (format (%.symbol (symbol ..type)) "#")) + +(def .public (existential? type) + (-> Type Bit) + (case type + {.#Primitive actual {.#End}} + (text.starts_with? ..prefix actual) + + _ + false)) + +(def (existential' module id) + (-> Text Nat Type) + {.#Primitive (format ..prefix module "#" (%.nat id)) (list)}) + +(def .public existential + (Operation Type) + (do phase.monad + [module (extension.lifted meta.current_module_name) + id (extension.lifted meta.seed)] + (in (..existential' module id)))) + +(def .public (expecting expected) + (All (_ a) (-> Type (Operation a) (Operation a))) + (extension.localized (the .#expected) (has .#expected) + (function.constant {.#Some expected}))) + +(def .public fresh + (All (_ a) (-> (Operation a) (Operation a))) + (extension.localized (the .#type_context) (has .#type_context) + (function.constant check.fresh_context))) + +(def .public (inference actualT) + (-> Type (Operation Any)) + (do phase.monad + [module (extension.lifted meta.current_module_name) + expectedT (extension.lifted meta.expected_type)] + (..check (check.check expectedT actualT) + ... (do [! check.monad] + ... [pre check.context + ... it (check.check expectedT actualT) + ... post check.context + ... .let [pre#var_counter (the .#var_counter pre)]] + ... (if (n.< (the .#var_counter post) + ... pre#var_counter) + ... (do ! + ... [.let [new! (is (-> [Nat (Maybe Type)] (Maybe Nat)) + ... (function (_ [id _]) + ... (if (n.< id pre#var_counter) + ... {.#Some id} + ... {.#None}))) + ... new_vars (|> post + ... (the .#var_bindings) + ... (list.all new!))] + ... _ (monad.each ! (function (_ @new) + ... (do ! + ... [:new: (check.try (check.identity new_vars @new))] + ... (case :new: + ... {try.#Success :new:} + ... (in :new:) + + ... {try.#Failure error} + ... (do ! + ... [[id _] check.existential + ... .let [:new: (..existential' module id)] + ... _ (check.bind :new: @new)] + ... (in :new:))))) + ... new_vars) + ... expectedT' (check.clean new_vars expectedT) + ... _ (check.with pre)] + ... (check.check expectedT' actualT)) + ... (in it))) + ))) + +(def .public (with_var it) + (All (_ a) + (-> (-> [check.Var Type] (Operation a)) + (Operation a))) + (do phase.monad + [@it,:it: (..check check.var) + it (it @it,:it:) + .let [[@it :it:] @it,:it:] + _ (..check (check.forget! @it))] + (in it))) + +(def .public (inferring action) + (All (_ a) (-> (Operation a) (Operation [Type a]))) + (<| ..with_var + (function (_ [@it :it:])) + (do phase.monad + [it (..expecting :it: action) + :it: (..check (check.identity (list) @it))] + (in [:it: it])))) diff --git a/stdlib/source/library/lux/meta/compiler/language/lux/declaration.lux b/stdlib/source/library/lux/meta/compiler/language/lux/declaration.lux new file mode 100644 index 000000000..1f2b4505a --- /dev/null +++ b/stdlib/source/library/lux/meta/compiler/language/lux/declaration.lux @@ -0,0 +1,102 @@ +(.require + [library + [lux (.except Module) + [abstract + [monad (.only do)]] + [control + ["[0]" try]] + [data + [collection + ["[0]" list (.use "[1]#[0]" monoid)]]]]] + [// + ["[0]" analysis] + ["[0]" synthesis] + ["[0]" generation] + [phase + ["[0]" extension]] + [/// + ["[0]" phase] + [meta + [archive + [module + [descriptor (.only Module)]]]]]]) + +(type .public (Component state phase) + (Record + [#state state + #phase phase])) + +(type .public (State anchor expression declaration) + (Record + [#analysis (Component analysis.State+ + analysis.Phase) + #synthesis (Component synthesis.State+ + synthesis.Phase) + #generation (Component (generation.State+ anchor expression declaration) + (generation.Phase anchor expression declaration))])) + +(type .public Import + (Record + [#module Module + #alias Text])) + +(type .public Requirements + (Record + [#imports (List Import) + #referrals (List Code)])) + +(def .public no_requirements + Requirements + [#imports (list) + #referrals (list)]) + +(def .public (merge_requirements left right) + (-> Requirements Requirements Requirements) + [#imports (list#composite (the #imports left) (the #imports right)) + #referrals (list#composite (the #referrals left) (the #referrals right))]) + +(with_template [ ] + [(type .public ( anchor expression declaration) + ( (..State anchor expression declaration) Code Requirements))] + + [State+ extension.State] + [Operation extension.Operation] + [Phase extension.Phase] + [Handler extension.Handler] + [Bundle extension.Bundle] + ) + +(with_template [ ] + [(def .public + (All (_ anchor expression declaration) + (Operation anchor expression declaration )) + (function (_ [bundle state]) + {try.#Success [[bundle state] (the [ ..#phase] state)]}))] + + [analysis ..#analysis analysis.Phase] + [synthesis ..#synthesis synthesis.Phase] + [generation ..#generation (generation.Phase anchor expression declaration)] + ) + +(with_template [ ] + [(def .public + (All (_ anchor expression declaration output) + (-> ( output) + (Operation anchor expression declaration output))) + (|>> (phase.sub [(the [ ..#state]) + (has [ ..#state])]) + extension.lifted))] + + [lifted_analysis ..#analysis analysis.Operation] + [lifted_synthesis ..#synthesis synthesis.Operation] + [lifted_generation ..#generation (generation.Operation anchor expression declaration)] + ) + +(def .public (set_current_module module) + (All (_ anchor expression declaration) + (-> Module (Operation anchor expression declaration Any))) + (do phase.monad + [_ (..lifted_analysis + (analysis.set_current_module module))] + (..lifted_generation + (generation.enter_module module)))) diff --git a/stdlib/source/library/lux/meta/compiler/language/lux/generation.lux b/stdlib/source/library/lux/meta/compiler/language/lux/generation.lux new file mode 100644 index 000000000..c217a6d6c --- /dev/null +++ b/stdlib/source/library/lux/meta/compiler/language/lux/generation.lux @@ -0,0 +1,398 @@ +(.require + [library + [lux (.except symbol) + [abstract + [monad (.only do)]] + [control + ["[0]" try (.only Try)] + ["[0]" exception (.only exception)] + ["[0]" function]] + [data + [binary (.only Binary)] + ["[0]" product] + ["[0]" text (.use "[1]#[0]" equivalence) + ["%" \\format (.only format)]] + [collection + ["[0]" sequence (.only Sequence)] + ["[0]" list (.use "[1]#[0]" functor mix)] + ["[0]" set (.only Set)]]] + [math + [number + ["n" nat]]] + [meta + ["[0]" symbol] + [macro + ["^" pattern] + ["[0]" template]]]]] + [// + [synthesis (.only Synthesis)] + [phase + ["[0]" extension]] + [/// + ["[0]" phase] + [meta + ["[0]" archive (.only Archive) + ["[0]" registry (.only Registry)] + ["[0]" unit] + ["[0]" artifact (.only) + ["[0]" category]] + ["[0]" module (.only) + ["[0]" descriptor]]]]]]) + +(type .public (Buffer declaration) + (Sequence [artifact.ID (Maybe Text) declaration])) + +(exception .public (cannot_interpret [error Text]) + (exception.report + "Error" error)) + +(with_template [] + [(exception .public ( [it artifact.ID]) + (exception.report + "Artifact ID" (%.nat it)))] + + [cannot_overwrite_output] + [no_buffer_for_saving_code] + ) + +(type .public (Host expression declaration) + (Interface + (is (-> unit.ID [(Maybe unit.ID) expression] (Try Any)) + evaluate) + (is (-> declaration (Try Any)) + execute) + (is (-> unit.ID (Maybe Text) [(Maybe unit.ID) expression] (Try [Text Any declaration])) + define) + + (is (-> unit.ID Binary declaration) + ingest) + (is (-> unit.ID (Maybe Text) declaration (Try Any)) + re_learn) + (is (-> unit.ID (Maybe Text) declaration (Try Any)) + re_load))) + +(type .public (State anchor expression declaration) + (Record + [#module descriptor.Module + #anchor (Maybe anchor) + #host (Host expression declaration) + #buffer (Maybe (Buffer declaration)) + #registry Registry + #registry_shift Nat + #counter Nat + #context (Maybe artifact.ID) + #log (Sequence Text) + #interim_artifacts (List artifact.ID)])) + +(with_template [ ] + [(type .public ( anchor expression declaration) + ( (State anchor expression declaration) Synthesis expression))] + + [State+ extension.State] + [Operation extension.Operation] + [Phase extension.Phase] + [Handler extension.Handler] + [Bundle extension.Bundle] + [Extender extension.Extender] + ) + +(def .public (state host module) + (All (_ anchor expression declaration) + (-> (Host expression declaration) + descriptor.Module + (..State anchor expression declaration))) + [#module module + #anchor {.#None} + #host host + #buffer {.#None} + #registry registry.empty + #registry_shift 0 + #counter 0 + #context {.#None} + #log sequence.empty + #interim_artifacts (list)]) + +(def .public empty_buffer + Buffer + sequence.empty) + +(with_template [ + + ] + [(exception .public ) + + (def .public + (All (_ anchor expression declaration output) ) + (function (_ body) + (function (_ [bundle state]) + (case (body [bundle (has {.#Some } state)]) + {try.#Success [[bundle' state'] output]} + {try.#Success [[bundle' (has (the state) state')] + output]} + + {try.#Failure error} + {try.#Failure error})))) + + (def .public + (All (_ anchor expression declaration) + (Operation anchor expression declaration )) + (function (_ (^.let stateE [bundle state])) + (case (the state) + {.#Some output} + {try.#Success [stateE output]} + + {.#None} + (exception.except [])))) + + (def .public ( value) + (All (_ anchor expression declaration) + (-> (Operation anchor expression declaration Any))) + (function (_ [bundle state]) + {try.#Success [[bundle (has {.#Some value} state)] + []]}))] + + [#anchor + (with_anchor anchor) + (-> anchor (Operation anchor expression declaration output) + (Operation anchor expression declaration output)) + anchor + set_anchor anchor anchor no_anchor] + + [#buffer + with_buffer + (-> (Operation anchor expression declaration output) + (Operation anchor expression declaration output)) + ..empty_buffer + set_buffer buffer (Buffer declaration) no_active_buffer] + ) + +(def .public get_registry + (All (_ anchor expression declaration) + (Operation anchor expression declaration Registry)) + (function (_ (^.let stateE [bundle state])) + {try.#Success [stateE (the #registry state)]})) + +(def .public (set_registry value) + (All (_ anchor expression declaration) + (-> Registry (Operation anchor expression declaration Any))) + (function (_ [bundle state]) + {try.#Success [[bundle (has #registry value state)] + []]})) + +(def .public next + (All (_ anchor expression declaration) + (Operation anchor expression declaration Nat)) + (do phase.monad + [count (extension.read (the #counter)) + _ (extension.update (revised #counter ++))] + (in count))) + +(def .public (symbol prefix) + (All (_ anchor expression declaration) + (-> Text (Operation anchor expression declaration Text))) + (at phase.monad each (|>> %.nat (format prefix)) ..next)) + +(def .public (enter_module module) + (All (_ anchor expression declaration) + (-> descriptor.Module (Operation anchor expression declaration Any))) + (extension.update (has #module module))) + +(def .public module + (All (_ anchor expression declaration) + (Operation anchor expression declaration descriptor.Module)) + (extension.read (the #module))) + +(def .public (evaluate! label code) + (All (_ anchor expression declaration) + (-> unit.ID [(Maybe unit.ID) expression] (Operation anchor expression declaration Any))) + (function (_ (^.let state+ [bundle state])) + (case (at (the #host state) evaluate label code) + {try.#Success output} + {try.#Success [state+ output]} + + {try.#Failure error} + (exception.except ..cannot_interpret [error])))) + +(def .public (execute! code) + (All (_ anchor expression declaration) + (-> declaration (Operation anchor expression declaration Any))) + (function (_ (^.let state+ [bundle state])) + (case (at (the #host state) execute code) + {try.#Success output} + {try.#Success [state+ output]} + + {try.#Failure error} + (exception.except ..cannot_interpret error)))) + +(def .public (define! context custom code) + (All (_ anchor expression declaration) + (-> unit.ID (Maybe Text) [(Maybe unit.ID) expression] (Operation anchor expression declaration [Text Any declaration]))) + (function (_ (^.let stateE [bundle state])) + (case (at (the #host state) define context custom code) + {try.#Success output} + {try.#Success [stateE output]} + + {try.#Failure error} + (exception.except ..cannot_interpret error)))) + +(def .public (save! artifact_id custom code) + (All (_ anchor expression declaration) + (-> artifact.ID (Maybe Text) declaration (Operation anchor expression declaration Any))) + (do [! phase.monad] + [?buffer (extension.read (the #buffer))] + (case ?buffer + {.#Some buffer} + ... TODO: Optimize by no longer checking for overwrites... + (if (sequence.any? (|>> product.left (n.= artifact_id)) buffer) + (phase.except ..cannot_overwrite_output [artifact_id]) + (extension.update (has #buffer {.#Some (sequence.suffix [artifact_id custom code] buffer)}))) + + {.#None} + (phase.except ..no_buffer_for_saving_code [artifact_id])))) + +(with_template [ ] + [(`` (def .public ( it (,, (template.spliced )) dependencies) + (All (_ anchor expression declaration) + (-> (,, (template.spliced )) (Set unit.ID) (Operation anchor expression declaration artifact.ID))) + (function (_ (^.let stateE [bundle state])) + (let [[id registry'] ( it dependencies (the #registry state))] + {try.#Success [[bundle (has #registry registry' state)] + id]}))))] + + [category.Definition mandatory? [mandatory?] [Bit] learn registry.definition] + [Text #1 [] [] learn_custom registry.custom] + [Text #0 [] [] learn_analyser registry.analyser] + [Text #0 [] [] learn_synthesizer registry.synthesizer] + [Text #0 [] [] learn_generator registry.generator] + [Text #0 [] [] learn_declaration registry.declaration] + ) + +(exception .public (unknown_definition [name Symbol + known_definitions (List category.Definition)]) + (exception.report + "Definition" (symbol.short name) + "Module" (symbol.module name) + "Known Definitions" (exception.listing product.left known_definitions))) + +(def .public (remember archive name) + (All (_ anchor expression declaration) + (-> Archive Symbol (Operation anchor expression declaration unit.ID))) + (function (_ (^.let stateE [bundle state])) + (let [[_module _name] name] + (do try.monad + [@module (archive.id _module archive) + registry (if (text#= (the #module state) _module) + {try.#Success (the #registry state)} + (do try.monad + [[_module output registry] (archive.find _module archive)] + {try.#Success registry}))] + (case (registry.id _name registry) + {.#None} + (exception.except ..unknown_definition [name (registry.definitions registry)]) + + {.#Some id} + {try.#Success [stateE [@module id]]}))))) + +(def .public (definition archive name) + (All (_ anchor expression declaration) + (-> Archive Symbol (Operation anchor expression declaration [unit.ID (Maybe category.Definition)]))) + (function (_ (^.let stateE [bundle state])) + (let [[_module _name] name] + (do try.monad + [@module (archive.id _module archive) + registry (if (text#= (the #module state) _module) + {try.#Success (the #registry state)} + (do try.monad + [[_module output registry] (archive.find _module archive)] + {try.#Success registry}))] + (case (registry.find_definition _name registry) + {.#None} + (exception.except ..unknown_definition [name (registry.definitions registry)]) + + {.#Some [@artifact def]} + {try.#Success [stateE [[@module @artifact] def]]}))))) + +(exception .public no_context) + +(def .public (module_id module archive) + (All (_ anchor expression declaration) + (-> descriptor.Module Archive (Operation anchor expression declaration module.ID))) + (function (_ (^.let stateE [bundle state])) + (do try.monad + [@module (archive.id module archive)] + (in [stateE @module])))) + +(def .public (context archive) + (All (_ anchor expression declaration) + (-> Archive (Operation anchor expression declaration unit.ID))) + (function (_ (^.let stateE [bundle state])) + (case (the #context state) + {.#None} + (exception.except ..no_context []) + + {.#Some id} + (do try.monad + [@module (archive.id (the #module state) archive)] + (in [stateE [@module id]]))))) + +(def .public (with_context @artifact body) + (All (_ anchor expression declaration a) + (-> artifact.ID + (Operation anchor expression declaration a) + (Operation anchor expression declaration a))) + (function (_ [bundle state]) + (do try.monad + [[[bundle' state'] output] (body [bundle (has #context {.#Some @artifact} state)])] + (in [[bundle' (has #context (the #context state) state')] + output])))) + +(def .public (with_registry_shift shift body) + (All (_ anchor expression declaration a) + (-> Nat + (Operation anchor expression declaration a) + (Operation anchor expression declaration a))) + (function (_ [bundle state]) + (do try.monad + [[[bundle' state'] output] (body [bundle (has #registry_shift shift state)])] + (in [[bundle' (has #registry_shift (the #registry_shift state) state')] + output])))) + +(def .public (with_new_context archive dependencies body) + (All (_ anchor expression declaration a) + (-> Archive (Set unit.ID) (Operation anchor expression declaration a) + (Operation anchor expression declaration [unit.ID a]))) + (function (_ (^.let stateE [bundle state])) + (let [[@artifact registry'] (registry.resource false dependencies (the #registry state)) + @artifact (n.+ @artifact (the #registry_shift state))] + (do try.monad + [[[bundle' state'] output] (body [bundle (|> state + (has #registry registry') + (has #context {.#Some @artifact}) + (revised #interim_artifacts (|>> {.#Item @artifact})))]) + @module (archive.id (the #module state) archive)] + (in [[bundle' (has #context (the #context state) state')] + [[@module @artifact] + output]]))))) + +(def .public (log! message) + (All (_ anchor expression declaration a) + (-> Text (Operation anchor expression declaration Any))) + (function (_ [bundle state]) + {try.#Success [[bundle + (revised #log (sequence.suffix message) state)] + []]})) + +(def .public (with_interim_artifacts archive body) + (All (_ anchor expression declaration a) + (-> Archive (Operation anchor expression declaration a) + (Operation anchor expression declaration [(List unit.ID) a]))) + (do phase.monad + [module (extension.read (the #module))] + (function (_ state+) + (do try.monad + [@module (archive.id module archive) + [[bundle' state'] output] (body state+)] + (in [[bundle' + (has #interim_artifacts (list) state')] + [(list#each (|>> [@module]) (the #interim_artifacts state')) + output]]))))) diff --git a/stdlib/source/library/lux/meta/compiler/language/lux/phase/analysis.lux b/stdlib/source/library/lux/meta/compiler/language/lux/phase/analysis.lux new file mode 100644 index 000000000..30e4a1360 --- /dev/null +++ b/stdlib/source/library/lux/meta/compiler/language/lux/phase/analysis.lux @@ -0,0 +1,136 @@ +(.require + [library + [lux (.except) + [abstract + [monad (.only do)]] + [control + ["[0]" exception (.only exception)]] + [data + [text + ["%" \\format (.only format)]] + [collection + ["[0]" list]]] + [math + [number + ["n" nat]]] + ["[0]" meta (.only) + ["[0]" location] + ["[0]" code] + [macro + ["^" pattern]]]]] + ["[0]" / + ["[1][0]" simple] + ["[1][0]" complex] + ["[1][0]" reference] + ["[1][0]" case] + ["[1][0]" function] + ["/[1]" // + ["[1][0]" extension] + ["/[1]" // + ["/" analysis (.only Analysis Operation Phase) + ["[1][0]" macro (.only Expander)] + ["[1][0]" type]] + [/// + ["//" phase] + ["[0]" reference] + [meta + [archive (.only Archive)]]]]]]) + +(exception .public (invalid [syntax Code]) + (exception.report + "Syntax" (%.code syntax))) + +(def variant_analysis + (template (_ analysis archive tag values) + ... (-> Phase Archive Symbol (List Code) (Operation Analysis)) + [(case values + (list value) + (/complex.variant analysis tag archive value) + + _ + (/complex.variant analysis tag archive (code.tuple values)))])) + +(def sum_analysis + (template (_ analysis archive lefts right? values) + ... (-> Phase Archive Nat Bit (List Code) (Operation Analysis)) + [(case values + (list value) + (/complex.sum analysis lefts right? archive value) + + _ + (/complex.sum analysis lefts right? archive (code.tuple values)))])) + +(def case_analysis + (template (_ analysis archive input branches code) + ... (-> Phase Archive Code (List Code) Code (Operation Analysis)) + [(case (list.pairs branches) + {.#Some branches} + (/case.case analysis branches archive input) + + {.#None} + (//.except ..invalid [code]))])) + +(def apply_analysis + (template (_ expander analysis archive functionC argsC+) + ... (-> Expander Phase Archive Code (List Code) (Operation Analysis)) + [(do [! //.monad] + [[functionT functionA] (/type.inferring + (analysis archive functionC))] + (case functionA + (/.constant def_name) + (do ! + [?macro (//extension.lifted (meta.macro def_name))] + (case ?macro + {.#Some macro} + (do ! + [expansion (//extension.lifted (/macro.single_expansion expander def_name macro argsC+))] + (analysis archive expansion)) + + _ + (/function.apply analysis argsC+ functionT functionA archive functionC))) + + _ + (/function.apply analysis argsC+ functionT functionA archive functionC)))])) + +(def .public (phase expander) + (-> Expander Phase) + (function (analysis archive code) + (<| (let [[location code'] code]) + ... The location must be set in the state for the sake + ... of having useful error messages. + (/.with_location location) + (case code + (^.with_template [ ] + [[_ { value}] + ( value)]) + ([.#Symbol /reference.reference] + [.#Text /simple.text] + [.#Nat /simple.nat] + [.#Bit /simple.bit] + [.#Frac /simple.frac] + [.#Int /simple.int] + [.#Rev /simple.rev]) + + (^.` [(,* elems)]) + (/complex.record analysis archive elems) + + (^.` {(, [_ {.#Symbol tag}]) (,* values)}) + (..variant_analysis analysis archive tag values) + + (^.` ({(,* branches)} (, input))) + (..case_analysis analysis archive input branches code) + + (^.` ([(, [_ {.#Symbol ["" function_name]}]) (, [_ {.#Symbol ["" arg_name]}])] (, body))) + (/function.function analysis function_name arg_name archive body) + + (^.` ((, [_ {.#Text extension_name}]) (,* extension_args))) + (//extension.apply archive analysis [extension_name extension_args]) + + (^.` ((, functionC) (,* argsC+))) + (..apply_analysis expander analysis archive functionC argsC+) + + (^.` {(, [_ {.#Nat lefts}]) (, [_ {.#Bit right?}]) (,* values)}) + (..sum_analysis analysis archive lefts right? values) + + _ + (//.except ..invalid [code]))))) diff --git a/stdlib/source/library/lux/meta/compiler/language/lux/phase/analysis/case.lux b/stdlib/source/library/lux/meta/compiler/language/lux/phase/analysis/case.lux new file mode 100644 index 000000000..6356d32c5 --- /dev/null +++ b/stdlib/source/library/lux/meta/compiler/language/lux/phase/analysis/case.lux @@ -0,0 +1,364 @@ +(.require + [library + [lux (.except Pattern case) + [abstract + ["[0]" monad (.only do)]] + [control + ["[0]" maybe] + ["[0]" try] + ["[0]" exception (.only exception)]] + [data + ["[0]" product] + [text + ["%" \\format (.only format)]] + [collection + ["[0]" list (.use "[1]#[0]" mix monoid monad)]]] + [math + [number + ["n" nat]]] + ["[0]" meta (.only) + ["[0]" code] + [macro + ["^" pattern]] + ["[0]" type (.only) + ["[0]" check (.only Check)]]]]] + ["[0]" / + ["/[1]" // + ["[1][0]" complex] + ["/[1]" // + ["[1][0]" extension] + [// + ["/" analysis (.only Analysis Operation Phase) + ["[1][0]" simple] + ["[1][0]" complex] + ["[1][0]" pattern (.only Pattern)] + ["[1][0]" type] + ["[1][0]" scope] + ["[1][0]" coverage (.only Coverage)]] + [/// + ["[1]" phase]]]]]]) + +(exception .public (mismatch [type Type + pattern Code]) + (exception.report + "Type" (%.type type) + "Pattern" (%.code pattern))) + +(exception .public (sum_has_no_case [case Nat + type Type]) + (exception.report + "Case" (%.nat case) + "Type" (%.type type))) + +(exception .public (invalid [it Code]) + (exception.report + "Pattern" (%.code it))) + +(exception .public (non_tuple [type Type]) + (exception.report + "Type" (%.type type))) + +(exception .public (non_exhaustive [input Code + branches (List [Code Code]) + coverage Coverage]) + (exception.report + "Input" (%.code input) + "Branches" (%.code (code.tuple (|> branches + (list#each (function (_ [slot value]) + (list slot value))) + list#conjoint))) + "Coverage" (/coverage.format coverage))) + +(exception .public empty_branches) + +(def (quantified envs baseT) + (-> (List (List Type)) Type Type) + (.case envs + {.#End} + baseT + + {.#Item head tail} + (quantified tail {.#UnivQ head baseT}))) + +... Type-checking on the input value is done during the analysis of a +... "case" expression, to ensure that the patterns being used make +... sense for the type of the input value. +... Sometimes, that input value is complex, by depending on +... type-variables or quantifications. +... This function makes it easier for "case" analysis to properly +... type-check the input with respect to the patterns. +(def .public (tuple :it:) + (-> Type (Check [(List check.Var) Type])) + (loop (again [envs (is (List (List Type)) + (list)) + :it: :it:]) + (.case :it: + {.#Var id} + (do check.monad + [?:it:' (check.peek id)] + (.case ?:it:' + {.#Some :it:'} + (again envs :it:') + + _ + (check.except ..non_tuple :it:))) + + {.#Named name unnamedT} + (again envs unnamedT) + + {.#UnivQ env unquantifiedT} + (again {.#Item env envs} unquantifiedT) + + {.#ExQ _} + (do check.monad + [[@head :head:] check.var + [tail :tuple:] (again envs (maybe.trusted (type.applied (list :head:) :it:)))] + (in [(list.partial @head tail) :tuple:])) + + {.#Apply _} + (do [! check.monad] + [.let [[:abstraction: :parameters:] (type.flat_application :it:)] + :abstraction: (.case :abstraction: + {.#Var @abstraction} + (do ! + [?:abstraction: (check.peek @abstraction)] + (.case ?:abstraction: + {.#Some :abstraction:} + (in :abstraction:) + + _ + (check.except ..non_tuple :it:))) + + _ + (in :abstraction:))] + (.case (type.applied :parameters: :abstraction:) + {.#Some :it:} + (again envs :it:) + + {.#None} + (check.except ..non_tuple :it:))) + + {.#Product _} + (|> :it: + type.flat_tuple + (list#each (..quantified envs)) + type.tuple + [(list)] + (at check.monad in)) + + _ + (at check.monad in [(list) (..quantified envs :it:)])))) + +(def (simple_pattern_analysis type :input: location output next) + (All (_ a) (-> Type Type Location Pattern (Operation a) (Operation [Pattern a]))) + (/.with_location location + (do ///.monad + [_ (/type.check (check.check :input: type)) + outputA next] + (in [output outputA])))) + +(def (tuple_pattern_analysis pattern_analysis :input: sub_patterns next) + (All (_ a) + (-> (-> (Maybe Nat) Type Code (Operation a) (Operation [Pattern a])) + Type (List Code) (Operation a) (Operation [Pattern a]))) + (do [! ///.monad] + [[@ex_var+ :input:'] (/type.check (..tuple :input:))] + (.case :input:' + {.#Product _} + (let [matches (loop (again [types (type.flat_tuple :input:') + patterns sub_patterns + output (is (List [Type Code]) + {.#End})]) + (.case [types patterns] + [{.#End} {.#End}] + output + + [{.#Item headT {.#End}} {.#Item headP {.#End}}] + {.#Item [headT headP] output} + + [remainingT {.#Item headP {.#End}}] + {.#Item [(type.tuple remainingT) headP] output} + + [{.#Item headT {.#End}} remainingP] + {.#Item [headT (code.tuple remainingP)] output} + + [{.#Item headT tailT} {.#Item headP tailP}] + (again tailT tailP {.#Item [headT headP] output}) + + _ + (undefined)))] + (do ! + [[memberP+ thenA] (list#mix (is (All (_ a) + (-> [Type Code] (Operation [(List Pattern) a]) + (Operation [(List Pattern) a]))) + (function (_ [memberT memberC] then) + (do ! + [[memberP [memberP+ thenA]] ((as (All (_ a) (-> (Maybe Nat) Type Code (Operation a) (Operation [Pattern a]))) + pattern_analysis) + {.#None} memberT memberC then)] + (in [(list.partial memberP memberP+) thenA])))) + (do ! + [nextA next] + (in [(list) nextA])) + matches) + _ (/type.check (monad.each check.monad check.forget! @ex_var+))] + (in [(/pattern.tuple memberP+) + thenA]))) + + _ + (/.except ..mismatch [:input:' (code.tuple sub_patterns)])))) + +... This function handles several concerns at once, but it must be that +... way because those concerns are interleaved when doing +... pattern-matching and they cannot be separated. +... The pattern is analysed in order to get a general feel for what is +... expected of the input value. This, in turn, informs the +... type-checking of the input. +... A kind of "continuation" value is passed around which signifies +... what needs to be done _after_ analysing a pattern. +... In general, this is done to analyse the "body" expression +... associated to a particular pattern _in the context of_ said +... pattern. +... The reason why *context* is important is because patterns may bind +... values to local variables, which may in turn be referenced in the +... body expressions. +... That is why the body must be analysed in the context of the +... pattern, and not separately. +(def (pattern_analysis num_tags :input: pattern next) + (All (_ a) (-> (Maybe Nat) Type Code (Operation a) (Operation [Pattern a]))) + (.case pattern + [location {.#Symbol ["" name]}] + (/.with_location location + (do ///.monad + [outputA (/scope.with_local [name :input:] + next) + idx /scope.next] + (in [{/pattern.#Bind idx} outputA]))) + + (^.with_template [ ] + [[location ] + (simple_pattern_analysis :input: location {/pattern.#Simple } next)]) + ([Bit {.#Bit pattern_value} {/simple.#Bit pattern_value}] + [Nat {.#Nat pattern_value} {/simple.#Nat pattern_value}] + [Int {.#Int pattern_value} {/simple.#Int pattern_value}] + [Rev {.#Rev pattern_value} {/simple.#Rev pattern_value}] + [Frac {.#Frac pattern_value} {/simple.#Frac pattern_value}] + [Text {.#Text pattern_value} {/simple.#Text pattern_value}] + [Any {.#Tuple {.#End}} {/simple.#Unit}]) + + [location {.#Tuple (list singleton)}] + (pattern_analysis {.#None} :input: singleton next) + + [location {.#Tuple sub_patterns}] + (/.with_location location + (do [! ///.monad] + [record (//complex.normal true sub_patterns) + record_size,members,recordT (is (Operation (Maybe [Nat (List Code) Type])) + (.case record + {.#Some record} + (//complex.order true record) + + {.#None} + (in {.#None})))] + (.case record_size,members,recordT + {.#Some [record_size members recordT]} + (do ! + [_ (.case :input: + {.#Var @input} + (/type.check (do check.monad + [? (check.bound? @input)] + (if ? + (in []) + (check.check :input: recordT)))) + + _ + (in []))] + (.case members + (list singleton) + (pattern_analysis {.#None} :input: singleton next) + + _ + (..tuple_pattern_analysis pattern_analysis :input: members next))) + + {.#None} + (..tuple_pattern_analysis pattern_analysis :input: sub_patterns next)))) + + [location {.#Variant (list.partial [_ {.#Nat lefts}] [_ {.#Bit right?}] values)}] + (/.with_location location + (do ///.monad + [[@ex_var+ :input:'] (/type.check (..tuple :input:))] + (.case :input:' + {.#Sum _} + (let [flat_sum (type.flat_variant :input:') + size_sum (list.size flat_sum) + num_cases (maybe.else size_sum num_tags) + idx (/complex.tag right? lefts)] + (.case (list.item idx flat_sum) + (^.multi {.#Some caseT} + (n.< num_cases idx)) + (do ///.monad + [[testP nextA] (if (and (n.> num_cases size_sum) + (n.= (-- num_cases) idx)) + (pattern_analysis {.#None} + (type.variant (list.after (-- num_cases) flat_sum)) + (` [(,* values)]) + next) + (pattern_analysis {.#None} caseT (` [(,* values)]) next)) + _ (/type.check (monad.each check.monad check.forget! @ex_var+))] + (in [(/pattern.variant [lefts right? testP]) + nextA])) + + _ + (/.except ..sum_has_no_case [idx :input:]))) + + {.#UnivQ _} + (do ///.monad + [[ex_id exT] (/type.check check.existential) + it (pattern_analysis num_tags + (maybe.trusted (type.applied (list exT) :input:')) + pattern + next) + _ (/type.check (monad.each check.monad check.forget! @ex_var+))] + (in it)) + + _ + (/.except ..mismatch [:input:' pattern])))) + + [location {.#Variant (list.partial [_ {.#Symbol tag}] values)}] + (/.with_location location + (do ///.monad + [tag (///extension.lifted (meta.normal tag)) + [idx group variantT] (///extension.lifted (meta.tag tag)) + _ (/type.check (check.check :input: variantT)) + .let [[lefts right?] (/complex.choice (list.size group) idx)]] + (pattern_analysis {.#Some (list.size group)} :input: (` {(, (code.nat lefts)) (, (code.bit right?)) (,* values)}) next))) + + _ + (/.except ..invalid [pattern]) + )) + +(def .public (case analyse branches archive inputC) + (-> Phase (List [Code Code]) Phase) + (.case branches + {.#Item [patternH bodyH] branchesT} + (do [! ///.monad] + [[:input: inputA] (<| /type.inferring + (analyse archive inputC)) + outputH (pattern_analysis {.#None} :input: patternH (analyse archive bodyH)) + outputT (monad.each ! + (function (_ [patternT bodyT]) + (pattern_analysis {.#None} :input: patternT (analyse archive bodyT))) + branchesT) + outputHC (|> outputH product.left /coverage.coverage /.of_try) + outputTC (monad.each ! (|>> product.left /coverage.coverage /.of_try) outputT) + _ (.case (monad.mix try.monad /coverage.composite outputHC outputTC) + {try.#Success coverage} + (///.assertion ..non_exhaustive [inputC branches coverage] + (/coverage.exhaustive? coverage)) + + {try.#Failure error} + (/.failure error))] + (in {/.#Case inputA [outputH outputT]})) + + {.#End} + (/.except ..empty_branches []))) diff --git a/stdlib/source/library/lux/meta/compiler/language/lux/phase/analysis/complex.lux b/stdlib/source/library/lux/meta/compiler/language/lux/phase/analysis/complex.lux new file mode 100644 index 000000000..d7b26aa8f --- /dev/null +++ b/stdlib/source/library/lux/meta/compiler/language/lux/phase/analysis/complex.lux @@ -0,0 +1,433 @@ +(.require + [library + [lux (.except) + [abstract + ["[0]" monad (.only do)]] + [control + ["[0]" maybe] + ["[0]" try] + ["[0]" exception (.only exception)] + ["[0]" state]] + [data + ["[0]" product] + ["[0]" text (.use "[1]#[0]" equivalence) + ["%" \\format (.only format)]] + [collection + ["[0]" list (.use "[1]#[0]" monad)] + ["[0]" dictionary (.only Dictionary)]]] + [math + [number + ["n" nat]]] + ["[0]" meta (.only) + ["[0]" symbol] + ["[0]" code] + ["[0]" type (.only) + ["[0]" check]]]]] + ["[0]" // + ["[1][0]" simple] + ["/[1]" // + ["[1][0]" extension] + [// + ["/" analysis (.only Analysis Operation Phase) + ["[1][0]" complex (.only Tag)] + ["[1][0]" type] + ["[1][0]" inference]] + [/// + ["[1]" phase (.use "[1]#[0]" monad)] + [meta + [archive (.only Archive)]]]]]]) + +(exception .public (not_a_quantified_type [type Type]) + (exception.report + "Type" (%.type type))) + +(with_template [] + [(exception .public ( [type Type + members (List Code)]) + (exception.report + "Type" (%.type type) + "Expression" (%.code (` [(,* members)]))))] + + [invalid_tuple_type] + [cannot_analyse_tuple] + ) + +(with_template [] + [(exception .public ( [type Type + lefts Nat + right? Bit + code Code]) + (exception.report + "Type" (%.type type) + "Lefts" (%.nat lefts) + "Right?" (%.bit right?) + "Expression" (%.code code)))] + + [invalid_variant_type] + [cannot_analyse_variant] + [cannot_infer_sum] + ) + +(exception .public (cannot_repeat_slot [key Symbol + record (List [Symbol Code])]) + (exception.report + "Slot" (%.code (code.symbol key)) + "Record" (%.code (code.tuple (|> record + (list#each (function (_ [keyI valC]) + (list (code.symbol keyI) valC))) + list#conjoint))))) + +(exception .public (slot_does_not_belong_to_record [key Symbol + type Type]) + (exception.report + "Slot" (%.code (code.symbol key)) + "Type" (%.type type))) + +(exception .public (record_size_mismatch [expected Nat + actual Nat + type Type + record (List [Symbol Code])]) + (exception.report + "Expected" (%.nat expected) + "Actual" (%.nat actual) + "Type" (%.type type) + "Expression" (%.code (|> record + (list#each (function (_ [keyI valueC]) + (list (code.symbol keyI) valueC))) + list#conjoint + code.tuple)))) + +(def .public (sum analyse lefts right? archive) + (-> Phase Nat Bit Phase) + (let [tag (/complex.tag right? lefts)] + (function (again valueC) + (do [! ///.monad] + [expectedT (///extension.lifted meta.expected_type) + expectedT' (/type.check (check.clean (list) expectedT))] + (/.with_exception ..cannot_analyse_variant [expectedT' lefts right? valueC] + (case expectedT + {.#Sum _} + (|> (analyse archive valueC) + (at ! each (|>> [lefts right?] /.variant)) + (/type.expecting (|> expectedT + type.flat_variant + (list.item tag) + (maybe.else .Nothing)))) + + {.#Named name unnamedT} + (<| (/type.expecting unnamedT) + (again valueC)) + + {.#Var id} + (do ! + [?expectedT' (/type.check (check.peek id))] + (case ?expectedT' + {.#Some expectedT'} + (<| (/type.expecting expectedT') + (again valueC)) + + ... Cannot do inference when the tag is numeric. + ... This is because there is no way of knowing how many + ... cases the inferred sum type would have. + _ + (/.except ..cannot_infer_sum [expectedT lefts right? valueC]))) + + {.#UnivQ _} + (do ! + [[@instance :instance:] (/type.check check.existential)] + (<| (/type.expecting (maybe.trusted (type.applied (list :instance:) expectedT))) + (again valueC))) + {.#ExQ _} + (<| /type.with_var + (function (_ [@instance :instance:])) + (/type.expecting (maybe.trusted (type.applied (list :instance:) expectedT))) + (again valueC)) + + {.#Apply inputT funT} + (case funT + {.#Var funT_id} + (do ! + [?funT' (/type.check (check.peek funT_id))] + (case ?funT' + {.#Some funT'} + (<| (/type.expecting {.#Apply inputT funT'}) + (again valueC)) + + _ + (/.except ..invalid_variant_type [expectedT lefts right? valueC]))) + + _ + (case (type.applied (list inputT) funT) + {.#Some outputT} + (<| (/type.expecting outputT) + (again valueC)) + + {.#None} + (/.except ..not_a_quantified_type [funT]))) + + _ + (/.except ..invalid_variant_type [expectedT lefts right? valueC]))))))) + +(def .public (variant analyse tag archive valueC) + (-> Phase Symbol Phase) + (do [! ///.monad] + [tag (///extension.lifted (meta.normal tag)) + [idx group variantT] (///extension.lifted (meta.tag tag)) + .let [case_size (list.size group) + [lefts right?] (/complex.choice case_size idx)] + expectedT (///extension.lifted meta.expected_type)] + (case expectedT + {.#Var _} + (do ! + [inferenceT (/inference.variant lefts right? variantT) + [inferredT valueA+] (/inference.general archive analyse inferenceT (list valueC))] + (in (/.variant [lefts right? (|> valueA+ list.head maybe.trusted)]))) + + _ + (..sum analyse lefts right? archive valueC)))) + +(def (typed_product analyse expectedT archive members) + (-> Phase Type Archive (List Code) (Operation Analysis)) + (<| (let [! ///.monad]) + (at ! each (|>> /.tuple)) + (is (Operation (List Analysis))) + (loop (again [membersT+ (type.flat_tuple expectedT) + membersC+ members]) + (case [membersT+ membersC+] + [{.#Item memberT {.#End}} {.#Item memberC {.#End}}] + (<| (at ! each (|>> list)) + (/type.expecting memberT) + (analyse archive memberC)) + + [{.#Item memberT {.#End}} _] + (<| (/type.expecting memberT) + (at ! each (|>> list) (analyse archive (code.tuple membersC+)))) + + [_ {.#Item memberC {.#End}}] + (<| (/type.expecting (type.tuple membersT+)) + (at ! each (|>> list) (analyse archive memberC))) + + [{.#Item memberT membersT+'} {.#Item memberC membersC+'}] + (do ! + [memberA (<| (/type.expecting memberT) + (analyse archive memberC)) + memberA+ (again membersT+' membersC+')] + (in {.#Item memberA memberA+})) + + _ + (/.except ..cannot_analyse_tuple [expectedT members]))))) + +(def .public (product analyse archive membersC) + (-> Phase Archive (List Code) (Operation Analysis)) + (do [! ///.monad] + [expectedT (///extension.lifted meta.expected_type)] + (/.with_exception ..cannot_analyse_tuple [expectedT membersC] + (case expectedT + {.#Product _} + (..typed_product analyse expectedT archive membersC) + + {.#Named name unnamedT} + (<| (/type.expecting unnamedT) + (product analyse archive membersC)) + + {.#Var id} + (do ! + [?expectedT' (/type.check (check.peek id))] + (case ?expectedT' + {.#Some expectedT'} + (<| (/type.expecting expectedT') + (product analyse archive membersC)) + + _ + ... Must infer... + (do ! + [membersTA (monad.each ! (|>> (analyse archive) /type.inferring) membersC) + _ (/type.check (check.check expectedT + (type.tuple (list#each product.left membersTA))))] + (in (/.tuple (list#each product.right membersTA)))))) + + {.#UnivQ _} + (do ! + [[@instance :instance:] (/type.check check.existential)] + (<| (/type.expecting (maybe.trusted (type.applied (list :instance:) expectedT))) + (product analyse archive membersC))) + + {.#ExQ _} + (<| /type.with_var + (function (_ [@instance :instance:])) + (/type.expecting (maybe.trusted (type.applied (list :instance:) expectedT))) + (product analyse archive membersC)) + + {.#Apply inputT funT} + (case funT + {.#Var funT_id} + (do ! + [?funT' (/type.check (check.peek funT_id))] + (case ?funT' + {.#Some funT'} + (<| (/type.expecting {.#Apply inputT funT'}) + (product analyse archive membersC)) + + _ + (/.except ..invalid_tuple_type [expectedT membersC]))) + + _ + (case (type.applied (list inputT) funT) + {.#Some outputT} + (<| (/type.expecting outputT) + (product analyse archive membersC)) + + {.#None} + (/.except ..not_a_quantified_type funT))) + + _ + (/.except ..invalid_tuple_type [expectedT membersC]) + )))) + +... There cannot be any ambiguity or improper syntax when analysing +... records, so they must be normalized for further analysis. +... Normalization just means that all the tags get resolved to their +... canonical form (with their corresponding module identified). +(def .public (normal pattern_matching? record) + (-> Bit (List Code) (Operation (Maybe (List [Symbol Code])))) + (loop (again [input record + output (is (List [Symbol Code]) + {.#End})]) + (case input + (list.partial [_ {.#Symbol ["" slotH]}] valueH tail) + (if pattern_matching? + (///#in {.#None}) + (do ///.monad + [slotH (///extension.lifted (meta.normal ["" slotH]))] + (again tail {.#Item [slotH valueH] output}))) + + (list.partial [_ {.#Symbol slotH}] valueH tail) + (do ///.monad + [slotH (///extension.lifted (meta.normal slotH))] + (again tail {.#Item [slotH valueH] output})) + + {.#End} + (///#in {.#Some output}) + + _ + (///#in {.#None})))) + +(def (local_binding? name) + (-> Text (Meta Bit)) + (at meta.monad each + (list.any? (list.any? (|>> product.left (text#= name)))) + meta.locals)) + +... Lux already possesses the means to analyse tuples, so +... re-implementing the same functionality for records makes no sense. +... Records, thus, get transformed into tuples by ordering the elements. +(def (order' head_k record) + (-> Symbol (List [Symbol Code]) (Operation (Maybe [Nat (List Code) Type]))) + (do [! ///.monad] + [slotH' (///extension.lifted + (do meta.monad + [head_k (meta.normal head_k)] + (meta.try (meta.slot head_k))))] + (case slotH' + {try.#Success [_ slot_set recordT]} + (do ! + [.let [size_record (list.size record) + size_ts (list.size slot_set)] + _ (if (n.= size_ts size_record) + (in []) + (/.except ..record_size_mismatch [size_ts size_record recordT record])) + .let [tuple_range (list.indices size_ts) + tag->idx (dictionary.of_list symbol.hash (list.zipped_2 slot_set tuple_range))] + idx->val (monad.mix ! + (function (_ [key val] idx->val) + (do ! + [key (///extension.lifted (meta.normal key))] + (case (dictionary.value key tag->idx) + {.#Some idx} + (if (dictionary.key? idx->val idx) + (/.except ..cannot_repeat_slot [key record]) + (in (dictionary.has idx val idx->val))) + + {.#None} + (/.except ..slot_does_not_belong_to_record [key recordT])))) + (is (Dictionary Nat Code) + (dictionary.empty n.hash)) + record) + .let [ordered_tuple (list#each (function (_ idx) + (maybe.trusted (dictionary.value idx idx->val))) + tuple_range)]] + (in {.#Some [size_ts ordered_tuple recordT]})) + + {try.#Failure error} + (in {.#None})))) + +(def .public (order pattern_matching? record) + (-> Bit (List [Symbol Code]) (Operation (Maybe [Nat (List Code) Type]))) + (case record + ... empty_record = empty_tuple = unit/any = [] + {.#End} + (///#in {.#Some [0 (list) .Any]}) + + {.#Item [head_k head_v] _} + (case head_k + ["" head_k'] + (if pattern_matching? + (///#in {.#None}) + (do ///.monad + [local_binding? (///extension.lifted + (..local_binding? head_k'))] + (if local_binding? + (in {.#None}) + (order' head_k record)))) + + _ + (order' head_k record)))) + +(def .public (record analyse archive members) + (-> Phase Archive (List Code) (Operation Analysis)) + (case members + (list) + //simple.unit + + (list singletonC) + (analyse archive singletonC) + + (list [_ {.#Symbol pseudo_slot}] singletonC) + (do [! ///.monad] + [head_k (///extension.lifted (meta.normal pseudo_slot)) + slot (///extension.lifted (meta.try (meta.slot head_k)))] + (case slot + {try.#Success [_ slot_set recordT]} + (case (list.size slot_set) + 1 (analyse archive singletonC) + _ (..product analyse archive members)) + + _ + (..product analyse archive members))) + + _ + (do [! ///.monad] + [?members (..normal false members)] + (case ?members + {.#None} + (..product analyse archive members) + + {.#Some slots} + (do ! + [record_size,membersC,recordT (..order false slots)] + (case record_size,membersC,recordT + {.#None} + (..product analyse archive members) + + {.#Some [record_size membersC recordT]} + (do ! + [expectedT (///extension.lifted meta.expected_type)] + (case expectedT + {.#Var _} + (do ! + [inferenceT (/inference.record record_size recordT) + [inferredT membersA] (/inference.general archive analyse inferenceT membersC)] + (in (/.tuple membersA))) + + _ + (..product analyse archive membersC))))))))) diff --git a/stdlib/source/library/lux/meta/compiler/language/lux/phase/analysis/function.lux b/stdlib/source/library/lux/meta/compiler/language/lux/phase/analysis/function.lux new file mode 100644 index 000000000..68d8ed9e4 --- /dev/null +++ b/stdlib/source/library/lux/meta/compiler/language/lux/phase/analysis/function.lux @@ -0,0 +1,141 @@ +(.require + [library + [lux (.except function) + [abstract + [monad (.only do)]] + [control + ["[0]" maybe] + ["[0]" try] + ["[0]" exception (.only exception)]] + [data + ["[0]" product] + ["[0]" text (.only) + ["%" \\format (.only format)]] + [collection + ["[0]" list (.use "[1]#[0]" monoid monad)]]] + [math + [number + ["n" nat]]] + ["[0]" meta (.only) + ["[0]" type (.only) + ["[0]" check]]]]] + ["[0]" /// + ["[1][0]" extension] + [// + ["/" analysis (.only Analysis Operation Phase) + ["[1][0]" type] + ["[1][0]" inference] + ["[1][0]" scope]] + [/// + ["[1]" phase (.use "[1]#[0]" functor)] + [reference (.only) + [variable (.only)]]]]]) + +(exception .public (cannot_analyse [expected Type + function Text + argument Text + body Code]) + (exception.report + "Type" (%.type expected) + "Function" function + "Argument" argument + "Body" (%.code body))) + +(exception .public (cannot_apply [:function: Type + functionC Code + arguments (List Code)]) + (exception.report + "Function type" (%.type :function:) + "Function" (%.code functionC) + "Arguments" (|> arguments + list.enumeration + (list#each (.function (_ [idx argC]) + (format (%.nat idx) " " (%.code argC)))) + (text.interposed text.new_line)))) + +(def .public (function analyse function_name arg_name archive body) + (-> Phase Text Text Phase) + (do [! ///.monad] + [expectedT (///extension.lifted meta.expected_type)] + (loop (again [expectedT expectedT]) + (/.with_exception ..cannot_analyse [expectedT function_name arg_name body] + (case expectedT + {.#Function :input: :output:} + (<| (at ! each (.function (_ [scope bodyA]) + {/.#Function (list#each (|>> /.variable) + (/scope.environment scope)) + bodyA})) + /scope.with + ... Functions have access not only to their argument, but + ... also to themselves, through a local variable. + (/scope.with_local [function_name expectedT]) + (/scope.with_local [arg_name :input:]) + (/type.expecting :output:) + (analyse archive body)) + + {.#Named name :anonymous:} + (again :anonymous:) + + {.#Apply argT funT} + (case (type.applied (list argT) funT) + {.#Some value} + (again value) + + {.#None} + (/.failure (exception.error ..cannot_analyse [expectedT function_name arg_name body]))) + + {.#UnivQ _} + (do ! + [[@instance :instance:] (/type.check check.existential)] + (again (maybe.trusted (type.applied (list :instance:) expectedT)))) + + {.#ExQ _} + (<| /type.with_var + (.function (_ [@instance :instance:])) + (again (maybe.trusted (type.applied (list :instance:) expectedT)))) + + {.#Var id} + (do ! + [?expectedT' (/type.check (check.peek id))] + (case ?expectedT' + {.#Some expectedT'} + (again expectedT') + + ... Inference + _ + (<| /type.with_var + (.function (_ [@input :input:])) + /type.with_var + (.function (_ [@output :output:])) + (do ! + [functionA (again {.#Function :input: :output:})]) + /type.check + (do check.monad + [:output: (check.identity (list) @output) + ?:input: (check.try (check.identity (list @output) @input)) + ? (check.linked? @input @output) + _ (<| (check.check expectedT) + (case ?:input: + {try.#Success :input:} + {.#Function :input: (if ? + :input: + :output:)} + + {try.#Failure _} + (|> (if ? + :input: + :output:) + {.#Function :input:} + (/inference.quantified @input 1) + {.#UnivQ (list)})))] + (in functionA))))) + + _ + (/.failure "") + ))))) + +(def .public (apply analyse argsC+ :function: functionA archive functionC) + (-> Phase (List Code) Type Analysis Phase) + (|> (/inference.general archive analyse :function: argsC+) + (///#each (|>> product.right [functionA] /.reified)) + (/.with_exception ..cannot_apply [:function: functionC argsC+]))) diff --git a/stdlib/source/library/lux/meta/compiler/language/lux/phase/analysis/reference.lux b/stdlib/source/library/lux/meta/compiler/language/lux/phase/analysis/reference.lux new file mode 100644 index 000000000..61daacb2f --- /dev/null +++ b/stdlib/source/library/lux/meta/compiler/language/lux/phase/analysis/reference.lux @@ -0,0 +1,115 @@ +(.require + [library + [lux (.except) + [abstract + [monad (.only do)]] + [control + ["[0]" exception (.only exception)]] + [data + ["[0]" text (.use "[1]#[0]" equivalence) + ["%" \\format (.only format)]]] + ["[0]" meta (.only) + [macro + ["^" pattern]]]]] + ["[0]" // + ["/[1]" // + ["[1][0]" extension] + [// + ["/" analysis (.only Analysis Operation) + ["[1][0]" type] + ["[1][0]" scope]] + [/// + ["[1][0]" reference] + ["[1]" phase]]]]]) + +(exception .public (foreign_module_has_not_been_imported [current Text + foreign Text + definition Symbol]) + (exception.report + "Current" current + "Foreign" foreign + "Definition" (%.symbol definition))) + +(exception .public (definition_has_not_been_exported [definition Symbol]) + (exception.report + "Definition" (%.symbol definition))) + +(exception .public (labels_are_not_definitions [definition Symbol]) + (exception.report + "Label" (%.symbol definition))) + +(def (definition def_name) + (-> Symbol (Operation Analysis)) + (with_expansions [ (in (|> def_name ///reference.constant {/.#Reference}))] + (do [! ///.monad] + [constant (///extension.lifted (meta.definition def_name))] + (case constant + {.#Alias real_def_name} + (definition real_def_name) + + {.#Definition [exported? actualT _]} + (do ! + [_ (/type.inference actualT) + (^.let def_name [::module ::name]) (///extension.lifted (meta.normal def_name)) + current (///extension.lifted meta.current_module_name)] + (if (text#= current ::module) + + (if exported? + (do ! + [imported! (///extension.lifted (meta.imported_by? ::module current))] + (if imported! + + (/.except ..foreign_module_has_not_been_imported [current ::module def_name]))) + (/.except ..definition_has_not_been_exported def_name)))) + + {.#Type [exported? value labels]} + (do ! + [_ (/type.inference .Type) + (^.let def_name [::module ::name]) (///extension.lifted (meta.normal def_name)) + current (///extension.lifted meta.current_module_name)] + (if (text#= current ::module) + + (if exported? + (do ! + [imported! (///extension.lifted (meta.imported_by? ::module current))] + (if imported! + + (/.except ..foreign_module_has_not_been_imported [current ::module def_name]))) + (/.except ..definition_has_not_been_exported def_name)))) + + {.#Tag _} + (/.except ..labels_are_not_definitions [def_name]) + + {.#Slot _} + (/.except ..labels_are_not_definitions [def_name]))))) + +(def (variable var_name) + (-> Text (Operation (Maybe Analysis))) + (do [! ///.monad] + [?var (/scope.variable var_name)] + (case ?var + {.#Some [actualT ref]} + (do ! + [_ (/type.inference actualT)] + (in {.#Some (|> ref ///reference.variable {/.#Reference})})) + + {.#None} + (in {.#None})))) + +(def .public (reference it) + (-> Symbol (Operation Analysis)) + (case it + ["" simple_name] + (do [! ///.monad] + [?var (variable simple_name)] + (case ?var + {.#Some varA} + (in varA) + + {.#None} + (do ! + [this_module (///extension.lifted meta.current_module_name)] + (definition [this_module simple_name])))) + + _ + (definition it))) diff --git a/stdlib/source/library/lux/meta/compiler/language/lux/phase/analysis/simple.lux b/stdlib/source/library/lux/meta/compiler/language/lux/phase/analysis/simple.lux new file mode 100644 index 000000000..c20161ec3 --- /dev/null +++ b/stdlib/source/library/lux/meta/compiler/language/lux/phase/analysis/simple.lux @@ -0,0 +1,33 @@ +(.require + [library + [lux (.except nat int rev) + [abstract + [monad (.only do)]]]] + ["[0]" /// + [// + ["/" analysis (.only Analysis Operation) + ["[1][0]" simple] + ["[1][0]" type]] + [/// + ["[1]" phase]]]]) + +(with_template [ ] + [(def .public ( value) + (-> (Operation Analysis)) + (do ///.monad + [_ (/type.inference )] + (in {/.#Simple { value}})))] + + [bit .Bit /simple.#Bit] + [nat .Nat /simple.#Nat] + [int .Int /simple.#Int] + [rev .Rev /simple.#Rev] + [frac .Frac /simple.#Frac] + [text .Text /simple.#Text] + ) + +(def .public unit + (Operation Analysis) + (do ///.monad + [_ (/type.inference .Any)] + (in {/.#Simple {/simple.#Unit}}))) diff --git a/stdlib/source/library/lux/meta/compiler/language/lux/phase/declaration.lux b/stdlib/source/library/lux/meta/compiler/language/lux/phase/declaration.lux new file mode 100644 index 000000000..86602280e --- /dev/null +++ b/stdlib/source/library/lux/meta/compiler/language/lux/phase/declaration.lux @@ -0,0 +1,125 @@ +(.require + [library + [lux (.except) + ["[0]" meta] + [abstract + ["[0]" monad (.only do)]] + [control + ["[0]" try] + ["[0]" exception (.only exception)]] + [data + [text + ["%" \\format (.only format)]] + [collection + ["[0]" list (.use "[1]#[0]" mix monoid)]]]]] + ["[0]" // + ["[1][0]" extension] + ["[1][0]" analysis] + ["/[1]" // + ["/" declaration (.only Operation Phase)] + ["[1][0]" analysis (.only) + ["[0]" evaluation] + ["[1]/[0]" macro (.only Expander)] + ["[1]/[0]" type]] + [/// + ["//" phase] + [reference (.only) + [variable (.only)]] + [meta + [archive (.only Archive)]]]]]) + +(exception .public (not_a_declaration [code Code]) + (exception.report + "Declaration" (%.code code))) + +(exception .public (invalid_macro_call [code Code]) + (exception.report + "Code" (%.code code))) + +(exception .public (macro_was_not_found [name Symbol]) + (exception.report + "Name" (%.symbol name))) + +(type Eval + (-> Type Code (Meta Any))) + +(def (meta_eval archive bundle compiler_eval) + (-> Archive ///analysis.Bundle evaluation.Eval + Eval) + (function (_ type code lux) + (case (compiler_eval archive type code [bundle lux]) + {try.#Success [[_bundle lux'] value]} + {try.#Success [lux' value]} + + {try.#Failure error} + {try.#Failure error}))) + +(def (requiring phase archive expansion) + (All (_ anchor expression declaration) + (-> (Phase anchor expression declaration) Archive (List Code) + (Operation anchor expression declaration /.Requirements))) + (function (_ state) + (loop (again [state state + input expansion + output /.no_requirements]) + (case input + {.#End} + {try.#Success [state output]} + + {.#Item head tail} + (case (phase archive head state) + {try.#Success [state' head']} + (again state' tail (/.merge_requirements head' output)) + + {try.#Failure error} + {try.#Failure error}))))) + +(with_expansions [ (these [|form_location| {.#Form (list.partial [|text_location| {.#Text "lux def module"}] annotations)}])] + (def .public (phase wrapper expander) + (-> //.Wrapper Expander Phase) + (let [analysis (//analysis.phase expander)] + (function (again archive code) + (do [! //.monad] + [state //.state + .let [compiler_eval (meta_eval archive + (the [//extension.#state /.#analysis /.#state //extension.#bundle] state) + (evaluation.evaluator expander + (the [//extension.#state /.#synthesis /.#state] state) + (the [//extension.#state /.#generation /.#state] state) + (the [//extension.#state /.#generation /.#phase] state))) + extension_eval (as Eval (wrapper (as_expected compiler_eval)))] + _ (//.with (has [//extension.#state /.#analysis /.#state //extension.#state .#eval] extension_eval state))] + (case code + [_ {.#Form (list.partial [_ {.#Text name}] inputs)}] + (//extension.apply archive again [name inputs]) + + [_ {.#Form (list.partial macro inputs)}] + (do ! + [expansion (/.lifted_analysis + (do ! + [macroA (<| (///analysis/type.expecting Macro) + (analysis archive macro))] + (case macroA + (///analysis.constant macro_name) + (do ! + [?macro (//extension.lifted (meta.macro macro_name)) + macro (case ?macro + {.#Some macro} + (in macro) + + {.#None} + (//.except ..macro_was_not_found macro_name))] + (//extension.lifted (///analysis/macro.expansion expander macro_name macro inputs))) + + _ + (//.except ..invalid_macro_call code))))] + (case expansion + (list.partial referrals) + (|> (again archive ) + (at ! each (revised /.#referrals (list#composite referrals)))) + + _ + (..requiring again archive expansion))) + + _ + (//.except ..not_a_declaration code))))))) diff --git a/stdlib/source/library/lux/meta/compiler/language/lux/phase/extension.lux b/stdlib/source/library/lux/meta/compiler/language/lux/phase/extension.lux new file mode 100644 index 000000000..36a7deaa1 --- /dev/null +++ b/stdlib/source/library/lux/meta/compiler/language/lux/phase/extension.lux @@ -0,0 +1,196 @@ +(.require + [library + [lux (.except with) + [abstract + [equivalence (.only Equivalence)] + [hash (.only Hash)] + ["[0]" monad (.only do)]] + [control + ["[0]" function] + ["[0]" try (.only Try)] + ["[0]" exception (.only exception)]] + [data + ["[0]" product] + ["[0]" text (.use "[1]#[0]" order) + ["%" \\format (.only Format format)]] + [collection + ["[0]" list] + ["[0]" dictionary (.only Dictionary)]]] + [meta + [macro + ["^" pattern]]]]] + [///// + ["//" phase] + [meta + [archive (.only Archive)]]]) + +(type .public Name + Text) + +(type .public (Extension a) + [Name (List a)]) + +(def .public equivalence + (All (_ a) (-> (Equivalence a) (Equivalence (Extension a)))) + (|>> list.equivalence + (product.equivalence text.equivalence))) + +(def .public hash + (All (_ a) (-> (Hash a) (Hash (Extension a)))) + (|>> list.hash + (product.hash text.hash))) + +(with_expansions [ (these (Dictionary Name (Handler s i o)))] + (type .public (Handler s i o) + (-> Name + (//.Phase [ s] i o) + (//.Phase [ s] (List i) o))) + + (type .public (Bundle s i o) + )) + +(def .public empty + Bundle + (dictionary.empty text.hash)) + +(type .public (State s i o) + (Record + [#bundle (Bundle s i o) + #state s])) + +(type .public (Operation s i o v) + (//.Operation (State s i o) v)) + +(type .public (Phase s i o) + (//.Phase (State s i o) i o)) + +(exception .public (cannot_overwrite [name Name]) + (exception.report + "Extension" (%.text name))) + +(exception .public (incorrect_arity [name Name + arity Nat + args Nat]) + (exception.report + "Extension" (%.text name) + "Expected" (%.nat arity) + "Actual" (%.nat args))) + +(exception .public [a] (invalid_syntax [name Name + %format (Format a) + inputs (List a)]) + (exception.report + "Extension" (%.text name) + "Inputs" (exception.listing %format inputs))) + +(exception .public [s i o] (unknown [name Name + bundle (Bundle s i o)]) + (exception.report + "Extension" (%.text name) + "Available" (|> bundle + dictionary.keys + (list.sorted text#<) + (exception.listing %.text)))) + +(type .public (Extender s i o) + (-> Any (Handler s i o))) + +(def .public (install extender name handler) + (All (_ s i o) + (-> (Extender s i o) Name (Handler s i o) (Operation s i o Any))) + (function (_ [bundle state]) + (case (dictionary.has' name (extender handler) bundle) + {try.#Success bundle'} + {try.#Success [[bundle' state] + []]} + + {try.#Failure _} + (exception.except ..cannot_overwrite name)))) + +(def .public (with extender extensions) + (All (_ s i o) + (-> Extender (Bundle s i o) (Operation s i o Any))) + (|> extensions + dictionary.entries + (monad.mix //.monad + (function (_ [extension handle] output) + (..install extender extension handle)) + []))) + +(def .public (apply archive phase [name parameters]) + (All (_ s i o) + (-> Archive (Phase s i o) (Extension i) (Operation s i o o))) + (function (_ (^.let stateE [bundle state])) + (case (dictionary.value name bundle) + {.#Some handler} + (((handler name phase) archive parameters) + stateE) + + {.#None} + (exception.except ..unknown [name bundle])))) + +(def .public (localized get set transform) + (All (_ s s' i o v) + (-> (-> s s') (-> s' s s) (-> s' s') + (-> (Operation s i o v) (Operation s i o v)))) + (function (_ operation) + (function (_ [bundle state]) + (let [old (get state)] + (case (operation [bundle (set (transform old) state)]) + {try.#Success [[bundle' state'] output]} + {try.#Success [[bundle' (set old state')] output]} + + {try.#Failure error} + {try.#Failure error}))))) + +(def .public (temporary transform) + (All (_ s i o v) + (-> (-> s s) + (-> (Operation s i o v) (Operation s i o v)))) + (function (_ operation) + (function (_ [bundle state]) + (case (operation [bundle (transform state)]) + {try.#Success [[bundle' state'] output]} + {try.#Success [[bundle' state] output]} + + {try.#Failure error} + {try.#Failure error})))) + +(def .public (with_state state) + (All (_ s i o v) + (-> s (-> (Operation s i o v) (Operation s i o v)))) + (..temporary (function.constant state))) + +(def .public (read get) + (All (_ s i o v) + (-> (-> s v) (Operation s i o v))) + (function (_ [bundle state]) + {try.#Success [[bundle state] (get state)]})) + +(def .public (update transform) + (All (_ s i o) + (-> (-> s s) (Operation s i o Any))) + (function (_ [bundle state]) + {try.#Success [[bundle (transform state)] []]})) + +(def .public (lifted action) + (All (_ s i o v) + (-> (//.Operation s v) (Operation s i o v))) + (function (_ [bundle state]) + (case (action state) + {try.#Success [state' output]} + {try.#Success [[bundle state'] output]} + + {try.#Failure error} + {try.#Failure error}))) + +(def .public (up it) + (All (_ s i o v) + (-> (Operation s i o v) (//.Operation s v))) + (function (_ state) + (case (it [..empty state]) + {try.#Success [[_ state'] output]} + {try.#Success [state' output]} + + {try.#Failure error} + {try.#Failure error}))) diff --git a/stdlib/source/library/lux/meta/compiler/language/lux/phase/extension/analysis.lux b/stdlib/source/library/lux/meta/compiler/language/lux/phase/extension/analysis.lux new file mode 100644 index 000000000..2a887e12d --- /dev/null +++ b/stdlib/source/library/lux/meta/compiler/language/lux/phase/extension/analysis.lux @@ -0,0 +1,16 @@ +(.require + [library + [lux (.except) + [data + [collection + ["[0]" dictionary]]]]] + [//// + [analysis (.only Bundle) + [evaluation (.only Eval)]]] + ["[0]" / + ["[1][0]" lux]]) + +(def .public (bundle eval host_specific) + (-> Eval Bundle Bundle) + (dictionary.composite host_specific + (/lux.bundle eval))) diff --git a/stdlib/source/library/lux/meta/compiler/language/lux/phase/extension/analysis/common_lisp.lux b/stdlib/source/library/lux/meta/compiler/language/lux/phase/extension/analysis/common_lisp.lux new file mode 100644 index 000000000..377ce23c4 --- /dev/null +++ b/stdlib/source/library/lux/meta/compiler/language/lux/phase/extension/analysis/common_lisp.lux @@ -0,0 +1,13 @@ +(.require + [library + [lux (.except)]] + [/// + ["[0]" bundle] + [/// + [analysis (.only Bundle)]]]) + +(def .public bundle + Bundle + (<| (bundle.prefix "common_lisp") + (|> bundle.empty + ))) diff --git a/stdlib/source/library/lux/meta/compiler/language/lux/phase/extension/analysis/js.lux b/stdlib/source/library/lux/meta/compiler/language/lux/phase/extension/analysis/js.lux new file mode 100644 index 000000000..e1fe38771 --- /dev/null +++ b/stdlib/source/library/lux/meta/compiler/language/lux/phase/extension/analysis/js.lux @@ -0,0 +1,233 @@ +(.require + [library + [lux (.except) + ["[0]" ffi] + [abstract + ["[0]" monad (.only do)]] + [control + ["<>" parser]] + [data + [collection + ["[0]" array] + ["[0]" dictionary] + ["[0]" list]]] + [meta + ["@" target (.only) + ["_" js]] + ["[0]" code + ["<[1]>" \\parser (.only Parser)]] + ["[0]" type (.only) + ["[0]" check]]]]] + [// + ["/" lux (.only custom)] + [// + ["[0]" bundle] + [/// + ["[0]" analysis (.only Analysis Operation Phase Handler Bundle) + ["[1]/[0]" type]] + [/// + ["[0]" phase]]]]]) + +(def array::new + Handler + (custom + [.any + (function (_ extension phase archive lengthC) + (<| analysis/type.with_var + (function (_ [@read :read:])) + analysis/type.with_var + (function (_ [@write :write:])) + (do phase.monad + [lengthA (analysis/type.expecting Nat + (phase archive lengthC)) + _ (analysis/type.inference (type_literal (array.Array' :read: :write:)))] + (in {analysis.#Extension extension (list lengthA)}))))])) + +(def array::length + Handler + (custom + [.any + (function (_ extension phase archive arrayC) + (<| analysis/type.with_var + (function (_ [@read :read:])) + analysis/type.with_var + (function (_ [@write :write:])) + (do phase.monad + [arrayA (analysis/type.expecting (type_literal (array.Array' :read: :write:)) + (phase archive arrayC)) + _ (analysis/type.inference Nat)] + (in {analysis.#Extension extension (list arrayA)}))))])) + +(def array::read + Handler + (custom + [(<>.and .any .any) + (function (_ extension phase archive [indexC arrayC]) + (<| analysis/type.with_var + (function (_ [@read :read:])) + analysis/type.with_var + (function (_ [@write :write:])) + (do phase.monad + [indexA (analysis/type.expecting Nat + (phase archive indexC)) + arrayA (analysis/type.expecting (type_literal (array.Array' :read: :write:)) + (phase archive arrayC)) + _ (analysis/type.inference :read:)] + (in {analysis.#Extension extension (list indexA arrayA)}))))])) + +(def array::write + Handler + (custom + [(all <>.and .any .any .any) + (function (_ extension phase archive [indexC valueC arrayC]) + (<| analysis/type.with_var + (function (_ [@read :read:])) + analysis/type.with_var + (function (_ [@write :write:])) + (do phase.monad + [indexA (analysis/type.expecting Nat + (phase archive indexC)) + valueA (analysis/type.expecting :write: + (phase archive valueC)) + arrayA (analysis/type.expecting (type_literal (array.Array' :read: :write:)) + (phase archive arrayC)) + _ (analysis/type.inference (type_literal (array.Array' :read: :write:)))] + (in {analysis.#Extension extension (list indexA valueA arrayA)}))))])) + +(def array::delete + Handler + (custom + [(all <>.and .any .any) + (function (_ extension phase archive [indexC arrayC]) + (<| analysis/type.with_var + (function (_ [@read :read:])) + analysis/type.with_var + (function (_ [@write :write:])) + (do phase.monad + [indexA (analysis/type.expecting Nat + (phase archive indexC)) + arrayA (analysis/type.expecting (type_literal (array.Array' :read: :write:)) + (phase archive arrayC)) + _ (analysis/type.inference (type_literal (array.Array' :read: :write:)))] + (in {analysis.#Extension extension (list indexA arrayA)}))))])) + +(def bundle::array + Bundle + (<| (bundle.prefix "array") + (|> bundle.empty + (bundle.install "new" array::new) + (bundle.install "length" array::length) + (bundle.install "read" array::read) + (bundle.install "write" array::write) + (bundle.install "delete" array::delete) + ))) + +(def object::new + Handler + (custom + [(all <>.and .any (.tuple (<>.some .any))) + (function (_ extension phase archive [constructorC inputsC]) + (do [! phase.monad] + [constructorA (analysis/type.expecting Any + (phase archive constructorC)) + inputsA (monad.each ! (|>> (phase archive) (analysis/type.expecting Any)) inputsC) + _ (analysis/type.inference .Any)] + (in {analysis.#Extension extension (list.partial constructorA inputsA)})))])) + +(def object::get + Handler + (custom + [(all <>.and .text .any) + (function (_ extension phase archive [fieldC objectC]) + (do phase.monad + [objectA (analysis/type.expecting Any + (phase archive objectC)) + _ (analysis/type.inference .Any)] + (in {analysis.#Extension extension (list (analysis.text fieldC) + objectA)})))])) + +(def object::do + Handler + (custom + [(all <>.and .text .any (.tuple (<>.some .any))) + (function (_ extension phase archive [methodC objectC inputsC]) + (do [! phase.monad] + [objectA (analysis/type.expecting Any + (phase archive objectC)) + inputsA (monad.each ! (|>> (phase archive) (analysis/type.expecting Any)) inputsC) + _ (analysis/type.inference .Any)] + (in {analysis.#Extension extension (list.partial (analysis.text methodC) + objectA + inputsA)})))])) + +(def bundle::object + Bundle + (<| (bundle.prefix "object") + (|> bundle.empty + (bundle.install "new" object::new) + (bundle.install "get" object::get) + (bundle.install "do" object::do) + (bundle.install "null" (/.nullary Any)) + (bundle.install "null?" (/.unary Any Bit)) + (bundle.install "undefined" (/.nullary Any)) + (bundle.install "undefined?" (/.unary Any Bit)) + ))) + +(def js::constant + Handler + (custom + [.text + (function (_ extension phase archive name) + (do phase.monad + [_ (analysis/type.inference Any)] + (in {analysis.#Extension extension (list (analysis.text name))})))])) + +(def js::apply + Handler + (custom + [(all <>.and .any (.tuple (<>.some .any))) + (function (_ extension phase archive [abstractionC inputsC]) + (do [! phase.monad] + [abstractionA (analysis/type.expecting Any + (phase archive abstractionC)) + inputsA (monad.each ! (|>> (phase archive) (analysis/type.expecting Any)) inputsC) + _ (analysis/type.inference Any)] + (in {analysis.#Extension extension (list.partial abstractionA inputsA)})))])) + +(def js::type_of + Handler + (custom + [.any + (function (_ extension phase archive objectC) + (do phase.monad + [objectA (analysis/type.expecting Any + (phase archive objectC)) + _ (analysis/type.inference .Text)] + (in {analysis.#Extension extension (list objectA)})))])) + +(def js::function + Handler + (custom + [(all <>.and .nat .any) + (function (_ extension phase archive [arity abstractionC]) + (do phase.monad + [.let [inputT (type.tuple (list.repeated arity Any))] + abstractionA (analysis/type.expecting (-> inputT Any) + (phase archive abstractionC)) + _ (analysis/type.inference (for @.js ffi.Function + Any))] + (in {analysis.#Extension extension (list (analysis.nat arity) + abstractionA)})))])) + +(def .public bundle + Bundle + (<| (bundle.prefix "js") + (|> bundle.empty + (dictionary.composite bundle::array) + (dictionary.composite bundle::object) + + (bundle.install "constant" js::constant) + (bundle.install "apply" js::apply) + (bundle.install "type-of" js::type_of) + (bundle.install "function" js::function) + ))) diff --git a/stdlib/source/library/lux/meta/compiler/language/lux/phase/extension/analysis/jvm.lux b/stdlib/source/library/lux/meta/compiler/language/lux/phase/extension/analysis/jvm.lux new file mode 100644 index 000000000..338029e94 --- /dev/null +++ b/stdlib/source/library/lux/meta/compiler/language/lux/phase/extension/analysis/jvm.lux @@ -0,0 +1,2754 @@ +(.require + [library + [lux (.except Type Module Primitive char int type) + ["[0]" ffi (.only import)] + [abstract + ["[0]" monad (.only do)]] + [control + ["<>" parser] + ["[0]" pipe] + ["[0]" maybe (.use "[1]#[0]" functor)] + ["[0]" try (.only Try) (.use "[1]#[0]" monad)] + ["[0]" exception (.only exception)] + [function + ["[0]" predicate]]] + [data + [binary (.only Binary) + ["[0]" \\format]] + ["[0]" product] + ["[0]" text (.use "[1]#[0]" equivalence) + ["%" \\format (.only format)] + ["<[1]>" \\parser]] + [collection + ["[0]" list (.use "[1]#[0]" mix monad monoid)] + ["[0]" array] + ["[0]" dictionary (.only Dictionary)] + ["[0]" sequence]]] + [math + [number + ["n" nat] + ["[0]" i32]]] + ["[0]" meta (.only) + ["[0]" code + ["<[1]>" \\parser (.only Parser)]] + [macro + ["^" pattern] + ["[0]" template]] + [target + ["[0]" jvm + ["[0]!" reflection] + ["_" bytecode (.only Bytecode) (.use "[1]#[0]" monad)] + ["[0]" modifier (.only Modifier) (.use "[1]#[0]" monoid)] + ["[0]" attribute] + ["[0]" field] + ["[0]" version] + ["[0]" method] + ["[0]" class] + ["[0]" constant (.only) + ["[0]" pool (.only Resource)]] + [encoding + ["[0]" name (.only External)]] + ["[1]" type (.only Type Argument Typed) (.use "[1]#[0]" equivalence) + ["[0]" category (.only Void Value' Value Return' Return Primitive Object Class Array Var Parameter Method)] + ["[0]" box] + ["[0]" reflection] + ["[0]" descriptor] + ["[0]" signature] + ["[0]" parser] + ["[0]" alias (.only Aliasing)] + ["[0]T" lux (.only Mapping)]]]] + ["[0]" type (.only) + ["[0]" check (.only Check) (.use "[1]#[0]" monad)]]]]] + ["[0]" // + ["[1][0]" lux (.only custom)] + ["/[1]" // (.only) + ["[1][0]" bundle] + ["/[1]" // + [generation + [jvm + ["[0]" runtime] + ["[0]" function + ["[1]" abstract]]]] + ["/[1]" // + ["[0]" generation] + ["[0]" declaration] + ["[1][0]" analysis (.only Analysis Operation Phase Handler Bundle) + ["[0]" complex] + ["[0]" pattern] + ["[0]" inference] + ["[0]A" type] + ["[0]" scope]] + [/// + ["[0]" phase (.use "[1]#[0]" monad)] + ["[0]" reference (.only) + ["[0]" variable]] + [meta + [archive (.only Archive) + [module + [descriptor (.only Module)]]]]]]]]]) + +(import java/lang/ClassLoader + "[1]::[0]") + +(import java/lang/Object + "[1]::[0]" + (equals [java/lang/Object] boolean)) + +(import java/lang/reflect/Type + "[1]::[0]") + +(import (java/lang/reflect/TypeVariable d) + "[1]::[0]" + (getName [] java/lang/String) + (getBounds [] [java/lang/reflect/Type])) + +(import java/lang/reflect/Modifier + "[1]::[0]" + ("static" isStatic [int] boolean) + ("static" isFinal [int] boolean) + ("static" isInterface [int] boolean) + ("static" isAbstract [int] boolean) + ("static" isPublic [int] boolean) + ("static" isProtected [int] boolean)) + +(import java/lang/annotation/Annotation + "[1]::[0]") + +(import java/lang/reflect/Method + "[1]::[0]" + (getName [] java/lang/String) + (getModifiers [] int) + (getDeclaringClass [] (java/lang/Class java/lang/Object)) + (getTypeParameters [] [(java/lang/reflect/TypeVariable java/lang/reflect/Method)]) + (getGenericParameterTypes [] [java/lang/reflect/Type]) + (getDeclaredAnnotations [] [java/lang/annotation/Annotation]) + + (getReturnType [] (java/lang/Class java/lang/Object)) + (getGenericReturnType [] "?" java/lang/reflect/Type) + + (getExceptionTypes [] [(java/lang/Class java/lang/Object)]) + (getGenericExceptionTypes [] [java/lang/reflect/Type])) + +(import (java/lang/reflect/Constructor c) + "[1]::[0]" + (getModifiers [] int) + (getDeclaringClass [] (java/lang/Class c)) + (getTypeParameters [] [(java/lang/reflect/TypeVariable (java/lang/reflect/Constructor c))]) + (getGenericParameterTypes [] [java/lang/reflect/Type]) + (getExceptionTypes [] [(java/lang/Class java/lang/Object)]) + (getGenericExceptionTypes [] [java/lang/reflect/Type]) + (getDeclaredAnnotations [] [java/lang/annotation/Annotation])) + +(import (java/lang/Class c) + "[1]::[0]" + ("static" forName [java/lang/String] "try" (java/lang/Class java/lang/Object)) + (getName [] java/lang/String) + (getModifiers [] int) + (isAssignableFrom [(java/lang/Class java/lang/Object)] boolean) + (getTypeParameters [] [(java/lang/reflect/TypeVariable (java/lang/Class c))]) + (getGenericInterfaces [] [java/lang/reflect/Type]) + (getGenericSuperclass [] "?" java/lang/reflect/Type) + (getDeclaredField [java/lang/String] "try" java/lang/reflect/Field) + (getConstructors [] [(java/lang/reflect/Constructor java/lang/Object)]) + (getDeclaredMethods [] [java/lang/reflect/Method]) + (getDeclaredAnnotations [] [java/lang/annotation/Annotation]) + (getSuperclass [] "?" (java/lang/Class java/lang/Object)) + (getInterfaces [] [(java/lang/Class java/lang/Object)])) + +(with_template [] + [(exception .public ( [class External + field Text]) + (exception.report + "Class" (%.text class) + "Field" (%.text field)))] + + [cannot_set_a_final_field] + [deprecated_field] + ) + +(exception .public (deprecated_method [class External + method Text + type .Type]) + (exception.report + "Class" (%.text class) + "Method" (%.text method) + "Type" (%.type type))) + +(exception .public (deprecated_class [class External]) + (exception.report + "Class" (%.text class))) + +(def (ensure_fresh_class! class_loader name) + (-> java/lang/ClassLoader External (Operation Any)) + (do phase.monad + [class (phase.lifted (reflection!.load class_loader name))] + (phase.assertion ..deprecated_class [name] + (|> class + java/lang/Class::getDeclaredAnnotations + reflection!.deprecated? + not)))) + +(def reflection + (All (_ category) (-> (Type (<| Return' Value' category)) Text)) + (|>> jvm.reflection reflection.reflection)) + +(def signature (|>> jvm.signature signature.signature)) + +(def object_class + External + "java.lang.Object") + +... TODO: Get rid of this with_template block and use the definition in +... lux/ffi.jvm.lux ASAP +(with_template [ ] + [(def .public + .Type + {.#Primitive {.#End}})] + + ... Boxes + [Boolean box.boolean] + [Byte box.byte] + [Short box.short] + [Integer box.int] + [Long box.long] + [Float box.float] + [Double box.double] + [Character box.char] + [String "java.lang.String"] + + ... Primitives + [boolean (reflection.reflection reflection.boolean)] + [byte (reflection.reflection reflection.byte)] + [short (reflection.reflection reflection.short)] + [int (reflection.reflection reflection.int)] + [long (reflection.reflection reflection.long)] + [float (reflection.reflection reflection.float)] + [double (reflection.reflection reflection.double)] + [char (reflection.reflection reflection.char)] + ) + +(.type Member + (Record + [#class External + #member Text])) + +(def member + (Parser Member) + (all <>.and .text .text)) + +(.type Method_Signature + (Record + [#method .Type + #deprecated? Bit + #throws (List .Type)])) + +(with_template [] + [(exception .public ( [type .Type]) + (exception.report + "Type" (%.type type)))] + + [non_object] + [non_array] + [non_parameter] + [non_jvm_type] + ) + +(with_template [] + [(exception .public ( [class External]) + (exception.report + "Class/type" (%.text class)))] + + [non_interface] + [non_throwable] + [primitives_are_not_objects] + ) + +(with_template [] + [(exception .public ( [class_variables (List (Type Var)) + class External + method Text + method_variables (List (Type Var)) + inputsJT (List (Type Value)) + hints (List Method_Signature)]) + (exception.report + "Class Variables" (exception.listing ..signature class_variables) + "Class" class + "Method" method + "Method Variables" (exception.listing ..signature method_variables) + "Arguments" (exception.listing ..signature inputsJT) + "Hints" (exception.listing %.type (list#each product.left hints))))] + + [no_candidates] + [too_many_candidates] + ) + +(exception .public (cannot_cast [from .Type + to .Type + value Code]) + (exception.report + "From" (%.type from) + "To" (%.type to) + "Value" (%.code value))) + +(with_template [] + [(exception .public ( [message Text]) + message)] + + [primitives_cannot_have_type_parameters] + + [cannot_possibly_be_an_instance] + + [unknown_type_var] + ) + +(def bundle::conversion + Bundle + (<| (///bundle.prefix "conversion") + (|> ///bundle.empty + (///bundle.install "double-to-float" (//lux.unary ..double ..float)) + (///bundle.install "double-to-int" (//lux.unary ..double ..int)) + (///bundle.install "double-to-long" (//lux.unary ..double ..long)) + (///bundle.install "float-to-double" (//lux.unary ..float ..double)) + (///bundle.install "float-to-int" (//lux.unary ..float ..int)) + (///bundle.install "float-to-long" (//lux.unary ..float ..long)) + (///bundle.install "int-to-byte" (//lux.unary ..int ..byte)) + (///bundle.install "int-to-char" (//lux.unary ..int ..char)) + (///bundle.install "int-to-double" (//lux.unary ..int ..double)) + (///bundle.install "int-to-float" (//lux.unary ..int ..float)) + (///bundle.install "int-to-long" (//lux.unary ..int ..long)) + (///bundle.install "int-to-short" (//lux.unary ..int ..short)) + (///bundle.install "long-to-double" (//lux.unary ..long ..double)) + (///bundle.install "long-to-float" (//lux.unary ..long ..float)) + (///bundle.install "long-to-int" (//lux.unary ..long ..int)) + (///bundle.install "long-to-short" (//lux.unary ..long ..short)) + (///bundle.install "long-to-byte" (//lux.unary ..long ..byte)) + (///bundle.install "char-to-byte" (//lux.unary ..char ..byte)) + (///bundle.install "char-to-short" (//lux.unary ..char ..short)) + (///bundle.install "char-to-int" (//lux.unary ..char ..int)) + (///bundle.install "char-to-long" (//lux.unary ..char ..long)) + (///bundle.install "byte-to-long" (//lux.unary ..byte ..long)) + (///bundle.install "short-to-long" (//lux.unary ..short ..long)) + ))) + +(with_template [ ] + [(def + Bundle + (<| (///bundle.prefix (reflection.reflection )) + (|> ///bundle.empty + (///bundle.install "+" (//lux.binary )) + (///bundle.install "-" (//lux.binary )) + (///bundle.install "*" (//lux.binary )) + (///bundle.install "/" (//lux.binary )) + (///bundle.install "%" (//lux.binary )) + (///bundle.install "=" (//lux.binary Bit)) + (///bundle.install "<" (//lux.binary Bit)) + (///bundle.install "and" (//lux.binary )) + (///bundle.install "or" (//lux.binary )) + (///bundle.install "xor" (//lux.binary )) + (///bundle.install "shl" (//lux.binary ..int )) + (///bundle.install "shr" (//lux.binary ..int )) + (///bundle.install "ushr" (//lux.binary ..int )) + )))] + + [bundle::int reflection.int ..int] + [bundle::long reflection.long ..long] + ) + +(with_template [ ] + [(def + Bundle + (<| (///bundle.prefix (reflection.reflection )) + (|> ///bundle.empty + (///bundle.install "+" (//lux.binary )) + (///bundle.install "-" (//lux.binary )) + (///bundle.install "*" (//lux.binary )) + (///bundle.install "/" (//lux.binary )) + (///bundle.install "%" (//lux.binary )) + (///bundle.install "=" (//lux.binary Bit)) + (///bundle.install "<" (//lux.binary Bit)) + )))] + + [bundle::float reflection.float ..float] + [bundle::double reflection.double ..double] + ) + +(def bundle::char + Bundle + (<| (///bundle.prefix (reflection.reflection reflection.char)) + (|> ///bundle.empty + (///bundle.install "=" (//lux.binary ..char ..char Bit)) + (///bundle.install "<" (//lux.binary ..char ..char Bit)) + ))) + +(def .public boxes + (Dictionary External [External (Type Primitive)]) + (|> (list [(reflection.reflection reflection.boolean) [box.boolean jvm.boolean]] + [(reflection.reflection reflection.byte) [box.byte jvm.byte]] + [(reflection.reflection reflection.short) [box.short jvm.short]] + [(reflection.reflection reflection.int) [box.int jvm.int]] + [(reflection.reflection reflection.long) [box.long jvm.long]] + [(reflection.reflection reflection.float) [box.float jvm.float]] + [(reflection.reflection reflection.double) [box.double jvm.double]] + [(reflection.reflection reflection.char) [box.char jvm.char]]) + (dictionary.of_list text.hash))) + +(def lux_array_type + (template (_ :read: :write:) + [{.#Primitive (static array.type_name) (list {.#Apply :write: {.#Apply :read: _Mutable}})}])) + +(def (jvm_type luxT) + (-> .Type (Operation (Type Value))) + (case luxT + {.#Named name anonymousT} + (jvm_type anonymousT) + + {.#Apply inputT abstractionT} + (case (type.applied (list inputT) abstractionT) + {.#Some outputT} + (jvm_type outputT) + + {.#None} + (/////analysis.except ..non_jvm_type luxT)) + + (lux_array_type elemT _) + (phase#each jvm.array (jvm_type elemT)) + + {.#Primitive class parametersT} + (case (dictionary.value class ..boxes) + {.#Some [_ primitive_type]} + (case parametersT + {.#End} + (phase#in primitive_type) + + _ + (/////analysis.except ..primitives_cannot_have_type_parameters class)) + + {.#None} + (do [! phase.monad] + [parametersJT (is (Operation (List (Type Parameter))) + (monad.each ! + (function (_ parameterT) + (do phase.monad + [parameterJT (jvm_type parameterT)] + (case (parser.parameter? parameterJT) + {.#Some parameterJT} + (in parameterJT) + + {.#None} + (/////analysis.except ..non_parameter parameterT)))) + parametersT))] + (in (jvm.class class parametersJT)))) + + {.#Ex _} + (phase#in (jvm.class ..object_class (list))) + + {.#Function _} + (phase#in function.class) + + _ + (/////analysis.except ..non_jvm_type luxT))) + +(def (jvm_array_type objectT) + (-> .Type (Operation (Type Array))) + (do phase.monad + [objectJ (jvm_type objectT)] + (|> objectJ + ..signature + (.result parser.array) + phase.lifted))) + +(def (primitive_array_length_handler primitive_type) + (-> (Type Primitive) Handler) + (function (_ extension_name analyse archive args) + (case args + (list arrayC) + (do phase.monad + [_ (typeA.inference ..int) + arrayA (<| (typeA.expecting {.#Primitive (|> (jvm.array primitive_type) + ..reflection) + (list)}) + (analyse archive arrayC))] + (in {/////analysis.#Extension extension_name (list arrayA)})) + + _ + (/////analysis.except ///.incorrect_arity [extension_name 1 (list.size args)])))) + +(def array::length::object + Handler + (function (_ extension_name analyse archive args) + (case args + (list arrayC) + (<| typeA.with_var + (function (_ [@read :read:])) + typeA.with_var + (function (_ [@write :write:])) + (do phase.monad + [_ (typeA.inference ..int) + arrayA (<| (typeA.expecting (.type_literal (array.Array' :read: :write:))) + (analyse archive arrayC)) + :read: (typeA.check (check.clean (list) :read:)) + :write: (typeA.check (check.clean (list) :write:)) + arrayJT (jvm_array_type (.type_literal (array.Array' :read: :write:)))] + (in {/////analysis.#Extension extension_name (list (/////analysis.text (..signature arrayJT)) + arrayA)}))) + + _ + (/////analysis.except ///.incorrect_arity [extension_name 1 (list.size args)])))) + +(def (new_primitive_array_handler primitive_type) + (-> (Type Primitive) Handler) + (function (_ extension_name analyse archive args) + (case args + (list lengthC) + (do phase.monad + [lengthA (<| (typeA.expecting ..int) + (analyse archive lengthC)) + _ (typeA.inference {.#Primitive (|> (jvm.array primitive_type) ..reflection) + (list)})] + (in {/////analysis.#Extension extension_name (list lengthA)})) + + _ + (/////analysis.except ///.incorrect_arity [extension_name 1 (list.size args)])))) + +(def array::new::object + Handler + (function (_ extension_name analyse archive args) + (case args + (list lengthC) + (do phase.monad + [lengthA (<| (typeA.expecting ..int) + (analyse archive lengthC)) + expectedT (///.lifted meta.expected_type) + expectedJT (jvm_array_type expectedT) + elementJT (case (parser.array? expectedJT) + {.#Some elementJT} + (in elementJT) + + {.#None} + (/////analysis.except ..non_array expectedT))] + (in {/////analysis.#Extension extension_name (list (/////analysis.text (..signature elementJT)) + lengthA)})) + + _ + (/////analysis.except ///.incorrect_arity [extension_name 1 (list.size args)])))) + +(def (check_parameter objectT) + (-> .Type (Operation (Type Parameter))) + (case objectT + (lux_array_type elementT _) + (/////analysis.except ..non_parameter objectT) + + {.#Primitive name parameters} + (`` (cond (or (,, (with_template [] + [(text#= (..reflection ) name)] + + [jvm.boolean] + [jvm.byte] + [jvm.short] + [jvm.int] + [jvm.long] + [jvm.float] + [jvm.double] + [jvm.char])) + (text.starts_with? descriptor.array_prefix name)) + (/////analysis.except ..non_parameter objectT) + + ... else + (phase#in (jvm.class name (list))))) + + {.#Named name anonymous} + (check_parameter anonymous) + + {.#Var @var} + (do phase.monad + [:var: (typeA.check (check.peek @var))] + (case :var: + {.#Some :var:} + (check_parameter :var:) + + {.#None} + (in (jvm.class ..object_class (list))))) + + (^.or {.#Ex id} + {.#Parameter id}) + (phase#in (jvm.class ..object_class (list))) + + (^.with_template [] + [{ env unquantified} + (check_parameter unquantified)]) + ([.#UnivQ] + [.#ExQ]) + + {.#Apply inputT abstractionT} + (case (type.applied (list inputT) abstractionT) + {.#Some outputT} + (check_parameter outputT) + + {.#None} + (/////analysis.except ..non_parameter objectT)) + + {.#Function _} + (phase#in function.class) + + _ + (/////analysis.except ..non_parameter objectT))) + +(def (check_jvm objectT) + (-> .Type (Operation (Type Value))) + (case objectT + {.#Primitive name {.#End}} + (`` (cond (,, (with_template [] + [(text#= (..reflection ) name) + (phase#in )] + + [jvm.boolean] + [jvm.byte] + [jvm.short] + [jvm.int] + [jvm.long] + [jvm.float] + [jvm.double] + [jvm.char])) + + (,, (with_template [] + [(text#= (..reflection (jvm.array )) name) + (phase#in (jvm.array ))] + + [jvm.boolean] + [jvm.byte] + [jvm.short] + [jvm.int] + [jvm.long] + [jvm.float] + [jvm.double] + [jvm.char])) + + (text.starts_with? descriptor.array_prefix name) + (let [[_ unprefixed] (maybe.trusted (text.split_by descriptor.array_prefix name))] + (at phase.monad each jvm.array + (check_jvm {.#Primitive unprefixed (list)}))) + + ... else + (phase#in (jvm.class name (list))))) + + (lux_array_type elementT _) + (|> elementT + check_jvm + (phase#each jvm.array)) + + {.#Primitive name parameters} + (do [! phase.monad] + [parameters (monad.each ! check_parameter parameters)] + (phase#in (jvm.class name parameters))) + + {.#Named name anonymous} + (check_jvm anonymous) + + (^.with_template [] + [{ env unquantified} + (check_jvm unquantified)]) + ([.#UnivQ] + [.#ExQ]) + + {.#Apply inputT abstractionT} + (case (type.applied (list inputT) abstractionT) + {.#Some outputT} + (check_jvm outputT) + + {.#None} + (/////analysis.except ..non_object objectT)) + + _ + (check_parameter objectT))) + +(with_template [ ] + [(def .public ( mapping typeJ) + (-> Mapping (Type ) (Operation .Type)) + (case (|> typeJ ..signature (.result ( mapping))) + {try.#Success check} + (typeA.check check) + + {try.#Failure error} + (phase.failure error)))] + + [boxed_reflection_type Value luxT.boxed_type] + [reflection_type Value luxT.type] + [boxed_reflection_return Return luxT.boxed_return] + [reflection_return Return luxT.return] + ) + +(def (check_object objectT) + (-> .Type (Operation [External .Type])) + (do [! phase.monad] + [:object: (check_jvm objectT) + .let [name (..reflection :object:)]] + (if (dictionary.key? ..boxes name) + (/////analysis.except ..primitives_are_not_objects [name]) + (do ! + [:object: (reflection_type luxT.fresh :object:)] + (phase#in [name :object:]))))) + +(def (check_return type) + (-> .Type (Operation (Type Return))) + (if (same? .Any type) + (phase#in jvm.void) + (check_jvm type))) + +(def (read_primitive_array_handler lux_type jvm_type) + (-> .Type (Type Primitive) Handler) + (function (_ extension_name analyse archive args) + (case args + (list idxC arrayC) + (do phase.monad + [_ (typeA.inference lux_type) + idxA (<| (typeA.expecting ..int) + (analyse archive idxC)) + arrayA (<| (typeA.expecting {.#Primitive (|> (jvm.array jvm_type) ..reflection) + (list)}) + (analyse archive arrayC))] + (in {/////analysis.#Extension extension_name (list idxA arrayA)})) + + _ + (/////analysis.except ///.incorrect_arity [extension_name 2 (list.size args)])))) + +(def array::read::object + Handler + (function (_ extension_name analyse archive args) + (case args + (list idxC arrayC) + (<| typeA.with_var + (function (_ [@read :read:])) + typeA.with_var + (function (_ [@write :write:])) + (do phase.monad + [_ (typeA.inference :read:) + arrayA (<| (typeA.expecting (.type_literal (array.Array' :read: :write:))) + (analyse archive arrayC)) + idxA (<| (typeA.expecting ..int) + (analyse archive idxC)) + :read: (typeA.check (check.clean (list) :read:)) + :write: (typeA.check (check.clean (list) :write:)) + arrayJT (jvm_array_type (.type_literal (array.Array' :read: :write:)))] + (in {/////analysis.#Extension extension_name (list (/////analysis.text (..signature arrayJT)) + idxA + arrayA)}))) + + _ + (/////analysis.except ///.incorrect_arity [extension_name 2 (list.size args)])))) + +(def (write_primitive_array_handler lux_type jvm_type) + (-> .Type (Type Primitive) Handler) + (let [array_type {.#Primitive (|> (jvm.array jvm_type) ..reflection) + (list)}] + (function (_ extension_name analyse archive args) + (case args + (list idxC valueC arrayC) + (do phase.monad + [_ (typeA.inference array_type) + idxA (<| (typeA.expecting ..int) + (analyse archive idxC)) + valueA (<| (typeA.expecting lux_type) + (analyse archive valueC)) + arrayA (<| (typeA.expecting array_type) + (analyse archive arrayC))] + (in {/////analysis.#Extension extension_name (list idxA + valueA + arrayA)})) + + _ + (/////analysis.except ///.incorrect_arity [extension_name 3 (list.size args)]))))) + +(def array::write::object + Handler + (function (_ extension_name analyse archive args) + (case args + (list idxC valueC arrayC) + (<| typeA.with_var + (function (_ [@read :read:])) + typeA.with_var + (function (_ [@write :write:])) + (do phase.monad + [_ (typeA.inference (.type_literal (array.Array' :read: :write:))) + arrayA (<| (typeA.expecting (.type_literal (array.Array' :read: :write:))) + (analyse archive arrayC)) + idxA (<| (typeA.expecting ..int) + (analyse archive idxC)) + valueA (<| (typeA.expecting :write:) + (analyse archive valueC)) + :read: (typeA.check (check.clean (list) :read:)) + :write: (typeA.check (check.clean (list) :write:)) + arrayJT (jvm_array_type (.type_literal (array.Array' :read: :write:)))] + (in {/////analysis.#Extension extension_name (list (/////analysis.text (..signature arrayJT)) + idxA + valueA + arrayA)}))) + + _ + (/////analysis.except ///.incorrect_arity [extension_name 3 (list.size args)])))) + +(def bundle::array + Bundle + (<| (///bundle.prefix "array") + (|> ///bundle.empty + (dictionary.composite (<| (///bundle.prefix "length") + (|> ///bundle.empty + (///bundle.install (reflection.reflection reflection.boolean) (primitive_array_length_handler jvm.boolean)) + (///bundle.install (reflection.reflection reflection.byte) (primitive_array_length_handler jvm.byte)) + (///bundle.install (reflection.reflection reflection.short) (primitive_array_length_handler jvm.short)) + (///bundle.install (reflection.reflection reflection.int) (primitive_array_length_handler jvm.int)) + (///bundle.install (reflection.reflection reflection.long) (primitive_array_length_handler jvm.long)) + (///bundle.install (reflection.reflection reflection.float) (primitive_array_length_handler jvm.float)) + (///bundle.install (reflection.reflection reflection.double) (primitive_array_length_handler jvm.double)) + (///bundle.install (reflection.reflection reflection.char) (primitive_array_length_handler jvm.char)) + (///bundle.install "object" array::length::object)))) + (dictionary.composite (<| (///bundle.prefix "new") + (|> ///bundle.empty + (///bundle.install (reflection.reflection reflection.boolean) (new_primitive_array_handler jvm.boolean)) + (///bundle.install (reflection.reflection reflection.byte) (new_primitive_array_handler jvm.byte)) + (///bundle.install (reflection.reflection reflection.short) (new_primitive_array_handler jvm.short)) + (///bundle.install (reflection.reflection reflection.int) (new_primitive_array_handler jvm.int)) + (///bundle.install (reflection.reflection reflection.long) (new_primitive_array_handler jvm.long)) + (///bundle.install (reflection.reflection reflection.float) (new_primitive_array_handler jvm.float)) + (///bundle.install (reflection.reflection reflection.double) (new_primitive_array_handler jvm.double)) + (///bundle.install (reflection.reflection reflection.char) (new_primitive_array_handler jvm.char)) + (///bundle.install "object" array::new::object)))) + (dictionary.composite (<| (///bundle.prefix "read") + (|> ///bundle.empty + (///bundle.install (reflection.reflection reflection.boolean) (read_primitive_array_handler ..boolean jvm.boolean)) + (///bundle.install (reflection.reflection reflection.byte) (read_primitive_array_handler ..byte jvm.byte)) + (///bundle.install (reflection.reflection reflection.short) (read_primitive_array_handler ..short jvm.short)) + (///bundle.install (reflection.reflection reflection.int) (read_primitive_array_handler ..int jvm.int)) + (///bundle.install (reflection.reflection reflection.long) (read_primitive_array_handler ..long jvm.long)) + (///bundle.install (reflection.reflection reflection.float) (read_primitive_array_handler ..float jvm.float)) + (///bundle.install (reflection.reflection reflection.double) (read_primitive_array_handler ..double jvm.double)) + (///bundle.install (reflection.reflection reflection.char) (read_primitive_array_handler ..char jvm.char)) + (///bundle.install "object" array::read::object)))) + (dictionary.composite (<| (///bundle.prefix "write") + (|> ///bundle.empty + (///bundle.install (reflection.reflection reflection.boolean) (write_primitive_array_handler ..boolean jvm.boolean)) + (///bundle.install (reflection.reflection reflection.byte) (write_primitive_array_handler ..byte jvm.byte)) + (///bundle.install (reflection.reflection reflection.short) (write_primitive_array_handler ..short jvm.short)) + (///bundle.install (reflection.reflection reflection.int) (write_primitive_array_handler ..int jvm.int)) + (///bundle.install (reflection.reflection reflection.long) (write_primitive_array_handler ..long jvm.long)) + (///bundle.install (reflection.reflection reflection.float) (write_primitive_array_handler ..float jvm.float)) + (///bundle.install (reflection.reflection reflection.double) (write_primitive_array_handler ..double jvm.double)) + (///bundle.install (reflection.reflection reflection.char) (write_primitive_array_handler ..char jvm.char)) + (///bundle.install "object" array::write::object)))) + ))) + +(def object::null + Handler + (function (_ extension_name analyse archive args) + (case args + (list) + (do phase.monad + [expectedT (///.lifted meta.expected_type) + [_ :object:] (check_object expectedT) + _ (typeA.inference :object:)] + (in {/////analysis.#Extension extension_name (list)})) + + _ + (/////analysis.except ///.incorrect_arity [extension_name 0 (list.size args)])))) + +(def object::null? + Handler + (function (_ extension_name analyse archive args) + (case args + (list objectC) + (do phase.monad + [_ (typeA.inference .Bit) + [objectT objectA] (typeA.inferring + (analyse archive objectC)) + _ (check_object objectT)] + (in {/////analysis.#Extension extension_name (list objectA)})) + + _ + (/////analysis.except ///.incorrect_arity [extension_name 1 (list.size args)])))) + +(def object::synchronized + Handler + (function (_ extension_name analyse archive args) + (case args + (list monitorC exprC) + (do phase.monad + [[monitorT monitorA] (typeA.inferring + (analyse archive monitorC)) + _ (check_object monitorT) + exprA (analyse archive exprC)] + (in {/////analysis.#Extension extension_name (list monitorA exprA)})) + + _ + (/////analysis.except ///.incorrect_arity [extension_name 2 (list.size args)])))) + +(def (object::throw class_loader) + (-> java/lang/ClassLoader Handler) + (function (_ extension_name analyse archive args) + (case args + (list exceptionC) + (do phase.monad + [_ (typeA.inference Nothing) + [exceptionT exceptionA] (typeA.inferring + (analyse archive exceptionC)) + [exception_class _] (check_object exceptionT) + ? (phase.lifted (reflection!.sub? class_loader "java.lang.Throwable" exception_class)) + _ (is (Operation Any) + (if ? + (in []) + (/////analysis.except non_throwable exception_class)))] + (in {/////analysis.#Extension extension_name (list exceptionA)})) + + _ + (/////analysis.except ///.incorrect_arity [extension_name 1 (list.size args)])))) + +(def (object::class class_loader) + (-> java/lang/ClassLoader Handler) + (function (_ extension_name analyse archive args) + (case args + (list classC) + (case classC + [_ {.#Text class}] + (do phase.monad + [_ (..ensure_fresh_class! class_loader class) + _ (typeA.inference {.#Primitive "java.lang.Class" (list {.#Primitive class (list)})}) + _ (phase.lifted (reflection!.load class_loader class))] + (in {/////analysis.#Extension extension_name (list (/////analysis.text class))})) + + _ + (/////analysis.except ///.invalid_syntax [extension_name %.code args])) + + _ + (/////analysis.except ///.incorrect_arity [extension_name 1 (list.size args)])))) + +(def (object::instance? class_loader) + (-> java/lang/ClassLoader Handler) + (..custom + [(all <>.and .text .any) + (function (_ extension_name analyse archive [sub_class objectC]) + (do phase.monad + [_ (..ensure_fresh_class! class_loader sub_class) + _ (typeA.inference Bit) + [objectT objectA] (typeA.inferring + (analyse archive objectC)) + [object_class _] (check_object objectT) + ? (phase.lifted (reflection!.sub? class_loader object_class sub_class))] + (if ? + (in {/////analysis.#Extension extension_name (list (/////analysis.text sub_class) objectA)}) + (/////analysis.except cannot_possibly_be_an_instance (format sub_class " !<= " object_class)))))])) + +(def (class_candidate_parents class_loader source_name fromT target_name target_class) + (-> java/lang/ClassLoader External .Type External (java/lang/Class java/lang/Object) (Operation (List [[Text .Type] Bit]))) + (do [! phase.monad] + [source_class (phase.lifted (reflection!.load class_loader source_name)) + mapping (phase.lifted (reflection!.correspond source_class fromT))] + (monad.each ! + (function (_ superJT) + (do ! + [superJT (phase.lifted (reflection!.type superJT)) + .let [super_name (..reflection superJT)] + super_class (phase.lifted (reflection!.load class_loader super_name)) + superT (reflection_type mapping superJT)] + (in [[super_name superT] (java/lang/Class::isAssignableFrom super_class target_class)]))) + (case (java/lang/Class::getGenericSuperclass source_class) + {.#Some super} + (list.partial super (array.list {.#None} (java/lang/Class::getGenericInterfaces source_class))) + + {.#None} + (if (java/lang/reflect/Modifier::isInterface (java/lang/Class::getModifiers source_class)) + {.#Item (as java/lang/reflect/Type (ffi.class_for java/lang/Object)) + (array.list {.#None} (java/lang/Class::getGenericInterfaces source_class))} + (array.list {.#None} (java/lang/Class::getGenericInterfaces source_class))))))) + +(def (inheritance_candidate_parents class_loader fromT target_class toT fromC) + (-> java/lang/ClassLoader .Type (java/lang/Class java/lang/Object) .Type Code (Operation (List [[Text .Type] Bit]))) + (case fromT + {.#Primitive _ (list.partial self_classT super_classT super_interfacesT+)} + (monad.each phase.monad + (function (_ superT) + (do [! phase.monad] + [super_name (at ! each ..reflection (check_jvm superT)) + super_class (phase.lifted (reflection!.load class_loader super_name))] + (in [[super_name superT] + (java/lang/Class::isAssignableFrom super_class target_class)]))) + (list.partial super_classT super_interfacesT+)) + + _ + (/////analysis.except ..cannot_cast [fromT toT fromC]))) + +(def (object::cast class_loader) + (-> java/lang/ClassLoader Handler) + (function (_ extension_name analyse archive args) + (case args + (list fromC) + (do [! phase.monad] + [toT (///.lifted meta.expected_type) + target_name (at ! each ..reflection (check_jvm toT)) + [fromT fromA] (typeA.inferring + (analyse archive fromC)) + source_name (at ! each ..reflection (check_jvm fromT)) + can_cast? (is (Operation Bit) + (`` (cond (,, (with_template [ ] + [(let [=primitive (reflection.reflection )] + (or (and (text#= =primitive source_name) + (or (text#= target_name) + (text#= =primitive target_name))) + (and (text#= source_name) + (text#= =primitive target_name)))) + (in true)] + + [reflection.boolean box.boolean] + [reflection.byte box.byte] + [reflection.short box.short] + [reflection.int box.int] + [reflection.long box.long] + [reflection.float box.float] + [reflection.double box.double] + [reflection.char box.char])) + + ... else + (do ! + [_ (phase.assertion ..primitives_are_not_objects [source_name] + (not (dictionary.key? ..boxes source_name))) + _ (phase.assertion ..primitives_are_not_objects [target_name] + (not (dictionary.key? ..boxes target_name))) + target_class (phase.lifted (reflection!.load class_loader target_name)) + _ (do ! + [source_class (phase.lifted (reflection!.load class_loader source_name))] + (phase.assertion ..cannot_cast [fromT toT fromC] + (java/lang/Class::isAssignableFrom source_class target_class)))] + (loop (again [[current_name currentT] [source_name fromT]]) + (if (text#= target_name current_name) + (in true) + (do ! + [candidate_parents (is (Operation (List [[Text .Type] Bit])) + (class_candidate_parents class_loader current_name currentT target_name target_class))] + (case (|> candidate_parents + (list.only product.right) + (list#each product.left)) + {.#Item [next_name nextT] _} + (again [next_name nextT]) + + {.#End} + (in false)))))))))] + (if can_cast? + (in {/////analysis.#Extension extension_name (list (/////analysis.text source_name) + (/////analysis.text target_name) + fromA)}) + (/////analysis.except ..cannot_cast [fromT toT fromC]))) + + _ + (/////analysis.except ///.invalid_syntax [extension_name %.code args])))) + +(def (bundle::object class_loader) + (-> java/lang/ClassLoader Bundle) + (<| (///bundle.prefix "object") + (|> ///bundle.empty + (///bundle.install "null" object::null) + (///bundle.install "null?" object::null?) + (///bundle.install "synchronized" object::synchronized) + (///bundle.install "throw" (object::throw class_loader)) + (///bundle.install "class" (object::class class_loader)) + (///bundle.install "instance?" (object::instance? class_loader)) + (///bundle.install "cast" (object::cast class_loader)) + ))) + +(def (get::static class_loader) + (-> java/lang/ClassLoader Handler) + (..custom + [..member + (function (_ extension_name analyse archive [class field]) + (do phase.monad + [_ (..ensure_fresh_class! class_loader class) + [final? deprecated? fieldJT] (phase.lifted + (do try.monad + [class (reflection!.load class_loader class)] + (reflection!.static_field field class))) + _ (phase.assertion ..deprecated_field [class field] + (not deprecated?)) + fieldT (reflection_type luxT.fresh fieldJT) + _ (typeA.inference fieldT)] + (in (<| {/////analysis.#Extension extension_name} + (list (/////analysis.text class) + (/////analysis.text field) + (/////analysis.text (..signature fieldJT)))))))])) + +(def (put::static class_loader) + (-> java/lang/ClassLoader Handler) + (..custom + [(all <>.and ..member .any) + (function (_ extension_name analyse archive [[class field] valueC]) + (do phase.monad + [_ (..ensure_fresh_class! class_loader class) + _ (typeA.inference Any) + [final? deprecated? fieldJT] (phase.lifted + (do try.monad + [class (reflection!.load class_loader class)] + (reflection!.static_field field class))) + _ (phase.assertion ..deprecated_field [class field] + (not deprecated?)) + ... _ (phase.assertion ..cannot_set_a_final_field [class field] + ... (not final?)) + fieldT (reflection_type luxT.fresh fieldJT) + valueA (<| (typeA.expecting fieldT) + (analyse archive valueC))] + (in (<| {/////analysis.#Extension extension_name} + (list (/////analysis.text class) + (/////analysis.text field) + (/////analysis.text (..signature fieldJT)) + valueA)))))])) + +(def (get::virtual class_loader) + (-> java/lang/ClassLoader Handler) + (..custom + [(all <>.and ..member .any) + (function (_ extension_name analyse archive [[class field] objectC]) + (do phase.monad + [_ (..ensure_fresh_class! class_loader class) + [objectT objectA] (typeA.inferring + (analyse archive objectC)) + [deprecated? mapping fieldJT] (phase.lifted + (do try.monad + [class (reflection!.load class_loader class) + [final? deprecated? fieldJT] (reflection!.virtual_field field class) + mapping (reflection!.correspond class objectT)] + (in [deprecated? mapping fieldJT]))) + _ (phase.assertion ..deprecated_field [class field] + (not deprecated?)) + fieldT (reflection_type mapping fieldJT) + _ (typeA.inference fieldT)] + (in (<| {/////analysis.#Extension extension_name} + (list (/////analysis.text class) + (/////analysis.text field) + (/////analysis.text (..signature fieldJT)) + objectA)))))])) + +(def (put::virtual class_loader) + (-> java/lang/ClassLoader Handler) + (..custom + [(all <>.and ..member .any .any) + (function (_ extension_name analyse archive [[class field] valueC objectC]) + (do phase.monad + [_ (..ensure_fresh_class! class_loader class) + [objectT objectA] (typeA.inferring + (analyse archive objectC)) + _ (typeA.inference objectT) + [final? deprecated? mapping fieldJT] (phase.lifted + (do try.monad + [class (reflection!.load class_loader class) + [final? deprecated? fieldJT] (reflection!.virtual_field field class) + mapping (reflection!.correspond class objectT)] + (in [final? deprecated? mapping fieldJT]))) + _ (phase.assertion ..deprecated_field [class field] + (not deprecated?)) + _ (phase.assertion ..cannot_set_a_final_field [class field] + (not final?)) + fieldT (reflection_type mapping fieldJT) + valueA (<| (typeA.expecting fieldT) + (analyse archive valueC))] + (in (<| {/////analysis.#Extension extension_name} + (list (/////analysis.text class) + (/////analysis.text field) + (/////analysis.text (..signature fieldJT)) + valueA + objectA)))))])) + +(.type Method_Style + (Variant + {#Static} + {#Abstract} + {#Virtual} + {#Special} + {#Interface})) + +(def (de_aliased aliasing) + (-> Aliasing (Type Value) (Type Value)) + (function (again it) + (`` (<| (case (parser.var? it) + {.#Some name} + (|> aliasing + (dictionary.value name) + (maybe#each jvm.var) + (maybe.else it)) + {.#None}) + (case (parser.class? it) + {.#Some [name parameters]} + (|> parameters + (list#each (|>> again (as (Type Parameter)))) + (jvm.class name)) + {.#None}) + (,, (with_template [ ] + [(case ( it) + {.#Some :sub:} + ( (as (Type ) (again :sub:))) + {.#None})] + + [parser.array? Value jvm.array] + [parser.lower? Class jvm.lower] + [parser.upper? Class jvm.upper] + )) + it)))) + +(def (check_method aliasing class method_name method_style inputsJT method) + (-> Aliasing (java/lang/Class java/lang/Object) Text Method_Style (List (Type Value)) java/lang/reflect/Method (Operation Bit)) + (do phase.monad + [parameters (|> (java/lang/reflect/Method::getGenericParameterTypes method) + (array.list {.#None}) + (monad.each try.monad reflection!.type) + phase.lifted) + .let [modifiers (java/lang/reflect/Method::getModifiers method) + correct_class? (java/lang/Class::isAssignableFrom class (java/lang/reflect/Method::getDeclaringClass method)) + correct_method? (text#= method_name (java/lang/reflect/Method::getName method)) + same_static? (case method_style + {#Static} + (java/lang/reflect/Modifier::isStatic modifiers) + + _ + true) + same_special? (case method_style + {#Special} + (not (or (java/lang/reflect/Modifier::isInterface (java/lang/Class::getModifiers class)) + (java/lang/reflect/Modifier::isAbstract modifiers))) + + _ + true) + same_inputs? (and (n.= (list.size inputsJT) + (list.size parameters)) + (list.every? (function (_ [expectedJC actualJC]) + (jvm#= expectedJC (de_aliased aliasing actualJC))) + (list.zipped_2 parameters inputsJT)))]] + (in (and correct_class? + correct_method? + same_static? + same_special? + same_inputs?)))) + +(def (check_constructor aliasing class inputsJT constructor) + (-> Aliasing (java/lang/Class java/lang/Object) (List (Type Value)) (java/lang/reflect/Constructor java/lang/Object) (Operation Bit)) + (do phase.monad + [parameters (|> (java/lang/reflect/Constructor::getGenericParameterTypes constructor) + (array.list {.#None}) + (monad.each try.monad reflection!.type) + phase.lifted)] + (in (and (java/lang/Object::equals class (java/lang/reflect/Constructor::getDeclaringClass constructor)) + (n.= (list.size inputsJT) (list.size parameters)) + (list.every? (function (_ [expectedJC actualJC]) + (jvm#= expectedJC (de_aliased aliasing actualJC))) + (list.zipped_2 parameters inputsJT)))))) + +(def index_parameter + (-> Nat .Type) + (|>> (n.* 2) ++ {.#Parameter})) + +(def (jvm_type_var_mapping owner_tvars method_tvars) + (-> (List Text) (List Text) [(List .Type) Mapping]) + (let [jvm_tvars (list#composite owner_tvars method_tvars) + lux_tvars (|> jvm_tvars + list.reversed + list.enumeration + (list#each (function (_ [idx name]) + [name (index_parameter idx)])) + list.reversed) + num_owner_tvars (list.size owner_tvars) + owner_tvarsT (|> lux_tvars (list.first num_owner_tvars) (list#each product.right)) + mapping (dictionary.of_list text.hash lux_tvars)] + [owner_tvarsT mapping])) + +(def (lux_class it) + (-> (java/lang/Class java/lang/Object) (Type Class)) + (jvm.class (java/lang/Class::getName it) (list))) + +(with_template [ ] + [(`` (def + (-> ( (,, (template.spliced ))) (List (Type Class))) + (|>> (,, (template.symbol [ "::getExceptionTypes"])) + (array.list {.#None}) + (list#each ..lux_class))))] + + [concrete_method_exceptions java/lang/reflect/Method []] + [concrete_constructor_exceptions java/lang/reflect/Constructor [java/lang/Object]] + ) + +(def (return_type it) + (-> java/lang/reflect/Method (Try (Type Return))) + (reflection!.return + (case (java/lang/reflect/Method::getGenericReturnType it) + {.#Some it} + it + + {.#None} + (java/lang/reflect/Method::getReturnType it)))) + +(def (method_signature method_style method) + (-> Method_Style java/lang/reflect/Method (Operation Method_Signature)) + (let [owner (java/lang/reflect/Method::getDeclaringClass method) + owner_tvars (case method_style + {#Static} + (list) + + _ + (|> (java/lang/Class::getTypeParameters owner) + (array.list {.#None}) + (list#each (|>> java/lang/reflect/TypeVariable::getName)))) + method_tvars (|> (java/lang/reflect/Method::getTypeParameters method) + (array.list {.#None}) + (list#each (|>> java/lang/reflect/TypeVariable::getName))) + [owner_tvarsT mapping] (jvm_type_var_mapping owner_tvars method_tvars)] + (do [! phase.monad] + [inputsT (|> (java/lang/reflect/Method::getGenericParameterTypes method) + (array.list {.#None}) + (monad.each ! (|>> reflection!.type phase.lifted)) + (phase#each (monad.each ! (..reflection_type mapping))) + phase#conjoint) + outputT (|> method + ..return_type + phase.lifted + (phase#each (..reflection_return mapping)) + phase#conjoint) + .let [concrete_exceptions (..concrete_method_exceptions method)] + concrete_exceptions (monad.each ! (..reflection_type mapping) concrete_exceptions) + generic_exceptions (|> (java/lang/reflect/Method::getGenericExceptionTypes method) + (array.list {.#None}) + (monad.each ! (|>> reflection!.type phase.lifted)) + (phase#each (monad.each ! (..reflection_type mapping))) + phase#conjoint) + .let [methodT (<| (type.univ_q (dictionary.size mapping)) + (type.function (case method_style + {#Static} + inputsT + + _ + (list.partial {.#Primitive (java/lang/Class::getName owner) owner_tvarsT} + inputsT))) + outputT)]] + (in [methodT + (reflection!.deprecated? (java/lang/reflect/Method::getDeclaredAnnotations method)) + (if (list.empty? generic_exceptions) + concrete_exceptions + generic_exceptions)])))) + +(def (constructor_signature constructor) + (-> (java/lang/reflect/Constructor java/lang/Object) (Operation Method_Signature)) + (let [owner (java/lang/reflect/Constructor::getDeclaringClass constructor) + owner_tvars (|> (java/lang/Class::getTypeParameters owner) + (array.list {.#None}) + (list#each (|>> java/lang/reflect/TypeVariable::getName))) + method_tvars (|> (java/lang/reflect/Constructor::getTypeParameters constructor) + (array.list {.#None}) + (list#each (|>> java/lang/reflect/TypeVariable::getName))) + [owner_tvarsT mapping] (jvm_type_var_mapping owner_tvars method_tvars)] + (do [! phase.monad] + [inputsT (|> (java/lang/reflect/Constructor::getGenericParameterTypes constructor) + (array.list {.#None}) + (monad.each ! (|>> reflection!.type phase.lifted)) + (phase#each (monad.each ! (reflection_type mapping))) + phase#conjoint) + .let [concrete_exceptions (..concrete_constructor_exceptions constructor)] + concrete_exceptions (monad.each ! (..reflection_type mapping) concrete_exceptions) + generic_exceptions (|> (java/lang/reflect/Constructor::getGenericExceptionTypes constructor) + (array.list {.#None}) + (monad.each ! (|>> reflection!.type phase.lifted)) + (phase#each (monad.each ! (reflection_type mapping))) + phase#conjoint) + .let [objectT {.#Primitive (java/lang/Class::getName owner) owner_tvarsT} + constructorT (<| (type.univ_q (dictionary.size mapping)) + (type.function inputsT) + objectT)]] + (in [constructorT + (reflection!.deprecated? (java/lang/reflect/Constructor::getDeclaredAnnotations constructor)) + (if (list.empty? generic_exceptions) + concrete_exceptions + generic_exceptions)])))) + +(.type Evaluation + (Variant + {#Pass Method_Signature} + {#Hint Method_Signature})) + +(with_template [ ] + [(def + (-> Evaluation (Maybe Method_Signature)) + (|>> (pipe.case + { output} + {.#Some output} + + _ + {.#None})))] + + [pass #Pass] + [hint #Hint] + ) + +(with_template [ ] + [(def + (-> (List (Type Var))) + (|>> + (array.list {.#None}) + (list#each (|>> java/lang/reflect/TypeVariable::getName jvm.var))))] + + [class_type_variables (java/lang/Class java/lang/Object) java/lang/Class::getTypeParameters] + [constructor_type_variables (java/lang/reflect/Constructor java/lang/Object) java/lang/reflect/Constructor::getTypeParameters] + [method_type_variables java/lang/reflect/Method java/lang/reflect/Method::getTypeParameters] + ) + +(def (aliasing expected actual) + (-> (List (Type Var)) (List (Type Var)) Aliasing) + (|> (list.zipped_2 (list#each parser.name actual) + (list#each parser.name expected)) + (dictionary.of_list text.hash))) + +(def (family_tree' it) + (-> (java/lang/Class java/lang/Object) + (List (java/lang/Class java/lang/Object))) + (let [interfaces (array.list {.#None} (java/lang/Class::getInterfaces it)) + supers (case (java/lang/Class::getSuperclass it) + {.#Some class} + (list.partial class interfaces) + + {.#None} + interfaces)] + (|> supers + (list#each family_tree') + list#conjoint + (list.partial it)))) + +(def family_tree + (-> (java/lang/Class java/lang/Object) + (List (java/lang/Class java/lang/Object))) + (|>> ..family_tree' + ... De-duplication + (list#mix (function (_ class all) + (dictionary.has (java/lang/Class::getName class) class all)) + (dictionary.empty text.hash)) + dictionary.values)) + +(def (all_declared_methods it) + (-> (java/lang/Class java/lang/Object) + (List java/lang/reflect/Method)) + (|> it + ..family_tree + (list#each (|>> java/lang/Class::getDeclaredMethods (array.list {.#None}))) + list#conjoint)) + +(def (method_candidate allow_inheritance? class_loader actual_class_tvars class_name actual_method_tvars method_name method_style inputsJT) + (-> Bit java/lang/ClassLoader (List (Type Var)) External (List (Type Var)) Text Method_Style (List (Type Value)) (Operation Method_Signature)) + (do [! phase.monad] + [class (phase.lifted (reflection!.load class_loader class_name)) + .let [expected_class_tvars (class_type_variables class)] + candidates (|> (if allow_inheritance? + (all_declared_methods class) + (array.list {.#None} (java/lang/Class::getDeclaredMethods class))) + (list.only (|>> java/lang/reflect/Method::getName (text#= method_name))) + (monad.each ! (is (-> java/lang/reflect/Method (Operation Evaluation)) + (function (_ method) + (do ! + [.let [expected_method_tvars (method_type_variables method) + aliasing (dictionary.composite (..aliasing expected_class_tvars actual_class_tvars) + (..aliasing expected_method_tvars actual_method_tvars))] + passes? (check_method aliasing class method_name method_style inputsJT method)] + (at ! each (if passes? + (|>> {#Pass}) + (|>> {#Hint})) + (method_signature method_style method)))))))] + (case (list.all pass candidates) + {.#Item method {.#End}} + (in method) + + {.#End} + (/////analysis.except ..no_candidates [actual_class_tvars class_name method_name actual_method_tvars inputsJT (list.all hint candidates)]) + + {.#Item method alternatives} + (if allow_inheritance? + (in method) + (/////analysis.except ..too_many_candidates [actual_class_tvars class_name method_name actual_method_tvars inputsJT (list.partial method alternatives)]))))) + +(def constructor_method + "") + +(def (constructor_candidate class_loader actual_class_tvars class_name actual_method_tvars inputsJT) + (-> java/lang/ClassLoader (List (Type Var)) External (List (Type Var)) (List (Type Value)) (Operation Method_Signature)) + (do [! phase.monad] + [class (phase.lifted (reflection!.load class_loader class_name)) + .let [expected_class_tvars (class_type_variables class)] + candidates (|> class + java/lang/Class::getConstructors + (array.list {.#None}) + (monad.each ! (function (_ constructor) + (do ! + [.let [expected_method_tvars (constructor_type_variables constructor) + aliasing (dictionary.composite (..aliasing expected_class_tvars actual_class_tvars) + (..aliasing expected_method_tvars actual_method_tvars))] + passes? (check_constructor aliasing class inputsJT constructor)] + (at ! each + (if passes? + (|>> {#Pass}) + (|>> {#Hint})) + (constructor_signature constructor))))))] + (case (list.all pass candidates) + {.#Item constructor {.#End}} + (in constructor) + + {.#End} + (/////analysis.except ..no_candidates [actual_class_tvars class_name ..constructor_method actual_method_tvars inputsJT (list.all hint candidates)]) + + candidates + (/////analysis.except ..too_many_candidates [actual_class_tvars class_name ..constructor_method actual_method_tvars inputsJT candidates])))) + +(with_template [ ] + [(def .public + (Parser (Type )) + (.then .text))] + + [var Var parser.var] + [class Class parser.class] + [type Value parser.value] + [return Return parser.return] + ) + +(def input + (Parser (Typed Code)) + (.tuple (<>.and ..type .any))) + +(def (decorate_inputs typesT inputsA) + (-> (List (Type Value)) (List Analysis) (List Analysis)) + (|> inputsA + (list.zipped_2 (list#each (|>> ..signature /////analysis.text) typesT)) + (list#each (function (_ [type value]) + (/////analysis.tuple (list type value)))))) + +(def type_vars + (.tuple (<>.some ..var))) + +(def (invoke::static class_loader) + (-> java/lang/ClassLoader Handler) + (..custom + [(all <>.and ..type_vars ..member ..type_vars (<>.some ..input)) + (function (_ extension_name analyse archive [class_tvars [class method] method_tvars argsTC]) + (do phase.monad + [_ (..ensure_fresh_class! class_loader class) + .let [argsT (list#each product.left argsTC)] + [methodT deprecated? exceptionsT] (..method_candidate false class_loader class_tvars class method_tvars method {#Static} argsT) + _ (phase.assertion ..deprecated_method [class method methodT] + (not deprecated?)) + [outputT argsA] (inference.general archive analyse methodT (list#each product.right argsTC)) + outputJT (check_return outputT)] + (in {/////analysis.#Extension extension_name (list.partial (/////analysis.text (..signature (jvm.class class (list)))) + (/////analysis.text method) + (/////analysis.text (..signature outputJT)) + (decorate_inputs argsT argsA))})))])) + +(def (invoke::virtual class_loader) + (-> java/lang/ClassLoader Handler) + (..custom + [(all <>.and ..type_vars ..member ..type_vars .any (<>.some ..input)) + (function (_ extension_name analyse archive [class_tvars [class method] method_tvars objectC argsTC]) + (do phase.monad + [_ (..ensure_fresh_class! class_loader class) + .let [argsT (list#each product.left argsTC)] + [methodT deprecated? exceptionsT] (..method_candidate true class_loader class_tvars class method_tvars method {#Virtual} argsT) + _ (phase.assertion ..deprecated_method [class method methodT] + (not deprecated?)) + [outputT allA] (inference.general archive analyse methodT (list.partial objectC (list#each product.right argsTC))) + .let [[objectA argsA] (case allA + {.#Item objectA argsA} + [objectA argsA] + + _ + (undefined))] + outputJT (check_return outputT)] + (in {/////analysis.#Extension extension_name (list.partial (/////analysis.text (..signature (jvm.class class (list)))) + (/////analysis.text method) + (/////analysis.text (..signature outputJT)) + objectA + (decorate_inputs argsT argsA))})))])) + +(def (invoke::special class_loader) + (-> java/lang/ClassLoader Handler) + (..custom + [(all <>.and ..type_vars ..member ..type_vars .any (<>.some ..input)) + (function (_ extension_name analyse archive [class_tvars [class method] method_tvars objectC argsTC]) + (do phase.monad + [_ (..ensure_fresh_class! class_loader class) + .let [argsT (list#each product.left argsTC)] + [methodT deprecated? exceptionsT] (..method_candidate false class_loader class_tvars class method_tvars method {#Special} argsT) + _ (phase.assertion ..deprecated_method [class method methodT] + (not deprecated?)) + [outputT allA] (inference.general archive analyse methodT (list.partial objectC (list#each product.right argsTC))) + .let [[objectA argsA] (case allA + {.#Item objectA argsA} + [objectA argsA] + + _ + (undefined))] + outputJT (check_return outputT)] + (in {/////analysis.#Extension extension_name (list.partial (/////analysis.text (..signature (jvm.class class (list)))) + (/////analysis.text method) + (/////analysis.text (..signature outputJT)) + objectA + (decorate_inputs argsT argsA))})))])) + +(def (invoke::interface class_loader) + (-> java/lang/ClassLoader Handler) + (..custom + [(all <>.and ..type_vars ..member ..type_vars .any (<>.some ..input)) + (function (_ extension_name analyse archive [class_tvars [class_name method] method_tvars objectC argsTC]) + (do phase.monad + [_ (..ensure_fresh_class! class_loader class_name) + .let [argsT (list#each product.left argsTC)] + class (phase.lifted (reflection!.load class_loader class_name)) + _ (phase.assertion non_interface class_name + (java/lang/reflect/Modifier::isInterface (java/lang/Class::getModifiers class))) + [methodT deprecated? exceptionsT] (..method_candidate true class_loader class_tvars class_name method_tvars method {#Interface} argsT) + _ (phase.assertion ..deprecated_method [class_name method methodT] + (not deprecated?)) + [outputT allA] (inference.general archive analyse methodT (list.partial objectC (list#each product.right argsTC))) + .let [[objectA argsA] (case allA + {.#Item objectA argsA} + [objectA argsA] + + _ + (undefined))] + outputJT (check_return outputT)] + (in {/////analysis.#Extension extension_name + (list.partial (/////analysis.text (..signature (jvm.class class_name (list)))) + (/////analysis.text method) + (/////analysis.text (..signature outputJT)) + objectA + (decorate_inputs argsT argsA))})))])) + +(def (invoke::constructor class_loader) + (-> java/lang/ClassLoader Handler) + (..custom + [(all <>.and ..type_vars .text ..type_vars (<>.some ..input)) + (function (_ extension_name analyse archive [class_tvars class method_tvars argsTC]) + (do phase.monad + [_ (..ensure_fresh_class! class_loader class) + .let [argsT (list#each product.left argsTC)] + [methodT deprecated? exceptionsT] (..constructor_candidate class_loader class_tvars class method_tvars argsT) + _ (phase.assertion ..deprecated_method [class ..constructor_method methodT] + (not deprecated?)) + [outputT argsA] (inference.general archive analyse methodT (list#each product.right argsTC))] + (in {/////analysis.#Extension extension_name (list.partial (/////analysis.text (..signature (jvm.class class (list)))) + (decorate_inputs argsT argsA))})))])) + +(def (bundle::member class_loader) + (-> java/lang/ClassLoader Bundle) + (<| (///bundle.prefix "member") + (|> ///bundle.empty + (dictionary.composite (<| (///bundle.prefix "get") + (|> ///bundle.empty + (///bundle.install "static" (get::static class_loader)) + (///bundle.install "virtual" (get::virtual class_loader))))) + (dictionary.composite (<| (///bundle.prefix "put") + (|> ///bundle.empty + (///bundle.install "static" (put::static class_loader)) + (///bundle.install "virtual" (put::virtual class_loader))))) + (dictionary.composite (<| (///bundle.prefix "invoke") + (|> ///bundle.empty + (///bundle.install "static" (invoke::static class_loader)) + (///bundle.install "virtual" (invoke::virtual class_loader)) + (///bundle.install "special" (invoke::special class_loader)) + (///bundle.install "interface" (invoke::interface class_loader)) + (///bundle.install "constructor" (invoke::constructor class_loader)) + ))) + ))) + +(.type .public (Annotation_Parameter a) + [Text a]) + +(def annotation_parameter + (Parser (Annotation_Parameter Code)) + (.tuple (<>.and .text .any))) + +(.type .public (Annotation a) + [Text (List (Annotation_Parameter a))]) + +(def .public annotation + (Parser (Annotation Code)) + (.form (<>.and .text (<>.some ..annotation_parameter)))) + +(def .public argument + (Parser Argument) + (.tuple (<>.and .text ..type))) + +(def (annotation_parameter_analysis [name value]) + (-> (Annotation_Parameter Analysis) Analysis) + (/////analysis.tuple (list (/////analysis.text name) value))) + +(def (annotation_analysis [name parameters]) + (-> (Annotation Analysis) Analysis) + (/////analysis.tuple (list.partial (/////analysis.text name) + (list#each annotation_parameter_analysis parameters)))) + +(with_template [ ] + [(def + (-> (Type ) Analysis) + (|>> ..signature /////analysis.text))] + + [var_analysis Var] + [class_analysis Class] + [value_analysis Value] + [return_analysis Return] + ) + +(def (typed_analysis [type term]) + (-> (Typed Analysis) Analysis) + (/////analysis.tuple (list (value_analysis type) term))) + +(def (argument_analysis [argument argumentJT]) + (-> Argument Analysis) + (/////analysis.tuple + (list (/////analysis.text argument) + (value_analysis argumentJT)))) + +(with_template [ ] + [(def ( [type class]) + (-> [(Type Class) (java/lang/Class java/lang/Object)] + (Try (List [(Type Class) Text (Type Method)]))) + (|> class + + (list.only (|>> java/lang/reflect/Method::getModifiers + (predicate.or (|>> java/lang/reflect/Modifier::isPublic) + (|>> java/lang/reflect/Modifier::isProtected)))) + + (monad.each try.monad + (function (_ method) + (do [! try.monad] + [.let [type_variables (|> (java/lang/reflect/Method::getTypeParameters method) + (array.list {.#None}) + (list#each (|>> java/lang/reflect/TypeVariable::getName + jvm.var)))] + inputs (|> (java/lang/reflect/Method::getGenericParameterTypes method) + (array.list {.#None}) + (monad.each ! reflection!.type)) + return (..return_type method) + .let [concrete_exceptions (..concrete_method_exceptions method)] + generic_exceptions (|> (java/lang/reflect/Method::getGenericExceptionTypes method) + (array.list {.#None}) + (monad.each ! reflection!.class))] + (in [type + (java/lang/reflect/Method::getName method) + (jvm.method [type_variables inputs return (if (list.empty? generic_exceptions) + concrete_exceptions + generic_exceptions)])]))))))] + + [abstract_methods (list.only (|>> java/lang/reflect/Method::getModifiers java/lang/reflect/Modifier::isAbstract)) + (<| (array.list {.#None}) java/lang/Class::getDeclaredMethods)] + [methods (<|) + ..all_declared_methods] + ) + +(def jvm_package_separator ".") + +(with_template [ ] + [(def ( class_loader) + (-> java/lang/ClassLoader (List (Type Class)) (Try (List [(Type Class) Text (Type Method)]))) + (|>> (monad.each try.monad (function (_ type) + (|> type + ..reflection + (reflection!.load class_loader) + (try#each (|>> [type]))))) + (try#each (monad.each try.monad )) + try#conjoint + (try#each list#conjoint)))] + + [all_abstract_methods ..abstract_methods] + [all_methods ..methods] + ) + +(with_template [] + [(exception .public ( [expected (List [(Type Class) Text (Type Method)]) + actual (List [(Type Class) Text (Type Method)])]) + (let [%method (is (%.Format [(Type Class) Text (Type Method)]) + (function (_ [super name type]) + (format (..signature super) " :: " (%.text name) " " (..signature type))))] + (exception.report + "Expected Methods" (exception.listing %method expected) + "Actual Methods" (exception.listing %method actual))))] + + [missing_abstract_methods] + [invalid_overriden_methods] + ) + +(.type .public Visibility + (Variant + {#Public} + {#Private} + {#Protected} + {#Default})) + +(.type .public Finality Bit) +(.type .public Strictness Bit) + +(def .public public_tag "public") +(def .public private_tag "private") +(def .public protected_tag "protected") +(def .public default_tag "default") + +(def .public visibility' + (.Parser Visibility) + (all <>.or + (.this ..public_tag) + (.this ..private_tag) + (.this ..protected_tag) + (.this ..default_tag) + )) + +(def .public visibility + (Parser Visibility) + (.then ..visibility' .text)) + +(def .public (visibility_analysis visibility) + (-> Visibility Analysis) + (/////analysis.text (case visibility + {#Public} ..public_tag + {#Private} ..private_tag + {#Protected} ..protected_tag + {#Default} ..default_tag))) + +(.type Exception + (Type Class)) + +(def .public parameter_types + (-> (List (Type Var)) (Check (List [(Type Var) .Type]))) + (monad.each check.monad + (function (_ parameterJ) + (do check.monad + [[_ parameterT] check.existential] + (in [parameterJ parameterT]))))) + +(.type .public (Abstract_Method a) + [Text + Visibility + (List (Annotation a)) + (List (Type Var)) + (List Argument) + (Type Return) + (List Exception)]) + +(def .public abstract_tag "abstract") + +(def .public abstract_method_definition + (Parser (Abstract_Method Code)) + (<| .form + (<>.after (.this_text ..abstract_tag)) + (all <>.and + .text + ..visibility + (.tuple (<>.some ..annotation)) + (.tuple (<>.some ..var)) + (.tuple (<>.some ..argument)) + ..return + (.tuple (<>.some ..class))))) + +(def (method_mapping of_class parameters) + (-> Mapping (List (Type Var)) (Check Mapping)) + (|> parameters + ..parameter_types + (check#each (list#mix (function (_ [parameterJ parameterT] mapping) + (dictionary.has (parser.name parameterJ) parameterT mapping)) + of_class)))) + +(def class_mapping + (-> (List (Type Var)) (Check Mapping)) + (..method_mapping luxT.fresh)) + +(def .public (analyse_abstract_method analyse archive method) + (-> Phase Archive (Abstract_Method Code) (Operation Analysis)) + (let [[method_name visibility annotations vars arguments return exceptions] method] + (do [! phase.monad] + [mapping (typeA.check (method_mapping luxT.fresh vars)) + annotationsA (monad.each ! (function (_ [name parameters]) + (do ! + [parametersA (monad.each ! (function (_ [name value]) + (do ! + [valueA (analyse archive value)] + (in [name valueA]))) + parameters)] + (in [name parametersA]))) + annotations)] + (in (/////analysis.tuple (list (/////analysis.text ..abstract_tag) + (/////analysis.text method_name) + (visibility_analysis visibility) + (/////analysis.tuple (list#each annotation_analysis annotationsA)) + (/////analysis.tuple (list#each var_analysis vars)) + (/////analysis.tuple (list#each ..argument_analysis arguments)) + (return_analysis return) + (/////analysis.tuple (list#each class_analysis exceptions)) + )))))) + +(.type .public (Constructor a) + [Visibility + Strictness + (List (Annotation a)) + (List (Type Var)) + (List Exception) + Text + (List Argument) + (List (Typed a)) + a]) + +(def .public constructor_tag "init") + +(def .public constructor_definition + (Parser (Constructor Code)) + (<| .form + (<>.after (.this_text ..constructor_tag)) + (all <>.and + ..visibility + .bit + (.tuple (<>.some ..annotation)) + (.tuple (<>.some ..var)) + (.tuple (<>.some ..class)) + .text + (.tuple (<>.some ..argument)) + (.tuple (<>.some ..input)) + .any))) + +(def (with_fake_parameter#pattern it) + (-> pattern.Pattern pattern.Pattern) + (case it + {pattern.#Simple _} + it + + {pattern.#Complex it} + {pattern.#Complex + (case it + {complex.#Variant it} + {complex.#Variant (revised complex.#value with_fake_parameter#pattern it)} + + {complex.#Tuple it} + {complex.#Tuple (list#each with_fake_parameter#pattern it)})} + + {pattern.#Bind it} + {pattern.#Bind (++ it)})) + +(def (with_fake_parameter it) + (-> Analysis Analysis) + (case it + {/////analysis.#Simple _} + it + + {/////analysis.#Structure it} + {/////analysis.#Structure + (case it + {complex.#Variant it} + {complex.#Variant (revised complex.#value with_fake_parameter it)} + + {complex.#Tuple it} + {complex.#Tuple (list#each with_fake_parameter it)})} + + {/////analysis.#Reference it} + {/////analysis.#Reference + (case it + {reference.#Variable it} + {reference.#Variable + (case it + {variable.#Local it} + {variable.#Local (++ it)} + + {variable.#Foreign _} + it)} + + {reference.#Constant _} + it)} + + {/////analysis.#Case value [head tail]} + {/////analysis.#Case (with_fake_parameter value) + (let [with_fake_parameter (is (-> /////analysis.Branch /////analysis.Branch) + (|>> (revised /////analysis.#when with_fake_parameter#pattern) + (revised /////analysis.#then with_fake_parameter)))] + [(with_fake_parameter head) + (list#each with_fake_parameter tail)])} + + {/////analysis.#Function environment body} + {/////analysis.#Function (list#each with_fake_parameter environment) + body} + + {/////analysis.#Apply parameter abstraction} + {/////analysis.#Apply (with_fake_parameter parameter) + (with_fake_parameter abstraction)} + + {/////analysis.#Extension name parameters} + {/////analysis.#Extension name + (list#each with_fake_parameter parameters)})) + +(def .public (hidden_method_body arity bodyA) + (-> Nat Analysis Analysis) + (<| /////analysis.tuple + (list (/////analysis.unit)) + (case arity + (^.or 0 1) + bodyA + + 2 + (let [forced_refencing (/////analysis.tuple (list#each (|>> /////analysis.local) (list.indices (++ arity))))] + {/////analysis.#Case (/////analysis.unit) + [[/////analysis.#when + {pattern.#Bind 2} + + /////analysis.#then + (/////analysis.tuple (list forced_refencing bodyA))] + (list)]}) + + _ + (let [forced_refencing (/////analysis.tuple (list#each (|>> /////analysis.local) (list.indices (++ arity))))] + {/////analysis.#Case (/////analysis.unit) + [[/////analysis.#when + {pattern.#Complex + {complex.#Tuple + (|> (-- arity) + list.indices + (list#each (|>> (n.+ 2) {pattern.#Bind})))}} + + /////analysis.#then + (/////analysis.tuple (list forced_refencing bodyA))] + (list)]})))) + +(def .public (analyse_constructor_method analyse archive selfT mapping method) + (-> Phase Archive .Type Mapping (Constructor Code) (Operation Analysis)) + (let [[visibility strict_fp? + annotations vars exceptions + self_name arguments super_arguments body] method] + (do [! phase.monad] + [mapping (typeA.check (method_mapping mapping vars)) + annotationsA (monad.each ! (function (_ [name parameters]) + (do ! + [parametersA (monad.each ! (function (_ [name value]) + (do ! + [valueA (analyse archive value)] + (in [name valueA]))) + parameters)] + (in [name parametersA]))) + annotations) + super_arguments (monad.each ! (function (_ [jvmT super_argC]) + (do ! + [luxT (reflection_type mapping jvmT) + super_argA (<| (typeA.expecting luxT) + (analyse archive super_argC))] + (in [jvmT super_argA]))) + super_arguments) + arguments' (monad.each ! + (function (_ [name jvmT]) + (do ! + [luxT (boxed_reflection_type mapping jvmT)] + (in [name luxT]))) + arguments) + [scope bodyA] (|> arguments' + {.#Item [self_name selfT]} + list.reversed + (list#mix scope.with_local (analyse archive body)) + (typeA.expecting .Any) + scope.with) + .let [arity (list.size arguments)]] + (in (/////analysis.tuple (list (/////analysis.text ..constructor_tag) + (visibility_analysis visibility) + (/////analysis.bit strict_fp?) + (/////analysis.tuple (list#each annotation_analysis annotationsA)) + (/////analysis.tuple (list#each var_analysis vars)) + (/////analysis.tuple (list#each class_analysis exceptions)) + (/////analysis.text self_name) + (/////analysis.tuple (list#each ..argument_analysis arguments)) + (/////analysis.tuple (list#each typed_analysis super_arguments)) + {/////analysis.#Function + (list#each (|>> /////analysis.variable) + (scope.environment scope)) + (<| (..hidden_method_body arity) + (case arity + 0 (with_fake_parameter bodyA) + _ bodyA))} + )))))) + +(.type .public (Virtual_Method a) + [Text + Visibility + Finality + Strictness + (List (Annotation a)) + (List (Type Var)) + Text + (List Argument) + (Type Return) + (List Exception) + a]) + +(def .public virtual_tag "virtual") + +(def .public virtual_method_definition + (Parser (Virtual_Method Code)) + (<| .form + (<>.after (.this_text ..virtual_tag)) + (all <>.and + .text + ..visibility + .bit + .bit + (.tuple (<>.some ..annotation)) + (.tuple (<>.some ..var)) + .text + (.tuple (<>.some ..argument)) + ..return + (.tuple (<>.some ..class)) + .any))) + +(.type .public (Method_Declaration a) + (Record + [#name Text + #annotations (List (Annotation a)) + #type_variables (List (Type Var)) + #exceptions (List (Type Class)) + #arguments (List (Type Value)) + #return (Type Return)])) + +(def .public method_declaration + (Parser (Method_Declaration Code)) + (.form + (all <>.and + .text + (.tuple (<>.some ..annotation)) + (.tuple (<>.some ..var)) + (.tuple (<>.some ..class)) + (.tuple (<>.some ..type)) + ..return + ))) + +(def .public (analyse_virtual_method analyse archive selfT mapping method) + (-> Phase Archive .Type Mapping (Virtual_Method Code) (Operation Analysis)) + (let [[method_name visibility + final? strict_fp? annotations vars + self_name arguments return exceptions + body] method] + (do [! phase.monad] + [mapping (typeA.check (method_mapping mapping vars)) + annotationsA (monad.each ! (function (_ [name parameters]) + (do ! + [parametersA (monad.each ! (function (_ [name value]) + (do ! + [valueA (analyse archive value)] + (in [name valueA]))) + parameters)] + (in [name parametersA]))) + annotations) + :return: (boxed_reflection_return mapping return) + arguments' (monad.each ! + (function (_ [name jvmT]) + (do ! + [luxT (boxed_reflection_type mapping jvmT)] + (in [name luxT]))) + arguments) + [scope bodyA] (|> arguments' + {.#Item [self_name selfT]} + list.reversed + (list#mix scope.with_local (analyse archive body)) + (typeA.expecting :return:) + scope.with) + .let [arity (list.size arguments)]] + (in (/////analysis.tuple (list (/////analysis.text ..virtual_tag) + (/////analysis.text method_name) + (visibility_analysis visibility) + (/////analysis.bit final?) + (/////analysis.bit strict_fp?) + (/////analysis.tuple (list#each annotation_analysis annotationsA)) + (/////analysis.tuple (list#each var_analysis vars)) + (/////analysis.text self_name) + (/////analysis.tuple (list#each ..argument_analysis arguments)) + (return_analysis return) + (/////analysis.tuple (list#each class_analysis exceptions)) + {/////analysis.#Function + (list#each (|>> /////analysis.variable) + (scope.environment scope)) + (<| (..hidden_method_body arity) + (case arity + 0 (with_fake_parameter bodyA) + _ bodyA))} + )))))) + +(.type .public (Static_Method a) + [Text + Visibility + Strictness + (List (Annotation a)) + (List (Type Var)) + (List Argument) + (Type Return) + (List Exception) + a]) + +(def .public static_tag "static") + +(def .public static_method_definition + (Parser (Static_Method Code)) + (<| .form + (<>.after (.this_text ..static_tag)) + (all <>.and + .text + ..visibility + .bit + (.tuple (<>.some ..annotation)) + (.tuple (<>.some ..var)) + (.tuple (<>.some ..argument)) + ..return + (.tuple (<>.some ..class)) + .any))) + +(def .public (analyse_static_method analyse archive mapping method) + (-> Phase Archive Mapping (Static_Method Code) (Operation Analysis)) + (let [[method_name visibility + strict_fp? annotations vars + arguments return exceptions + body] method] + (do [! phase.monad] + [mapping (typeA.check (method_mapping mapping vars)) + annotationsA (monad.each ! (function (_ [name parameters]) + (do ! + [parametersA (monad.each ! (function (_ [name value]) + (do ! + [valueA (analyse archive value)] + (in [name valueA]))) + parameters)] + (in [name parametersA]))) + annotations) + :return: (boxed_reflection_return mapping return) + arguments' (monad.each ! + (function (_ [name jvmT]) + (do ! + [luxT (boxed_reflection_type mapping jvmT)] + (in [name luxT]))) + arguments) + [scope bodyA] (|> arguments' + list.reversed + (list#mix scope.with_local (analyse archive body)) + (typeA.expecting :return:) + scope.with)] + (in (/////analysis.tuple (list (/////analysis.text ..static_tag) + (/////analysis.text method_name) + (visibility_analysis visibility) + (/////analysis.bit strict_fp?) + (/////analysis.tuple (list#each annotation_analysis annotationsA)) + (/////analysis.tuple (list#each var_analysis vars)) + (/////analysis.tuple (list#each ..argument_analysis arguments)) + (return_analysis return) + (/////analysis.tuple (list#each class_analysis + exceptions)) + {/////analysis.#Function + (list#each (|>> /////analysis.variable) + (scope.environment scope)) + (/////analysis.tuple (list bodyA))} + )))))) + +(.type .public (Overriden_Method a) + [(Type Class) + Text + Bit + (List (Annotation a)) + (List (Type Var)) + Text + (List Argument) + (Type Return) + (List (Type Class)) + a]) + +(def .public overriden_tag "override") + +(def .public overriden_method_definition + (Parser (Overriden_Method Code)) + (<| .form + (<>.after (.this_text ..overriden_tag)) + (all <>.and + ..class + .text + .bit + (.tuple (<>.some ..annotation)) + (.tuple (<>.some ..var)) + .text + (.tuple (<>.some ..argument)) + ..return + (.tuple (<>.some ..class)) + .any + ))) + +(exception .public (unknown_super [name Text + supers (List (Type Class))]) + (exception.report + "Name" (%.text name) + "Available" (exception.listing (|>> parser.read_class product.left) supers))) + +(exception .public (mismatched_super_parameters [name Text + expected Nat + actual Nat]) + (exception.report + "Name" (%.text name) + "Expected" (%.nat expected) + "Actual" (%.nat actual))) + +(def (override_mapping mapping supers parent_type) + (-> Mapping (List (Type Class)) (Type Class) (Operation (List [Text .Type]))) + (let [[parent_name parent_parameters] (parser.read_class parent_type)] + (case (list.one (function (_ super) + (let [[super_name super_parameters] (parser.read_class super)] + (if (text#= parent_name super_name) + {.#Some super_parameters} + {.#None}))) + supers) + {.#Some super_parameters} + (let [expected_count (list.size parent_parameters) + actual_count (list.size super_parameters)] + (if (n.= expected_count actual_count) + (do [! phase.monad] + [parent_parameters (|> parent_parameters + (monad.each maybe.monad parser.var?) + try.of_maybe + phase.lifted)] + (|> super_parameters + (monad.each ! (..reflection_type mapping)) + (at ! each (|>> (list.zipped_2 parent_parameters))))) + (phase.lifted (exception.except ..mismatched_super_parameters [parent_name expected_count actual_count])))) + + {.#None} + (phase.lifted (exception.except ..unknown_super [parent_name supers]))))) + +(def .public (with_override_mapping supers parent_type mapping) + (-> (List (Type Class)) (Type Class) Mapping (Operation Mapping)) + (do phase.monad + [override_mapping (..override_mapping mapping supers parent_type)] + (in (list#mix (function (_ [super_var bound_type] mapping) + (dictionary.has super_var bound_type mapping)) + mapping + override_mapping)))) + +(def .public (analyse_overriden_method analyse archive selfT mapping supers method) + (-> Phase Archive .Type Mapping (List (Type Class)) (Overriden_Method Code) (Operation Analysis)) + (let [[parent_type method_name + strict_fp? annotations vars + self_name arguments return exceptions + body] method] + (do [! phase.monad] + [mapping (..with_override_mapping supers parent_type mapping) + mapping (typeA.check (method_mapping mapping vars)) + annotationsA (monad.each ! (function (_ [name parameters]) + (do ! + [parametersA (monad.each ! (function (_ [name value]) + (do ! + [valueA (analyse archive value)] + (in [name valueA]))) + parameters)] + (in [name parametersA]))) + annotations) + arguments' (monad.each ! + (function (_ [name jvmT]) + (do ! + [luxT (boxed_reflection_type mapping jvmT)] + (in [name luxT]))) + arguments) + :return: (boxed_reflection_return mapping return) + [scope bodyA] (|> arguments' + {.#Item [self_name selfT]} + list.reversed + (list#mix scope.with_local (analyse archive body)) + (typeA.expecting :return:) + scope.with) + .let [arity (list.size arguments)]] + (in (/////analysis.tuple (list (/////analysis.text ..overriden_tag) + (class_analysis parent_type) + (/////analysis.text method_name) + (/////analysis.bit strict_fp?) + (/////analysis.tuple (list#each annotation_analysis annotationsA)) + (/////analysis.tuple (list#each var_analysis vars)) + (/////analysis.text self_name) + (/////analysis.tuple (list#each ..argument_analysis arguments)) + (return_analysis return) + (/////analysis.tuple (list#each class_analysis + exceptions)) + {/////analysis.#Function + (list#each (|>> /////analysis.variable) + (scope.environment scope)) + (<| (..hidden_method_body arity) + (case arity + 0 (with_fake_parameter bodyA) + _ bodyA))} + )))))) + +(def (matched? [sub sub_method subJT] [super super_method superJT]) + (-> [(Type Class) Text (Type Method)] [(Type Class) Text (Type Method)] Bit) + (and (at descriptor.equivalence = (jvm.descriptor super) (jvm.descriptor sub)) + (text#= super_method sub_method) + (jvm#= superJT subJT))) + +(def (mismatched_methods super_set sub_set) + (-> (List [(Type Class) Text (Type Method)]) + (List [(Type Class) Text (Type Method)]) + (List [(Type Class) Text (Type Method)])) + (list.only (function (_ sub) + (not (list.any? (matched? sub) super_set))) + sub_set)) + +(exception .public (class_parameter_mismatch [name Text + declaration (Type Class) + expected (List Text) + actual (List (Type Parameter))]) + (exception.report + "Class" (%.text name) + "Declaration" (signature.signature (jvm.signature declaration)) + "Expected (amount)" (%.nat (list.size expected)) + "Expected (parameters)" (exception.listing %.text expected) + "Actual (amount)" (%.nat (list.size actual)) + "Actual (parameters)" (exception.listing ..signature actual))) + +(def (super_aliasing class_loader class) + (-> java/lang/ClassLoader (Type Class) (Operation Aliasing)) + (do phase.monad + [.let [[name actual_parameters] (parser.read_class class)] + jvm_class (phase.lifted (reflection!.load class_loader name)) + .let [expected_parameters (|> (java/lang/Class::getTypeParameters jvm_class) + (array.list {.#None}) + (list#each (|>> java/lang/reflect/TypeVariable::getName)))] + _ (phase.assertion ..class_parameter_mismatch [name class expected_parameters actual_parameters] + (n.= (list.size expected_parameters) + (list.size actual_parameters)))] + (in (|> (list.zipped_2 expected_parameters actual_parameters) + (list#mix (function (_ [expected actual] mapping) + (case (parser.var? actual) + {.#Some actual} + (dictionary.has actual expected mapping) + + {.#None} + mapping)) + alias.fresh))))) + +(def (anonymous_class_name module id) + (-> Module Nat Text) + (let [global (text.replaced .module_separator ..jvm_package_separator module) + local (format "anonymous-class" (%.nat id))] + (format global ..jvm_package_separator local))) + +(def .public (require_complete_method_concretion class_loader supers methods) + (-> java/lang/ClassLoader (List (Type Class)) (List (Overriden_Method Code)) (Operation Any)) + (do [! phase.monad] + [required_abstract_methods (phase.lifted (all_abstract_methods class_loader supers)) + available_methods (phase.lifted (all_methods class_loader supers)) + overriden_methods (monad.each ! (function (_ [parent_type method_name + strict_fp? annotations type_vars + self_name arguments return exceptions + body]) + (do ! + [aliasing (super_aliasing class_loader parent_type)] + (in (|> (jvm.method [type_vars + (list#each product.right arguments) + return + exceptions]) + (alias.method aliasing) + [parent_type method_name])))) + methods) + .let [missing_abstract_methods (mismatched_methods overriden_methods required_abstract_methods) + invalid_overriden_methods (mismatched_methods available_methods overriden_methods)] + _ (phase.assertion ..missing_abstract_methods [required_abstract_methods overriden_methods] + (list.empty? missing_abstract_methods)) + _ (phase.assertion ..invalid_overriden_methods [available_methods invalid_overriden_methods] + (list.empty? invalid_overriden_methods))] + (in []))) + +(.type Declaration + [Text (List (Type Var))]) + +(.type Constant + [Text (List Annotation) (Type Value) Code]) + +(.type Variable + [Text (Modifier field.Field) (Modifier field.Field) (List Annotation) (Type Value)]) + +(.type Field + (Variant + {#Constant Constant} + {#Variable Variable})) + +(.type (Method_Definition a) + (Variant + {#Constructor (..Constructor a)} + {#Virtual_Method (..Virtual_Method a)} + {#Static_Method (..Static_Method a)} + {#Overriden_Method (..Overriden_Method a)} + {#Abstract_Method (..Abstract_Method a)})) + +(def class_name + (|>> parser.read_class product.left name.internal)) + +(def (mock_class [name parameters] super interfaces fields methods modifier) + (-> Declaration (Type Class) (List (Type Class)) + (List (Resource field.Field)) (List (Resource method.Method)) (Modifier class.Class) + (Try [External Binary])) + (let [signature (signature.inheritance (list#each jvm.signature parameters) + (jvm.signature super) + (list#each jvm.signature interfaces))] + (try#each (|>> (\\format.result class.format) + [name]) + (class.class version.v6_0 + (all modifier#composite + class.public + modifier) + (name.internal name) + {.#Some signature} + (..class_name super) + (list#each ..class_name interfaces) + fields + methods + sequence.empty)))) + +(def constant::modifier + (Modifier field.Field) + (all modifier#composite + field.public + field.static + field.final + )) + +(def (field_definition field) + (-> Field (Resource field.Field)) + (case field + ... TODO: Handle annotations. + {#Constant [name annotations type value]} + (case value + (^.with_template [ ] + [[_ { value}] + (do pool.monad + [constant (`` (|> value (,, (template.spliced )))) + attribute (attribute.constant constant)] + (field.field ..constant::modifier name #1 (sequence.sequence attribute)))]) + ([.#Bit jvm.boolean [(pipe.case #0 +0 #1 +1) .i64 i32.i32 constant.integer pool.integer]] + [.#Int jvm.byte [.i64 i32.i32 constant.integer pool.integer]] + [.#Int jvm.short [.i64 i32.i32 constant.integer pool.integer]] + [.#Int jvm.int [.i64 i32.i32 constant.integer pool.integer]] + [.#Int jvm.long [constant.long pool.long]] + [.#Frac jvm.float [ffi.double_to_float constant.float pool.float]] + [.#Frac jvm.double [constant.double pool.double]] + [.#Nat jvm.char [.i64 i32.i32 constant.integer pool.integer]] + [.#Text (jvm.class "java.lang.String" (list)) [pool.string]] + ) + + ... TODO: Tighten this pattern-matching so this catch-all clause isn't necessary. + _ + (undefined)) + + ... TODO: Handle annotations. + {#Variable [name visibility state annotations type]} + (field.field (modifier#composite visibility state) + name #1 type sequence.empty))) + +(def method_privacy + (-> ffi.Privacy (Modifier method.Method)) + (|>> (pipe.case + {ffi.#PublicP} method.public + {ffi.#PrivateP} method.private + {ffi.#ProtectedP} method.protected + {ffi.#DefaultP} modifier.empty))) + +(def constructor_name + "") + +(def (mock_value valueT) + (-> (Type Value) (Bytecode Any)) + (case (jvm.primitive? valueT) + {.#Left classT} + _.aconst_null + + {.#Right primitiveT} + (cond (at jvm.equivalence = jvm.long primitiveT) + _.lconst_0 + + (at jvm.equivalence = jvm.float primitiveT) + _.fconst_0 + + (at jvm.equivalence = jvm.double primitiveT) + _.dconst_0 + + ... jvm.boolean jvm.byte jvm.short jvm.int jvm.char + _.iconst_0))) + +(def (mock_return :return:) + (-> (Type Return) (Bytecode Any)) + (case (jvm.void? :return:) + {.#Right :return:} + _.return + + {.#Left valueT} + (all _.composite + (mock_value valueT) + (case (jvm.primitive? valueT) + {.#Left classT} + _.areturn + + {.#Right primitiveT} + (cond (at jvm.equivalence = jvm.long primitiveT) + _.lreturn + + (at jvm.equivalence = jvm.float primitiveT) + _.freturn + + (at jvm.equivalence = jvm.double primitiveT) + _.dreturn + + ... jvm.boolean jvm.byte jvm.short jvm.int jvm.char + _.ireturn))))) + +(def (mock_method super method) + (-> (Type Class) (Method_Definition Code) (Resource method.Method)) + (case method + {#Constructor [privacy strict_floating_point? annotations variables exceptions + self arguments constructor_arguments + body]} + (method.method (all modifier#composite + (..method_privacy privacy) + (if strict_floating_point? + method.strict + modifier.empty)) + ..constructor_name + #0 (jvm.method [variables (list#each product.right arguments) jvm.void exceptions]) + (list) + {.#Some (all _.composite + (_.aload 0) + (|> constructor_arguments + (list#each (|>> product.left ..mock_value)) + (monad.all _.monad)) + (|> (jvm.method [(list) (list#each product.left constructor_arguments) jvm.void (list)]) + (_.invokespecial super ..constructor_name)) + _.return + )}) + + {#Overriden_Method [super name strict_floating_point? annotations variables + self arguments return exceptions + body]} + (method.method (all modifier#composite + method.public + (if strict_floating_point? + method.strict + modifier.empty)) + name + #0 (jvm.method [variables (list#each product.right arguments) return exceptions]) + (list) + {.#Some (..mock_return return)}) + + {#Virtual_Method [name privacy final? strict_floating_point? annotations variables + self arguments return exceptions + body]} + (method.method (all modifier#composite + (..method_privacy privacy) + (if strict_floating_point? + method.strict + modifier.empty) + (if final? + method.final + modifier.empty)) + name + #0 (jvm.method [variables (list#each product.right arguments) return exceptions]) + (list) + {.#Some (..mock_return return)}) + + {#Static_Method [name privacy strict_floating_point? annotations + variables arguments return exceptions + body]} + (method.method (all modifier#composite + method.static + (..method_privacy privacy) + (if strict_floating_point? + method.strict + modifier.empty)) + name + #0 (jvm.method [variables (list#each product.right arguments) return exceptions]) + (list) + {.#Some (..mock_return return)}) + + {#Abstract_Method [name privacy annotations + variables arguments return exceptions]} + (method.method (all modifier#composite + method.abstract + (..method_privacy privacy)) + name + #0 (jvm.method [variables (list#each product.right arguments) return exceptions]) + (list) + {.#None}) + )) + +(def (mock declaration super interfaces inheritance fields methods) + (-> Declaration + (Type Class) (List (Type Class)) + (Modifier class.Class) (List ..Field) (List (Method_Definition Code)) + (Try [External Binary])) + (mock_class declaration super interfaces + (list#each ..field_definition fields) + (list#each (..mock_method super) methods) + inheritance)) + +(def (class::anonymous class_loader host) + (-> java/lang/ClassLoader runtime.Host Handler) + (..custom + [(all <>.and + (.tuple (<>.some ..var)) + ..class + (.tuple (<>.some ..class)) + (.tuple (<>.some ..input)) + (.tuple (<>.some ..overriden_method_definition))) + (function (_ extension_name analyse archive [parameters + super_class + super_interfaces + constructor_args + methods]) + (do [! phase.monad] + [_ (..ensure_fresh_class! class_loader (..reflection super_class)) + _ (monad.each ! (|>> ..reflection (..ensure_fresh_class! class_loader)) super_interfaces) + + self_name (///.lifted (do meta.monad + [where meta.current_module_name + id meta.seed] + (in (..anonymous_class_name where id)))) + .let [selfT {.#Primitive self_name (list)}] + mock (<| phase.lifted + (..mock [self_name parameters] + super_class + super_interfaces + class.final + (list) + (list#each (|>> {#Overriden_Method}) methods))) + ... Necessary for reflection to work properly during analysis. + _ (phase.lifted (at host execute mock)) + + mapping (typeA.check (..class_mapping parameters)) + super_classT (typeA.check (luxT.check (luxT.class mapping) (..signature super_class))) + super_interfaceT+ (typeA.check (monad.each check.monad + (|>> ..signature (luxT.check (luxT.class mapping))) + super_interfaces)) + _ (typeA.inference selfT) + constructor_argsA+ (monad.each ! (function (_ [type term]) + (do ! + [argT (reflection_type mapping type) + termA (<| (typeA.expecting argT) + (analyse archive term))] + (in [type termA]))) + constructor_args) + .let [supers {.#Item super_class super_interfaces}] + _ (..require_complete_method_concretion class_loader supers methods) + methodsA (monad.each ! (analyse_overriden_method analyse archive selfT mapping supers) methods)] + (in {/////analysis.#Extension extension_name + (list (class_analysis super_class) + (/////analysis.tuple (list#each class_analysis super_interfaces)) + (/////analysis.tuple (list#each typed_analysis constructor_argsA+)) + (/////analysis.tuple methodsA))})))])) + +(def (bundle::class class_loader host) + (-> java/lang/ClassLoader runtime.Host Bundle) + (<| (///bundle.prefix "class") + (|> ///bundle.empty + (///bundle.install "anonymous" (class::anonymous class_loader host)) + ))) + +(def .public (bundle class_loader host) + (-> java/lang/ClassLoader runtime.Host Bundle) + (<| (///bundle.prefix "jvm") + (|> ///bundle.empty + (dictionary.composite bundle::conversion) + (dictionary.composite bundle::int) + (dictionary.composite bundle::long) + (dictionary.composite bundle::float) + (dictionary.composite bundle::double) + (dictionary.composite bundle::char) + (dictionary.composite bundle::array) + (dictionary.composite (bundle::object class_loader)) + (dictionary.composite (bundle::member class_loader)) + (dictionary.composite (bundle::class class_loader host)) + ))) diff --git a/stdlib/source/library/lux/meta/compiler/language/lux/phase/extension/analysis/lua.lux b/stdlib/source/library/lux/meta/compiler/language/lux/phase/extension/analysis/lua.lux new file mode 100644 index 000000000..803e0f40f --- /dev/null +++ b/stdlib/source/library/lux/meta/compiler/language/lux/phase/extension/analysis/lua.lux @@ -0,0 +1,267 @@ +(.require + [library + [lux (.except) + ["[0]" ffi] + [abstract + ["[0]" monad (.only do)]] + [control + ["<>" parser]] + [data + [collection + ["[0]" array] + ["[0]" dictionary] + ["[0]" list]]] + [meta + ["@" target (.only) + ["_" lua]] + ["[0]" code + ["<[1]>" \\parser (.only Parser)]] + ["[0]" type (.only) + ["[0]" check]]]]] + [// + ["/" lux (.only custom)] + [// + ["[0]" bundle] + [/// + ["[0]" analysis (.only Analysis Operation Phase Handler Bundle) + ["[1]/[0]" type]] + [/// + ["[0]" phase]]]]]) + +(def Nil + (for @.lua ffi.Nil + Any)) + +(def Object + (for @.lua (type_literal (ffi.Object Any)) + Any)) + +(def Function + (for @.lua ffi.Function + Any)) + +(def array::new + Handler + (custom + [.any + (function (_ extension phase archive lengthC) + (<| analysis/type.with_var + (function (_ [@read :read:])) + analysis/type.with_var + (function (_ [@write :write:])) + (do phase.monad + [lengthA (analysis/type.expecting Nat + (phase archive lengthC)) + _ (analysis/type.inference (type_literal (array.Array' :read: :write:)))] + (in {analysis.#Extension extension (list lengthA)}))))])) + +(def array::length + Handler + (custom + [.any + (function (_ extension phase archive arrayC) + (<| analysis/type.with_var + (function (_ [@read :read:])) + analysis/type.with_var + (function (_ [@write :write:])) + (do phase.monad + [arrayA (analysis/type.expecting (type_literal (array.Array' :read: :write:)) + (phase archive arrayC)) + _ (analysis/type.inference Nat)] + (in {analysis.#Extension extension (list arrayA)}))))])) + +(def array::read + Handler + (custom + [(<>.and .any .any) + (function (_ extension phase archive [indexC arrayC]) + (<| analysis/type.with_var + (function (_ [@read :read:])) + analysis/type.with_var + (function (_ [@write :write:])) + (do phase.monad + [indexA (analysis/type.expecting Nat + (phase archive indexC)) + arrayA (analysis/type.expecting (type_literal (array.Array' :read: :write:)) + (phase archive arrayC)) + _ (analysis/type.inference :read:)] + (in {analysis.#Extension extension (list indexA arrayA)}))))])) + +(def array::write + Handler + (custom + [(all <>.and .any .any .any) + (function (_ extension phase archive [indexC valueC arrayC]) + (<| analysis/type.with_var + (function (_ [@read :read:])) + analysis/type.with_var + (function (_ [@write :write:])) + (do phase.monad + [indexA (analysis/type.expecting Nat + (phase archive indexC)) + valueA (analysis/type.expecting :write: + (phase archive valueC)) + arrayA (analysis/type.expecting (type_literal (array.Array' :read: :write:)) + (phase archive arrayC)) + _ (analysis/type.inference (type_literal (array.Array' :read: :write:)))] + (in {analysis.#Extension extension (list indexA valueA arrayA)}))))])) + +(def array::delete + Handler + (custom + [(all <>.and .any .any) + (function (_ extension phase archive [indexC arrayC]) + (<| analysis/type.with_var + (function (_ [@read :read:])) + analysis/type.with_var + (function (_ [@write :write:])) + (do phase.monad + [indexA (analysis/type.expecting Nat + (phase archive indexC)) + arrayA (analysis/type.expecting (type_literal (array.Array' :read: :write:)) + (phase archive arrayC)) + _ (analysis/type.inference (type_literal (array.Array' :read: :write:)))] + (in {analysis.#Extension extension (list indexA arrayA)}))))])) + +(def bundle::array + Bundle + (<| (bundle.prefix "array") + (|> bundle.empty + (bundle.install "new" array::new) + (bundle.install "length" array::length) + (bundle.install "read" array::read) + (bundle.install "write" array::write) + (bundle.install "delete" array::delete) + ))) + +(def object::get + Handler + (custom + [(all <>.and .text .any) + (function (_ extension phase archive [fieldC objectC]) + (do phase.monad + [objectA (analysis/type.expecting ..Object + (phase archive objectC)) + _ (analysis/type.inference .Any)] + (in {analysis.#Extension extension (list (analysis.text fieldC) + objectA)})))])) + +(def object::do + Handler + (custom + [(all <>.and .text .any (.tuple (<>.some .any))) + (function (_ extension phase archive [methodC objectC inputsC]) + (do [! phase.monad] + [objectA (analysis/type.expecting ..Object + (phase archive objectC)) + inputsA (monad.each ! (|>> (phase archive) (analysis/type.expecting Any)) inputsC) + _ (analysis/type.inference .Any)] + (in {analysis.#Extension extension (list.partial (analysis.text methodC) + objectA + inputsA)})))])) + +(def bundle::object + Bundle + (<| (bundle.prefix "object") + (|> bundle.empty + (bundle.install "get" object::get) + (bundle.install "do" object::do) + (bundle.install "nil" (/.nullary ..Nil)) + (bundle.install "nil?" (/.unary Any Bit)) + ))) + +(with_template [ ] + [(def + Handler + (custom + [.any + (function (_ extension phase archive inputC) + (do [! phase.monad] + [inputA (analysis/type.expecting (type_literal ) + (phase archive inputC)) + _ (analysis/type.inference (type_literal ))] + (in {analysis.#Extension extension (list inputA)})))]))] + + [utf8::encode Text (array.Array (I64 Any))] + [utf8::decode (array.Array (I64 Any)) Text] + ) + +(def bundle::utf8 + Bundle + (<| (bundle.prefix "utf8") + (|> bundle.empty + (bundle.install "encode" utf8::encode) + (bundle.install "decode" utf8::decode) + ))) + +(def lua::constant + Handler + (custom + [.text + (function (_ extension phase archive name) + (do phase.monad + [_ (analysis/type.inference Any)] + (in {analysis.#Extension extension (list (analysis.text name))})))])) + +(def lua::apply + Handler + (custom + [(all <>.and .any (.tuple (<>.some .any))) + (function (_ extension phase archive [abstractionC inputsC]) + (do [! phase.monad] + [abstractionA (analysis/type.expecting ..Function + (phase archive abstractionC)) + inputsA (monad.each ! (|>> (phase archive) (analysis/type.expecting Any)) inputsC) + _ (analysis/type.inference Any)] + (in {analysis.#Extension extension (list.partial abstractionA inputsA)})))])) + +(def lua::power + Handler + (custom + [(all <>.and .any .any) + (function (_ extension phase archive [powerC baseC]) + (do [! phase.monad] + [powerA (analysis/type.expecting Frac + (phase archive powerC)) + baseA (analysis/type.expecting Frac + (phase archive baseC)) + _ (analysis/type.inference Frac)] + (in {analysis.#Extension extension (list powerA baseA)})))])) + +(def lua::import + Handler + (custom + [.text + (function (_ extension phase archive name) + (do phase.monad + [_ (analysis/type.inference ..Object)] + (in {analysis.#Extension extension (list (analysis.text name))})))])) + +(def lua::function + Handler + (custom + [(all <>.and .nat .any) + (function (_ extension phase archive [arity abstractionC]) + (do phase.monad + [.let [inputT (type.tuple (list.repeated arity Any))] + abstractionA (analysis/type.expecting (-> inputT Any) + (phase archive abstractionC)) + _ (analysis/type.inference ..Function)] + (in {analysis.#Extension extension (list (analysis.nat arity) + abstractionA)})))])) + +(def .public bundle + Bundle + (<| (bundle.prefix "lua") + (|> bundle.empty + (dictionary.composite bundle::array) + (dictionary.composite bundle::object) + (dictionary.composite bundle::utf8) + + (bundle.install "constant" lua::constant) + (bundle.install "apply" lua::apply) + (bundle.install "power" lua::power) + (bundle.install "import" lua::import) + (bundle.install "function" lua::function) + (bundle.install "script universe" (/.nullary .Bit)) + ))) diff --git a/stdlib/source/library/lux/meta/compiler/language/lux/phase/extension/analysis/lux.lux b/stdlib/source/library/lux/meta/compiler/language/lux/phase/extension/analysis/lux.lux new file mode 100644 index 000000000..b053b850c --- /dev/null +++ b/stdlib/source/library/lux/meta/compiler/language/lux/phase/extension/analysis/lux.lux @@ -0,0 +1,313 @@ +(.require + [library + [lux (.except) + [abstract + ["[0]" monad (.only do)]] + [control + ["<>" parser] + ["[0]" maybe] + ["[0]" try] + ["[0]" exception (.only exception)]] + [data + ["[0]" text (.only) + ["%" \\format (.only format)]] + [collection + ["[0]" list (.use "[1]#[0]" functor)] + ["[0]" dictionary (.only Dictionary)]]] + [math + [number + ["n" nat]]] + ["[0]" meta (.only) + ["[0]" code + ["<[1]>" \\parser (.only Parser)]] + [macro + ["^" pattern]] + [type + ["[0]" check]]]]] + ["[0]" /// (.only) + ["[1][0]" bundle] + ["/[1]" // + [// + ["[1][0]" analysis (.only Analysis Operation Phase Handler Bundle) + [evaluation (.only Eval)] + ["[0]A" type]] + [/// + ["[1]" phase] + [meta + [archive (.only Archive)]]]]]]) + +(def .public (custom [syntax handler]) + (All (_ s) + (-> [(Parser s) + (-> Text Phase Archive s (Operation Analysis))] + Handler)) + (function (_ extension_name analyse archive args) + (case (.result syntax args) + {try.#Success inputs} + (handler extension_name analyse archive inputs) + + {try.#Failure _} + (////analysis.except ///.invalid_syntax [extension_name %.code args])))) + +(def (simple inputsT+ outputT) + (-> (List Type) Type Handler) + (let [num_expected (list.size inputsT+)] + (function (_ extension_name analyse archive args) + (let [num_actual (list.size args)] + (if (n.= num_expected num_actual) + (do [! ////.monad] + [_ (typeA.inference outputT) + argsA (monad.each ! + (function (_ [argT argC]) + (<| (typeA.expecting argT) + (analyse archive argC))) + (list.zipped_2 inputsT+ args))] + (in {////analysis.#Extension extension_name argsA})) + (////analysis.except ///.incorrect_arity [extension_name num_expected num_actual])))))) + +(def .public (nullary valueT) + (-> Type Handler) + (simple (list) valueT)) + +(def .public (unary inputT outputT) + (-> Type Type Handler) + (simple (list inputT) outputT)) + +(def .public (binary subjectT paramT outputT) + (-> Type Type Type Handler) + (simple (list subjectT paramT) outputT)) + +(def .public (trinary subjectT param0T param1T outputT) + (-> Type Type Type Type Handler) + (simple (list subjectT param0T param1T) outputT)) + +... TODO: Get rid of this ASAP +(these + (exception .public (char_text_must_be_size_1 [text Text]) + (exception.report + "Text" (%.text text))) + + (def text_char + (Parser text.Char) + (do <>.monad + [raw .text] + (case (text.size raw) + 1 (in (|> raw (text.char 0) maybe.trusted)) + _ (<>.failure (exception.error ..char_text_must_be_size_1 [raw]))))) + + (def lux::syntax_char_case! + (..custom + [(all <>.and + .any + (.tuple (<>.some (<>.and (.tuple (<>.many ..text_char)) + .any))) + .any) + (function (_ extension_name phase archive [input conditionals else]) + (do [! ////.monad] + [input (<| (typeA.expecting text.Char) + (phase archive input)) + expectedT (///.lifted meta.expected_type) + conditionals (monad.each ! (function (_ [cases branch]) + (do ! + [branch (<| (typeA.expecting expectedT) + (phase archive branch))] + (in [cases branch]))) + conditionals) + else (<| (typeA.expecting expectedT) + (phase archive else))] + (in (|> conditionals + (list#each (function (_ [cases branch]) + (////analysis.tuple + (list (////analysis.tuple (list#each (|>> ////analysis.nat) cases)) + branch)))) + (list.partial input else) + {////analysis.#Extension extension_name}))))]))) + +... "lux is" represents reference/pointer equality. +(def lux::is + Handler + (function (_ extension_name analyse archive args) + (<| typeA.with_var + (function (_ [@var :var:])) + ((binary :var: :var: Bit extension_name) + analyse archive args)))) + +... "lux try" provides a simple way to interact with the host platform's +... error_handling facilities. +(def lux::try + Handler + (function (_ extension_name analyse archive args) + (case args + (list opC) + (<| typeA.with_var + (function (_ [@var :var:])) + (do [! ////.monad] + [_ (typeA.inference (type_literal (Either Text :var:)))] + (|> opC + (analyse archive) + (typeA.expecting (type_literal (-> .Any :var:))) + (at ! each (|>> list {////analysis.#Extension extension_name}))))) + + _ + (////analysis.except ///.incorrect_arity [extension_name 1 (list.size args)])))) + +(def lux::in_module + Handler + (function (_ extension_name analyse archive argsC+) + (case argsC+ + (list [_ {.#Text module_name}] exprC) + (////analysis.with_current_module module_name + (analyse archive exprC)) + + _ + (////analysis.except ///.invalid_syntax [extension_name %.code argsC+])))) + +(def (lux::type::check eval) + (-> Eval Handler) + (function (_ extension_name analyse archive args) + (case args + (list typeC valueC) + (do [! ////.monad] + [actualT (at ! each (|>> (as Type)) + (eval archive Type typeC)) + _ (typeA.inference actualT)] + (<| (typeA.expecting actualT) + (analyse archive valueC))) + + _ + (////analysis.except ///.incorrect_arity [extension_name 2 (list.size args)])))) + +(def (lux::type::as eval) + (-> Eval Handler) + (function (_ extension_name analyse archive args) + (case args + (list typeC valueC) + (do [! ////.monad] + [actualT (at ! each (|>> (as Type)) + (eval archive Type typeC)) + _ (typeA.inference actualT) + [valueT valueA] (typeA.inferring + (analyse archive valueC))] + (in valueA)) + + _ + (////analysis.except ///.incorrect_arity [extension_name 2 (list.size args)])))) + +(def (caster input output) + (-> Type Type Handler) + (..custom + [.any + (function (_ extension_name phase archive valueC) + (do [! ////.monad] + [_ (typeA.inference output)] + (<| (typeA.expecting input) + (phase archive valueC))))])) + +(exception .public (not_a_type [symbol Symbol]) + (exception.report + "Symbol" (%.symbol symbol))) + +(def lux::macro + Handler + (..custom + [.any + (function (_ extension_name phase archive valueC) + (do [! ////.monad] + [_ (typeA.inference .Macro) + input_type (loop (again [input_name (symbol .Macro')]) + (do ! + [input_type (///.lifted (meta.definition (symbol .Macro')))] + (case input_type + (^.or {.#Definition [exported? def_type def_value]} + {.#Type [exported? def_value labels]}) + (in (as Type def_value)) + + (^.or {.#Tag _} + {.#Slot _}) + (////.failure (exception.error ..not_a_type [(symbol .Macro')])) + + {.#Alias real_name} + (again real_name))))] + (<| (typeA.expecting input_type) + (phase archive valueC))))])) + +(def (bundle::lux eval) + (-> Eval Bundle) + (|> ///bundle.empty + (///bundle.install "syntax char case!" lux::syntax_char_case!) + (///bundle.install "is" lux::is) + (///bundle.install "try" lux::try) + (///bundle.install "type check" (lux::type::check eval)) + (///bundle.install "type as" (lux::type::as eval)) + (///bundle.install "macro" ..lux::macro) + (///bundle.install "type check type" (..caster .Type .Type)) + (///bundle.install "in-module" lux::in_module))) + +(def bundle::io + Bundle + (<| (///bundle.prefix "io") + (|> ///bundle.empty + (///bundle.install "log" (unary Text Any)) + (///bundle.install "error" (unary Text Nothing)) + (///bundle.install "exit" (unary Int Nothing))))) + +(def I64* + (type_literal (I64 Any))) + +(def bundle::i64 + Bundle + (<| (///bundle.prefix "i64") + (|> ///bundle.empty + (///bundle.install "and" (binary I64* I64* I64)) + (///bundle.install "or" (binary I64* I64* I64)) + (///bundle.install "xor" (binary I64* I64* I64)) + (///bundle.install "left-shift" (binary Nat I64* I64)) + (///bundle.install "right-shift" (binary Nat I64* I64)) + (///bundle.install "=" (binary I64* I64* Bit)) + (///bundle.install "<" (binary Int Int Bit)) + (///bundle.install "+" (binary I64* I64* I64)) + (///bundle.install "-" (binary I64* I64* I64)) + (///bundle.install "*" (binary Int Int Int)) + (///bundle.install "/" (binary Int Int Int)) + (///bundle.install "%" (binary Int Int Int)) + (///bundle.install "f64" (unary Int Frac)) + (///bundle.install "char" (unary Int Text))))) + +(def bundle::f64 + Bundle + (<| (///bundle.prefix "f64") + (|> ///bundle.empty + (///bundle.install "+" (binary Frac Frac Frac)) + (///bundle.install "-" (binary Frac Frac Frac)) + (///bundle.install "*" (binary Frac Frac Frac)) + (///bundle.install "/" (binary Frac Frac Frac)) + (///bundle.install "%" (binary Frac Frac Frac)) + (///bundle.install "=" (binary Frac Frac Bit)) + (///bundle.install "<" (binary Frac Frac Bit)) + (///bundle.install "i64" (unary Frac Int)) + (///bundle.install "encode" (unary Frac Text)) + (///bundle.install "decode" (unary Text (type_literal (Maybe Frac))))))) + +(def bundle::text + Bundle + (<| (///bundle.prefix "text") + (|> ///bundle.empty + (///bundle.install "=" (binary Text Text Bit)) + (///bundle.install "<" (binary Text Text Bit)) + (///bundle.install "concat" (binary Text Text Text)) + (///bundle.install "index" (trinary Nat Text Text (type_literal (Maybe Nat)))) + (///bundle.install "size" (unary Text Nat)) + (///bundle.install "char" (binary Nat Text Nat)) + (///bundle.install "clip" (trinary Nat Nat Text Text)) + ))) + +(def .public (bundle eval) + (-> Eval Bundle) + (<| (///bundle.prefix "lux") + (|> ///bundle.empty + (dictionary.composite (bundle::lux eval)) + (dictionary.composite bundle::i64) + (dictionary.composite bundle::f64) + (dictionary.composite bundle::text) + (dictionary.composite bundle::io) + ))) diff --git a/stdlib/source/library/lux/meta/compiler/language/lux/phase/extension/analysis/php.lux b/stdlib/source/library/lux/meta/compiler/language/lux/phase/extension/analysis/php.lux new file mode 100644 index 000000000..b5a632992 --- /dev/null +++ b/stdlib/source/library/lux/meta/compiler/language/lux/phase/extension/analysis/php.lux @@ -0,0 +1,221 @@ +(.require + [library + [lux (.except) + ["[0]" ffi] + [abstract + ["[0]" monad (.only do)]] + [control + ["<>" parser]] + [data + [collection + ["[0]" array (.only Array)] + ["[0]" dictionary] + ["[0]" list]]] + [meta + ["@" target (.only) + ["_" php]] + ["[0]" code + ["<[1]>" \\parser (.only Parser)]] + ["[0]" type (.only) + ["[0]" check]]]]] + [// + ["/" lux (.only custom)] + [// + ["[0]" bundle] + [// + ["[0]" analysis + ["[1]/[0]" type]] + [// + ["[0]" analysis (.only Analysis Operation Phase Handler Bundle)] + [/// + ["[0]" phase]]]]]]) + +(def array::new + Handler + (custom + [.any + (function (_ extension phase archive lengthC) + (<| analysis/type.with_var + (function (_ [@var :var:])) + (do phase.monad + [lengthA (analysis/type.with_type Nat + (phase archive lengthC)) + _ (analysis/type.infer (type_literal (Array :var:)))] + (in {analysis.#Extension extension (list lengthA)}))))])) + +(def array::length + Handler + (custom + [.any + (function (_ extension phase archive arrayC) + (<| analysis/type.with_var + (function (_ [@var :var:])) + (do phase.monad + [arrayA (analysis/type.with_type (type_literal (Array :var:)) + (phase archive arrayC)) + _ (analysis/type.infer Nat)] + (in {analysis.#Extension extension (list arrayA)}))))])) + +(def array::read + Handler + (custom + [(<>.and .any .any) + (function (_ extension phase archive [indexC arrayC]) + (<| analysis/type.with_var + (function (_ [@var :var:])) + (do phase.monad + [indexA (analysis/type.with_type Nat + (phase archive indexC)) + arrayA (analysis/type.with_type (type_literal (Array :var:)) + (phase archive arrayC)) + _ (analysis/type.infer :var:)] + (in {analysis.#Extension extension (list indexA arrayA)}))))])) + +(def array::write + Handler + (custom + [(all <>.and .any .any .any) + (function (_ extension phase archive [indexC valueC arrayC]) + (<| analysis/type.with_var + (function (_ [@var :var:])) + (do phase.monad + [indexA (analysis/type.with_type Nat + (phase archive indexC)) + valueA (analysis/type.with_type :var: + (phase archive valueC)) + arrayA (analysis/type.with_type (type_literal (Array :var:)) + (phase archive arrayC)) + _ (analysis/type.infer (type_literal (Array :var:)))] + (in {analysis.#Extension extension (list indexA valueA arrayA)}))))])) + +(def array::delete + Handler + (custom + [(all <>.and .any .any) + (function (_ extension phase archive [indexC arrayC]) + (<| analysis/type.with_var + (function (_ [@var :var:])) + (do phase.monad + [indexA (analysis/type.with_type Nat + (phase archive indexC)) + arrayA (analysis/type.with_type (type_literal (Array :var:)) + (phase archive arrayC)) + _ (analysis/type.infer (type_literal (Array :var:)))] + (in {analysis.#Extension extension (list indexA arrayA)}))))])) + +(def bundle::array + Bundle + (<| (bundle.prefix "array") + (|> bundle.empty + (bundle.install "new" array::new) + (bundle.install "length" array::length) + (bundle.install "read" array::read) + (bundle.install "write" array::write) + (bundle.install "delete" array::delete) + ))) + +(def Null + (for @.php ffi.Null + Any)) + +(def Object + (for @.php (type_literal (ffi.Object Any)) + Any)) + +(def Function + (for @.php ffi.Function + Any)) + +(def object::new + Handler + (custom + [(all <>.and .text (<>.some .any)) + (function (_ extension phase archive [constructor inputsC]) + (do [! phase.monad] + [inputsA (monad.each ! (|>> (phase archive) (analysis/type.with_type Any)) inputsC) + _ (analysis/type.infer .Any)] + (in {analysis.#Extension extension (list.partial (analysis.text constructor) inputsA)})))])) + +(def object::get + Handler + (custom + [(all <>.and .text .any) + (function (_ extension phase archive [fieldC objectC]) + (do phase.monad + [objectA (analysis/type.with_type ..Object + (phase archive objectC)) + _ (analysis/type.infer .Any)] + (in {analysis.#Extension extension (list (analysis.text fieldC) + objectA)})))])) + +(def object::do + Handler + (custom + [(all <>.and .text .any (<>.some .any)) + (function (_ extension phase archive [methodC objectC inputsC]) + (do [! phase.monad] + [objectA (analysis/type.with_type ..Object + (phase archive objectC)) + inputsA (monad.each ! (|>> (phase archive) (analysis/type.with_type Any)) inputsC) + _ (analysis/type.infer .Any)] + (in {analysis.#Extension extension (list.partial (analysis.text methodC) + objectA + inputsA)})))])) + +(def bundle::object + Bundle + (<| (bundle.prefix "object") + (|> bundle.empty + (bundle.install "new" object::new) + (bundle.install "get" object::get) + (bundle.install "do" object::do) + (bundle.install "null" (/.nullary ..Null)) + (bundle.install "null?" (/.unary Any Bit)) + ))) + +(def php::constant + Handler + (custom + [.text + (function (_ extension phase archive name) + (do phase.monad + [_ (analysis/type.infer Any)] + (in {analysis.#Extension extension (list (analysis.text name))})))])) + +(def php::apply + Handler + (custom + [(all <>.and .any (<>.some .any)) + (function (_ extension phase archive [abstractionC inputsC]) + (do [! phase.monad] + [abstractionA (analysis/type.with_type ..Function + (phase archive abstractionC)) + inputsA (monad.each ! (|>> (phase archive) (analysis/type.with_type Any)) inputsC) + _ (analysis/type.infer Any)] + (in {analysis.#Extension extension (list.partial abstractionA inputsA)})))])) + +(def php::pack + Handler + (custom + [(all <>.and .any .any) + (function (_ extension phase archive [formatC dataC]) + (do [! phase.monad] + [formatA (analysis/type.with_type Text + (phase archive formatC)) + dataA (analysis/type.with_type (type_literal (Array (I64 Any))) + (phase archive dataC)) + _ (analysis/type.infer Text)] + (in {analysis.#Extension extension (list formatA dataA)})))])) + +(def .public bundle + Bundle + (<| (bundle.prefix "php") + (|> bundle.empty + (dictionary.composite bundle::array) + (dictionary.composite bundle::object) + + (bundle.install "constant" php::constant) + (bundle.install "apply" php::apply) + (bundle.install "pack" php::pack) + (bundle.install "script universe" (/.nullary .Bit)) + ))) diff --git a/stdlib/source/library/lux/meta/compiler/language/lux/phase/extension/analysis/python.lux b/stdlib/source/library/lux/meta/compiler/language/lux/phase/extension/analysis/python.lux new file mode 100644 index 000000000..1f7316fbd --- /dev/null +++ b/stdlib/source/library/lux/meta/compiler/language/lux/phase/extension/analysis/python.lux @@ -0,0 +1,245 @@ +(.require + [library + [lux (.except) + ["[0]" ffi] + [abstract + ["[0]" monad (.only do)]] + [control + ["<>" parser]] + [data + [collection + ["[0]" array] + ["[0]" dictionary] + ["[0]" list]]] + [meta + ["@" target (.only) + ["_" python]] + ["[0]" code + ["<[1]>" \\parser (.only Parser)]] + ["[0]" type (.only) + ["[0]" check]]]]] + [// + ["/" lux (.only custom)] + [// + ["[0]" bundle] + [/// + ["[0]" analysis (.only Analysis Operation Phase Handler Bundle) + ["[1]/[0]" type]] + [/// + ["[0]" phase]]]]]) + +(def array::new + Handler + (custom + [.any + (function (_ extension phase archive lengthC) + (<| analysis/type.with_var + (function (_ [@read :read:])) + analysis/type.with_var + (function (_ [@write :write:])) + (do phase.monad + [lengthA (analysis/type.expecting Nat + (phase archive lengthC)) + _ (analysis/type.inference (type_literal (array.Array' :read: :write:)))] + (in {analysis.#Extension extension (list lengthA)}))))])) + +(def array::length + Handler + (custom + [.any + (function (_ extension phase archive arrayC) + (<| analysis/type.with_var + (function (_ [@read :read:])) + analysis/type.with_var + (function (_ [@write :write:])) + (do phase.monad + [arrayA (analysis/type.expecting (type_literal (array.Array' :read: :write:)) + (phase archive arrayC)) + _ (analysis/type.inference Nat)] + (in {analysis.#Extension extension (list arrayA)}))))])) + +(def array::read + Handler + (custom + [(<>.and .any .any) + (function (_ extension phase archive [indexC arrayC]) + (<| analysis/type.with_var + (function (_ [@read :read:])) + analysis/type.with_var + (function (_ [@write :write:])) + (do phase.monad + [indexA (analysis/type.expecting Nat + (phase archive indexC)) + arrayA (analysis/type.expecting (type_literal (array.Array' :read: :write:)) + (phase archive arrayC)) + _ (analysis/type.inference :read:)] + (in {analysis.#Extension extension (list indexA arrayA)}))))])) + +(def array::write + Handler + (custom + [(all <>.and .any .any .any) + (function (_ extension phase archive [indexC valueC arrayC]) + (<| analysis/type.with_var + (function (_ [@read :read:])) + analysis/type.with_var + (function (_ [@write :write:])) + (do phase.monad + [indexA (analysis/type.expecting Nat + (phase archive indexC)) + valueA (analysis/type.expecting :write: + (phase archive valueC)) + arrayA (analysis/type.expecting (type_literal (array.Array' :read: :write:)) + (phase archive arrayC)) + _ (analysis/type.inference (type_literal (array.Array' :read: :write:)))] + (in {analysis.#Extension extension (list indexA valueA arrayA)}))))])) + +(def array::delete + Handler + (custom + [(all <>.and .any .any) + (function (_ extension phase archive [indexC arrayC]) + (<| analysis/type.with_var + (function (_ [@read :read:])) + analysis/type.with_var + (function (_ [@write :write:])) + (do phase.monad + [indexA (analysis/type.expecting Nat + (phase archive indexC)) + arrayA (analysis/type.expecting (type_literal (array.Array' :read: :write:)) + (phase archive arrayC)) + _ (analysis/type.inference (type_literal (array.Array' :read: :write:)))] + (in {analysis.#Extension extension (list indexA arrayA)}))))])) + +(def bundle::array + Bundle + (<| (bundle.prefix "array") + (|> bundle.empty + (bundle.install "new" array::new) + (bundle.install "length" array::length) + (bundle.install "read" array::read) + (bundle.install "write" array::write) + (bundle.install "delete" array::delete) + ))) + +(def None + (for @.python ffi.None + Any)) + +(def Object + (for @.python (type_literal (ffi.Object Any)) + Any)) + +(def Function + (for @.python ffi.Function + Any)) + +(def Dict + (for @.python ffi.Dict + Any)) + +(def object::get + Handler + (custom + [(all <>.and .text .any) + (function (_ extension phase archive [fieldC objectC]) + (do phase.monad + [objectA (analysis/type.expecting ..Object + (phase archive objectC)) + _ (analysis/type.inference .Any)] + (in {analysis.#Extension extension (list (analysis.text fieldC) + objectA)})))])) + +(def object::do + Handler + (custom + [(all <>.and .text .any (.tuple (<>.some .any))) + (function (_ extension phase archive [methodC objectC inputsC]) + (do [! phase.monad] + [objectA (analysis/type.expecting ..Object + (phase archive objectC)) + inputsA (monad.each ! (|>> (phase archive) (analysis/type.expecting Any)) inputsC) + _ (analysis/type.inference .Any)] + (in {analysis.#Extension extension (list.partial (analysis.text methodC) + objectA + inputsA)})))])) + +(def bundle::object + Bundle + (<| (bundle.prefix "object") + (|> bundle.empty + (bundle.install "get" object::get) + (bundle.install "do" object::do) + (bundle.install "none" (/.nullary ..None)) + (bundle.install "none?" (/.unary Any Bit)) + ))) + +(def python::constant + Handler + (custom + [.text + (function (_ extension phase archive name) + (do phase.monad + [_ (analysis/type.inference Any)] + (in {analysis.#Extension extension (list (analysis.text name))})))])) + +(def python::import + Handler + (custom + [.text + (function (_ extension phase archive name) + (do phase.monad + [_ (analysis/type.inference ..Object)] + (in {analysis.#Extension extension (list (analysis.text name))})))])) + +(def python::apply + Handler + (custom + [(all <>.and .any (.tuple (<>.some .any))) + (function (_ extension phase archive [abstractionC inputsC]) + (do [! phase.monad] + [abstractionA (analysis/type.expecting ..Function + (phase archive abstractionC)) + inputsA (monad.each ! (|>> (phase archive) (analysis/type.expecting Any)) inputsC) + _ (analysis/type.inference Any)] + (in {analysis.#Extension extension (list.partial abstractionA inputsA)})))])) + +(def python::function + Handler + (custom + [(all <>.and .nat .any) + (function (_ extension phase archive [arity abstractionC]) + (do phase.monad + [.let [inputT (type.tuple (list.repeated arity Any))] + abstractionA (analysis/type.expecting (-> inputT Any) + (phase archive abstractionC)) + _ (analysis/type.inference ..Function)] + (in {analysis.#Extension extension (list (analysis.nat arity) + abstractionA)})))])) + +(def python::exec + Handler + (custom + [(all <>.and .any .any) + (function (_ extension phase archive [codeC globalsC]) + (do phase.monad + [codeA (analysis/type.expecting Text + (phase archive codeC)) + globalsA (analysis/type.expecting ..Dict + (phase archive globalsC)) + _ (analysis/type.inference .Any)] + (in {analysis.#Extension extension (list codeA globalsA)})))])) + +(def .public bundle + Bundle + (<| (bundle.prefix "python") + (|> bundle.empty + (dictionary.composite bundle::array) + (dictionary.composite bundle::object) + + (bundle.install "constant" python::constant) + (bundle.install "import" python::import) + (bundle.install "apply" python::apply) + (bundle.install "function" python::function) + (bundle.install "exec" python::exec) + ))) diff --git a/stdlib/source/library/lux/meta/compiler/language/lux/phase/extension/analysis/r.lux b/stdlib/source/library/lux/meta/compiler/language/lux/phase/extension/analysis/r.lux new file mode 100644 index 000000000..6dc3f4c09 --- /dev/null +++ b/stdlib/source/library/lux/meta/compiler/language/lux/phase/extension/analysis/r.lux @@ -0,0 +1,37 @@ +(.require + [library + [lux (.except) + ["[0]" ffi] + [abstract + ["[0]" monad (.only do)]] + [control + ["<>" parser]] + [data + [collection + ["[0]" array (.only Array)] + ["[0]" dictionary] + ["[0]" list]]] + [meta + ["@" target + ["_" r]] + ["[0]" code + ["<[1]>" \\parser (.only Parser)]] + ["[0]" type (.only) + ["[0]" check]]]]] + [// + ["/" lux (.only custom)] + [// + ["[0]" bundle] + [// + ["[0]" analysis + ["[1]/[0]" type]] + [// + ["[0]" analysis (.only Analysis Operation Phase Handler Bundle)] + [/// + ["[0]" phase]]]]]]) + +(def .public bundle + Bundle + (<| (bundle.prefix "r") + (|> bundle.empty + ))) diff --git a/stdlib/source/library/lux/meta/compiler/language/lux/phase/extension/analysis/ruby.lux b/stdlib/source/library/lux/meta/compiler/language/lux/phase/extension/analysis/ruby.lux new file mode 100644 index 000000000..60c77b4e7 --- /dev/null +++ b/stdlib/source/library/lux/meta/compiler/language/lux/phase/extension/analysis/ruby.lux @@ -0,0 +1,214 @@ +(.require + [library + [lux (.except) + ["[0]" ffi] + [abstract + ["[0]" monad (.only do)]] + [control + ["<>" parser]] + [data + [collection + ["[0]" array] + ["[0]" dictionary] + ["[0]" list]]] + [meta + ["@" target (.only) + ["_" ruby]] + ["[0]" code + ["<[1]>" \\parser (.only Parser)]] + ["[0]" type (.only) + ["[0]" check]]]]] + [// + ["/" lux (.only custom)] + [// + ["[0]" bundle] + [/// + ["[0]" analysis (.only Analysis Operation Phase Handler Bundle) + ["[1]/[0]" type]] + [/// + ["[0]" phase]]]]]) + +(def array::new + Handler + (custom + [.any + (function (_ extension phase archive lengthC) + (<| analysis/type.with_var + (function (_ [@read :read:])) + analysis/type.with_var + (function (_ [@write :write:])) + (do phase.monad + [lengthA (<| (analysis/type.expecting Nat) + (phase archive lengthC)) + _ (analysis/type.inference (type_literal (array.Array' :read: :write:)))] + (in {analysis.#Extension extension (list lengthA)}))))])) + +(def array::length + Handler + (custom + [.any + (function (_ extension phase archive arrayC) + (<| analysis/type.with_var + (function (_ [@read :read:])) + analysis/type.with_var + (function (_ [@write :write:])) + (do phase.monad + [arrayA (<| (analysis/type.expecting (type_literal (array.Array' :read: :write:))) + (phase archive arrayC)) + _ (analysis/type.inference Nat)] + (in {analysis.#Extension extension (list arrayA)}))))])) + +(def array::read + Handler + (custom + [(<>.and .any .any) + (function (_ extension phase archive [indexC arrayC]) + (<| analysis/type.with_var + (function (_ [@read :read:])) + analysis/type.with_var + (function (_ [@write :write:])) + (do phase.monad + [indexA (<| (analysis/type.expecting Nat) + (phase archive indexC)) + arrayA (<| (analysis/type.expecting (type_literal (array.Array' :read: :write:))) + (phase archive arrayC)) + _ (analysis/type.inference :read:)] + (in {analysis.#Extension extension (list indexA arrayA)}))))])) + +(def array::write + Handler + (custom + [(all <>.and .any .any .any) + (function (_ extension phase archive [indexC valueC arrayC]) + (<| analysis/type.with_var + (function (_ [@read :read:])) + analysis/type.with_var + (function (_ [@write :write:])) + (do phase.monad + [indexA (<| (analysis/type.expecting Nat) + (phase archive indexC)) + valueA (<| (analysis/type.expecting :write:) + (phase archive valueC)) + arrayA (<| (analysis/type.expecting (type_literal (array.Array' :read: :write:))) + (phase archive arrayC)) + _ (analysis/type.inference (type_literal (array.Array' :read: :write:)))] + (in {analysis.#Extension extension (list indexA valueA arrayA)}))))])) + +(def array::delete + Handler + (custom + [(all <>.and .any .any) + (function (_ extension phase archive [indexC arrayC]) + (<| analysis/type.with_var + (function (_ [@read :read:])) + analysis/type.with_var + (function (_ [@write :write:])) + (do phase.monad + [indexA (<| (analysis/type.expecting Nat) + (phase archive indexC)) + arrayA (<| (analysis/type.expecting (type_literal (array.Array' :read: :write:))) + (phase archive arrayC)) + _ (analysis/type.inference (type_literal (array.Array' :read: :write:)))] + (in {analysis.#Extension extension (list indexA arrayA)}))))])) + +(def bundle::array + Bundle + (<| (bundle.prefix "array") + (|> bundle.empty + (bundle.install "new" array::new) + (bundle.install "length" array::length) + (bundle.install "read" array::read) + (bundle.install "write" array::write) + (bundle.install "delete" array::delete) + ))) + +(def Nil + (for @.ruby ffi.Nil + Any)) + +(def Object + (for @.ruby (type_literal (ffi.Object Any)) + Any)) + +(def Function + (for @.ruby ffi.Function + Any)) + +(def object::get + Handler + (custom + [(all <>.and .text .any) + (function (_ extension phase archive [fieldC objectC]) + (do phase.monad + [objectA (<| (analysis/type.expecting ..Object) + (phase archive objectC)) + _ (analysis/type.inference .Any)] + (in {analysis.#Extension extension (list (analysis.text fieldC) + objectA)})))])) + +(def object::do + Handler + (custom + [(all <>.and .text .any (.tuple (<>.some .any))) + (function (_ extension phase archive [methodC objectC inputsC]) + (do [! phase.monad] + [objectA (<| (analysis/type.expecting ..Object) + (phase archive objectC)) + inputsA (monad.each ! (|>> (phase archive) (analysis/type.expecting Any)) inputsC) + _ (analysis/type.inference .Any)] + (in {analysis.#Extension extension (list.partial (analysis.text methodC) + objectA + inputsA)})))])) + +(def bundle::object + Bundle + (<| (bundle.prefix "object") + (|> bundle.empty + (bundle.install "get" object::get) + (bundle.install "do" object::do) + (bundle.install "nil" (/.nullary ..Nil)) + (bundle.install "nil?" (/.unary Any Bit)) + ))) + +(def ruby::constant + Handler + (custom + [.text + (function (_ extension phase archive name) + (do phase.monad + [_ (analysis/type.inference Any)] + (in {analysis.#Extension extension (list (analysis.text name))})))])) + +(def ruby::apply + Handler + (custom + [(all <>.and .any (.tuple (<>.some .any))) + (function (_ extension phase archive [abstractionC inputsC]) + (do [! phase.monad] + [abstractionA (<| (analysis/type.expecting ..Function) + (phase archive abstractionC)) + inputsA (monad.each ! (|>> (phase archive) (analysis/type.expecting Any)) inputsC) + _ (analysis/type.inference Any)] + (in {analysis.#Extension extension (list.partial abstractionA inputsA)})))])) + +(def ruby::import + Handler + (custom + [.text + (function (_ extension phase archive name) + (do phase.monad + [_ (analysis/type.inference Bit)] + (in {analysis.#Extension extension (list (analysis.text name))})))])) + +(def .public bundle + Bundle + (<| (bundle.prefix "ruby") + (|> bundle.empty + (dictionary.composite bundle::array) + (dictionary.composite bundle::object) + + (bundle.install "constant" ruby::constant) + (bundle.install "apply" ruby::apply) + (bundle.install "import" ruby::import) + (bundle.install "script universe" (/.nullary .Bit)) + ))) diff --git a/stdlib/source/library/lux/meta/compiler/language/lux/phase/extension/analysis/scheme.lux b/stdlib/source/library/lux/meta/compiler/language/lux/phase/extension/analysis/scheme.lux new file mode 100644 index 000000000..089e5ae69 --- /dev/null +++ b/stdlib/source/library/lux/meta/compiler/language/lux/phase/extension/analysis/scheme.lux @@ -0,0 +1,164 @@ +(.require + [library + [lux (.except) + ["[0]" ffi] + [abstract + ["[0]" monad (.only do)]] + [control + ["<>" parser]] + [data + [collection + ["[0]" array (.only Array)] + ["[0]" dictionary] + ["[0]" list]]] + [meta + ["@" target (.only) + ["_" scheme]] + ["[0]" code + ["<[1]>" \\parser (.only Parser)]] + ["[0]" type (.only) + ["[0]" check]]]]] + [// + ["/" lux (.only custom)] + [// + ["[0]" bundle] + [// + ["[0]" analysis + ["[1]/[0]" type]] + [// + ["[0]" analysis (.only Analysis Operation Phase Handler Bundle)] + [/// + ["[0]" phase]]]]]]) + +(def array::new + Handler + (custom + [.any + (function (_ extension phase archive lengthC) + (<| analysis/type.with_var + (function (_ [@var :var:])) + (do phase.monad + [lengthA (analysis/type.with_type Nat + (phase archive lengthC)) + _ (analysis/type.infer (type_literal (Array :var:)))] + (in {analysis.#Extension extension (list lengthA)}))))])) + +(def array::length + Handler + (custom + [.any + (function (_ extension phase archive arrayC) + (<| analysis/type.with_var + (function (_ [@var :var:])) + (do phase.monad + [arrayA (analysis/type.with_type (type_literal (Array :var:)) + (phase archive arrayC)) + _ (analysis/type.infer Nat)] + (in {analysis.#Extension extension (list arrayA)}))))])) + +(def array::read + Handler + (custom + [(<>.and .any .any) + (function (_ extension phase archive [indexC arrayC]) + (<| analysis/type.with_var + (function (_ [@var :var:])) + (do phase.monad + [indexA (analysis/type.with_type Nat + (phase archive indexC)) + arrayA (analysis/type.with_type (type_literal (Array :var:)) + (phase archive arrayC)) + _ (analysis/type.infer :var:)] + (in {analysis.#Extension extension (list indexA arrayA)}))))])) + +(def array::write + Handler + (custom + [(all <>.and .any .any .any) + (function (_ extension phase archive [indexC valueC arrayC]) + (<| analysis/type.with_var + (function (_ [@var :var:])) + (do phase.monad + [indexA (analysis/type.with_type Nat + (phase archive indexC)) + valueA (analysis/type.with_type :var: + (phase archive valueC)) + arrayA (analysis/type.with_type (type_literal (Array :var:)) + (phase archive arrayC)) + _ (analysis/type.infer (type_literal (Array :var:)))] + (in {analysis.#Extension extension (list indexA valueA arrayA)}))))])) + +(def array::delete + Handler + (custom + [(all <>.and .any .any) + (function (_ extension phase archive [indexC arrayC]) + (<| analysis/type.with_var + (function (_ [@var :var:])) + (do phase.monad + [indexA (analysis/type.with_type Nat + (phase archive indexC)) + arrayA (analysis/type.with_type (type_literal (Array :var:)) + (phase archive arrayC)) + _ (analysis/type.infer (type_literal (Array :var:)))] + (in {analysis.#Extension extension (list indexA arrayA)}))))])) + +(def bundle::array + Bundle + (<| (bundle.prefix "array") + (|> bundle.empty + (bundle.install "new" array::new) + (bundle.install "length" array::length) + (bundle.install "read" array::read) + (bundle.install "write" array::write) + (bundle.install "delete" array::delete) + ))) + +(def Nil + (for @.scheme ffi.Nil + Any)) + +(def Function + (for @.scheme ffi.Function + Any)) + +(def bundle::object + Bundle + (<| (bundle.prefix "object") + (|> bundle.empty + (bundle.install "nil" (/.nullary ..Nil)) + (bundle.install "nil?" (/.unary Any Bit)) + ))) + +(def scheme::constant + Handler + (custom + [.text + (function (_ extension phase archive name) + (do phase.monad + [_ (analysis/type.infer Any)] + (in {analysis.#Extension extension (list (analysis.text name))})))])) + +(def scheme::apply + Handler + (custom + [(all <>.and .any (<>.some .any)) + (function (_ extension phase archive [abstractionC inputsC]) + (do [! phase.monad] + [abstractionA (analysis/type.with_type ..Function + (phase archive abstractionC)) + inputsA (monad.each ! (|>> (phase archive) (analysis/type.with_type Any)) inputsC) + _ (analysis/type.infer Any)] + (in {analysis.#Extension extension (list.partial abstractionA inputsA)})))])) + +(def .public bundle + Bundle + (<| (bundle.prefix "scheme") + (|> bundle.empty + (dictionary.composite bundle::array) + (dictionary.composite bundle::object) + + (bundle.install "constant" scheme::constant) + (bundle.install "apply" scheme::apply) + (bundle.install "script universe" (/.nullary .Bit)) + ))) diff --git a/stdlib/source/library/lux/meta/compiler/language/lux/phase/extension/bundle.lux b/stdlib/source/library/lux/meta/compiler/language/lux/phase/extension/bundle.lux new file mode 100644 index 000000000..1436c1002 --- /dev/null +++ b/stdlib/source/library/lux/meta/compiler/language/lux/phase/extension/bundle.lux @@ -0,0 +1,29 @@ +(.require + [library + [lux (.except) + [abstract + [monad (.only do)]] + [data + ["[0]" text (.only) + ["%" \\format (.only format)]] + [collection + ["[0]" list (.use "[1]#[0]" functor)] + ["[0]" dictionary (.only Dictionary)]]]]] + [// (.only Handler Bundle)]) + +(def .public empty + Bundle + (dictionary.empty text.hash)) + +(def .public (install name anonymous) + (All (_ s i o) + (-> Text (Handler s i o) + (-> (Bundle s i o) (Bundle s i o)))) + (dictionary.has name anonymous)) + +(def .public (prefix prefix) + (All (_ s i o) + (-> Text (-> (Bundle s i o) (Bundle s i o)))) + (|>> dictionary.entries + (list#each (function (_ [key val]) [(format prefix " " key) val])) + (dictionary.of_list text.hash))) diff --git a/stdlib/source/library/lux/meta/compiler/language/lux/phase/extension/declaration/jvm.lux b/stdlib/source/library/lux/meta/compiler/language/lux/phase/extension/declaration/jvm.lux new file mode 100644 index 000000000..9585f0521 --- /dev/null +++ b/stdlib/source/library/lux/meta/compiler/language/lux/phase/extension/declaration/jvm.lux @@ -0,0 +1,984 @@ +(.require + [library + [lux (.except Type Definition Primitive) + ["[0]" ffi (.only import)] + [abstract + ["[0]" monad (.only do)]] + [control + ["<>" parser (.use "[1]#[0]" monad)] + ["[0]" pipe] + ["[0]" try (.only Try) (.use "[1]#[0]" functor)] + ["[0]" exception]] + [data + ["[0]" product] + [binary (.only Binary) + ["[0]" \\format]] + ["[0]" text + ["%" \\format (.only format)] + ["<[1]>" \\parser]] + [collection + ["[0]" list (.use "[1]#[0]" functor mix)] + ["[0]" dictionary] + ["[0]" sequence] + ["[0]" set (.only Set)]]] + [math + [number + ["n" nat] + ["[0]" i32]]] + [meta + ["[0]" code + ["<[1]>" \\parser (.only Parser)]] + [macro + ["^" pattern] + ["[0]" template]] + [type + ["[0]" check (.only Check)]] + [target + [jvm + ["_" bytecode (.only Bytecode) (.use "[1]#[0]" monad)] + ["[0]" modifier (.only Modifier) (.use "[1]#[0]" monoid)] + ["[0]" attribute] + ["[0]" field] + ["[0]" version] + ["[0]" method (.only Method)] + ["[0]" class] + ["[0]" constant (.only) + ["[0]" pool (.only Resource)]] + [encoding + ["[0]" name (.only External)]] + ["[0]" type (.only Type Constraint Argument Typed) + [category (.only Void Value Return Primitive Object Class Array Var Parameter)] + ["[0]T" lux (.only Mapping)] + ["[0]" signature] + ["[0]" reflection] + ["[0]" descriptor (.only Descriptor)] + ["[0]" parser]]]] + [compiler + ["[0]" phase] + [reference + [variable (.only Register)]] + [meta + [archive (.only Archive) + ["[0]" artifact] + ["[0]" unit]] + ["[0]" cache + [dependency + ["[1]" artifact]]]] + [language + [lux + ["[0]" generation] + ["[0]" declaration (.only Handler Bundle)] + ["[0]" analysis (.only Analysis) + ["[0]A" type] + ["[0]A" scope]] + ["[0]" synthesis (.only Synthesis) + ["<[1]>" \\parser]] + [phase + [generation + [jvm + ["[0]" runtime (.only Anchor Definition Extender)] + ["[0]" value]]] + ["[0]" extension (.only) + ["[0]" bundle] + [analysis + ["[0]" jvm]] + [generation + [jvm + ["[0]" host]]] + [declaration + ["/" lux]]]]]]]]]]) + +(type Operation + (declaration.Operation Anchor (Bytecode Any) Definition)) + +(def signature (|>> type.signature signature.signature)) +(def reflection (|>> type.reflection reflection.reflection)) + +(type Declaration + [Text (List (Type Var))]) + +(def declaration + (Parser Declaration) + (.form (<>.and .text (<>.some jvm.var)))) + +(def method_privacy + (-> ffi.Privacy (Modifier method.Method)) + (|>> (pipe.case + {ffi.#PublicP} method.public + {ffi.#PrivateP} method.private + {ffi.#ProtectedP} method.protected + {ffi.#DefaultP} modifier.empty))) + +(def visibility' + (.Parser (Modifier field.Field)) + (`` (all <>.either + (,, (with_template [