diff options
23 files changed, 1194 insertions, 4 deletions
diff --git a/documentation/research.md b/documentation/research.md new file mode 100644 index 000000000..0344c452b --- /dev/null +++ b/documentation/research.md @@ -0,0 +1,9 @@ +# Reference + +1. [Designing File Formats](https://www.fadden.com/tech/file-formats.html) +1. [The Twelve-Factor Container](https://medium.com/notbinary/the-twelve-factor-container-8d1edc2a49d4) +1. [What is PL Research?](https://www.youtube.com/watch?v=vyF5d-EFIwU) +1. https://www.ambient-mixer.com/ +1. https://github.com/danistefanovic/build-your-own-x +1. [LoCal: A Language for Programs Operating onSerialized Data](http://recurial.com/pldi19main.pdf) + diff --git a/documentation/research/Array.md b/documentation/research/Array.md new file mode 100644 index 000000000..29c0dc889 --- /dev/null +++ b/documentation/research/Array.md @@ -0,0 +1,4 @@ +# Reference + +1. [Dex: array programming with typed indices](https://openreview.net/pdf?id=rJxd7vsWPS) + diff --git a/documentation/research/Cache.md b/documentation/research/Cache.md new file mode 100644 index 000000000..cba5d6826 --- /dev/null +++ b/documentation/research/Cache.md @@ -0,0 +1,4 @@ +# Reference + +1. https://github.com/eko/gocache + diff --git a/documentation/research/Compilation.md b/documentation/research/Compilation.md new file mode 100644 index 000000000..2249ebdc3 --- /dev/null +++ b/documentation/research/Compilation.md @@ -0,0 +1,4 @@ +# Demand-driven + +1. [Queries: demand-driven compilation](https://github.com/rust-lang/rustc-guide/blob/master/src/query.md) + diff --git a/documentation/research/Data format.md b/documentation/research/Data format.md new file mode 100644 index 000000000..6961ff704 --- /dev/null +++ b/documentation/research/Data format.md @@ -0,0 +1,4 @@ +# Reference + +1. https://internetobject.org/ + diff --git a/documentation/research/Graphic User Interface (GUI).md b/documentation/research/Graphic User Interface (GUI).md index a796aaf2c..32f391764 100644 --- a/documentation/research/Graphic User Interface (GUI).md +++ b/documentation/research/Graphic User Interface (GUI).md @@ -1,5 +1,18 @@ +# Design + +1. [Ant Design](https://ant.design/) +1. [7 Practical Tips for Cheating at Design](https://medium.com/refactoring-ui/7-practical-tips-for-cheating-at-design-40c736799886) + +# Dark Patterns + +1. https://neal.fun/dark-patterns/ + # Immediate mode 1. [Sol on Immediate Mode GUIs (IMGUI)](http://sol.gfxile.net/imgui/) 1. [Immediate-Mode Graphical User Interfaces (2005)](https://caseymuratori.com/blog_0001) +# Accessibility + +1. [What I’ve learned about accessibility in SPAs](https://nolanlawson.com/2019/11/05/what-ive-learned-about-accessibility-in-spas/) + diff --git a/documentation/research/Memory Management.md b/documentation/research/Memory Management.md index abfe8a1e8..21a222ed9 100644 --- a/documentation/research/Memory Management.md +++ b/documentation/research/Memory Management.md @@ -1,3 +1,7 @@ +# Allocation + +1. [Always Bump Downwards](https://fitzgeraldnick.com/2019/11/01/always-bump-downwards.html) + # Compaction 1. ["Compacting the Uncompactable" by Bobby Powers](https://www.youtube.com/watch?v=c1UBJbfR-H0) @@ -10,8 +14,13 @@ 1. [Floorplan: Spatial Layout in Memory Management Systems](https://conf.researchr.org/details/gpce-2019/gpce-2019-papers/6/Floorplan-Spatial-Layout-in-Memory-Management-Systems) +# Garbage collection + +1. [Baby's First Garbage Collector](http://journal.stuffwithstuff.com/2013/12/08/babys-first-garbage-collector/) + # Reference +1. [Scopes Describe Frames: A Uniform Model for Memory Layout in Dynamic Semantics](http://drops.dagstuhl.de/opus/volltexte/2016/6114/) 1. https://uridiumauthor.blogspot.com/2018/06/memory-management.html 1. https://github.com/mtrebi/memory-allocators 1. http://www.newlisp.org/MemoryManagement.html diff --git a/documentation/research/Procedural generation.md b/documentation/research/Procedural generation.md new file mode 100644 index 000000000..40553176b --- /dev/null +++ b/documentation/research/Procedural generation.md @@ -0,0 +1,4 @@ +# Fractional Brownian Motion + +1. http://iquilezles.org/www/articles/fbm/fbm.htm + diff --git a/documentation/research/Security.md b/documentation/research/Security.md index cdb12bcb7..bf6f219a5 100644 --- a/documentation/research/Security.md +++ b/documentation/research/Security.md @@ -1,3 +1,7 @@ +# Finger-printing + +1. https://github.com/Valve/fingerprintjs2 + # Access Control List 1. [Capirca: Multi-platform ACL generation system](https://github.com/google/capirca) @@ -26,6 +30,7 @@ # Vulnerability +1. [Against Cipher Agility in Cryptography Protocols](https://paragonie.com/blog/2019/10/against-agility-in-cryptography-protocols) 1. [Padding the struct: How a compiler optimization can disclose stack memory](https://www.nccgroup.trust/us/about-us/newsroom-and-events/blog/2019/october/padding-the-struct-how-a-compiler-optimization-can-disclose-stack-memory/) 1. [PCG generators are easily “crackable”](https://news.ycombinator.com/item?id=21475210) 1. [Safely Creating And Using Temporary Files](https://www.netmeister.org/blog/mktemp.html) @@ -40,6 +45,7 @@ # Reference +1. [Don't get pwned: practicing the principle of least privilege](https://cloud.google.com/blog/products/identity-security/dont-get-pwned-practicing-the-principle-of-least-privilege) 1. [Good Practices for Capability URLs](https://www.w3.org/TR/capability-urls/) 1. [Secure Socket API](https://securesocketapi.org/) 1. [Mind your Language(s): A discussion about languages and security](https://www.ssi.gouv.fr/uploads/IMG/pdf/Mind_Your_Languages_-_version_longue.pdf) diff --git a/documentation/research/back-end/Python.md b/documentation/research/back-end/Python.md new file mode 100644 index 000000000..5a3266107 --- /dev/null +++ b/documentation/research/back-end/Python.md @@ -0,0 +1,4 @@ +# Platform + +1. [BeeWare: Write once. Deploy everywhere.](https://beeware.org/) + diff --git a/documentation/research/back-end/native.md b/documentation/research/back-end/native.md index 19ad6f882..7631b0d5e 100644 --- a/documentation/research/back-end/native.md +++ b/documentation/research/back-end/native.md @@ -48,6 +48,7 @@ # Floating point arithmetic +1. [Accurate Differences of Products with Kahan's Algorithm](https://pharr.org/matt/blog/2019/11/03/difference-of-floats.html) 1. https://floating-point-gui.de/ 1. [Faster floating point arithmetic with Exclusive OR](http://nfrechette.github.io/2019/10/22/float_xor_optimization/) 1. https://oded.ninja/2017/05/01/floating-point/ diff --git a/documentation/research/machine_learning.md b/documentation/research/machine_learning.md index cc2d4d548..fe5871b87 100644 --- a/documentation/research/machine_learning.md +++ b/documentation/research/machine_learning.md @@ -10,6 +10,7 @@ # Reference +1. ["Multi-Level Intermediate Representation" Compiler Infrastructure](https://github.com/tensorflow/mlir) 1. [Sampling can be faster than optimization](https://www.pnas.org/content/116/42/20881) 1. [Layer rotation: a surprisingly powerful indicator of generalization in deep networks](https://arxiv.org/abs/1806.01603v2) 1. https://nostalgebraist.tumblr.com/post/185326092369/the-transformer-explained @@ -72,6 +73,8 @@ # Differentiable programming +1. [The principles behind Differentiable Programming - Erik Meijer](https://www.youtube.com/watch?v=lk0PhtSHE38) +1. [Kotlin∇: Type-safe Symbolic Differentiation for Kotlin](https://github.com/breandan/kotlingrad) 1. [Differentiable Programming Manifesto](https://github.com/apple/swift/blob/master/docs/DifferentiableProgramming.md) 1. [Backpropagation in the Simply Typed Lambda-calculus with Linear Negation](https://arxiv.org/abs/1909.13768) 1. [One-and-a-Half Simple Differential Programming Languages](https://pages.cpsc.ucalgary.ca/~robin/FMCS/FMCS2019/slides/GordonPlotkin-FMCS2019.pdf) diff --git a/documentation/research/math.md b/documentation/research/math.md index 27fab7503..36071c92b 100644 --- a/documentation/research/math.md +++ b/documentation/research/math.md @@ -92,11 +92,16 @@ # Discrete mathematics +1. [Applied Discrete Structures](http://discretemath.org/ads-latex/ads.pdf) 1. [Notes on Discrete Mathematics](http://www.cs.yale.edu/homes/aspnes/classes/202/notes.pdf) 1. [The system of integer functions, an efficient version of discrete mathematical analysis](https://arxiv.org/abs/1710.00676) 1. [Computing the Continuous Discretely: Integer-Point Enumeration in Polyhedra](http://math.sfsu.edu/beck/papers/ccd.pdf) 1. [Discrete Mathematics: An Open Introduction](http://discrete.openmathbooks.org/dmoi2/frontmatter.html) +# Probability + +1. [Introduction to Probability at anadvanced leve](https://www.stat.berkeley.edu/~aditya/resources/AllLectures2018Fall201A.pdf) + # Linear Algebra 1. [Don’t invert that matrix](https://www.johndcook.com/blog/2010/01/19/dont-invert-that-matrix/) @@ -126,8 +131,13 @@ 1. [Convolution is outer product](https://arxiv.org/abs/1905.01289) 1. [Graphical Calculus for products and convolutions](https://arxiv.org/abs/1903.01366) +# Domain Theory + +1. [A Brief Intro to Domain Theory](https://www.alignmentforum.org/posts/4C4jha5SdReWgg7dF/a-brief-intro-to-domain-theory) + # Category Theory +1. [Awesome Applied Category Theory](https://github.com/statebox/awesome-applied-ct) 1. [Categorical Query Language](https://www.categoricaldata.net/) 1. [Abstract and Concrete Categories: The Joy of Cats](http://katmat.math.uni-bremen.de/acc/acc.pdf) 1. https://bartoszmilewski.com/ @@ -147,6 +157,8 @@ # Geometric Algebra | Clifford Algebra +1. [Exterior Product](https://medium.com/@marksaroufim/exterior-product-ecd5836c28ab) +1. [Projective geometric algebra: A modern framework for doing geometry](http://page.math.tu-berlin.de/~gunn/PGA/index.html) 1. [Geometric Algebra for Computer Graphics](https://slides.com/enkimute/siggraph/#/) 1. https://bivector.net/ 1. https://slehar.wordpress.com/2014/03/18/clifford-algebra-a-visual-introduction/ @@ -259,8 +271,13 @@ 1. https://en.wikibooks.org/wiki/GLPK 1. https://white.ucc.asn.au/2018/05/28/Optimizing-your-diet-with-JuMP.html +# Measure theory + +1. [Resources for Learning Measure Theory](https://bcmullins.github.io/measure_theory_resources/) + # Combinatorics +1. [Advances in Combinatorics](https://www.advancesincombinatorics.com/) 1. http://andy.kitchen/combinations.html 1. [Combinatorial Algorithms](http://www2.denizyuret.com/bib/kreher/donald1999combinatorial/combinatorialA.pdf) diff --git a/documentation/research/paradigm/Answer Set Programming.md b/documentation/research/paradigm/Answer Set Programming.md new file mode 100644 index 000000000..089debd99 --- /dev/null +++ b/documentation/research/paradigm/Answer Set Programming.md @@ -0,0 +1,4 @@ +# Reference + +1. [Introduction to Answer Set Programming (ASP)](https://lucas.bourneuf.net/blog/drafts/tuto-asp-en.html) + diff --git a/documentation/research/paradigm/Concept programming.md b/documentation/research/paradigm/Concept programming.md new file mode 100644 index 000000000..c91489723 --- /dev/null +++ b/documentation/research/paradigm/Concept programming.md @@ -0,0 +1,8 @@ +# Language + +1. [XL (programming language)](https://en.wikipedia.org/wiki/XL_(programming_language)) +1. http://xlr.sourceforge.net/ +1. https://sourceforge.net/projects/xlr/ +1. https://github.com/c3d/xl +1. http://mozart-dev.sourceforge.net/xl.html + diff --git a/documentation/research/paradigm/probabilistic_programming.md b/documentation/research/paradigm/probabilistic_programming.md index 7799eac7c..0a4670d9a 100644 --- a/documentation/research/paradigm/probabilistic_programming.md +++ b/documentation/research/paradigm/probabilistic_programming.md @@ -11,6 +11,8 @@ # Reference +1. [Paradigms of Probabilistic Programming](https://www.youtube.com/watch?v=CmH1xxKRbiE) +1. [Anatomy of a Probabilistic Programming Framework](https://eigenfoo.xyz/prob-prog-frameworks/) 1. [Probabilistic Programming with monad‑bayes, Part 1: First Steps](https://www.tweag.io/posts/2019-09-20-monad-bayes-1.html) 1. [Probabilistic Programming with monad‑bayes, Part 2: Linear Regression](https://www.tweag.io/posts/2019-11-08-monad-bayes-2.html) 1. [FACTORIE](http://factorie.cs.umass.edu/) diff --git a/documentation/research/parsing.md b/documentation/research/parsing.md index f33307463..1d5bac732 100644 --- a/documentation/research/parsing.md +++ b/documentation/research/parsing.md @@ -1,3 +1,5 @@ # Reference +1. [Base64 encoding and decoding at almost the speed of a memory copy](https://arxiv.org/abs/1910.05109) 1. [Parsing XML at the Speed of Light](https://aosabook.org/en/posa/parsing-xml-at-the-speed-of-light.html) + diff --git a/documentation/research/text_editor & ide.md b/documentation/research/text_editor & ide.md index e1eb5b6cc..0f6ccf128 100644 --- a/documentation/research/text_editor & ide.md +++ b/documentation/research/text_editor & ide.md @@ -43,6 +43,7 @@ # Reference +1. [It’s 2019. Why don’t we have good code editors?](https://thoughts.thorlaksson.com/2019/09/27/its-2019-why-dont-we-have-good-code-editors/) 1. [Text Editing Hates You Too](https://lord.io/blog/2019/text-editing-hates-you-too/) 1. [Why ContentEditable is Terrible](https://medium.engineering/why-contenteditable-is-terrible-122d8a40e480) 1. [Broot: A better way to navigate directories](https://github.com/Canop/broot) @@ -109,6 +110,8 @@ # Extensibility +1. [The Spoofax Language Workbench](https://metaborg.github.io/spoofax/) +1. [A Language Independent Task Engine for Incremental Name and Type Analysis](https://www.researchgate.net/publication/290110229_A_Language_Independent_Task_Engine_for_Incremental_Name_and_Type_Analysis) 1. [Extensible Type-Directed Editing](http://cattheory.com/extensibleTypeDirectedEditing.pdf) # Parsing @@ -192,6 +195,7 @@ ## Structured editing +1. [俺のlisp](https://github.com/illiichi/orenolisp) 1. [豆腐 (Tofu): meaningful code editing](https://gregoor.github.io/tofu/) 1. [Tiled Text](http://www.tiledtext.com/projects/tiledtext) 1. [Deuce: A Lightweight User Interface for Structured Editing](https://arxiv.org/abs/1707.00015) diff --git a/documentation/research/tool/Notebook.md b/documentation/research/tool/Notebook.md new file mode 100644 index 000000000..7ec319d79 --- /dev/null +++ b/documentation/research/tool/Notebook.md @@ -0,0 +1,4 @@ +# Reference + +1. https://jupyter.org/ + diff --git a/stdlib/source/lux/target/jvm/type/alias.lux b/stdlib/source/lux/target/jvm/type/alias.lux index 49b4c0297..d21cbc1c2 100644 --- a/stdlib/source/lux/target/jvm/type/alias.lux +++ b/stdlib/source/lux/target/jvm/type/alias.lux @@ -12,7 +12,6 @@ ["." text ["%" format (#+ format)]] [collection - [array (#+ Array)] ["." dictionary (#+ Dictionary)]]]] ["." // (#+ Type) [category (#+ Void Value Return Method Primitive Object Class Array Var Parameter)] diff --git a/stdlib/source/lux/tool/compiler/phase/extension/analysis/jvm.lux b/stdlib/source/lux/tool/compiler/phase/extension/analysis/jvm.lux index 8202fd101..c4481998e 100644 --- a/stdlib/source/lux/tool/compiler/phase/extension/analysis/jvm.lux +++ b/stdlib/source/lux/tool/compiler/phase/extension/analysis/jvm.lux @@ -1,5 +1,5 @@ (.module: - [lux (#- Type primitive type char int) + [lux (#- Type Module primitive type char int) ["." host (#+ import:)] ["." macro] [abstract diff --git a/stdlib/source/lux/tool/compiler/phase/generation/jvm/extension.lux b/stdlib/source/lux/tool/compiler/phase/generation/jvm/extension.lux index b7cc9c9fe..d436d1974 100644 --- a/stdlib/source/lux/tool/compiler/phase/generation/jvm/extension.lux +++ b/stdlib/source/lux/tool/compiler/phase/generation/jvm/extension.lux @@ -5,7 +5,7 @@ ["." dictionary]]]] ["." / #_ ["#." common] - ## ["#." host] + ["#." host] [// [runtime (#+ Bundle)]]]) @@ -13,5 +13,5 @@ Bundle ($_ dictionary.merge /common.bundle - ## /host.bundle + /host.bundle )) diff --git a/stdlib/source/lux/tool/compiler/phase/generation/jvm/extension/host.lux b/stdlib/source/lux/tool/compiler/phase/generation/jvm/extension/host.lux new file mode 100644 index 000000000..7b14d2c07 --- /dev/null +++ b/stdlib/source/lux/tool/compiler/phase/generation/jvm/extension/host.lux @@ -0,0 +1,1085 @@ +(.module: + [lux (#- Type) + [abstract + ["." monad (#+ do)]] + [control + ["." try] + ["." exception (#+ exception:)] + ["<>" parser + ["<t>" text] + ["<s>" synthesis (#+ Parser)]]] + [data + ["." product] + ["." maybe] + ["." text ("#@." equivalence)] + [number + ["." i32]] + [collection + ["." list ("#@." monad)] + ["." dictionary (#+ Dictionary)] + ["." set] + ["." row]] + ["." format #_ + ["#" binary]]] + [target + [jvm + ["." version] + ["." modifier ("#@." monoid)] + ["." method (#+ Method)] + ["." class (#+ Class)] + [constant + [pool (#+ Resource)]] + [encoding + ["." name]] + ["_" bytecode (#+ Label Bytecode) ("#@." monad) + ["__" instruction (#+ Primitive-Array-Type)]] + ["." type (#+ Type Typed Argument) + ["." category (#+ Void Value' Value Return' Return Primitive Object Array Var Parameter)] + ["." box] + ["." reflection] + ["." signature] + ["." parser]]]]] + ["." // #_ + [common (#+ custom)] + ["/#" // + [runtime (#+ Operation Bundle Handler)] + ["#." reference] + [function + [field + [variable + ["." foreign]]]] + ["//#" /// + ["." generation + [extension (#+ Nullary Unary Binary Trinary Variadic + nullary unary binary trinary variadic)]] + [extension + ["#." bundle] + [analysis + ["/" jvm]]] + ["/#" // + [analysis (#+ Environment)] + ["#." reference (#+ Variable)] + ["#." synthesis (#+ Synthesis Path %synthesis)]]]]]) + +(template [<name> <0> <1>] + [(def: <name> + (Bytecode Any) + ($_ _.compose + <0> + <1>))] + + [l2s _.l2i _.i2s] + [l2b _.l2i _.i2b] + [l2c _.l2i _.i2c] + ) + +(template [<conversion> <name>] + [(def: (<name> inputG) + (Unary (Bytecode Any)) + (if (is? _.nop <conversion>) + inputG + ($_ _.compose + inputG + <conversion>)))] + + [_.d2f conversion::double-to-float] + [_.d2i conversion::double-to-int] + [_.d2l conversion::double-to-long] + [_.f2d conversion::float-to-double] + [_.f2i conversion::float-to-int] + [_.f2l conversion::float-to-long] + [_.i2b conversion::int-to-byte] + [_.i2c conversion::int-to-char] + [_.i2d conversion::int-to-double] + [_.i2f conversion::int-to-float] + [_.i2l conversion::int-to-long] + [_.i2s conversion::int-to-short] + [_.l2d conversion::long-to-double] + [_.l2f conversion::long-to-float] + [_.l2i conversion::long-to-int] + [..l2s conversion::long-to-short] + [..l2b conversion::long-to-byte] + [..l2c conversion::long-to-char] + [_.i2b conversion::char-to-byte] + [_.i2s conversion::char-to-short] + [_.nop conversion::char-to-int] + [_.i2l conversion::char-to-long] + [_.i2l conversion::byte-to-long] + [_.i2l conversion::short-to-long] + ) + +(def: bundle::conversion + Bundle + (<| (/////bundle.prefix "conversion") + (|> (: Bundle /////bundle.empty) + (/////bundle.install "double-to-float" (unary conversion::double-to-float)) + (/////bundle.install "double-to-int" (unary conversion::double-to-int)) + (/////bundle.install "double-to-long" (unary conversion::double-to-long)) + (/////bundle.install "float-to-double" (unary conversion::float-to-double)) + (/////bundle.install "float-to-int" (unary conversion::float-to-int)) + (/////bundle.install "float-to-long" (unary conversion::float-to-long)) + (/////bundle.install "int-to-byte" (unary conversion::int-to-byte)) + (/////bundle.install "int-to-char" (unary conversion::int-to-char)) + (/////bundle.install "int-to-double" (unary conversion::int-to-double)) + (/////bundle.install "int-to-float" (unary conversion::int-to-float)) + (/////bundle.install "int-to-long" (unary conversion::int-to-long)) + (/////bundle.install "int-to-short" (unary conversion::int-to-short)) + (/////bundle.install "long-to-double" (unary conversion::long-to-double)) + (/////bundle.install "long-to-float" (unary conversion::long-to-float)) + (/////bundle.install "long-to-int" (unary conversion::long-to-int)) + (/////bundle.install "long-to-short" (unary conversion::long-to-short)) + (/////bundle.install "long-to-byte" (unary conversion::long-to-byte)) + (/////bundle.install "long-to-char" (unary conversion::long-to-char)) + (/////bundle.install "char-to-byte" (unary conversion::char-to-byte)) + (/////bundle.install "char-to-short" (unary conversion::char-to-short)) + (/////bundle.install "char-to-int" (unary conversion::char-to-int)) + (/////bundle.install "char-to-long" (unary conversion::char-to-long)) + (/////bundle.install "byte-to-long" (unary conversion::byte-to-long)) + (/////bundle.install "short-to-long" (unary conversion::short-to-long)) + ))) + +(template [<name> <op>] + [(def: (<name> [xG yG]) + (Binary (Bytecode Any)) + ($_ _.compose + xG + yG + <op>))] + + [int::+ _.iadd] + [int::- _.isub] + [int::* _.imul] + [int::/ _.idiv] + [int::% _.irem] + [int::and _.iand] + [int::or _.ior] + [int::xor _.ixor] + [int::shl _.ishl] + [int::shr _.ishr] + [int::ushr _.iushr] + + [long::+ _.ladd] + [long::- _.lsub] + [long::* _.lmul] + [long::/ _.ldiv] + [long::% _.lrem] + [long::and _.land] + [long::or _.lor] + [long::xor _.lxor] + [long::shl _.lshl] + [long::shr _.lshr] + [long::ushr _.lushr] + + [float::+ _.fadd] + [float::- _.fsub] + [float::* _.fmul] + [float::/ _.fdiv] + [float::% _.frem] + + [double::+ _.dadd] + [double::- _.dsub] + [double::* _.dmul] + [double::/ _.ddiv] + [double::% _.drem] + ) + +(def: $Boolean (type.class box.boolean (list))) +(def: falseG (_.getstatic ..$Boolean "FALSE" ..$Boolean)) +(def: trueG (_.getstatic ..$Boolean "TRUE" ..$Boolean)) + +(template [<name> <op>] + [(def: (<name> [xG yG]) + (Binary (Bytecode Any)) + (do _.monad + [@then _.new-label + @end _.new-label] + ($_ _.compose + xG + yG + (<op> @then) + falseG + (_.goto @end) + (_.set-label @then) + trueG + (_.set-label @end))))] + + [int::= _.if-icmpeq] + [int::< _.if-icmplt] + + [char::= _.if-icmpeq] + [char::< _.if-icmplt] + ) + +(template [<name> <op> <reference>] + [(def: (<name> [xG yG]) + (Binary (Bytecode Any)) + (do _.monad + [@then _.new-label + @end _.new-label] + ($_ _.compose + xG + yG + <op> + (_.int (i32.i32 (.i64 <reference>))) + (_.if-icmpeq @then) + falseG + (_.goto @end) + (_.set-label @then) + trueG + (_.set-label @end))))] + + [long::= _.lcmp +0] + [long::< _.lcmp -1] + + [float::= _.fcmpg +0] + [float::< _.fcmpg -1] + + [double::= _.dcmpg +0] + [double::< _.dcmpg -1] + ) + +(def: bundle::int + Bundle + (<| (/////bundle.prefix (reflection.reflection reflection.int)) + (|> (: Bundle /////bundle.empty) + (/////bundle.install "+" (binary int::+)) + (/////bundle.install "-" (binary int::-)) + (/////bundle.install "*" (binary int::*)) + (/////bundle.install "/" (binary int::/)) + (/////bundle.install "%" (binary int::%)) + (/////bundle.install "=" (binary int::=)) + (/////bundle.install "<" (binary int::<)) + (/////bundle.install "and" (binary int::and)) + (/////bundle.install "or" (binary int::or)) + (/////bundle.install "xor" (binary int::xor)) + (/////bundle.install "shl" (binary int::shl)) + (/////bundle.install "shr" (binary int::shr)) + (/////bundle.install "ushr" (binary int::ushr)) + ))) + +(def: bundle::long + Bundle + (<| (/////bundle.prefix (reflection.reflection reflection.long)) + (|> (: Bundle /////bundle.empty) + (/////bundle.install "+" (binary long::+)) + (/////bundle.install "-" (binary long::-)) + (/////bundle.install "*" (binary long::*)) + (/////bundle.install "/" (binary long::/)) + (/////bundle.install "%" (binary long::%)) + (/////bundle.install "=" (binary long::=)) + (/////bundle.install "<" (binary long::<)) + (/////bundle.install "and" (binary long::and)) + (/////bundle.install "or" (binary long::or)) + (/////bundle.install "xor" (binary long::xor)) + (/////bundle.install "shl" (binary long::shl)) + (/////bundle.install "shr" (binary long::shr)) + (/////bundle.install "ushr" (binary long::ushr)) + ))) + +(def: bundle::float + Bundle + (<| (/////bundle.prefix (reflection.reflection reflection.float)) + (|> (: Bundle /////bundle.empty) + (/////bundle.install "+" (binary float::+)) + (/////bundle.install "-" (binary float::-)) + (/////bundle.install "*" (binary float::*)) + (/////bundle.install "/" (binary float::/)) + (/////bundle.install "%" (binary float::%)) + (/////bundle.install "=" (binary float::=)) + (/////bundle.install "<" (binary float::<)) + ))) + +(def: bundle::double + Bundle + (<| (/////bundle.prefix (reflection.reflection reflection.double)) + (|> (: Bundle /////bundle.empty) + (/////bundle.install "+" (binary double::+)) + (/////bundle.install "-" (binary double::-)) + (/////bundle.install "*" (binary double::*)) + (/////bundle.install "/" (binary double::/)) + (/////bundle.install "%" (binary double::%)) + (/////bundle.install "=" (binary double::=)) + (/////bundle.install "<" (binary double::<)) + ))) + +(def: bundle::char + Bundle + (<| (/////bundle.prefix (reflection.reflection reflection.char)) + (|> (: Bundle /////bundle.empty) + (/////bundle.install "=" (binary char::=)) + (/////bundle.install "<" (binary char::<)) + ))) + +(template [<name> <category> <parser>] + [(def: #export <name> + (Parser (Type <category>)) + (<t>.embed <parser> <s>.text))] + + [var Var parser.var] + [class category.Class parser.class] + [object Object parser.object] + [value Value parser.value] + [return Return parser.return] + ) + +(exception: #export (not-an-object-array {arrayJT (Type Array)}) + (exception.report + ["JVM Type" (|> arrayJT type.signature signature.signature)])) + +(def: #export object-array + (Parser (Type Object)) + (do <>.monad + [arrayJT (<t>.embed parser.array <s>.text)] + (case (parser.array? arrayJT) + (#.Some elementJT) + (case (parser.object? elementJT) + (#.Some elementJT) + (wrap elementJT) + + #.None + (<>.fail (exception.construct ..not-an-object-array arrayJT))) + + #.None + (undefined)))) + +(def: (primitive-array-length-handler jvm-primitive) + (-> (Type Primitive) Handler) + (..custom + [<s>.any + (function (_ extension-name generate arrayS) + (do /////.monad + [arrayG (generate arrayS)] + (wrap ($_ _.compose + arrayG + (_.checkcast (type.array jvm-primitive)) + _.arraylength))))])) + +(def: array::length::object + Handler + (..custom + [($_ <>.and ..object-array <s>.any) + (function (_ extension-name generate [elementJT arrayS]) + (do /////.monad + [arrayG (generate arrayS)] + (wrap ($_ _.compose + arrayG + (_.checkcast (type.array elementJT)) + _.arraylength))))])) + +(def: (new-primitive-array-handler jvm-primitive) + (-> Primitive-Array-Type Handler) + (..custom + [<s>.any + (function (_ extension-name generate [lengthS]) + (do /////.monad + [lengthG (generate lengthS)] + (wrap ($_ _.compose + lengthG + (_.newarray jvm-primitive)))))])) + +(def: array::new::object + Handler + (..custom + [($_ <>.and ..object <s>.any) + (function (_ extension-name generate [objectJT lengthS]) + (do /////.monad + [lengthG (generate lengthS)] + (wrap ($_ _.compose + lengthG + (_.anewarray objectJT)))))])) + +(def: (read-primitive-array-handler jvm-primitive loadG) + (-> (Type Primitive) (Bytecode Any) Handler) + (..custom + [($_ <>.and <s>.any <s>.any) + (function (_ extension-name generate [idxS arrayS]) + (do /////.monad + [arrayG (generate arrayS) + idxG (generate idxS)] + (wrap ($_ _.compose + arrayG + (_.checkcast (type.array jvm-primitive)) + idxG + loadG))))])) + +(def: array::read::object + Handler + (..custom + [($_ <>.and ..object-array <s>.any <s>.any) + (function (_ extension-name generate [elementJT idxS arrayS]) + (do /////.monad + [arrayG (generate arrayS) + idxG (generate idxS)] + (wrap ($_ _.compose + arrayG + (_.checkcast (type.array elementJT)) + idxG + _.aaload))))])) + +(def: (write-primitive-array-handler jvm-primitive storeG) + (-> (Type Primitive) (Bytecode Any) Handler) + (..custom + [($_ <>.and <s>.any <s>.any <s>.any) + (function (_ extension-name generate [idxS valueS arrayS]) + (do /////.monad + [arrayG (generate arrayS) + idxG (generate idxS) + valueG (generate valueS)] + (wrap ($_ _.compose + arrayG + (_.checkcast (type.array jvm-primitive)) + _.dup + idxG + valueG + storeG))))])) + +(def: array::write::object + Handler + (..custom + [($_ <>.and ..object-array <s>.any <s>.any <s>.any) + (function (_ extension-name generate [elementJT idxS valueS arrayS]) + (do /////.monad + [arrayG (generate arrayS) + idxG (generate idxS) + valueG (generate valueS)] + (wrap ($_ _.compose + arrayG + (_.checkcast (type.array elementJT)) + _.dup + idxG + valueG + _.aastore))))])) + +(def: bundle::array + Bundle + (<| (/////bundle.prefix "array") + (|> /////bundle.empty + (dictionary.merge (<| (/////bundle.prefix "length") + (|> /////bundle.empty + (/////bundle.install (reflection.reflection reflection.boolean) (primitive-array-length-handler type.boolean)) + (/////bundle.install (reflection.reflection reflection.byte) (primitive-array-length-handler type.byte)) + (/////bundle.install (reflection.reflection reflection.short) (primitive-array-length-handler type.short)) + (/////bundle.install (reflection.reflection reflection.int) (primitive-array-length-handler type.int)) + (/////bundle.install (reflection.reflection reflection.long) (primitive-array-length-handler type.long)) + (/////bundle.install (reflection.reflection reflection.float) (primitive-array-length-handler type.float)) + (/////bundle.install (reflection.reflection reflection.double) (primitive-array-length-handler type.double)) + (/////bundle.install (reflection.reflection reflection.char) (primitive-array-length-handler type.char)) + (/////bundle.install "object" array::length::object)))) + (dictionary.merge (<| (/////bundle.prefix "new") + (|> /////bundle.empty + (/////bundle.install (reflection.reflection reflection.boolean) (new-primitive-array-handler __.t-boolean)) + (/////bundle.install (reflection.reflection reflection.byte) (new-primitive-array-handler __.t-byte)) + (/////bundle.install (reflection.reflection reflection.short) (new-primitive-array-handler __.t-short)) + (/////bundle.install (reflection.reflection reflection.int) (new-primitive-array-handler __.t-int)) + (/////bundle.install (reflection.reflection reflection.long) (new-primitive-array-handler __.t-long)) + (/////bundle.install (reflection.reflection reflection.float) (new-primitive-array-handler __.t-float)) + (/////bundle.install (reflection.reflection reflection.double) (new-primitive-array-handler __.t-double)) + (/////bundle.install (reflection.reflection reflection.char) (new-primitive-array-handler __.t-char)) + (/////bundle.install "object" array::new::object)))) + (dictionary.merge (<| (/////bundle.prefix "read") + (|> /////bundle.empty + (/////bundle.install (reflection.reflection reflection.boolean) (read-primitive-array-handler type.boolean _.baload)) + (/////bundle.install (reflection.reflection reflection.byte) (read-primitive-array-handler type.byte _.baload)) + (/////bundle.install (reflection.reflection reflection.short) (read-primitive-array-handler type.short _.saload)) + (/////bundle.install (reflection.reflection reflection.int) (read-primitive-array-handler type.int _.iaload)) + (/////bundle.install (reflection.reflection reflection.long) (read-primitive-array-handler type.long _.laload)) + (/////bundle.install (reflection.reflection reflection.float) (read-primitive-array-handler type.float _.faload)) + (/////bundle.install (reflection.reflection reflection.double) (read-primitive-array-handler type.double _.daload)) + (/////bundle.install (reflection.reflection reflection.char) (read-primitive-array-handler type.char _.caload)) + (/////bundle.install "object" array::read::object)))) + (dictionary.merge (<| (/////bundle.prefix "write") + (|> /////bundle.empty + (/////bundle.install (reflection.reflection reflection.boolean) (write-primitive-array-handler type.boolean _.bastore)) + (/////bundle.install (reflection.reflection reflection.byte) (write-primitive-array-handler type.byte _.bastore)) + (/////bundle.install (reflection.reflection reflection.short) (write-primitive-array-handler type.short _.sastore)) + (/////bundle.install (reflection.reflection reflection.int) (write-primitive-array-handler type.int _.iastore)) + (/////bundle.install (reflection.reflection reflection.long) (write-primitive-array-handler type.long _.lastore)) + (/////bundle.install (reflection.reflection reflection.float) (write-primitive-array-handler type.float _.fastore)) + (/////bundle.install (reflection.reflection reflection.double) (write-primitive-array-handler type.double _.dastore)) + (/////bundle.install (reflection.reflection reflection.char) (write-primitive-array-handler type.char _.castore)) + (/////bundle.install "object" array::write::object)))) + ))) + +(def: (object::null _) + (Nullary (Bytecode Any)) + _.aconst-null) + +(def: (object::null? objectG) + (Unary (Bytecode Any)) + (do _.monad + [@then _.new-label + @end _.new-label] + ($_ _.compose + objectG + (_.ifnull @then) + ..falseG + (_.goto @end) + (_.set-label @then) + ..trueG + (_.set-label @end)))) + +(def: (object::synchronized [monitorG exprG]) + (Binary (Bytecode Any)) + ($_ _.compose + monitorG + _.dup + _.monitorenter + exprG + _.swap + _.monitorexit)) + +(def: (object::throw exceptionG) + (Unary (Bytecode Any)) + ($_ _.compose + exceptionG + _.athrow)) + +(def: $Class (type.class "java.lang.Class" (list))) +(def: $String (type.class "java.lang.String" (list))) + +(def: object::class + Handler + (..custom + [<s>.text + (function (_ extension-name generate [class]) + (do /////.monad + [] + (wrap ($_ _.compose + (_.string class) + (_.invokestatic ..$Class "forName" (type.method [(list ..$String) ..$Class (list)]))))))])) + +(def: object::instance? + Handler + (..custom + [($_ <>.and <s>.text <s>.any) + (function (_ extension-name generate [class objectS]) + (do /////.monad + [objectG (generate objectS)] + (wrap ($_ _.compose + objectG + (_.instanceof (type.class class (list))) + (_.invokestatic ..$Boolean "valueOf" (type.method [(list type.boolean) ..$Boolean (list)]))))))])) + +(def: reflection + (All [category] + (-> (Type (<| Return' Value' category)) Text)) + (|>> type.reflection reflection.reflection)) + +(def: object::cast + Handler + (..custom + [($_ <>.and <s>.text <s>.text <s>.any) + (function (_ extension-name generate [from to valueS]) + (do /////.monad + [valueG (generate valueS)] + (wrap (`` (cond (~~ (template [<object> <type> <unwrap>] + [(and (text@= (..reflection <type>) + from) + (text@= <object> + to)) + (let [$<object> (type.class <object> (list))] + ($_ _.compose + valueG + (_.invokestatic $<object> "valueOf" (type.method [(list <type>) $<object> (list)])))) + + (and (text@= <object> + from) + (text@= (..reflection <type>) + to)) + (let [$<object> (type.class <object> (list))] + ($_ _.compose + valueG + (_.checkcast $<object>) + (_.invokevirtual $<object> <unwrap> (type.method [(list) <type> (list)]))))] + + [box.boolean type.boolean "booleanValue"] + [box.byte type.byte "byteValue"] + [box.short type.short "shortValue"] + [box.int type.int "intValue"] + [box.long type.long "longValue"] + [box.float type.float "floatValue"] + [box.double type.double "doubleValue"] + [box.char type.char "charValue"])) + ## else + valueG)))))])) + +(def: bundle::object + Bundle + (<| (/////bundle.prefix "object") + (|> (: Bundle /////bundle.empty) + (/////bundle.install "null" (nullary object::null)) + (/////bundle.install "null?" (unary object::null?)) + (/////bundle.install "synchronized" (binary object::synchronized)) + (/////bundle.install "throw" (unary object::throw)) + (/////bundle.install "class" object::class) + (/////bundle.install "instance?" object::instance?) + (/////bundle.install "cast" object::cast) + ))) + +(def: primitives + (Dictionary Text (Type Primitive)) + (|> (list [(reflection.reflection reflection.boolean) type.boolean] + [(reflection.reflection reflection.byte) type.byte] + [(reflection.reflection reflection.short) type.short] + [(reflection.reflection reflection.int) type.int] + [(reflection.reflection reflection.long) type.long] + [(reflection.reflection reflection.float) type.float] + [(reflection.reflection reflection.double) type.double] + [(reflection.reflection reflection.char) type.char]) + (dictionary.from-list text.hash))) + +(def: get::static + Handler + (..custom + [($_ <>.and <s>.text <s>.text <s>.text) + (function (_ extension-name generate [class field unboxed]) + (do /////.monad + [#let [$class (type.class class (list))]] + (case (dictionary.get unboxed ..primitives) + (#.Some primitive) + (wrap (_.getstatic $class field primitive)) + + #.None + (wrap (_.getstatic $class field (type.class unboxed (list)))))))])) + +(def: unitG (_.string //////synthesis.unit)) + +(def: put::static + Handler + (..custom + [($_ <>.and <s>.text <s>.text <s>.text <s>.any) + (function (_ extension-name generate [class field unboxed valueS]) + (do /////.monad + [valueG (generate valueS) + #let [$class (type.class class (list))]] + (case (dictionary.get unboxed ..primitives) + (#.Some primitive) + (wrap ($_ _.compose + valueG + (_.putstatic $class field primitive) + ..unitG)) + + #.None + (wrap ($_ _.compose + valueG + (_.checkcast $class) + (_.putstatic $class field $class) + ..unitG)))))])) + +(def: get::virtual + Handler + (..custom + [($_ <>.and <s>.text <s>.text <s>.text <s>.any) + (function (_ extension-name generate [class field unboxed objectS]) + (do /////.monad + [objectG (generate objectS) + #let [$class (type.class class (list)) + getG (case (dictionary.get unboxed ..primitives) + (#.Some primitive) + (_.getfield $class field primitive) + + #.None + (_.getfield $class field (type.class unboxed (list))))]] + (wrap ($_ _.compose + objectG + (_.checkcast $class) + getG))))])) + +(def: put::virtual + Handler + (..custom + [($_ <>.and <s>.text <s>.text <s>.text <s>.any <s>.any) + (function (_ extension-name generate [class field unboxed valueS objectS]) + (do /////.monad + [valueG (generate valueS) + objectG (generate objectS) + #let [$class (type.class class (list)) + putG (case (dictionary.get unboxed ..primitives) + (#.Some primitive) + (_.putfield $class field primitive) + + #.None + (let [$unboxed (type.class unboxed (list))] + ($_ _.compose + (_.checkcast $unboxed) + (_.putfield $class field $unboxed))))]] + (wrap ($_ _.compose + objectG + (_.checkcast $class) + _.dup + valueG + putG))))])) + +(type: Input (Typed Synthesis)) + +(def: input + (Parser Input) + (<s>.tuple (<>.and ..value <s>.any))) + +(def: (generate-input generate [valueT valueS]) + (-> (-> Synthesis (Operation (Bytecode Any))) Input + (Operation (Typed (Bytecode Any)))) + (do /////.monad + [valueG (generate valueS)] + (case (type.primitive? valueT) + (#.Right valueT) + (wrap [valueT valueG]) + + (#.Left valueT) + (wrap [valueT ($_ _.compose + valueG + (_.checkcast valueT))])))) + +(def: (prepare-output outputT) + (-> (Type Return) (Bytecode Any)) + (case (type.void? outputT) + (#.Right outputT) + ..unitG + + (#.Left outputT) + (:: _.monad wrap []))) + +(def: invoke::static + Handler + (..custom + [($_ <>.and ..class <s>.text ..return (<>.some ..input)) + (function (_ extension-name generate [class method outputT inputsTS]) + (do /////.monad + [inputsTG (monad.map @ (generate-input generate) inputsTS)] + (wrap ($_ _.compose + (monad.map _.monad product.right inputsTG) + (_.invokestatic class method (type.method [(list@map product.left inputsTG) outputT (list)])) + (prepare-output outputT)))))])) + +(template [<name> <invoke>] + [(def: <name> + Handler + (..custom + [($_ <>.and ..class <s>.text ..return <s>.any (<>.some ..input)) + (function (_ extension-name generate [class method outputT objectS inputsTS]) + (do /////.monad + [objectG (generate objectS) + inputsTG (monad.map @ (generate-input generate) inputsTS)] + (wrap ($_ _.compose + objectG + (_.checkcast class) + (monad.map _.monad product.right inputsTG) + (<invoke> class method (type.method [(list@map product.left inputsTG) outputT (list)])) + (prepare-output outputT)))))]))] + + [invoke::virtual _.invokevirtual] + [invoke::special _.invokespecial] + [invoke::interface _.invokeinterface] + ) + +(def: invoke::constructor + Handler + (..custom + [($_ <>.and ..class (<>.some ..input)) + (function (_ extension-name generate [class inputsTS]) + (do /////.monad + [inputsTG (monad.map @ (generate-input generate) inputsTS)] + (wrap ($_ _.compose + (_.new class) + _.dup + (monad.map _.monad product.right inputsTG) + (_.invokespecial class "<init>" (type.method [(list@map product.left inputsTG) type.void (list)]))))))])) + +(def: bundle::member + Bundle + (<| (/////bundle.prefix "member") + (|> (: Bundle /////bundle.empty) + (dictionary.merge (<| (/////bundle.prefix "get") + (|> (: Bundle /////bundle.empty) + (/////bundle.install "static" get::static) + (/////bundle.install "virtual" get::virtual)))) + (dictionary.merge (<| (/////bundle.prefix "put") + (|> (: Bundle /////bundle.empty) + (/////bundle.install "static" put::static) + (/////bundle.install "virtual" put::virtual)))) + (dictionary.merge (<| (/////bundle.prefix "invoke") + (|> (: Bundle /////bundle.empty) + (/////bundle.install "static" invoke::static) + (/////bundle.install "virtual" invoke::virtual) + (/////bundle.install "special" invoke::special) + (/////bundle.install "interface" invoke::interface) + (/////bundle.install "constructor" invoke::constructor)))) + ))) + +(def: annotation-parameter + (Parser (/.Annotation-Parameter Synthesis)) + (<s>.tuple (<>.and <s>.text <s>.any))) + +(def: annotation + (Parser (/.Annotation Synthesis)) + (<s>.tuple (<>.and <s>.text (<>.some ..annotation-parameter)))) + +(def: argument + (Parser Argument) + (<s>.tuple (<>.and <s>.text ..value))) + +(def: overriden-method-definition + (Parser [Environment (/.Overriden-Method Synthesis)]) + (<s>.tuple (do <>.monad + [_ (<s>.text! /.overriden-tag) + ownerT ..class + name <s>.text + strict-fp? <s>.bit + annotations (<s>.tuple (<>.some ..annotation)) + vars (<s>.tuple (<>.some ..var)) + self-name <s>.text + arguments (<s>.tuple (<>.some ..argument)) + returnT ..return + exceptionsT (<s>.tuple (<>.some ..class)) + [environment body] (<s>.function 1 + (<s>.tuple <s>.any))] + (wrap [environment + [ownerT name + strict-fp? annotations vars + self-name arguments returnT exceptionsT + body]])))) + +(def: (normalize-path normalize) + (-> (-> Synthesis Synthesis) + (-> Path Path)) + (function (recur path) + (case path + (^ (//////synthesis.path/then bodyS)) + (//////synthesis.path/then (normalize bodyS)) + + (^template [<tag>] + (^ (<tag> leftP rightP)) + (<tag> (recur leftP) (recur rightP))) + ([#//////synthesis.Alt] + [#//////synthesis.Seq]) + + (^template [<tag>] + (^ (<tag> value)) + path) + ([#//////synthesis.Pop] + [#//////synthesis.Test] + [#//////synthesis.Bind] + [#//////synthesis.Access])))) + +(def: (normalize-method-body mapping) + (-> (Dictionary Variable Variable) Synthesis Synthesis) + (function (recur body) + (case body + (^template [<tag>] + (^ (<tag> value)) + body) + ([#//////synthesis.Primitive] + [//////synthesis.constant]) + + (^ (//////synthesis.variant [lefts right? sub])) + (//////synthesis.variant [lefts right? (recur sub)]) + + (^ (//////synthesis.tuple members)) + (//////synthesis.tuple (list@map recur members)) + + (^ (//////synthesis.variable var)) + (|> mapping + (dictionary.get var) + (maybe.default var) + //////synthesis.variable) + + (^ (//////synthesis.branch/case [inputS pathS])) + (//////synthesis.branch/case [(recur inputS) (normalize-path recur pathS)]) + + (^ (//////synthesis.branch/let [inputS register outputS])) + (//////synthesis.branch/let [(recur inputS) register (recur outputS)]) + + (^ (//////synthesis.branch/if [testS thenS elseS])) + (//////synthesis.branch/if [(recur testS) (recur thenS) (recur elseS)]) + + (^ (//////synthesis.loop/scope [offset initsS+ bodyS])) + (//////synthesis.loop/scope [offset (list@map recur initsS+) (recur bodyS)]) + + (^ (//////synthesis.loop/recur updatesS+)) + (//////synthesis.loop/recur (list@map recur updatesS+)) + + (^ (//////synthesis.function/abstraction [environment arity bodyS])) + (//////synthesis.function/abstraction [(|> environment (list@map (function (_ local) + (|> mapping + (dictionary.get local) + (maybe.default local))))) + arity + bodyS]) + + (^ (//////synthesis.function/apply [functionS inputsS+])) + (//////synthesis.function/apply [(recur functionS) (list@map recur inputsS+)]) + + (#//////synthesis.Extension [name inputsS+]) + (#//////synthesis.Extension [name (list@map recur inputsS+)])))) + +(def: $Object (type.class "java.lang.Object" (list))) + +(def: (anonymous-init-method env) + (-> Environment (Type category.Method)) + (type.method [(list.repeat (list.size env) ..$Object) + type.void + (list)])) + +(def: (with-anonymous-init class env super-class inputsTG) + (-> (Type category.Class) Environment (Type category.Class) (List (Typed (Bytecode Any))) (Resource Method)) + (let [store-capturedG (|> env + list.size + list.indices + (monad.map _.monad (.function (_ register) + ($_ _.compose + (_.aload 0) + (_.aload (inc register)) + (_.putfield class (///reference.foreign-name register) $Object)))))] + (method.method method.public "<init>" (anonymous-init-method env) + (list) + (#.Some ($_ _.compose + (_.aload 0) + (monad.map _.monad product.right inputsTG) + (_.invokespecial super-class "<init>" (type.method [(list@map product.left inputsTG) type.void (list)])) + store-capturedG + _.return))))) + +(def: (anonymous-instance class env) + (-> (Type category.Class) Environment (Operation (Bytecode Any))) + (do /////.monad + [captureG+ (monad.map @ ///reference.variable env)] + (wrap ($_ _.compose + (_.new class) + _.dup + (monad.seq _.monad captureG+) + (_.invokespecial class "<init>" (anonymous-init-method env)))))) + +(def: (returnG returnT) + (-> (Type Return) (Bytecode Any)) + (case (type.void? returnT) + (#.Right returnT) + _.return + + (#.Left returnT) + (case (type.primitive? returnT) + (#.Left returnT) + ($_ _.compose + (_.checkcast returnT) + _.areturn) + + (#.Right returnT) + (cond (or (:: type.equivalence = type.boolean returnT) + (:: type.equivalence = type.byte returnT) + (:: type.equivalence = type.short returnT) + (:: type.equivalence = type.int returnT) + (:: type.equivalence = type.char returnT)) + _.ireturn + + (:: type.equivalence = type.long returnT) + _.lreturn + + (:: type.equivalence = type.float returnT) + _.freturn + + ## (:: type.equivalence = type.double returnT) + _.dreturn)))) + +(def: class::anonymous + Handler + (..custom + [($_ <>.and + <s>.text + ..class + (<s>.tuple (<>.some ..class)) + (<s>.tuple (<>.some ..input)) + (<s>.tuple (<>.some ..overriden-method-definition))) + (function (_ extension-name generate [class-name + super-class super-interfaces + inputsTS + overriden-methods]) + (do /////.monad + [#let [class (type.class class-name (list)) + total-environment (|> overriden-methods + ## Get all the environments. + (list@map product.left) + ## Combine them. + list@join + ## Remove duplicates. + (set.from-list //////reference.hash) + set.to-list) + global-mapping (|> total-environment + ## Give them names as "foreign" variables. + list.enumerate + (list@map (function (_ [id capture]) + [capture (#//////reference.Foreign id)])) + (dictionary.from-list //////reference.hash)) + normalized-methods (list@map (function (_ [environment + [ownerT name + strict-fp? annotations vars + self-name arguments returnT exceptionsT + body]]) + (let [local-mapping (|> environment + list.enumerate + (list@map (function (_ [foreign-id capture]) + [(#//////reference.Foreign foreign-id) + (|> global-mapping + (dictionary.get capture) + maybe.assume)])) + (dictionary.from-list //////reference.hash))] + [ownerT name + strict-fp? annotations vars + self-name arguments returnT exceptionsT + (normalize-method-body local-mapping body)])) + overriden-methods)] + inputsTI (monad.map @ (generate-input generate) inputsTS) + method-definitions (monad.map @ (function (_ [ownerT name + strict-fp? annotations vars + self-name arguments returnT exceptionsT + bodyS]) + (do @ + [bodyG (generation.with-specific-context class-name + (generate bodyS))] + (wrap (method.method ($_ modifier@compose + method.public + method.final + (if strict-fp? + method.strict + modifier@identity)) + name + (type.method [(list@map product.right arguments) + returnT + exceptionsT]) + (list) + (#.Some ($_ _.compose + bodyG + (returnG returnT))))))) + normalized-methods) + bytecode (<| (:: @ map (format.run class.writer)) + /////.lift + (class.class version.v6_0 ($_ modifier@compose class.public class.final) + (name.internal class-name) + (name.internal (..reflection super-class)) + (list@map (|>> ..reflection name.internal) super-interfaces) + (foreign.variables total-environment) + (list& (..with-anonymous-init class total-environment super-class inputsTI) + method-definitions) + (row.row))) + _ (generation.save! true ["" class-name] [class-name bytecode])] + (anonymous-instance class total-environment)))])) + +(def: bundle::class + Bundle + (<| (/////bundle.prefix "class") + (|> (: Bundle /////bundle.empty) + (/////bundle.install "anonymous" class::anonymous) + ))) + +(def: #export bundle + Bundle + (<| (/////bundle.prefix "jvm") + (|> ..bundle::conversion + (dictionary.merge ..bundle::int) + (dictionary.merge ..bundle::long) + (dictionary.merge ..bundle::float) + (dictionary.merge ..bundle::double) + (dictionary.merge ..bundle::char) + (dictionary.merge ..bundle::array) + (dictionary.merge ..bundle::object) + (dictionary.merge ..bundle::member) + (dictionary.merge ..bundle::class) + ))) |