aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorEduardo Julian2019-09-07 01:50:37 -0400
committerEduardo Julian2019-09-07 01:50:37 -0400
commitb63ac226cc2ea843f08f7c72b18d22602462c624 (patch)
tree7fb72562c39549108b7a48c1a6819c9bd3a64dab
parent181f93f3e963c9738ed60f6f5e2d2a37253a0b1b (diff)
Modified compiler's machinery to use the new abstractions for descriptors and signatures.
-rw-r--r--documentation/research/Memory Management.md4
-rw-r--r--documentation/research/Type theory/Dependent types.md4
-rw-r--r--documentation/research/distributed_programming.md1
-rw-r--r--documentation/research/game_programming.md146
-rw-r--r--documentation/research/machine_learning.md4
-rw-r--r--documentation/research/math.md4
-rw-r--r--documentation/research/operating_system.md1
-rw-r--r--documentation/research/paradigm/Ambient-Oriented Programming.md5
-rw-r--r--documentation/research/paradigm/logic_programming.md1
-rw-r--r--documentation/research/tool/build_system.md1
-rw-r--r--new-luxc/source/luxc/lang/host/jvm.lux9
-rw-r--r--new-luxc/source/luxc/lang/host/jvm/def.lux107
-rw-r--r--new-luxc/source/luxc/lang/host/jvm/inst.lux115
-rw-r--r--new-luxc/source/luxc/lang/statement/jvm.lux52
-rw-r--r--new-luxc/source/luxc/lang/translation/jvm.lux16
-rw-r--r--new-luxc/source/luxc/lang/translation/jvm/case.lux34
-rw-r--r--new-luxc/source/luxc/lang/translation/jvm/function.lux47
-rw-r--r--new-luxc/source/luxc/lang/translation/jvm/primitive.lux9
-rw-r--r--new-luxc/source/luxc/lang/translation/jvm/procedure/common.lux109
-rw-r--r--new-luxc/source/luxc/lang/translation/jvm/procedure/host.lux675
-rw-r--r--new-luxc/source/luxc/lang/translation/jvm/reference.lux7
-rw-r--r--new-luxc/source/luxc/lang/translation/jvm/runtime.lux102
-rw-r--r--new-luxc/source/luxc/lang/translation/jvm/structure.lux13
-rw-r--r--new-luxc/source/program.lux18
-rw-r--r--stdlib/source/lux/control/parser/code.lux11
-rw-r--r--stdlib/source/lux/control/parser/text.lux11
-rw-r--r--stdlib/source/lux/control/try.lux9
-rw-r--r--stdlib/source/lux/macro/syntax/common/reader.lux2
-rw-r--r--stdlib/source/lux/target/jvm/reflection.lux185
-rw-r--r--stdlib/source/lux/target/jvm/type.lux200
-rw-r--r--stdlib/source/lux/target/jvm/type/alias.lux112
-rw-r--r--stdlib/source/lux/target/jvm/type/box.lux7
-rw-r--r--stdlib/source/lux/target/jvm/type/category.lux1
-rw-r--r--stdlib/source/lux/target/jvm/type/descriptor.lux49
-rw-r--r--stdlib/source/lux/target/jvm/type/lux.lux138
-rw-r--r--stdlib/source/lux/target/jvm/type/parser.lux195
-rw-r--r--stdlib/source/lux/target/jvm/type/reflection.lux10
-rw-r--r--stdlib/source/lux/target/jvm/type/signature.lux4
-rw-r--r--stdlib/source/lux/tool/compiler/phase/extension/analysis/jvm.lux823
-rw-r--r--stdlib/source/lux/tool/compiler/phase/extension/statement/lux.lux6
40 files changed, 1757 insertions, 1490 deletions
diff --git a/documentation/research/Memory Management.md b/documentation/research/Memory Management.md
new file mode 100644
index 000000000..80f80ce12
--- /dev/null
+++ b/documentation/research/Memory Management.md
@@ -0,0 +1,4 @@
+# Reference counting
+
+1. [Counting Immutable Beans: Reference Counting Optimized for Purely Functional Programming](https://arxiv.org/abs/1908.05647)
+
diff --git a/documentation/research/Type theory/Dependent types.md b/documentation/research/Type theory/Dependent types.md
index f8849fcd1..8ea68473b 100644
--- a/documentation/research/Type theory/Dependent types.md
+++ b/documentation/research/Type theory/Dependent types.md
@@ -1,9 +1,13 @@
# Exemplar
+1. [A simple type-theoretic language: Mini-TT](http://www.cse.chalmers.se/~bengt/papers/GKminiTT.pdf)
1. https://cedille.github.io/
# Reference
+1. [A Path To DOT: Formalizing Fully Path-Dependent Types](https://arxiv.org/abs/1904.07298)
+1. [Ghosts of Departed Proofs (Functional Pearl)](https://www.youtube.com/watch?v=2cAxOJEiL00)
+1. [Ghosts of Departed Proofs (Functional Pearl)](https://kataskeue.com/gdp.pdf)
1. [F# Linear algebra with type-level dimensions and static checks](https://notebooks.azure.com/allisterb/projects/sylvester/html/Sylvester.Tensors.ipynb)
1. [From Scheme to Dependent Types in 100 lines by Gershom Bazerman](https://vimeo.com/134561872 &&& https://vimeo.com/135746080)
1. [A Tutorial Implementation of a Dependently Typed Lambda Calculus](https://www.andres-loeh.de/LambdaPi/)
diff --git a/documentation/research/distributed_programming.md b/documentation/research/distributed_programming.md
index 991edf8b0..17f48122c 100644
--- a/documentation/research/distributed_programming.md
+++ b/documentation/research/distributed_programming.md
@@ -67,6 +67,7 @@
# Logical clock
+1. [Version Vectors are not Vector Clocks](https://haslab.wordpress.com/2011/07/08/version-vectors-are-not-vector-clocks/)
1. [Distributed Systems: Physical, Logical, and Vector Clocks](https://levelup.gitconnected.com/distributed-systems-physical-logical-and-vector-clocks-7ca989f5f780)
1. [The Bloom Clock](https://arxiv.org/pdf/1905.13064.pdf)
1. [Why Logical Clocks are Easy: Sometimes all you need is the right language.](https://queue.acm.org/detail.cfm?id=2917756)
diff --git a/documentation/research/game_programming.md b/documentation/research/game_programming.md
index 5034eda93..30fa24165 100644
--- a/documentation/research/game_programming.md
+++ b/documentation/research/game_programming.md
@@ -1,3 +1,12 @@
+# Noise
+
+1. [Perlin noise](https://en.wikipedia.org/wiki/Perlin_noise)
+1. [Gradient noise](https://en.wikipedia.org/wiki/Gradient_noise)
+1. [Value noise](https://en.wikipedia.org/wiki/Value_noise)
+1. [Simplex noise](https://en.wikipedia.org/wiki/Simplex_noise)
+1. [OpenSimplex noise](https://en.wikipedia.org/wiki/OpenSimplex_noise)
+1. [Worley noise](https://en.wikipedia.org/wiki/Worley_noise)
+
# Ethics
1. [Ethics in Game Design - PAX Prime 2012](https://www.youtube.com/watch?v=sIS5cJzeLGA)
@@ -59,6 +68,9 @@
# Rendering
+1. [The Graphics Codex](http://graphicscodex.com/)
+1. [PIXELARTOR: Animation Tool for converting 3D models with animations to 2D sprite frames](https://github.com/Chleba/PIXELARTOR)
+1. https://raytracing.github.io/
1. [WebGL2 Fundamentals](https://webgl2fundamentals.org/)
1. [Tiles to Curves: Fun With Voronoi Graphs (part 1)](https://www.gamedev.net/articles/programming/general-and-gameplay-programming/tiles-to-curves-fun-with-voronoi-graphs-part-1-r5150/)
1. [Lazy Incremental Computation for Efficient Scene Graph Rendering](https://www.cg.tuwien.ac.at/courses/RendEng/2015/RendEng-2015-11-16-paper2.pdf)
@@ -124,6 +136,7 @@
# Entity Component System (ECS)
+1. [On DOTS: Entity Component System](https://blogs.unity3d.com/2019/03/08/on-dots-entity-component-system/)
1. http://cowboyprogramming.com/2007/01/05/evolve-your-heirachy/
1. [Bob Nystrom - Is There More to Game Architecture than ECS?](https://www.youtube.com/watch?v=JxI3Eu5DPwE)
@@ -168,6 +181,7 @@
# Hexagonal grid
1. https://www.redblobgames.com/grids/hexagons/
+1. [Hex Grid Geometry for Game Developers (1.3)](http://www.gamelogic.co.za/downloads/HexMath2.pdf)
# Mods / Modding
@@ -185,6 +199,138 @@
# Design
+1. [WIRED by Design: A Game Designer Explains the Counterintuitive Secret to Fun](https://www.youtube.com/watch?v=78rPt0RsosQ)
+1. [How to Add Literally Infinite Features into Minecraft (with one update)](https://www.youtube.com/watch?v=CS5DQVSp058)
+1. [Can We Make Talking as Much Fun as Shooting? | Game Maker's Toolkit](https://www.youtube.com/watch?v=l9TzqNQBmr0)
+1. [Are Score Systems Still Relevant? | Game Maker's Toolkit](https://www.youtube.com/watch?v=K6y9PJipfpk)
+1. [What Makes a Good Combat System? | Game Maker's Toolkit](https://www.youtube.com/watch?v=8X4fx-YncqA)
+1. [The Rise of the Systemic Game | Game Maker's Toolkit](https://www.youtube.com/watch?v=SnpAAX9CkIc)
+1. [Playing Past Your Mistakes | Game Maker's Toolkit](https://www.youtube.com/watch?v=Go0BQugwGgM)
+1. [How to Keep Players Engaged (Without Being Evil) | Game Maker's Toolkit](https://www.youtube.com/watch?v=hbzGO_Qonu0)
+1. [Building Better Skill Trees | Game Maker's Toolkit](https://www.youtube.com/watch?v=wsmEuHa1eL8)
+1. [The Year Stealth Games Got Serious | Game Maker's Toolkit](https://www.youtube.com/watch?v=Iz-XTR3pwrE)
+1. [Why Synergies are the Secret to Slay the Spire’s Fun | Game Maker’s Toolkit](https://www.youtube.com/watch?v=terD4Bk3L_8)
+1. [Why Metro Exodus is 2019’s Most Immersive Open World Game | Game Maker's Toolkit](https://www.youtube.com/watch?v=8geGHbWIMXA)
+1. [Roguelikes, Persistency, and Progression | Game Maker's Toolkit](https://www.youtube.com/watch?v=G9FB5R4wVno)
+1. [Do We Need a Soulslike Genre? | Game Maker's Toolkit](https://www.youtube.com/watch?v=Lx7BWayWu08)
+1. [The Lost Soul Arts of Demon's Souls](https://www.youtube.com/watch?v=Np5PdpsfINA)
+1. [Dark Souls 2 Critique](https://www.youtube.com/watch?v=UScsme8didI)
+1. [The World Design of Castlevania: Symphony of the Night | Boss Keys](https://www.youtube.com/watch?v=a1hHOVIkrcc)
+1. [Forging God of War's Leviathan Axe | Game Maker's Toolkit](https://www.youtube.com/watch?v=vwbz9gxoQFg)
+1. [How Thief's Stealth System Almost Didn't Work | War Stories | Ars Technica](https://www.youtube.com/watch?v=qzD9ldLoc3c)
+1. [What Makes a Good Puzzle? | Game Maker's Toolkit](https://www.youtube.com/watch?v=zsjC6fa_YBg)
+1. [How Games Use Feedback Loops | Game Maker’s Toolkit](https://www.youtube.com/watch?v=H4kbJObhcHw)
+1. [Three Other Approaches to Turn Timers | GMTK Extra](https://www.youtube.com/watch?v=QAVf7rb0IwM)
+1. [The World Design of Dark Souls | Boss Keys](https://www.youtube.com/watch?v=QhWdBhc3Wjc)
+1. [Depth, Mastery, and Vanquish | Game Maker's Toolkit](https://www.youtube.com/watch?v=IG8LVpuzYls)
+1. [Morality in the Mechanics | Game Maker's Toolkit](https://www.youtube.com/watch?v=6RHH7M4siPM)
+1. [Anatomy of a Side Quest: Beyond the Beef | Game Maker's Toolkit](https://www.youtube.com/watch?v=yM1yR7WYqgM)
+1. [Telling Stories with Systems | Game Maker's Toolkit](https://www.youtube.com/watch?v=NyMndWpihTM)
+1. [What Makes Good AI? | Game Maker's Toolkit](https://www.youtube.com/watch?v=9bbhJi0NBkk)
+1. [What Makes a Good Detective Game? | Game Maker's Toolkit](https://www.youtube.com/watch?v=gwV_mA2cv_0)
+1. [How Game Designers Protect Players From Themselves | Game Maker's Toolkit](https://www.youtube.com/watch?v=7L8vAGGitr8)
+1. [What Made Psychonauts Special | Game Maker's Toolkit](https://www.youtube.com/watch?v=5I4vD2S01d0)
+1. [How Event[0] Works | Game Maker's Toolkit](https://www.youtube.com/watch?v=bCJw4hQkPj4)
+1. [The Comeback of the Immersive Sim | Game Maker's Toolkit](https://www.youtube.com/watch?v=kbyTOAlhRHk)
+1. [How Games Do Health | Game Maker's Toolkit](https://www.youtube.com/watch?v=4AEKbBF3URE)
+1. [Should Dark Souls Have an Easy Mode? | Game Maker's Toolkit](https://www.youtube.com/watch?v=K5tPJDZv_VE)
+1. [Is Extreme RNG Bad For Game Design? (Critical Thought)](https://www.youtube.com/watch?v=yVhQWkQoykQ)
+1. [What Does it Mean to Last in the Game Industry? | Critical Thought](https://www.youtube.com/watch?v=Xku4IOO37s0)
+1. [The Game Design Trap of a Zelda Roguelike](https://www.youtube.com/watch?v=oWSj8WEy9YE)
+1. [Using Supplemental Content to Grow Rogue-Like and Strategy Game Design -- Critical Thought](https://www.youtube.com/watch?v=xsbPr0SND5s)
+1. [A Critical Thought on Class Based RPG Design](https://www.youtube.com/watch?v=EcX3rPHmmfI)
+1. [Why 2D Game Design Is Never Going Away | Critical Thought](https://www.youtube.com/watch?v=CqO4DgJZC04)
+1. [A Critical Thought on RPG Class Design](https://www.youtube.com/watch?v=ykvwgSAwvgM)
+1. [The Difficulty Behind Grand Strategy Game Design -- Critical Thought](https://www.youtube.com/watch?v=Vthi6_fgkWk)
+1. [Is The Swindle the First Great Heist Game? | Game Maker's Toolkit](https://www.youtube.com/watch?v=cUbyNJKsi7E)
+1. [Redesigning Death | Game Maker's Toolkit](https://www.youtube.com/watch?v=6WyalnKQIpg)
+1. [Secrets of Game Feel and Juice | Game Maker's Toolkit](https://www.youtube.com/watch?v=216_5nu4aVQ)
+1. [The Game Design Trap of Modern Retro Games -- Critical Thought](https://www.youtube.com/watch?v=utfM4OVAlXw)
+1. [The Secret to Replayable Video Games: Defining Variance (Critical Thought)](https://www.youtube.com/watch?v=6jmhzfk7cI0)
+1. [The Limits of Battle Royale Game Design | Critical Thought](https://www.youtube.com/watch?v=jGEokQBbZm8)
+1. [A Critical Thought on WRPG vs JRPG Design](https://www.youtube.com/watch?v=QptfFveZH40)
+1. [When Does a Video Game Become Tactical? (Critical Thought)](https://www.youtube.com/watch?v=9DjMyJ4c6sc)
+1. [How Numbers Impact Game Design (Critical Thought)](https://www.youtube.com/watch?v=ychRUeGxuA4)
+1. [A Critical Thought on Asymmetrical Design and Balance](https://www.youtube.com/watch?v=ah-q6gmcCcM)
+1. [A Critical Thought on RPG Progression](https://www.youtube.com/watch?v=kou6zzE7odk)
+1. [A Critical Thought on Gear-Based Progression](https://www.youtube.com/watch?v=Qtf4JrJADuE)
+1. [The Difference Between Environmental and Level Design in Video Games -- Critical Thought](https://www.youtube.com/watch?v=Lmf1oQIwNCk)
+1. [The Limitations of Leveling in Game Design | Critical Thought](https://www.youtube.com/watch?v=V4EK53qA2ZA)
+1. [What Makes Grinding Fun in Videogames | Critical Thought](https://www.youtube.com/watch?v=a5skg3YF6D0)
+1. [Should Videogames be a Mystery? | Critical Thought](https://www.youtube.com/watch?v=J3Pm61xk444)
+1. [A Critical Thought on Apex Predator Stealth Game Design](https://www.youtube.com/watch?v=69rJy146F7I)
+1. [The Limits of Realism in Video Games -- Critical Thought](https://www.youtube.com/watch?v=R_hXwd-TXqw)
+1. [What Makes an Immersive Sim? (Critical Thought)](https://www.youtube.com/watch?v=lMi1PNiQoTg)
+1. [A Critical Thought on the Bar of Game Design](https://www.youtube.com/watch?v=30xMJFRNwpc)
+1. [A Critical Thought on Persistent Systems in Game Design](https://www.youtube.com/watch?v=uk_1VoMtmK8)
+1. [A Critical Thought on Game Pricing](https://www.youtube.com/watch?v=BGAa11Wmnsw)
+1. [A Critical Thought on 7-9 Review Scores](https://www.youtube.com/watch?v=QjI_ayarAq4)
+1. [A Critical Thought on Event-Driven Game Design](https://www.youtube.com/watch?v=df_cS3N5Ri4)
+1. [A Critical Thought on the Flow State and Video Games](https://www.youtube.com/watch?v=dGfuN7PT8Fg)
+1. [A Critical Thought on Boss Battle Design](https://www.youtube.com/watch?v=R73FdiuwNQc)
+1. [The Difference Between Graphics and Aesthetics in Videogames (Critical Thought)](https://www.youtube.com/watch?v=dDh_P0FZYCE)
+1. [A Critical Thought on the Foundation of Emergent Gameplay](https://www.youtube.com/watch?v=EbYvxZcMzGw)
+1. [A Critical Thought on Environmental Storytelling in Video Games](https://www.youtube.com/watch?v=bryR9RY7KFs)
+1. [A Critical Thought on Puzzle Design](https://www.youtube.com/watch?v=jlPokDZWN3Q)
+1. [A Critical Thought on Good Stealth Game Design](https://www.youtube.com/watch?v=MMhR5o2EcLc)
+1. [How to Define Gameplay in Videogames | Critical Thought](https://www.youtube.com/watch?v=S97Z8WarJT4)
+1. [A Critical Thought on "Upen" World Game Design](https://www.youtube.com/watch?v=d0aced1ONCM)
+1. [A Critical Thought on the Hierarchy of Fail States](https://www.youtube.com/watch?v=FACTASJ5UzA)
+1. [The Problems With Designing for Depth in Videogames (Critical Thought)](https://www.youtube.com/watch?v=a9tbDWdZ7W0)
+1. [The Contradiction of Fun Pain in Video Games -- Critical Thought](https://www.youtube.com/watch?v=SYaEAOlbCwE)
+1. [A Critical Thought on Creating Enemy Behaviors in Game Design](https://www.youtube.com/watch?v=FoG_8wVdoow)
+1. [A Critical Thought on Balancing Failure in Game Design](https://www.youtube.com/watch?v=DZW9f48G2mQ)
+1. [How Dissonance Can Affect Videogames | Critical Thought](https://www.youtube.com/watch?v=Ip12_GQ09Bk)
+1. [Defining the Core Gameplay Loop of your Game | Critical Thought](https://www.youtube.com/watch?v=-kIwf-dNXr0)
+1. [Helpful Tips to Improve Playability in Game Design | Critical Thought](https://www.youtube.com/watch?v=pNsIe6EU4Cc)
+1. [A Critical Thought on Understanding Emergent Gameplay](https://www.youtube.com/watch?v=LTc_zIsUfMw)
+1. [Defining Accessibility vs. Playability in Game Design | Critical Thought](https://www.youtube.com/watch?v=ASwCEelR_J8)
+1. [How to Fix Loot Boxes Before They're Banned | Critical Thought](https://www.youtube.com/watch?v=cPoaRpDRZbc)
+1. [The Design Behind Effective Loot Tables -- Critical Thought](https://www.youtube.com/watch?v=Nz3dk3Q4LxY)
+1. [A Critical Thought on When Video Game Difficulty Becomes Cheap](https://www.youtube.com/watch?v=fae9Q173YUU)
+1. [A Critical Thought on Fair Use and Fan Games](https://www.youtube.com/watch?v=cTUW6-P_3Rg)
+1. [A Critical Thought on Direct vs. Indirect Competition](https://www.youtube.com/watch?v=_Klc69XDR1w)
+1. [A Critical Thought on Conditioning Players](https://www.youtube.com/watch?v=efeqryVz7ro)
+1. [Sanderson's Laws of Magic](https://stormlightarchive.fandom.com/wiki/Sanderson%27s_Laws_of_Magic)
+1. [A Critical Thought on Combining RPG and Action Games](https://www.youtube.com/watch?v=Kh8itq2jf_M)
+1. [The Three Elements of Good Level Design in Video Games -- Critical Thought](https://www.youtube.com/watch?v=sHKc_DqdxQk)
+1. [The Three Forms of Stealth Gameplay (Critical Thought)](https://www.youtube.com/watch?v=nLOMq5qCxKU)
+1. [The Deeper Design Behind the Dark Souls Formula -- Critical Thought](https://www.youtube.com/watch?v=hlccvyRGdPI)
+1. [The Limits of Randomization in Game Design -- Critical Thought](https://www.youtube.com/watch?v=fuIihMRNEeE)
+1. [How RNG in Games is Like a Spice -- Critical Thought](https://www.youtube.com/watch?v=A3cG4IHaOUY)
+1. [The Failing Point of Free to Play Game Design -- Critical Thought](https://www.youtube.com/watch?v=_7-cQdFgD4k)
+1. [A Critical Thought on Game Design Abstraction](https://www.youtube.com/watch?v=odCFa72nQCc)
+1. [A Critical Thought on Difficulty Scaling in Game Design](https://www.youtube.com/watch?v=Y4AQPefZwt0)
+1. [What Makes the Collectible Hunt So Addicting in Videogames | Critical Thought](https://www.youtube.com/watch?v=mg-OlFeU0YQ)
+1. [What Makes a Metroidvania Work? | Critical Thought](https://www.youtube.com/watch?v=4ggILevH7Tw)
+1. [A Critical Thought on the Worst Kind of Video Game Grinding](https://www.youtube.com/watch?v=7jrYVFsW_Rw)
+1. [A Critical Thought on Mixed Genre Game Design](https://www.youtube.com/watch?v=g7_nVpGVuHQ)
+1. [The Problems With Punishment Systems in Videogames | Critical Thought](https://www.youtube.com/watch?v=gkp2tW_rzz0)
+1. [Can Persistence Work in Esports? (Critical Thought)](https://www.youtube.com/watch?v=4BysWm6SqTk)
+1. [A Critical Thought on The Race to the Bottom](https://www.youtube.com/watch?v=YhdbYhoWECs)
+1. [A Critical Thought on Why Build Orders Spell Trouble for Video Games](https://www.youtube.com/watch?v=XJHxfnWUdTc)
+1. [A Critical Thought on Persistence Mechanics](https://www.youtube.com/watch?v=G2W7JGB8uug)
+1. [A Critical Thought on Regenerating Health Game Design](https://www.youtube.com/watch?v=tPlPxGAskx8)
+1. [A Critical Thought on Meta-Game Design](https://www.youtube.com/watch?v=pjpf7wFnvaU)
+1. [A Critical Thought on Hard Games](https://www.youtube.com/watch?v=z92x3tnXG2A)
+1. [A Critical Thought on Downtime in Video Games](https://www.youtube.com/watch?v=t46bDmK4qFo)
+1. [A Critical Thought on Item Hoarding](https://www.youtube.com/watch?v=hMybxTFMMXw)
+1. [Why Morality Systems in Games Don't Work -- Critical Thought](https://www.youtube.com/watch?v=qvNMXZFc8og)
+1. [A Critical Thought on ELO Rating Systems](https://www.youtube.com/watch?v=1akzEbNLKqs)
+1. [A Critical Thought on Probability in Game Design](https://www.youtube.com/watch?v=wgi-MH1PxAg)
+1. [Defining (And Reducing) Grinding in Video Games -- Critical Thought](https://www.youtube.com/watch?v=dPH2OkVJmnM)
+1. [Explaining the Assassin's Creed Odyssey Backlash on Player Choice-- Critical Thought](https://www.youtube.com/watch?v=sJhPYiNopKo)
+1. [Arkham Knight and the Scourge of Scale | Game Maker's Toolkit](https://www.youtube.com/watch?v=Kvbnc-7Y0fE)
+1. [A Critical Thought on WRPG vs CRPG Design](https://www.youtube.com/watch?v=mzsRs-qinJU)
+1. [A Critical Thought on Unpredictable Competitive Games](https://www.youtube.com/watch?v=LyrFdFwCYxw)
+1. [A Critical Thought on Game Reviewers](https://www.youtube.com/watch?v=ejLcJ680Je0)
+1. [A Critical Thought on Disgaea's Design and Layered Game Systems](https://www.youtube.com/watch?v=s_z5liQ4Zbw)
+1. [A Critical Thought on the Dangers of Feature Creep](https://www.youtube.com/watch?v=3lvkxfOrnSo)
+1. [A Critical Thought on Making Competitive Games](https://www.youtube.com/watch?v=su0zUE_iU14)
+1. [A Critical Thought on Power Curves in Game Design](https://www.youtube.com/watch?v=j0-Mmcfq3so)
+1. [A Critical Thought on the Blue Shell Debate](https://www.youtube.com/watch?v=teYuozYi8Kg)
+1. [A Critical Thought on Strategy Guides](https://www.youtube.com/watch?v=vW3qgpt4s2c)
+1. [A Critical Thought on Breaking Games](https://www.youtube.com/watch?v=aorjSqZMb5E)
1. [Level Design Patterns in 2D Games](http://akhalifa.com/documents/level-design-patterns.pdf)
1. https://en.wikipedia.org/wiki/Rules_of_Play
diff --git a/documentation/research/machine_learning.md b/documentation/research/machine_learning.md
index ca4780853..eac777566 100644
--- a/documentation/research/machine_learning.md
+++ b/documentation/research/machine_learning.md
@@ -1,3 +1,7 @@
+# Transformer
+
+1. [Transformers from scratch](http://www.peterbloem.nl/blog/transformers)
+
# Exemplar
1. https://ml5js.org/
diff --git a/documentation/research/math.md b/documentation/research/math.md
index 6e72785c7..d271bb0f6 100644
--- a/documentation/research/math.md
+++ b/documentation/research/math.md
@@ -69,6 +69,7 @@
# Bézier curves
+1. [Circles and lines vs. polynomial splines](https://wordsandbuttons.online/circles_and_lines_vs_polynomial_splines.html)
1. https://cormullion.github.io/blog/2018/06/21/bezier.html
1. https://pomax.github.io/bezierinfo/
1. https://99designs.com/blog/engineering/math-draw-vector-curves/
@@ -138,6 +139,8 @@
# Geometric Algebra | Clifford Algebra
+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/
1. [Vectors and Beyond: Geometric Algebra and its Philosophical Significance](http://www.tara.tcd.ie/bitstream/handle/2262/61825/Vectors%20and%20Beyond%20as%20Printed.pdf?sequence=1&isAllowed=y)
1. [Let's remove Quaternions from every 3D Engine](http://marctenbosch.com/quaternions/)
@@ -255,6 +258,7 @@
# Vector
+1. [A Student's Guide to Vectors and Tensors (Student's Guides)](https://www.amazon.com/Students-Guide-Vectors-Tensors-Guides/dp/0521171903)
1. https://www.researchgate.net/publication/327989714_Coordinate_Free_Vector_Algebra_in_R2
# Knot theory
diff --git a/documentation/research/operating_system.md b/documentation/research/operating_system.md
index 2e26a3976..bd0c59f73 100644
--- a/documentation/research/operating_system.md
+++ b/documentation/research/operating_system.md
@@ -157,6 +157,7 @@
# Shell
+1. [Magritte: A Language for Pipe-Based Programming](http://files.jneen.net/academic/thesis.pdf)
1. https://latacora.singles/2018/06/21/loud-subshells.html
1. https://github.com/ipetkov/conch-runtime
1. https://www.spinellis.gr/sw/dgsh/
diff --git a/documentation/research/paradigm/Ambient-Oriented Programming.md b/documentation/research/paradigm/Ambient-Oriented Programming.md
new file mode 100644
index 000000000..4ff41ff5e
--- /dev/null
+++ b/documentation/research/paradigm/Ambient-Oriented Programming.md
@@ -0,0 +1,5 @@
+# Reference
+
+1. [Ambient-Oriented Programming in AmbientTalk](http://citeseerx.ist.psu.edu/viewdoc/download?doi=10.1.1.417.906&rep=rep1&type=pdf)
+1. [Ambient-oriented programming](https://dl.acm.org/citation.cfm?id=1094867)
+1. [AmbientTalk](https://en.wikipedia.org/wiki/AmbientTalk)
diff --git a/documentation/research/paradigm/logic_programming.md b/documentation/research/paradigm/logic_programming.md
index 6e1c604cf..25c059ca9 100644
--- a/documentation/research/paradigm/logic_programming.md
+++ b/documentation/research/paradigm/logic_programming.md
@@ -29,6 +29,7 @@
# Language
+1. [Curry: A Truly Integrated Functional Logic Language](https://www-ps.informatik.uni-kiel.de/currywiki/)
1. https://flix.github.io/
1. http://logtalk.org/
1. https://github.com/fnogatz/CHR.js
diff --git a/documentation/research/tool/build_system.md b/documentation/research/tool/build_system.md
index d52222929..24fa96627 100644
--- a/documentation/research/tool/build_system.md
+++ b/documentation/research/tool/build_system.md
@@ -1,5 +1,6 @@
# Exemplar
+1. [Pier: Yet another Haskell build tool](https://www.youtube.com/watch?v=JmenfeDVi0w)
1. https://buckbuild.com/
1. http://boot-clj.com/
1. http://gulpjs.com/
diff --git a/new-luxc/source/luxc/lang/host/jvm.lux b/new-luxc/source/luxc/lang/host/jvm.lux
index 7216a1708..d3ead1095 100644
--- a/new-luxc/source/luxc/lang/host/jvm.lux
+++ b/new-luxc/source/luxc/lang/host/jvm.lux
@@ -1,5 +1,5 @@
(.module:
- [lux (#- Definition)
+ [lux (#- Definition Type)
[host (#+ import:)]
[abstract
monad]
@@ -15,7 +15,8 @@
[syntax (#+ syntax:)]]
[target
[jvm
- [type (#+ Class)]]]
+ ["." type (#+ Type)
+ [category (#+ Class)]]]]
[tool
[compiler
[reference (#+ Register)]
@@ -119,5 +120,5 @@
(org/objectweb/asm/Label::new)))
(def: #export (simple-class name)
- (-> Text Class)
- [name (list)])
+ (-> Text (Type Class))
+ (type.class name (list)))
diff --git a/new-luxc/source/luxc/lang/host/jvm/def.lux b/new-luxc/source/luxc/lang/host/jvm/def.lux
index b663b9b31..08fccc640 100644
--- a/new-luxc/source/luxc/lang/host/jvm/def.lux
+++ b/new-luxc/source/luxc/lang/host/jvm/def.lux
@@ -11,16 +11,21 @@
["%" format (#+ format)]]
[collection
["." array (#+ Array)]
- ["." list ("#/." functor)]]]
+ ["." list ("#@." functor)]]]
[target
[jvm
[encoding
["." name]]
- ["$t" type (#+ Method Class Type Parameter)
- ["." reflection]
+ ["." type (#+ Type Constraint)
+ [category (#+ Class Value Method)]
+ ["." signature (#+ Signature)]
["." descriptor (#+ Descriptor)]]]]]
["." //])
+(def: signature (|>> type.signature signature.signature))
+(def: descriptor (|>> type.descriptor descriptor.descriptor))
+(def: class-name (|>> type.descriptor descriptor.class-name name.read))
+
(import: #long java/lang/Object)
(import: #long java/lang/String)
@@ -72,7 +77,7 @@
(def: (string-array values)
(-> (List Text) (Array Text))
(let [output (host.array String (list.size values))]
- (exec (list/map (function (_ [idx value])
+ (exec (list@map (function (_ [idx value])
(host.array-write idx value output))
(list.enumerate values))
output)))
@@ -118,36 +123,32 @@
(if (get@ #//.transientF config) (Opcodes::ACC_TRANSIENT) +0)
(if (get@ #//.volatileF config) (Opcodes::ACC_VOLATILE) +0)))
-(def: class-to-type
- (-> Class Type)
- (|>> #$t.Class #$t.Generic))
-
(def: param-signature
- (-> Class Text)
- (|>> class-to-type $t.signature (format ":")))
+ (-> (Type Class) Text)
+ (|>> ..signature (format ":")))
(def: (formal-param [name super interfaces])
- (-> Parameter Text)
+ (-> Constraint Text)
(format name
(param-signature super)
(|> interfaces
- (list/map param-signature)
+ (list@map param-signature)
(text.join-with ""))))
-(def: (parameters-signature parameters super interfaces)
- (-> (List Parameter) Class (List Class)
+(def: (constraints-signature constraints super interfaces)
+ (-> (List Constraint) (Type Class) (List (Type Class))
Text)
- (let [formal-params (if (list.empty? parameters)
+ (let [formal-params (if (list.empty? constraints)
""
(format "<"
- (|> parameters
- (list/map formal-param)
+ (|> constraints
+ (list@map formal-param)
(text.join-with ""))
">"))]
(format formal-params
- (|> super class-to-type $t.signature)
+ (..signature super)
(|> interfaces
- (list/map (|>> class-to-type $t.signature))
+ (list@map ..signature)
(text.join-with "")))))
(def: class-computes
@@ -160,9 +161,9 @@
(def: binary-name (|>> name.internal name.read))
(template [<name> <flag>]
- [(def: #export (<name> version visibility config name parameters super interfaces
+ [(def: #export (<name> version visibility config name constraints super interfaces
definitions)
- (-> //.Version //.Visibility //.Class-Config Text (List Parameter) Class (List Class) //.Def
+ (-> //.Version //.Visibility //.Class-Config Text (List Constraint) (Type Class) (List (Type Class)) //.Def
(host.type [byte]))
(let [writer (|> (do-to (ClassWriter::new class-computes)
(ClassWriter::visit (version-flag version)
@@ -172,10 +173,10 @@
(visibility-flag visibility)
(class-flags config))
(..binary-name name)
- (parameters-signature parameters super interfaces)
- (|> super product.left ..binary-name)
+ (constraints-signature constraints super interfaces)
+ (..class-name super)
(|> interfaces
- (list/map (|>> product.left ..binary-name))
+ (list@map ..class-name)
string-array)))
definitions)
_ (ClassWriter::visitEnd writer)]
@@ -185,11 +186,13 @@
[abstract (Opcodes::ACC_ABSTRACT)]
)
-(def: $Object Class ["java.lang.Object" (list)])
+(def: $Object
+ (Type Class)
+ (type.class "java.lang.Object" (list)))
-(def: #export (interface version visibility config name parameters interfaces
+(def: #export (interface version visibility config name constraints interfaces
definitions)
- (-> //.Version //.Visibility //.Class-Config Text (List Parameter) (List Class) //.Def
+ (-> //.Version //.Visibility //.Class-Config Text (List Constraint) (List (Type Class)) //.Def
(host.type [byte]))
(let [writer (|> (do-to (ClassWriter::new class-computes)
(ClassWriter::visit (version-flag version)
@@ -199,25 +202,25 @@
(visibility-flag visibility)
(class-flags config))
(..binary-name name)
- (parameters-signature parameters $Object interfaces)
- (|> $Object product.left ..binary-name)
+ (constraints-signature constraints $Object interfaces)
+ (..class-name $Object)
(|> interfaces
- (list/map (|>> product.left ..binary-name))
+ (list@map ..class-name)
string-array)))
definitions)
_ (ClassWriter::visitEnd writer)]
(ClassWriter::toByteArray writer)))
-(def: #export (method visibility config name type then)
- (-> //.Visibility //.Method-Config Text (Descriptor descriptor.Method) //.Inst
+(def: #export (method visibility config name [signature descriptor] then)
+ (-> //.Visibility //.Method-Config Text [(Signature Method) (Descriptor Method)] //.Inst
//.Def)
(function (_ writer)
(let [=method (ClassWriter::visitMethod ($_ i.+
(visibility-flag visibility)
(method-flags config))
(..binary-name name)
- (descriptor.descriptor type)
- (host.null)
+ (descriptor.descriptor descriptor)
+ (signature.signature signature)
(string-array (list))
writer)
_ (MethodVisitor::visitCode =method)
@@ -226,8 +229,8 @@
_ (MethodVisitor::visitEnd =method)]
writer)))
-(def: #export (abstract-method visibility config name type)
- (-> //.Visibility //.Method-Config Text (Descriptor descriptor.Method)
+(def: #export (abstract-method visibility config name [signature descriptor])
+ (-> //.Visibility //.Method-Config Text [(Signature Method) (Descriptor Method)]
//.Def)
(function (_ writer)
(let [=method (ClassWriter::visitMethod ($_ i.+
@@ -235,22 +238,22 @@
(method-flags config)
(Opcodes::ACC_ABSTRACT))
(..binary-name name)
- (descriptor.descriptor type)
- (host.null)
+ (descriptor.descriptor descriptor)
+ (signature.signature signature)
(string-array (list))
writer)
_ (MethodVisitor::visitEnd =method)]
writer)))
(def: #export (field visibility config name type)
- (-> //.Visibility //.Field-Config Text (Descriptor descriptor.Field) //.Def)
+ (-> //.Visibility //.Field-Config Text (Type Value) //.Def)
(function (_ writer)
(let [=field (do-to (ClassWriter::visitField ($_ i.+
(visibility-flag visibility)
(field-flags config))
(..binary-name name)
- (descriptor.descriptor type)
- (host.null)
+ (..descriptor type)
+ (..signature type)
(host.null)
writer)
(FieldVisitor::visitEnd))]
@@ -264,22 +267,22 @@
(visibility-flag visibility)
(field-flags config))
(..binary-name name)
- (descriptor.descriptor <jvm-type>)
- (host.null)
+ (..descriptor <jvm-type>)
+ (..signature <jvm-type>)
(<prepare> value)
writer)
(FieldVisitor::visitEnd))]
writer)))]
- [boolean-field Bit descriptor.boolean function.identity]
- [byte-field Int descriptor.byte host.long-to-byte]
- [short-field Int descriptor.short host.long-to-short]
- [int-field Int descriptor.int host.long-to-int]
- [long-field Int descriptor.long function.identity]
- [float-field Frac descriptor.float host.double-to-float]
- [double-field Frac descriptor.double function.identity]
- [char-field Nat descriptor.char (|>> .int host.long-to-int host.int-to-char)]
- [string-field Text (descriptor.class "java.lang.String") function.identity]
+ [boolean-field Bit type.boolean function.identity]
+ [byte-field Int type.byte host.long-to-byte]
+ [short-field Int type.short host.long-to-short]
+ [int-field Int type.int host.long-to-int]
+ [long-field Int type.long function.identity]
+ [float-field Frac type.float host.double-to-float]
+ [double-field Frac type.double function.identity]
+ [char-field Nat type.char (|>> .int host.long-to-int host.int-to-char)]
+ [string-field Text (type.class "java.lang.String" (list)) function.identity]
)
(def: #export (fuse defs)
diff --git a/new-luxc/source/luxc/lang/host/jvm/inst.lux b/new-luxc/source/luxc/lang/host/jvm/inst.lux
index 8d5bd3b6e..72d7e58ca 100644
--- a/new-luxc/source/luxc/lang/host/jvm/inst.lux
+++ b/new-luxc/source/luxc/lang/host/jvm/inst.lux
@@ -1,5 +1,5 @@
(.module:
- [lux (#- int char)
+ [lux (#- Type int char)
["." host (#+ import: do-to)]
[abstract
[monad (#+ do)]]
@@ -23,15 +23,22 @@
[target
[jvm
[encoding
- ["." name]]
- [type
+ ["." name (#+ External)]]
+ ["." type (#+ Type) ("#@." equivalence)
+ [category (#+ Void Value Return Method Primitive Object Class Array Var Parameter)]
["." box]
- ["." descriptor (#+ Descriptor Primitive) ("#@." equivalence)]]]]
+ ["." signature (#+ Signature)]
+ ["." descriptor (#+ Descriptor)]
+ ["." reflection]]]]
[tool
[compiler
[phase (#+ Operation)]]]]
["." // (#+ Inst)])
+(def: class-name (|>> type.descriptor descriptor.class-name name.read))
+(def: descriptor (|>> type.descriptor descriptor.descriptor))
+(def: reflection (|>> type.reflection reflection.reflection))
+
## [Host]
(import: #long java/lang/Object)
(import: #long java/lang/String)
@@ -239,10 +246,10 @@
(template [<name> <inst>]
[(def: #export (<name> class field type)
- (-> (Descriptor descriptor.Class) Text (Descriptor descriptor.Field) Inst)
+ (-> (Type Class) Text (Type Value) Inst)
(function (_ visitor)
(do-to visitor
- (org/objectweb/asm/MethodVisitor::visitFieldInsn (<inst>) (descriptor.class-name class) field (descriptor.descriptor type)))))]
+ (org/objectweb/asm/MethodVisitor::visitFieldInsn (<inst>) (..class-name class) field (..descriptor type)))))]
[GETSTATIC org/objectweb/asm/Opcodes::GETSTATIC]
[PUTSTATIC org/objectweb/asm/Opcodes::PUTSTATIC]
@@ -251,44 +258,54 @@
[GETFIELD org/objectweb/asm/Opcodes::GETFIELD]
)
-(template [<name> <inst>]
- [(def: #export (<name> class)
- (-> (Descriptor descriptor.Object) Inst)
- (function (_ visitor)
- (do-to visitor
- (org/objectweb/asm/MethodVisitor::visitTypeInsn (<inst>) (descriptor.class-name class)))))]
+(template [<category> <instructions>+]
+ [(`` (template [<name> <inst>]
+ [(def: #export (<name> class)
+ (-> (Type <category>) Inst)
+ (function (_ visitor)
+ (do-to visitor
+ (org/objectweb/asm/MethodVisitor::visitTypeInsn (<inst>) (..class-name class)))))]
+
+ (~~ (template.splice <instructions>+))))]
+
+ [Object
+ [[CHECKCAST org/objectweb/asm/Opcodes::CHECKCAST]
+ [ANEWARRAY org/objectweb/asm/Opcodes::ANEWARRAY]]]
- [CHECKCAST org/objectweb/asm/Opcodes::CHECKCAST]
- [NEW org/objectweb/asm/Opcodes::NEW]
- [INSTANCEOF org/objectweb/asm/Opcodes::INSTANCEOF]
- [ANEWARRAY org/objectweb/asm/Opcodes::ANEWARRAY]
+ [Class
+ [[NEW org/objectweb/asm/Opcodes::NEW]
+ [INSTANCEOF org/objectweb/asm/Opcodes::INSTANCEOF]]]
)
(def: #export (NEWARRAY type)
- (-> (Descriptor Primitive) Inst)
+ (-> (Type Primitive) Inst)
(function (_ visitor)
(do-to visitor
(org/objectweb/asm/MethodVisitor::visitIntInsn (org/objectweb/asm/Opcodes::NEWARRAY)
(`` (cond (~~ (template [<descriptor> <opcode>]
- [(descriptor@= <descriptor> type) (<opcode>)]
+ [(type@= <descriptor> type) (<opcode>)]
- [descriptor.boolean org/objectweb/asm/Opcodes::T_BOOLEAN]
- [descriptor.byte org/objectweb/asm/Opcodes::T_BYTE]
- [descriptor.short org/objectweb/asm/Opcodes::T_SHORT]
- [descriptor.int org/objectweb/asm/Opcodes::T_INT]
- [descriptor.long org/objectweb/asm/Opcodes::T_LONG]
- [descriptor.float org/objectweb/asm/Opcodes::T_FLOAT]
- [descriptor.double org/objectweb/asm/Opcodes::T_DOUBLE]
- [descriptor.char org/objectweb/asm/Opcodes::T_CHAR]))
+ [type.boolean org/objectweb/asm/Opcodes::T_BOOLEAN]
+ [type.byte org/objectweb/asm/Opcodes::T_BYTE]
+ [type.short org/objectweb/asm/Opcodes::T_SHORT]
+ [type.int org/objectweb/asm/Opcodes::T_INT]
+ [type.long org/objectweb/asm/Opcodes::T_LONG]
+ [type.float org/objectweb/asm/Opcodes::T_FLOAT]
+ [type.double org/objectweb/asm/Opcodes::T_DOUBLE]
+ [type.char org/objectweb/asm/Opcodes::T_CHAR]))
## else
(undefined)))))))
(template [<name> <inst>]
- [(def: #export (<name> class method-name type interface?)
- (-> (Descriptor descriptor.Class) Text (Descriptor descriptor.Method) Bit Inst)
+ [(def: #export (<name> class method-name [method-signature method-descriptor] interface?)
+ (-> (Type Class) Text [(Signature Method) (Descriptor Method)] Bit Inst)
(function (_ visitor)
(do-to visitor
- (org/objectweb/asm/MethodVisitor::visitMethodInsn (<inst>) (descriptor.class-name class) method-name (descriptor.descriptor type) interface?))))]
+ (org/objectweb/asm/MethodVisitor::visitMethodInsn (<inst>)
+ (..class-name class)
+ method-name
+ (descriptor.descriptor method-descriptor)
+ interface?))))]
[INVOKESTATIC org/objectweb/asm/Opcodes::INVOKESTATIC]
[INVOKEVIRTUAL org/objectweb/asm/Opcodes::INVOKEVIRTUAL]
@@ -346,10 +363,10 @@
(org/objectweb/asm/MethodVisitor::visitTableSwitchInsn min max default labels-array)))))
(def: #export (try @from @to @handler exception)
- (-> //.Label //.Label //.Label (Descriptor descriptor.Class) Inst)
+ (-> //.Label //.Label //.Label (Type Class) Inst)
(function (_ visitor)
(do-to visitor
- (org/objectweb/asm/MethodVisitor::visitTryCatchBlock @from @to @handler (descriptor.class-name exception)))))
+ (org/objectweb/asm/MethodVisitor::visitTryCatchBlock @from @to @handler (..class-name exception)))))
(def: #export (label @label)
(-> //.Label Inst)
@@ -358,8 +375,8 @@
(org/objectweb/asm/MethodVisitor::visitLabel @label))))
(def: #export (array type)
- (-> (Descriptor descriptor.Value) Inst)
- (case (descriptor.primitive? type)
+ (-> (Type Value) Inst)
+ (case (type.primitive? type)
(#.Left object)
(ANEWARRAY object)
@@ -368,18 +385,18 @@
(template [<name> <boolean> <byte> <short> <int> <long> <float> <double> <char>]
[(def: (<name> type)
- (-> (Descriptor Primitive) Text)
+ (-> (Type Primitive) Text)
(`` (cond (~~ (template [<descriptor> <output>]
- [(descriptor@= <descriptor> type) <output>]
+ [(type@= <descriptor> type) <output>]
- [descriptor.boolean <boolean>]
- [descriptor.byte <byte>]
- [descriptor.short <short>]
- [descriptor.int <int>]
- [descriptor.long <long>]
- [descriptor.float <float>]
- [descriptor.double <double>]
- [descriptor.char <char>]))
+ [type.boolean <boolean>]
+ [type.byte <byte>]
+ [type.short <short>]
+ [type.int <int>]
+ [type.long <long>]
+ [type.float <float>]
+ [type.double <double>]
+ [type.char <char>]))
## else
(undefined))))]
@@ -392,15 +409,15 @@
)
(def: #export (wrap type)
- (-> (Descriptor Primitive) Inst)
- (let [wrapper (descriptor.class (primitive-wrapper type))]
- (INVOKESTATIC wrapper "valueOf" (descriptor.method [(list type) wrapper]) #0)))
+ (-> (Type Primitive) Inst)
+ (let [wrapper (type.class (primitive-wrapper type) (list))]
+ (INVOKESTATIC wrapper "valueOf" (type.method [(list type) wrapper (list)]) #0)))
(def: #export (unwrap type)
- (-> (Descriptor Primitive) Inst)
- (let [wrapper (descriptor.class (primitive-wrapper type))]
+ (-> (Type Primitive) Inst)
+ (let [wrapper (type.class (primitive-wrapper type) (list))]
(|>> (CHECKCAST wrapper)
- (INVOKEVIRTUAL wrapper (primitive-unwrap type) (descriptor.method [(list) type]) #0))))
+ (INVOKEVIRTUAL wrapper (primitive-unwrap type) (type.method [(list) type (list)]) #0))))
(def: #export (fuse insts)
(-> (List Inst) Inst)
diff --git a/new-luxc/source/luxc/lang/statement/jvm.lux b/new-luxc/source/luxc/lang/statement/jvm.lux
index bc0cd375e..20ba938d1 100644
--- a/new-luxc/source/luxc/lang/statement/jvm.lux
+++ b/new-luxc/source/luxc/lang/statement/jvm.lux
@@ -1,10 +1,11 @@
(.module:
- [lux (#- Definition)
+ [lux (#- Type Definition)
[abstract
["." monad (#+ do)]]
[control
["<>" parser
- ["<c>" code (#+ Parser)]]]
+ ["<c>" code (#+ Parser)]
+ ["<t>" text]]]
[data
["." product]
[text
@@ -16,9 +17,12 @@
["." check (#+ Check)]]
[target
[jvm
- ["." type (#+ Var Parameter Class Argument Typed Return)
+ ["." type (#+ Type Constraint Argument Typed)
+ [category (#+ Void Value Return Method Primitive Object Class Array Var Parameter)]
[".T" lux]
- ["." descriptor (#+ Descriptor)]]]]
+ ["." signature]
+ ["." descriptor (#+ Descriptor)]
+ ["." parser]]]]
[tool
[compiler
["." statement (#+ Handler Bundle)]
@@ -38,12 +42,14 @@
["$" jvm (#+ Anchor Inst Definition Operation Phase)
["_." def]]]]])
+(def: signature (|>> type.signature signature.signature))
+
(type: Declaration
- [Text (List Text)])
+ [Text (List (Type Var))])
(def: declaration
(Parser Declaration)
- (<c>.form (<>.and <c>.text (<>.some <c>.text))))
+ (<c>.form (<>.and <c>.text (<>.some jvm.var))))
(type: Inheritance
#FinalI
@@ -75,14 +81,12 @@
(Parser Annotation)
<c>.any)
-(def: field-descriptor
- (Parser (Descriptor descriptor.Field))
- (:: <>.monad map
- (|>> (:coerce (Descriptor descriptor.Field)))
- <c>.text))
+(def: field-type
+ (Parser (Type Value))
+ (<t>.embed parser.value <c>.text))
(type: Constant
- [Text (List Annotation) (Descriptor descriptor.Field) Code])
+ [Text (List Annotation) (Type Value) Code])
(def: constant
(Parser Constant)
@@ -91,12 +95,12 @@
($_ <>.and
<c>.text
(<c>.tuple (<>.some ..annotation))
- ..field-descriptor
+ ..field-type
<c>.any
)))
(type: Variable
- [Text jvm.Visibility State (List Annotation) (Descriptor descriptor.Field)])
+ [Text jvm.Visibility State (List Annotation) (Type Value)])
(def: variable
(Parser Variable)
@@ -107,7 +111,7 @@
jvm.visibility
..state
(<c>.tuple (<>.some ..annotation))
- ..field-descriptor
+ ..field-type
)))
(type: Field
@@ -136,9 +140,11 @@
jvm.overriden-method-definition
))
-(def: (parameter name)
- (-> Text Parameter)
- [name [type.object-class (list)] (list)])
+(def: (constraint name)
+ (-> Text Constraint)
+ {#type.name name
+ #type.super-class (type.class "java.lang.Object" (list))
+ #type.super-interfaces (list)})
(def: jvm::class
(Handler Anchor Inst Definition)
@@ -165,7 +171,7 @@
(typeA.with-env
(jvm.parameter-types parameters)))
#let [mapping (list@fold (function (_ [parameterJ parameterT] mapping)
- (dictionary.put parameterJ parameterT mapping))
+ (dictionary.put (parser.name parameterJ) parameterT mapping))
luxT.fresh
parameters)
field-definitions (|> fields
@@ -203,11 +209,11 @@
_def.fuse)]
super-classT (statement.lift-analysis
(typeA.with-env
- (luxT.class mapping super-class)))
+ (luxT.check (luxT.class mapping) (..signature super-class))))
super-interfaceT+ (statement.lift-analysis
(typeA.with-env
(monad.map check.monad
- (luxT.class mapping)
+ (|>> ..signature (luxT.check (luxT.class mapping)))
super-interfaces)))
#let [selfT (jvm.inheritance-relationship-type (#.Primitive name (list@map product.right parameters))
super-classT
@@ -243,9 +249,9 @@
## TODO: Handle abstract classes.
#AbstractI (undefined)
#DefaultI $.noneC)
- name (list@map (|>> product.left ..parameter) parameters)
+ name (list@map (|>> product.left parser.name ..constraint) parameters)
super-class super-interfaces
- (|>> field-definitions))]))
+ field-definitions)]))
#let [_ (log! (format "Class " name))]]
(wrap statement.no-requirements)))]))
diff --git a/new-luxc/source/luxc/lang/translation/jvm.lux b/new-luxc/source/luxc/lang/translation/jvm.lux
index 7388e8c30..86d7f9b9a 100644
--- a/new-luxc/source/luxc/lang/translation/jvm.lux
+++ b/new-luxc/source/luxc/lang/translation/jvm.lux
@@ -21,7 +21,7 @@
[target
[jvm
["." loader (#+ Library)]
- [type
+ ["." type
["." descriptor]]]]
[tool
[compiler
@@ -49,7 +49,7 @@
(type: #export ByteCode Binary)
(def: #export value-field Text "_value")
-(def: #export $Value (descriptor.class "java.lang.Object"))
+(def: #export $Value (type.class "java.lang.Object" (list)))
(exception: #export (cannot-load {class Text} {error Text})
(exception.report
@@ -93,15 +93,15 @@
bytecode (def.class #jvm.V1_6
#jvm.Public jvm.noneC
bytecode-name
- (list) ["java.lang.Object" (list)]
+ (list) $Value
(list)
(|>> (def.field #jvm.Public ($_ jvm.++F jvm.finalF jvm.staticF)
..value-field ..$Value)
(def.method #jvm.Public ($_ jvm.++M jvm.staticM jvm.strictM)
"<clinit>"
- (descriptor.method [(list) descriptor.void])
+ (type.method [(list) type.void (list)])
(|>> valueI
- (inst.PUTSTATIC (descriptor.class bytecode-name) ..value-field ..$Value)
+ (inst.PUTSTATIC (type.class bytecode-name (list)) ..value-field ..$Value)
inst.RETURN))))]
(io.run (do (try.with io.monad)
[_ (loader.store eval-class bytecode library)
@@ -151,6 +151,6 @@
(def: #export runtime-class "LuxRuntime")
(def: #export function-class "LuxFunction")
-(def: #export $Variant (descriptor.array ..$Value))
-(def: #export $Tuple (descriptor.array ..$Value))
-(def: #export $Function (descriptor.class ..function-class))
+(def: #export $Variant (type.array ..$Value))
+(def: #export $Tuple (type.array ..$Value))
+(def: #export $Function (type.class ..function-class (list)))
diff --git a/new-luxc/source/luxc/lang/translation/jvm/case.lux b/new-luxc/source/luxc/lang/translation/jvm/case.lux
index f57671f36..d676f2996 100644
--- a/new-luxc/source/luxc/lang/translation/jvm/case.lux
+++ b/new-luxc/source/luxc/lang/translation/jvm/case.lux
@@ -1,5 +1,5 @@
(.module:
- [lux (#- if let case)
+ [lux (#- Type if let case)
[abstract
[monad (#+ do)]]
[control
@@ -10,8 +10,10 @@
["n" nat]]]
[target
[jvm
- [type
- ["." descriptor]]]]
+ ["." type (#+ Type)
+ ["." category (#+ Void Value Return Primitive Object Class Array Var Parameter Method)]
+ ["." descriptor (#+ Descriptor)]
+ ["." signature (#+ Signature)]]]]
[tool
[compiler
["." synthesis (#+ Path Synthesis)]
@@ -24,7 +26,7 @@
["." //
["." runtime]])
-(def: $Runtime (descriptor.class //.runtime-class))
+(def: $Runtime (type.class //.runtime-class (list)))
(def: (pop-altI stack-depth)
(-> Nat Inst)
@@ -43,7 +45,7 @@
(def: pushI
Inst
- (|>> (_.INVOKESTATIC $Runtime "pm_push" (descriptor.method [(list runtime.$Stack //.$Value) runtime.$Stack]) #0)))
+ (|>> (_.INVOKESTATIC $Runtime "pm_push" (type.method [(list runtime.$Stack //.$Value) runtime.$Stack (list)]) #0)))
(def: (path' phase stack-depth @else @end path)
(-> Phase Nat Label Label Path (Operation Inst))
@@ -58,19 +60,19 @@
(^ (synthesis.path/bit value))
(operation@wrap (.let [jumpI (.if value _.IFEQ _.IFNE)]
(|>> peekI
- (_.unwrap descriptor.boolean)
+ (_.unwrap type.boolean)
(jumpI @else))))
(^ (synthesis.path/i64 value))
(operation@wrap (|>> peekI
- (_.unwrap descriptor.long)
+ (_.unwrap type.long)
(_.long (.int value))
_.LCMP
(_.IFNE @else)))
(^ (synthesis.path/f64 value))
(operation@wrap (|>> peekI
- (_.unwrap descriptor.double)
+ (_.unwrap type.double)
(_.double value)
_.DCMPL
(_.IFNE @else)))
@@ -78,9 +80,9 @@
(^ (synthesis.path/text value))
(operation@wrap (|>> peekI
(_.string value)
- (_.INVOKEVIRTUAL (descriptor.class "java.lang.Object")
+ (_.INVOKEVIRTUAL (type.class "java.lang.Object" (list))
"equals"
- (descriptor.method [(list //.$Value) descriptor.boolean])
+ (type.method [(list //.$Value) type.boolean (list)])
#0)
(_.IFEQ @else)))
@@ -99,7 +101,7 @@
(_.CHECKCAST //.$Variant)
(_.int (.int (<prepare> idx)))
<flag>
- (_.INVOKESTATIC $Runtime "pm_variant" (descriptor.method [(list //.$Variant runtime.$Tag runtime.$Flag) runtime.$Value]) #0)
+ (_.INVOKESTATIC $Runtime "pm_variant" (type.method [(list //.$Variant runtime.$Tag runtime.$Flag) runtime.$Value (list)]) #0)
_.DUP
(_.IFNULL @fail)
(_.GOTO @success)
@@ -117,7 +119,7 @@
_.AALOAD
lefts
- (_.INVOKESTATIC $Runtime "tuple_left" (descriptor.method [(list //.$Tuple runtime.$Index) //.$Value]) #0))]
+ (_.INVOKESTATIC $Runtime "tuple_left" (type.method [(list //.$Tuple runtime.$Index) //.$Value (list)]) #0))]
(|>> peekI
(_.CHECKCAST //.$Tuple)
(_.int (.int lefts))
@@ -128,7 +130,7 @@
(operation@wrap (|>> peekI
(_.CHECKCAST //.$Tuple)
(_.int (.int lefts))
- (_.INVOKESTATIC $Runtime "tuple_right" (descriptor.method [(list //.$Tuple runtime.$Index) //.$Value]) #0)
+ (_.INVOKESTATIC $Runtime "tuple_right" (type.method [(list //.$Tuple runtime.$Index) //.$Value (list)]) #0)
pushI))
## Extra optimization
@@ -154,7 +156,7 @@
(wrap (|>> peekI
(_.CHECKCAST //.$Tuple)
(_.int (.int lefts))
- (_.INVOKESTATIC $Runtime <getter> (descriptor.method [(list //.$Tuple runtime.$Index) //.$Value]) #0)
+ (_.INVOKESTATIC $Runtime <getter> (type.method [(list //.$Tuple runtime.$Index) //.$Value (list)]) #0)
(_.ASTORE register)
then!))))
([synthesis.member/left "tuple_left"]
@@ -187,7 +189,7 @@
(wrap (|>> pathI
(_.label @else)
_.POP
- (_.INVOKESTATIC $Runtime "pm_fail" (descriptor.method [(list) descriptor.void]) #0)
+ (_.INVOKESTATIC $Runtime "pm_fail" (type.method [(list) type.void (list)]) #0)
_.NULL
(_.GOTO @end)))))
@@ -200,7 +202,7 @@
(wrap (<| _.with-label (function (_ @else))
_.with-label (function (_ @end))
(|>> testI
- (_.unwrap descriptor.boolean)
+ (_.unwrap type.boolean)
(_.IFEQ @else)
thenI
(_.GOTO @end)
diff --git a/new-luxc/source/luxc/lang/translation/jvm/function.lux b/new-luxc/source/luxc/lang/translation/jvm/function.lux
index dca622efa..9592510ab 100644
--- a/new-luxc/source/luxc/lang/translation/jvm/function.lux
+++ b/new-luxc/source/luxc/lang/translation/jvm/function.lux
@@ -13,8 +13,10 @@
["." list ("#@." functor monoid)]]]
[target
[jvm
- [type
- ["." descriptor (#+ Descriptor Class Method Value)]]]]
+ ["." type (#+ Type)
+ ["." category (#+ Void Value Return Primitive Object Class Array Var Parameter Method)]
+ ["." descriptor (#+ Descriptor)]
+ ["." signature (#+ Signature)]]]]
[tool
[compiler
[arity (#+ Arity)]
@@ -39,33 +41,34 @@
(-> Arity Bit)
(n.> 1 arity))
-(def: reset-method
- (-> (Descriptor Class) (Descriptor Method))
- (|>> [(list)] descriptor.method))
+(def: (reset-method return)
+ (-> (Type Class) [(Signature Method) (Descriptor Method)])
+ (type.method [(list) return (list)]))
(def: (captured-args env)
- (-> Environment (List (Descriptor Value)))
+ (-> Environment (List (Type Value)))
(list.repeat (list.size env) //.$Value))
(def: (init-method env arity)
- (-> Environment Arity (Descriptor Method))
+ (-> Environment Arity [(Signature Method) (Descriptor Method)])
(if (poly-arg? arity)
- (descriptor.method [(list.concat (list (captured-args env)
- (list descriptor.int)
- (list.repeat (dec arity) //.$Value)))
- descriptor.void])
- (descriptor.method [(captured-args env) descriptor.void])))
+ (type.method [(list.concat (list (captured-args env)
+ (list type.int)
+ (list.repeat (dec arity) //.$Value)))
+ type.void
+ (list)])
+ (type.method [(captured-args env) type.void (list)])))
(def: (implementation-method arity)
- (descriptor.method [(list.repeat arity //.$Value) //.$Value]))
+ (type.method [(list.repeat arity //.$Value) //.$Value (list)]))
(def: get-amount-of-partialsI
Inst
(|>> (_.ALOAD 0)
- (_.GETFIELD //.$Function runtime.partials-field descriptor.int)))
+ (_.GETFIELD //.$Function runtime.partials-field type.int)))
(def: (load-fieldI class field)
- (-> (Descriptor Class) Text Inst)
+ (-> (Type Class) Text Inst)
(|>> (_.ALOAD 0)
(_.GETFIELD class field //.$Value)))
@@ -114,7 +117,7 @@
function.identity))
(def: (instance class arity env)
- (-> (Descriptor Class) Arity Environment (Operation Inst))
+ (-> (Type Class) Arity Environment (Operation Inst))
(do phase.monad
[captureI+ (monad.map @ reference.variable env)
#let [argsI (if (poly-arg? arity)
@@ -129,7 +132,7 @@
(_.INVOKESPECIAL class "<init>" (init-method env arity) #0)))))
(def: (with-reset class arity env)
- (-> (Descriptor Class) Arity Environment Def)
+ (-> (Type Class) Arity Environment Def)
(def.method #$.Public $.noneM "reset" (reset-method class)
(if (poly-arg? arity)
(let [env-size (list.size env)
@@ -160,7 +163,7 @@
_.ARETURN)))
(def: function-init-method
- (descriptor.method [(list descriptor.int) descriptor.void]))
+ (type.method [(list type.int) type.void (list)]))
(def: (function-init arity env-size)
(-> Arity Nat Inst)
@@ -171,7 +174,7 @@
(_.INVOKESPECIAL //.$Function "<init>" function-init-method #0))))
(def: (with-init class env arity)
- (-> (Descriptor Class) Environment Arity Def)
+ (-> (Type Class) Environment Arity Def)
(let [env-size (list.size env)
offset-partial (: (-> Nat Nat)
(|>> inc (n.+ env-size)))
@@ -200,7 +203,7 @@
_.RETURN))))
(def: (with-apply class env function-arity @begin bodyI apply-arity)
- (-> (Descriptor Class) Environment Arity Label Inst Arity
+ (-> (Type Class) Environment Arity Label Inst Arity
Def)
(let [num-partials (dec function-arity)
@default ($.new-label [])
@@ -261,7 +264,7 @@
(_.TABLESWITCH +0 (|> num-partials dec .int)
@default @labels)
casesI
- (_.INVOKESTATIC runtime.$Runtime "apply_fail" (descriptor.method [(list) descriptor.void]) #0)
+ (_.INVOKESTATIC runtime.$Runtime "apply_fail" (type.method [(list) type.void (list)]) #0)
_.NULL
_.ARETURN
))))
@@ -269,7 +272,7 @@
(def: #export (with-function @begin class env arity bodyI)
(-> Label Text Environment Arity Inst
(Operation [Def Inst]))
- (let [classD (descriptor.class class)
+ (let [classD (type.class class (list))
env-size (list.size env)
applyD (: Def
(if (poly-arg? arity)
diff --git a/new-luxc/source/luxc/lang/translation/jvm/primitive.lux b/new-luxc/source/luxc/lang/translation/jvm/primitive.lux
index d5f8d56cb..873c363bd 100644
--- a/new-luxc/source/luxc/lang/translation/jvm/primitive.lux
+++ b/new-luxc/source/luxc/lang/translation/jvm/primitive.lux
@@ -2,8 +2,7 @@
[lux (#- i64)
[target
[jvm
- [type
- ["." descriptor]]]]
+ ["." type]]]
[tool
[compiler
[phase ("operation@." monad)]]]]
@@ -15,7 +14,7 @@
(def: #export bit
(-> Bit (Operation Inst))
- (let [Boolean (descriptor.class "java.lang.Boolean")]
+ (let [Boolean (type.class "java.lang.Boolean" (list))]
(function (_ value)
(operation@wrap (_.GETSTATIC Boolean (if value "TRUE" "FALSE") Boolean)))))
@@ -25,7 +24,7 @@
(let [loadI (|> value <load>)]
(operation@wrap (|>> loadI <wrap>))))]
- [i64 (I64 Any) (<| _.long .int) (_.wrap descriptor.long)]
- [f64 Frac _.double (_.wrap descriptor.double)]
+ [i64 (I64 Any) (<| _.long .int) (_.wrap type.long)]
+ [f64 Frac _.double (_.wrap type.double)]
[text Text _.string (<|)]
)
diff --git a/new-luxc/source/luxc/lang/translation/jvm/procedure/common.lux b/new-luxc/source/luxc/lang/translation/jvm/procedure/common.lux
index 6e7891460..06ae2ba26 100644
--- a/new-luxc/source/luxc/lang/translation/jvm/procedure/common.lux
+++ b/new-luxc/source/luxc/lang/translation/jvm/procedure/common.lux
@@ -16,8 +16,7 @@
["." dictionary]]]
[target
[jvm
- [type
- ["." descriptor]]]]
+ ["." type]]]
[tool
[compiler
["." synthesis (#+ Synthesis %synthesis)]
@@ -53,19 +52,19 @@
(#static MIN_VALUE Double)
(#static MAX_VALUE Double))
-(def: $String (descriptor.class "java.lang.String"))
-(def: $CharSequence (descriptor.class "java.lang.CharSequence"))
-(def: $System (descriptor.class "java.lang.System"))
-(def: $Object (descriptor.class "java.lang.Object"))
+(def: $String (type.class "java.lang.String" (list)))
+(def: $CharSequence (type.class "java.lang.CharSequence" (list)))
+(def: $System (type.class "java.lang.System" (list)))
+(def: $Object (type.class "java.lang.Object" (list)))
-(def: lux-intI Inst (|>> _.I2L (_.wrap descriptor.long)))
-(def: jvm-intI Inst (|>> (_.unwrap descriptor.long) _.L2I))
+(def: lux-intI Inst (|>> _.I2L (_.wrap type.long)))
+(def: jvm-intI Inst (|>> (_.unwrap type.long) _.L2I))
(def: check-stringI Inst (_.CHECKCAST $String))
(def: (predicateI tester)
(-> (-> Label Inst)
Inst)
- (let [$Boolean (descriptor.class "java.lang.Boolean")]
+ (let [$Boolean (type.class "java.lang.Boolean" (list))]
(<| _.with-label (function (_ @then))
_.with-label (function (_ @end))
(|>> (tester @then)
@@ -111,7 +110,7 @@
conditionalsG (|> conditionalsG+
(list@map product.right)
_.fuse)]]
- (wrap (|>> inputG (_.unwrap descriptor.long) _.L2I
+ (wrap (|>> inputG (_.unwrap type.long) _.L2I
(_.LOOKUPSWITCH @else table)
conditionalsG
(_.label @else)
@@ -130,15 +129,15 @@
(|>> riskyI
(_.CHECKCAST ///.$Function)
(_.INVOKESTATIC runtime.$Runtime "try"
- (descriptor.method [(list ///.$Function) ///.$Variant])
+ (type.method [(list ///.$Function) ///.$Variant (list)])
#0)))
(template [<name> <op>]
[(def: (<name> [maskI inputI])
(Binary Inst)
- (|>> inputI (_.unwrap descriptor.long)
- maskI (_.unwrap descriptor.long)
- <op> (_.wrap descriptor.long)))]
+ (|>> inputI (_.unwrap type.long)
+ maskI (_.unwrap type.long)
+ <op> (_.wrap type.long)))]
[i64::and _.LAND]
[i64::or _.LOR]
@@ -148,10 +147,10 @@
(template [<name> <op>]
[(def: (<name> [shiftI inputI])
(Binary Inst)
- (|>> inputI (_.unwrap descriptor.long)
+ (|>> inputI (_.unwrap type.long)
shiftI jvm-intI
<op>
- (_.wrap descriptor.long)))]
+ (_.wrap type.long)))]
[i64::left-shift _.LSHL]
[i64::arithmetic-right-shift _.LSHR]
@@ -163,9 +162,9 @@
(Nullary Inst)
(|>> <const> (_.wrap <type>)))]
- [f64::smallest (_.double (Double::MIN_VALUE)) descriptor.double]
- [f64::min (_.double (f.* -1.0 (Double::MAX_VALUE))) descriptor.double]
- [f64::max (_.double (Double::MAX_VALUE)) descriptor.double]
+ [f64::smallest (_.double (Double::MIN_VALUE)) type.double]
+ [f64::min (_.double (f.* -1.0 (Double::MAX_VALUE))) type.double]
+ [f64::max (_.double (Double::MAX_VALUE)) type.double]
)
(template [<name> <type> <op>]
@@ -176,25 +175,25 @@
<op>
(_.wrap <type>)))]
- [i64::+ descriptor.long _.LADD]
- [i64::- descriptor.long _.LSUB]
- [i64::* descriptor.long _.LMUL]
- [i64::/ descriptor.long _.LDIV]
- [i64::% descriptor.long _.LREM]
+ [i64::+ type.long _.LADD]
+ [i64::- type.long _.LSUB]
+ [i64::* type.long _.LMUL]
+ [i64::/ type.long _.LDIV]
+ [i64::% type.long _.LREM]
- [f64::+ descriptor.double _.DADD]
- [f64::- descriptor.double _.DSUB]
- [f64::* descriptor.double _.DMUL]
- [f64::/ descriptor.double _.DDIV]
- [f64::% descriptor.double _.DREM]
+ [f64::+ type.double _.DADD]
+ [f64::- type.double _.DSUB]
+ [f64::* type.double _.DMUL]
+ [f64::/ type.double _.DDIV]
+ [f64::% type.double _.DREM]
)
-(template [<eq> <lt> <descriptor> <cmp>]
+(template [<eq> <lt> <type> <cmp>]
[(template [<name> <reference>]
[(def: (<name> [paramI subjectI])
(Binary Inst)
- (|>> subjectI (_.unwrap <descriptor>)
- paramI (_.unwrap <descriptor>)
+ (|>> subjectI (_.unwrap <type>)
+ paramI (_.unwrap <type>)
<cmp>
(_.int <reference>)
(predicateI _.IF_ICMPEQ)))]
@@ -202,8 +201,8 @@
[<eq> +0]
[<lt> -1])]
- [i64::= i64::< descriptor.long _.LCMP]
- [f64::= f64::< descriptor.double _.DCMPG]
+ [i64::= i64::< type.long _.LCMP]
+ [f64::= f64::< type.double _.DCMPG]
)
(template [<name> <prepare> <transform>]
@@ -211,22 +210,22 @@
(Unary Inst)
(|>> inputI <prepare> <transform>))]
- [i64::f64 (_.unwrap descriptor.long) (<| (_.wrap descriptor.double) _.L2D)]
- [i64::char (_.unwrap descriptor.long)
- ((|>> _.L2I _.I2C (_.INVOKESTATIC (descriptor.class "java.lang.Character") "toString" (descriptor.method [(list descriptor.char) $String]) #0)))]
+ [i64::f64 (_.unwrap type.long) (<| (_.wrap type.double) _.L2D)]
+ [i64::char (_.unwrap type.long)
+ ((|>> _.L2I _.I2C (_.INVOKESTATIC (type.class "java.lang.Character" (list)) "toString" (type.method [(list type.char) $String (list)]) #0)))]
- [f64::i64 (_.unwrap descriptor.double) (<| (_.wrap descriptor.long) _.D2L)]
- [f64::encode (_.unwrap descriptor.double)
- (_.INVOKESTATIC (descriptor.class "java.lang.Double") "toString" (descriptor.method [(list descriptor.double) $String]) #0)]
+ [f64::i64 (_.unwrap type.double) (<| (_.wrap type.long) _.D2L)]
+ [f64::encode (_.unwrap type.double)
+ (_.INVOKESTATIC (type.class "java.lang.Double" (list)) "toString" (type.method [(list type.double) $String (list)]) #0)]
[f64::decode ..check-stringI
- (_.INVOKESTATIC runtime.$Runtime "decode_frac" (descriptor.method [(list $String) ///.$Variant]) #0)]
+ (_.INVOKESTATIC runtime.$Runtime "decode_frac" (type.method [(list $String) ///.$Variant (list)]) #0)]
)
(def: (text::size inputI)
(Unary Inst)
(|>> inputI
..check-stringI
- (_.INVOKEVIRTUAL $String "length" (descriptor.method [(list) descriptor.int]) #0)
+ (_.INVOKEVIRTUAL $String "length" (type.method [(list) type.int (list)]) #0)
lux-intI))
(template [<name> <pre-subject> <pre-param> <op> <post>]
@@ -237,13 +236,13 @@
<op> <post>))]
[text::= (<|) (<|)
- (_.INVOKEVIRTUAL $Object "equals" (descriptor.method [(list $Object) descriptor.boolean]) #0)
- (_.wrap descriptor.boolean)]
+ (_.INVOKEVIRTUAL $Object "equals" (type.method [(list $Object) type.boolean (list)]) #0)
+ (_.wrap type.boolean)]
[text::< ..check-stringI ..check-stringI
- (_.INVOKEVIRTUAL $String "compareTo" (descriptor.method [(list $String) descriptor.int]) #0)
+ (_.INVOKEVIRTUAL $String "compareTo" (type.method [(list $String) type.int (list)]) #0)
(predicateI _.IFLT)]
[text::char ..check-stringI jvm-intI
- (_.INVOKEVIRTUAL $String "charAt" (descriptor.method [(list descriptor.int) descriptor.char]) #0)
+ (_.INVOKEVIRTUAL $String "charAt" (type.method [(list type.int) type.char (list)]) #0)
lux-intI]
)
@@ -251,16 +250,16 @@
(Binary Inst)
(|>> leftI ..check-stringI
rightI ..check-stringI
- (_.INVOKEVIRTUAL $String "concat" (descriptor.method [(list $String) $String]) #0)))
+ (_.INVOKEVIRTUAL $String "concat" (type.method [(list $String) $String (list)]) #0)))
(def: (text::clip [startI endI subjectI])
(Trinary Inst)
(|>> subjectI ..check-stringI
startI jvm-intI
endI jvm-intI
- (_.INVOKEVIRTUAL $String "substring" (descriptor.method [(list descriptor.int descriptor.int) $String]) #0)))
+ (_.INVOKEVIRTUAL $String "substring" (type.method [(list type.int type.int) $String (list)]) #0)))
-(def: index-method (descriptor.method [(list $String descriptor.int) descriptor.int]))
+(def: index-method (type.method [(list $String type.int) type.int (list)]))
(def: (text::index [startI partI textI])
(Trinary Inst)
(<| _.with-label (function (_ @not-found))
@@ -280,10 +279,10 @@
runtime.noneI
(_.label @end))))
-(def: string-method (descriptor.method [(list $String) descriptor.void]))
+(def: string-method (type.method [(list $String) type.void (list)]))
(def: (io::log messageI)
(Unary Inst)
- (let [$PrintStream (descriptor.class "java.io.PrintStream")]
+ (let [$PrintStream (type.class "java.io.PrintStream" (list))]
(|>> (_.GETSTATIC $System "out" $PrintStream)
messageI
..check-stringI
@@ -292,7 +291,7 @@
(def: (io::error messageI)
(Unary Inst)
- (let [$Error (descriptor.class "java.lang.Error")]
+ (let [$Error (type.class "java.lang.Error" (list))]
(|>> (_.NEW $Error)
_.DUP
messageI
@@ -303,13 +302,13 @@
(def: (io::exit codeI)
(Unary Inst)
(|>> codeI jvm-intI
- (_.INVOKESTATIC $System "exit" (descriptor.method [(list descriptor.int) descriptor.void]) #0)
+ (_.INVOKESTATIC $System "exit" (type.method [(list type.int) type.void (list)]) #0)
_.NULL))
(def: (io::current-time _)
(Nullary Inst)
- (|>> (_.INVOKESTATIC $System "currentTimeMillis" (descriptor.method [(list) descriptor.long]) #0)
- (_.wrap descriptor.long)))
+ (|>> (_.INVOKESTATIC $System "currentTimeMillis" (type.method [(list) type.long (list)]) #0)
+ (_.wrap type.long)))
(def: bundle::lux
Bundle
diff --git a/new-luxc/source/luxc/lang/translation/jvm/procedure/host.lux b/new-luxc/source/luxc/lang/translation/jvm/procedure/host.lux
index a51d1715b..58643797b 100644
--- a/new-luxc/source/luxc/lang/translation/jvm/procedure/host.lux
+++ b/new-luxc/source/luxc/lang/translation/jvm/procedure/host.lux
@@ -1,5 +1,5 @@
(.module:
- [lux (#- primitive int char)
+ [lux (#- Type primitive int char type)
[abstract
["." monad (#+ do)]]
[control
@@ -13,17 +13,20 @@
["." maybe]
[number
["." nat]]
- ["." text]
+ ["." text ("#@." equivalence)]
[collection
["." list ("#@." monad)]
["." dictionary (#+ Dictionary)]
["." set]]]
[target
- ["." jvm #_
- ["#" type (#+ Bound Generic Class Var Typed Argument Return)
+ [jvm
+ ["." type (#+ Type Typed Argument)
+ ["." category (#+ Void Value Return Primitive Object Class Array Var Parameter Method)]
["." box]
["." reflection]
- ["." descriptor (#+ Descriptor Value Primitive Object Method)]]]]
+ ["." descriptor (#+ Descriptor)]
+ ["." signature (#+ Signature)]
+ ["." parser]]]]
[tool
[compiler
[analysis (#+ Environment)]
@@ -52,8 +55,6 @@
["#." reference]
["#." function]]])
-(exception: #export invalid-syntax-for-argument-generation)
-
(template [<name> <inst>]
[(def: <name>
Inst
@@ -172,7 +173,7 @@
[double::% _.DREM]
)
-(def: $Boolean (descriptor.class box.boolean))
+(def: $Boolean (type.class box.boolean (list)))
(def: falseI (_.GETSTATIC $Boolean "FALSE" $Boolean))
(def: trueI (_.GETSTATIC $Boolean "TRUE" $Boolean))
@@ -225,7 +226,7 @@
(def: int
Bundle
- (<| (bundle.prefix reflection.int)
+ (<| (bundle.prefix (reflection.reflection reflection.int))
(|> (: Bundle bundle.empty)
(bundle.install "+" (binary int::+))
(bundle.install "-" (binary int::-))
@@ -244,7 +245,7 @@
(def: long
Bundle
- (<| (bundle.prefix reflection.long)
+ (<| (bundle.prefix (reflection.reflection reflection.long))
(|> (: Bundle bundle.empty)
(bundle.install "+" (binary long::+))
(bundle.install "-" (binary long::-))
@@ -263,7 +264,7 @@
(def: float
Bundle
- (<| (bundle.prefix reflection.float)
+ (<| (bundle.prefix (reflection.reflection reflection.float))
(|> (: Bundle bundle.empty)
(bundle.install "+" (binary float::+))
(bundle.install "-" (binary float::-))
@@ -276,7 +277,7 @@
(def: double
Bundle
- (<| (bundle.prefix reflection.double)
+ (<| (bundle.prefix (reflection.reflection reflection.double))
(|> (: Bundle bundle.empty)
(bundle.install "+" (binary double::+))
(bundle.install "-" (binary double::-))
@@ -289,36 +290,42 @@
(def: char
Bundle
- (<| (bundle.prefix reflection.char)
+ (<| (bundle.prefix (reflection.reflection reflection.char))
(|> (: Bundle bundle.empty)
(bundle.install "=" (binary char::=))
(bundle.install "<" (binary char::<))
)))
(def: (array-java-type nesting elem-class)
- (-> Nat Text (Descriptor Object))
- (descriptor.array (case nesting
- 1 (case elem-class
- (^ (static reflection.boolean)) descriptor.boolean
- (^ (static reflection.byte)) descriptor.byte
- (^ (static reflection.short)) descriptor.short
- (^ (static reflection.int)) descriptor.int
- (^ (static reflection.long)) descriptor.long
- (^ (static reflection.float)) descriptor.float
- (^ (static reflection.double)) descriptor.double
- (^ (static reflection.char)) descriptor.char
- _ (descriptor.class elem-class))
- _ (array-java-type (dec nesting) elem-class))))
+ (-> Nat Text (Type Object))
+ (type.array (case nesting
+ 0 (undefined)
+ 1 (`` (cond (~~ (template [<type>]
+ [(text@= (reflection.reflection (type.reflection <type>))
+ elem-class)
+ <type>]
+
+ [type.boolean]
+ [type.byte]
+ [type.short]
+ [type.int]
+ [type.long]
+ [type.float]
+ [type.double]
+ [type.char]))
+ ## else
+ (type.class elem-class (list))))
+ _ (array-java-type (dec nesting) elem-class))))
(def: (primitive-array-length-handler jvm-primitive)
- (-> (Descriptor Primitive) Handler)
+ (-> (Type Primitive) Handler)
(..custom
[<s>.any
(function (_ extension-name generate arrayS)
(do phase.monad
[arrayI (generate arrayS)]
(wrap (|>> arrayI
- (_.CHECKCAST (descriptor.array jvm-primitive))
+ (_.CHECKCAST (type.array jvm-primitive))
_.ARRAYLENGTH))))]))
(def: (array::length::object extension-name generate inputs)
@@ -337,7 +344,7 @@
(phase.throw extension.invalid-syntax [extension-name %synthesis inputs])))
(def: (new-primitive-array-handler jvm-primitive)
- (-> (Descriptor Primitive) Handler)
+ (-> (Type Primitive) Handler)
(function (_ extension-name generate inputs)
(case inputs
(^ (list lengthS))
@@ -364,7 +371,7 @@
(phase.throw extension.invalid-syntax [extension-name %synthesis inputs])))
(def: (read-primitive-array-handler jvm-primitive loadI)
- (-> (Descriptor Primitive) Inst Handler)
+ (-> (Type Primitive) Inst Handler)
(function (_ extension-name generate inputs)
(case inputs
(^ (list idxS arrayS))
@@ -372,7 +379,7 @@
[arrayI (generate arrayS)
idxI (generate idxS)]
(wrap (|>> arrayI
- (_.CHECKCAST (descriptor.array jvm-primitive))
+ (_.CHECKCAST (type.array jvm-primitive))
idxI
loadI)))
@@ -398,7 +405,7 @@
(phase.throw extension.invalid-syntax [extension-name %synthesis inputs])))
(def: (write-primitive-array-handler jvm-primitive storeI)
- (-> (Descriptor Primitive) Inst Handler)
+ (-> (Type Primitive) Inst Handler)
(function (_ extension-name generate inputs)
(case inputs
(^ (list idxS valueS arrayS))
@@ -407,7 +414,7 @@
idxI (generate idxS)
valueI (generate valueS)]
(wrap (|>> arrayI
- (_.CHECKCAST (descriptor.array jvm-primitive))
+ (_.CHECKCAST (type.array jvm-primitive))
_.DUP
idxI
valueI
@@ -444,47 +451,47 @@
(|> bundle.empty
(dictionary.merge (<| (bundle.prefix "length")
(|> bundle.empty
- (bundle.install reflection.boolean (primitive-array-length-handler descriptor.boolean))
- (bundle.install reflection.byte (primitive-array-length-handler descriptor.byte))
- (bundle.install reflection.short (primitive-array-length-handler descriptor.short))
- (bundle.install reflection.int (primitive-array-length-handler descriptor.int))
- (bundle.install reflection.long (primitive-array-length-handler descriptor.long))
- (bundle.install reflection.float (primitive-array-length-handler descriptor.float))
- (bundle.install reflection.double (primitive-array-length-handler descriptor.double))
- (bundle.install reflection.char (primitive-array-length-handler descriptor.char))
+ (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.boolean (new-primitive-array-handler descriptor.boolean))
- (bundle.install reflection.byte (new-primitive-array-handler descriptor.byte))
- (bundle.install reflection.short (new-primitive-array-handler descriptor.short))
- (bundle.install reflection.int (new-primitive-array-handler descriptor.int))
- (bundle.install reflection.long (new-primitive-array-handler descriptor.long))
- (bundle.install reflection.float (new-primitive-array-handler descriptor.float))
- (bundle.install reflection.double (new-primitive-array-handler descriptor.double))
- (bundle.install reflection.char (new-primitive-array-handler descriptor.char))
+ (bundle.install (reflection.reflection reflection.boolean) (new-primitive-array-handler type.boolean))
+ (bundle.install (reflection.reflection reflection.byte) (new-primitive-array-handler type.byte))
+ (bundle.install (reflection.reflection reflection.short) (new-primitive-array-handler type.short))
+ (bundle.install (reflection.reflection reflection.int) (new-primitive-array-handler type.int))
+ (bundle.install (reflection.reflection reflection.long) (new-primitive-array-handler type.long))
+ (bundle.install (reflection.reflection reflection.float) (new-primitive-array-handler type.float))
+ (bundle.install (reflection.reflection reflection.double) (new-primitive-array-handler type.double))
+ (bundle.install (reflection.reflection reflection.char) (new-primitive-array-handler type.char))
(bundle.install "object" array::new::object))))
(dictionary.merge (<| (bundle.prefix "read")
(|> bundle.empty
- (bundle.install reflection.boolean (read-primitive-array-handler descriptor.boolean _.BALOAD))
- (bundle.install reflection.byte (read-primitive-array-handler descriptor.byte _.BALOAD))
- (bundle.install reflection.short (read-primitive-array-handler descriptor.short _.SALOAD))
- (bundle.install reflection.int (read-primitive-array-handler descriptor.int _.IALOAD))
- (bundle.install reflection.long (read-primitive-array-handler descriptor.long _.LALOAD))
- (bundle.install reflection.float (read-primitive-array-handler descriptor.float _.FALOAD))
- (bundle.install reflection.double (read-primitive-array-handler descriptor.double _.DALOAD))
- (bundle.install reflection.char (read-primitive-array-handler descriptor.char _.CALOAD))
+ (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.boolean (write-primitive-array-handler descriptor.boolean _.BASTORE))
- (bundle.install reflection.byte (write-primitive-array-handler descriptor.byte _.BASTORE))
- (bundle.install reflection.short (write-primitive-array-handler descriptor.short _.SASTORE))
- (bundle.install reflection.int (write-primitive-array-handler descriptor.int _.IASTORE))
- (bundle.install reflection.long (write-primitive-array-handler descriptor.long _.LASTORE))
- (bundle.install reflection.float (write-primitive-array-handler descriptor.float _.FASTORE))
- (bundle.install reflection.double (write-primitive-array-handler descriptor.double _.DASTORE))
- (bundle.install reflection.char (write-primitive-array-handler descriptor.char _.CASTORE))
+ (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))))
)))
@@ -518,7 +525,7 @@
(|>> exceptionI
_.ATHROW))
-(def: $Class (descriptor.class "java.lang.Class"))
+(def: $Class (type.class "java.lang.Class" (list)))
(def: (object::class extension-name generate inputs)
Handler
@@ -528,8 +535,9 @@
[]
(wrap (|>> (_.string class)
(_.INVOKESTATIC $Class "forName"
- (descriptor.method [(list (descriptor.class "java.lang.String"))
- $Class])
+ (type.method [(list (type.class "java.lang.String" (list)))
+ $Class
+ (list)])
false))))
_
@@ -543,8 +551,8 @@
(do phase.monad
[objectI (generate objectS)]
(wrap (|>> objectI
- (_.INSTANCEOF (descriptor.class class))
- (_.wrap descriptor.boolean)))))]))
+ (_.INSTANCEOF (type.class class (list)))
+ (_.wrap type.boolean)))))]))
(def: (object::cast extension-name generate inputs)
Handler
@@ -552,25 +560,29 @@
(^ (list (synthesis.text from) (synthesis.text to) valueS))
(do phase.monad
[valueI (generate valueS)]
- (case [from to]
- ## Wrap
- (^template [<primitive> <object> <type>]
- (^ [(static <primitive>) (static <object>)])
- (wrap (|>> valueI (_.wrap <type>)))
-
- (^ [(static <object>) (static <primitive>)])
- (wrap (|>> valueI (_.unwrap <type>))))
- ([reflection.boolean box.boolean descriptor.boolean]
- [reflection.byte box.byte descriptor.byte]
- [reflection.short box.short descriptor.short]
- [reflection.int box.int descriptor.int]
- [reflection.long box.long descriptor.long]
- [reflection.float box.float descriptor.float]
- [reflection.double box.double descriptor.double]
- [reflection.char box.char descriptor.char])
-
- _
- (wrap valueI)))
+ (`` (cond (~~ (template [<object> <type>]
+ [(and (text@= (reflection.reflection (type.reflection <type>))
+ from)
+ (text@= <object>
+ to))
+ (wrap (|>> valueI (_.wrap <type>)))
+
+ (and (text@= <object>
+ from)
+ (text@= (reflection.reflection (type.reflection <type>))
+ to))
+ (wrap (|>> valueI (_.unwrap <type>)))]
+
+ [box.boolean type.boolean]
+ [box.byte type.byte]
+ [box.short type.short]
+ [box.int type.int]
+ [box.long type.long]
+ [box.float type.float]
+ [box.double type.double]
+ [box.char type.char]))
+ ## else
+ (wrap valueI))))
_
(phase.throw extension.invalid-syntax [extension-name %synthesis inputs])))
@@ -589,211 +601,187 @@
)))
(def: primitives
- (Dictionary Text (Descriptor Primitive))
- (|> (list [reflection.boolean descriptor.boolean]
- [reflection.byte descriptor.byte]
- [reflection.short descriptor.short]
- [reflection.int descriptor.int]
- [reflection.long descriptor.long]
- [reflection.float descriptor.float]
- [reflection.double descriptor.double]
- [reflection.char descriptor.char])
+ (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: (static::get extension-name generate inputs)
+(def: static::get
Handler
- (case inputs
- (^ (list (synthesis.text class)
- (synthesis.text field)
- (synthesis.text unboxed)))
- (do phase.monad
- []
- (case (dictionary.get unboxed ..primitives)
- (#.Some primitive)
- (wrap (_.GETSTATIC (descriptor.class class) field primitive))
-
- #.None
- (wrap (_.GETSTATIC (descriptor.class class) field (descriptor.class unboxed)))))
-
- _
- (phase.throw extension.invalid-syntax [extension-name %synthesis inputs])))
-
-(def: (static::put extension-name generate inputs)
+ (..custom
+ [($_ <>.and <s>.text <s>.text <s>.text)
+ (function (_ extension-name generate [class field unboxed])
+ (do phase.monad
+ []
+ (case (dictionary.get unboxed ..primitives)
+ (#.Some primitive)
+ (wrap (_.GETSTATIC (type.class class (list)) field primitive))
+
+ #.None
+ (wrap (_.GETSTATIC (type.class class (list)) field (type.class unboxed (list)))))))]))
+
+(def: static::put
Handler
- (case inputs
- (^ (list (synthesis.text class)
- (synthesis.text field)
- (synthesis.text unboxed)
- valueS))
- (do phase.monad
- [valueI (generate valueS)
- #let [$class (descriptor.class class)]]
- (case (dictionary.get unboxed ..primitives)
- (#.Some primitive)
- (wrap (|>> valueI
- (_.PUTSTATIC $class field primitive)
- (_.string synthesis.unit)))
-
- #.None
- (wrap (|>> valueI
- (_.CHECKCAST $class)
- (_.PUTSTATIC $class field $class)
- (_.string synthesis.unit)))))
-
- _
- (phase.throw extension.invalid-syntax [extension-name %synthesis inputs])))
-
-(def: (virtual::get extension-name generate inputs)
+ (..custom
+ [($_ <>.and <s>.text <s>.text <s>.text <s>.any)
+ (function (_ extension-name generate [class field unboxed valueS])
+ (do phase.monad
+ [valueI (generate valueS)
+ #let [$class (type.class class (list))]]
+ (case (dictionary.get unboxed ..primitives)
+ (#.Some primitive)
+ (wrap (|>> valueI
+ (_.PUTSTATIC $class field primitive)
+ (_.string synthesis.unit)))
+
+ #.None
+ (wrap (|>> valueI
+ (_.CHECKCAST $class)
+ (_.PUTSTATIC $class field $class)
+ (_.string synthesis.unit))))))]))
+
+(def: virtual::get
Handler
- (case inputs
- (^ (list (synthesis.text class)
- (synthesis.text field)
- (synthesis.text unboxed)
- objectS))
- (do phase.monad
- [objectI (generate objectS)
- #let [$class (descriptor.class class)
- getI (case (dictionary.get unboxed ..primitives)
- (#.Some primitive)
- (_.GETFIELD $class field primitive)
-
- #.None
- (_.GETFIELD $class field (descriptor.class unboxed)))]]
- (wrap (|>> objectI
- (_.CHECKCAST $class)
- getI)))
-
- _
- (phase.throw extension.invalid-syntax [extension-name %synthesis inputs])))
+ (..custom
+ [($_ <>.and <s>.text <s>.text <s>.text <s>.any)
+ (function (_ extension-name generate [class field unboxed objectS])
+ (do phase.monad
+ [objectI (generate objectS)
+ #let [$class (type.class class (list))
+ getI (case (dictionary.get unboxed ..primitives)
+ (#.Some primitive)
+ (_.GETFIELD $class field primitive)
+
+ #.None
+ (_.GETFIELD $class field (type.class unboxed (list))))]]
+ (wrap (|>> objectI
+ (_.CHECKCAST $class)
+ getI))))]))
-(def: (virtual::put extension-name generate inputs)
+(def: virtual::put
Handler
- (case inputs
- (^ (list (synthesis.text class)
- (synthesis.text field)
- (synthesis.text unboxed)
- valueS
- objectS))
- (do phase.monad
- [valueI (generate valueS)
- objectI (generate objectS)
- #let [$class (descriptor.class class)
- putI (case (dictionary.get unboxed ..primitives)
- (#.Some primitive)
- (_.PUTFIELD $class field primitive)
-
- #.None
- (let [$unboxed (descriptor.class unboxed)]
- (|>> (_.CHECKCAST $unboxed)
- (_.PUTFIELD $class field $unboxed))))]]
- (wrap (|>> objectI
- (_.CHECKCAST $class)
- _.DUP
- valueI
- putI)))
+ (..custom
+ [($_ <>.and <s>.text <s>.text <s>.text <s>.any <s>.any)
+ (function (_ extension-name generate [class field unboxed valueS objectS])
+ (do phase.monad
+ [valueI (generate valueS)
+ objectI (generate objectS)
+ #let [$class (type.class class (list))
+ putI (case (dictionary.get unboxed ..primitives)
+ (#.Some primitive)
+ (_.PUTFIELD $class field primitive)
+
+ #.None
+ (let [$unboxed (type.class unboxed (list))]
+ (|>> (_.CHECKCAST $unboxed)
+ (_.PUTFIELD $class field $unboxed))))]]
+ (wrap (|>> objectI
+ (_.CHECKCAST $class)
+ _.DUP
+ valueI
+ putI))))]))
- _
- (phase.throw extension.invalid-syntax [extension-name %synthesis inputs])))
+(template [<name> <category> <parser>]
+ [(def: #export <name>
+ (Parser (Type <category>))
+ (<t>.embed <parser> <s>.text))]
-(def: (generate-arg generate argS)
- (-> (-> Synthesis (Operation Inst)) Synthesis
- (Operation [Type Inst]))
- (case argS
- (^ (synthesis.tuple (list (synthesis.text argD) argS)))
- (do phase.monad
- [argT (phase.lift (<t>.run jvm.parse-signature argD))
- argI (generate argS)]
- (wrap [argT argI]))
+ [var Var parser.var]
+ [class Class parser.class]
+ [value Value parser.value]
+ [return Return parser.return]
+ )
- _
- (phase.throw invalid-syntax-for-argument-generation [])))
+(type: Input (Typed Synthesis))
-(def: (method-return-type description)
- (-> Text (Operation Return))
- (case description
- (^ (static descriptor.void))
- (phase@wrap #.None)
+(def: input
+ (Parser Input)
+ (<s>.tuple (<>.and ..value <s>.any)))
- _
- (|> description
- (<t>.run jvm.parse-signature)
- phase.lift
- (phase@map (|>> #.Some)))))
-
-(def: (prepare-argI [type argI])
- (-> [Type Inst] Inst)
- (case (jvm.class-name type)
- (#.Some class-name)
- (|>> argI
- (_.CHECKCAST class-name))
-
- #.None
- argI))
-
-(def: (prepare-returnI return)
- (-> Return Inst)
- (case return
- (#.Some _)
- function.identity
-
- #.None
- (_.string synthesis.unit)))
+(def: (generate-input generate [valueT valueS])
+ (-> (-> Synthesis (Operation Inst)) Input
+ (Operation (Typed Inst)))
+ (do phase.monad
+ [valueI (generate valueS)]
+ (case (type.primitive? valueT)
+ (#.Right valueT)
+ (wrap [valueT valueI])
+
+ (#.Left valueT)
+ (wrap [valueT (|>> valueI
+ (_.CHECKCAST valueT))]))))
+
+(def: voidI (_.string synthesis.unit))
+
+(def: (prepare-output outputT)
+ (-> (Type Return) Inst)
+ (case (type.void? outputT)
+ (#.Right outputT)
+ ..voidI
+
+ (#.Left outputT)
+ function.identity))
(def: invoke::static
Handler
(..custom
- [($_ <>.and <s>.text <s>.text <s>.text (<>.some <s>.any))
- (function (_ extension-name generate [class method unboxed argsS])
+ [($_ <>.and ..class <s>.text ..return (<>.some ..input))
+ (function (_ extension-name generate [class method outputT inputsTS])
(do phase.monad
- [argsTI (monad.map @ (generate-arg generate) argsS)
- returnT (method-return-type unboxed)]
- (wrap (|>> (_.fuse (list@map ..prepare-argI argsTI))
+ [inputsTI (monad.map @ (generate-input generate) inputsTS)]
+ (wrap (|>> (_.fuse (list@map product.right inputsTI))
(_.INVOKESTATIC class method
- (descriptor.method [(list@map product.left argsTI)
- returnT])
+ (type.method [(list@map product.left inputsTI)
+ outputT
+ (list)])
false)
- (prepare-returnI returnT)))))]))
+ (prepare-output outputT)))))]))
(template [<name> <invoke> <interface?>]
[(def: <name>
Handler
(..custom
- [($_ <>.and <s>.text <s>.text <s>.text <s>.any (<>.some <s>.any))
- (function (_ extension-name generate [class method unboxed objectS argsS])
+ [($_ <>.and ..class <s>.text ..return <s>.any (<>.some ..input))
+ (function (_ extension-name generate [class method outputT objectS inputsTS])
(do phase.monad
[objectI (generate objectS)
- argsTI (monad.map @ (generate-arg generate) argsS)
- returnT (method-return-type unboxed)]
+ inputsTI (monad.map @ (generate-input generate) inputsTS)]
(wrap (|>> objectI
(_.CHECKCAST class)
- (_.fuse (list@map ..prepare-argI argsTI))
+ (_.fuse (list@map product.right inputsTI))
(<invoke> class method
- (descriptor.method [(list@map product.left argsTI)
- returnT])
+ (type.method [(list@map product.left inputsTI)
+ outputT
+ (list)])
<interface?>)
- (prepare-returnI returnT)))))]))]
+ (prepare-output outputT)))))]))]
[invoke::virtual _.INVOKEVIRTUAL false]
[invoke::special _.INVOKESPECIAL false]
[invoke::interface _.INVOKEINTERFACE true]
)
-(def: (invoke::constructor extension-name generate inputs)
+(def: invoke::constructor
Handler
- (case inputs
- (^ (list& (synthesis.text class) argsS))
- (do phase.monad
- [argsTI (monad.map @ (generate-arg generate) argsS)]
- (wrap (|>> (_.NEW class)
- _.DUP
- (_.fuse (list@map ..prepare-argI argsTI))
- (_.INVOKESPECIAL class "<init>"
- (descriptor.method [(list@map product.left argsTI)
- descriptor.void])
- false))))
-
- _
- (phase.throw extension.invalid-syntax [extension-name %synthesis inputs])))
+ (..custom
+ [($_ <>.and ..class (<>.some ..input))
+ (function (_ extension-name generate [class inputsTS])
+ (do phase.monad
+ [inputsTI (monad.map @ (generate-input generate) inputsTS)]
+ (wrap (|>> (_.NEW class)
+ _.DUP
+ (_.fuse (list@map product.right inputsTI))
+ (_.INVOKESPECIAL class "<init>"
+ (type.method [(list@map product.left inputsTI)
+ type.void
+ (list)])
+ false)))))]))
(def: member
Bundle
@@ -816,68 +804,6 @@
(bundle.install "constructor" invoke::constructor))))
)))
-(def: var
- (Parser Var)
- <s>.text)
-
-(def: bound
- (Parser Bound)
- (<>.or (<s>.constant! ["" ">"])
- (<s>.constant! ["" "<"])))
-
-(def: (class' generic)
- (-> (Parser Generic) (Parser Class))
- (<s>.tuple (<>.and <s>.text (<>.some generic))))
-
-(def: generic
- (Parser Generic)
- (<>.rec
- (function (_ generic)
- (let [wildcard (<>.or (<s>.constant! ["" "?"])
- (<s>.tuple (<>.and ..bound generic)))]
- ($_ <>.or
- ..var
- wildcard
- (class' generic))))))
-
-(def: class
- (Parser Class)
- (class' ..generic))
-
-(def: primitive
- (Parser (Descriptor Primitive))
- ($_ <>.or
- (<>.after (<s>.constant! ["" reflection.boolean])
- (<>@wrap descriptor.boolean))
- (<>.after (<s>.constant! ["" reflection.byte])
- (<>@wrap descriptor.byte))
- (<>.after (<s>.constant! ["" reflection.short])
- (<>@wrap descriptor.short))
- (<>.after (<s>.constant! ["" reflection.int])
- (<>@wrap descriptor.int))
- (<>.after (<s>.constant! ["" reflection.long])
- (<>@wrap descriptor.long))
- (<>.after (<s>.constant! ["" reflection.float])
- (<>@wrap descriptor.float))
- (<>.after (<s>.constant! ["" reflection.double])
- (<>@wrap descriptor.double))
- (<>.after (<s>.constant! ["" reflection.char])
- (<>@wrap descriptor.char))
- ))
-
-(def: jvm-type
- (Parser Type)
- (<>.rec
- (function (_ jvm-type)
- ($_ <>.or
- ..primitive
- ..generic
- (<s>.tuple jvm-type)))))
-
-(def: constructor-arg
- (Parser (Typed Synthesis))
- (<s>.tuple (<>.and ..jvm-type <s>.any)))
-
(def: annotation-parameter
(Parser (/.Annotation-Parameter Synthesis))
(<s>.tuple (<>.and <s>.text <s>.any)))
@@ -888,12 +814,7 @@
(def: argument
(Parser Argument)
- (<s>.tuple (<>.and <s>.text ..jvm-type)))
-
-(def: return
- (Parser Return)
- (<>.or (<s>.constant! ["" (descriptor.descriptor descriptor.void)])
- ..jvm-type))
+ (<s>.tuple (<>.and <s>.text ..value)))
(def: overriden-method-definition
(Parser [Environment (/.Overriden-Method Synthesis)])
@@ -989,15 +910,16 @@
(#synthesis.Extension [name inputsS+])
(#synthesis.Extension [name (list@map recur inputsS+)]))))
-(def: $Object (descriptor.class "java.lang.Object"))
+(def: $Object (type.class "java.lang.Object" (list)))
(def: (anonymous-init-method env)
- (-> Environment (Descriptor Method))
- (descriptor.method [(list.repeat (list.size env) $Object)
- descriptor.void]))
+ (-> Environment [(Signature Method) (Descriptor Method)])
+ (type.method [(list.repeat (list.size env) $Object)
+ type.void
+ (list)]))
-(def: (with-anonymous-init class env super-class constructor-argsI)
- (-> Text Environment Class (List (Typed Inst)) Def)
+(def: (with-anonymous-init class env super-class inputsTI)
+ (-> (Type Class) Environment (Type Class) (List (Typed Inst)) Def)
(let [store-capturedI (|> env
list.size
list.indices
@@ -1008,17 +930,18 @@
_.fuse)]
(_def.method #$.Public $.noneM "<init>" (anonymous-init-method env)
(|>> (_.ALOAD 0)
- ((_.fuse (list@map product.right constructor-argsI)))
- (_.INVOKESPECIAL (product.left super-class)
+ ((_.fuse (list@map product.right inputsTI)))
+ (_.INVOKESPECIAL super-class
"<init>"
- (descriptor.method [(list@map product.left constructor-argsI)
- descriptor.void])
+ (type.method [(list@map product.left inputsTI)
+ type.void
+ (list)])
#0)
store-capturedI
_.RETURN))))
(def: (anonymous-instance class env)
- (-> Text Environment (Operation Inst))
+ (-> (Type Class) Environment (Operation Inst))
(do phase.monad
[captureI+ (monad.map @ ///reference.variable env)]
(wrap (|>> (_.NEW class)
@@ -1026,6 +949,34 @@
(_.fuse captureI+)
(_.INVOKESPECIAL class "<init>" (anonymous-init-method env) #0)))))
+(def: (returnI returnT)
+ (-> (Type Return) Inst)
+ (case (type.void? returnT)
+ (#.Right returnT)
+ _.RETURN
+
+ (#.Left returnT)
+ (case (type.primitive? returnT)
+ (#.Left 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
@@ -1033,14 +984,15 @@
<s>.text
..class
(<s>.tuple (<>.some ..class))
- (<s>.tuple (<>.some ..constructor-arg))
+ (<s>.tuple (<>.some ..input))
(<s>.tuple (<>.some ..overriden-method-definition)))
(function (_ extension-name generate [class-name
super-class super-interfaces
- constructor-args
+ inputsTS
overriden-methods])
(do phase.monad
- [#let [total-environment (|> overriden-methods
+ [#let [class (type.class class-name (list))
+ total-environment (|> overriden-methods
## Get all the environments.
(list@map product.left)
## Combine them.
@@ -1072,12 +1024,7 @@
self-name arguments returnT exceptionsT
(normalize-method-body local-mapping body)]))
overriden-methods)]
- constructor-argsI (monad.map @
- (function (_ [argJT argS])
- (do @
- [argG (generate argS)]
- (wrap [argJT argG])))
- constructor-args)
+ inputsTI (monad.map @ (generate-input generate) inputsTS)
method-definitions (|> normalized-methods
(monad.map @ (function (_ [ownerT name
strict-fp? annotations vars
@@ -1090,36 +1037,10 @@
($_ $.++M $.finalM $.strictM)
$.finalM)
name
- (descriptor.method [(list@map product.right arguments)
- returnT]
- ## (list@map (|>> #jvm.Class)
- ## exceptionsT)
- )
- (let [returnI (case returnT
- (#.Some returnT)
- (case returnT
- (#jvm.Primitive returnT)
- (case returnT
- (^or #jvm.Boolean
- #jvm.Byte #jvm.Short #jvm.Int
- #jvm.Char)
- _.IRETURN
-
- #jvm.Long
- _.LRETURN
-
- #jvm.Float
- _.FRETURN
-
- #jvm.Double
- _.DRETURN)
-
- _
- _.ARETURN)
-
- #.None
- _.RETURN)]
- (|>> bodyG returnI)))))))
+ (type.method [(list@map product.right arguments)
+ returnT
+ exceptionsT])
+ (|>> bodyG (returnI returnT)))))))
(:: @ map _def.fuse))
_ (generation.save! true ["" class-name]
[class-name
@@ -1127,9 +1048,9 @@
class-name (list)
super-class super-interfaces
(|>> (///function.with-environment total-environment)
- (..with-anonymous-init class-name total-environment super-class constructor-argsI)
+ (..with-anonymous-init class total-environment super-class inputsTI)
method-definitions))])]
- (anonymous-instance class-name total-environment)))]))
+ (anonymous-instance class total-environment)))]))
(def: bundle::class
Bundle
diff --git a/new-luxc/source/luxc/lang/translation/jvm/reference.lux b/new-luxc/source/luxc/lang/translation/jvm/reference.lux
index 1995fcd74..77e98b73b 100644
--- a/new-luxc/source/luxc/lang/translation/jvm/reference.lux
+++ b/new-luxc/source/luxc/lang/translation/jvm/reference.lux
@@ -7,8 +7,7 @@
["%" format (#+ format)]]]
[target
[jvm
- [type
- ["." descriptor]]]]
+ ["." type]]]
[tool
[compiler
["." name]
@@ -36,7 +35,7 @@
(do phase.monad
[function-class generation.context]
(wrap (|>> (_.ALOAD 0)
- (_.GETFIELD (descriptor.class function-class)
+ (_.GETFIELD (type.class function-class (list))
(|> variable .nat foreign-name)
//.$Value)))))
@@ -57,4 +56,4 @@
(-> Name (Operation Inst))
(do phase.monad
[bytecode-name (generation.remember name)]
- (wrap (_.GETSTATIC (descriptor.class bytecode-name) //.value-field //.$Value))))
+ (wrap (_.GETSTATIC (type.class bytecode-name (list)) //.value-field //.$Value))))
diff --git a/new-luxc/source/luxc/lang/translation/jvm/runtime.lux b/new-luxc/source/luxc/lang/translation/jvm/runtime.lux
index 0f3a89faf..594964be0 100644
--- a/new-luxc/source/luxc/lang/translation/jvm/runtime.lux
+++ b/new-luxc/source/luxc/lang/translation/jvm/runtime.lux
@@ -1,5 +1,5 @@
(.module:
- [lux #*
+ [lux (#- Type)
[abstract
[monad (#+ do)]]
[data
@@ -8,8 +8,10 @@
["." math]
[target
[jvm
- [type
- ["." descriptor (#+ Descriptor)]]]]
+ ["." type (#+ Type)
+ ["." category (#+ Void Value Return Primitive Object Class Array Var Parameter Method)]
+ ["." descriptor (#+ Descriptor)]
+ ["." signature (#+ Signature)]]]]
[tool
[compiler
[arity (#+ Arity)]
@@ -24,36 +26,36 @@
["_" inst]]]]]
["." // (#+ ByteCode)])
-(def: $Text (descriptor.class "java.lang.String"))
-(def: #export $Tag descriptor.int)
-(def: #export $Flag (descriptor.class "java.lang.Object"))
-(def: #export $Value (descriptor.class "java.lang.Object"))
-(def: #export $Index descriptor.int)
-(def: #export $Stack (descriptor.array $Value))
-(def: $Throwable (descriptor.class "java.lang.Throwable"))
-(def: #export $Runtime (descriptor.class "java.lang.Runtime"))
+(def: $Text (type.class "java.lang.String" (list)))
+(def: #export $Tag type.int)
+(def: #export $Flag (type.class "java.lang.Object" (list)))
+(def: #export $Value (type.class "java.lang.Object" (list)))
+(def: #export $Index type.int)
+(def: #export $Stack (type.array $Value))
+(def: $Throwable (type.class "java.lang.Throwable" (list)))
+(def: #export $Runtime (type.class "java.lang.Runtime" (list)))
(def: nullary-init-methodT
- (descriptor.method [(list) descriptor.void]))
+ (type.method [(list) type.void (list)]))
(def: throw-methodT
- (descriptor.method [(list) descriptor.void]))
+ (type.method [(list) type.void (list)]))
(def: #export logI
Inst
- (let [PrintStream (descriptor.class "java.io.PrintStream")
- outI (_.GETSTATIC (descriptor.class "java.lang.System") "out" PrintStream)
+ (let [PrintStream (type.class "java.io.PrintStream" (list))
+ outI (_.GETSTATIC (type.class "java.lang.System" (list)) "out" PrintStream)
printI (function (_ method)
- (_.INVOKEVIRTUAL PrintStream method (descriptor.method [(list $Value) descriptor.void]) #0))]
+ (_.INVOKEVIRTUAL PrintStream method (type.method [(list $Value) type.void (list)]) #0))]
(|>> outI (_.string "LOG: ") (printI "print")
outI _.SWAP (printI "println"))))
(def: variant-method
- (descriptor.method [(list $Tag $Flag $Value) //.$Variant]))
+ (type.method [(list $Tag $Flag $Value) //.$Variant (list)]))
(def: #export variantI
Inst
- (_.INVOKESTATIC (descriptor.class //.runtime-class) "variant_make" variant-method #0))
+ (_.INVOKESTATIC (type.class //.runtime-class (list)) "variant_make" variant-method #0))
(def: #export leftI
Inst
@@ -85,7 +87,7 @@
(<| _.with-label (function (_ @from))
_.with-label (function (_ @to))
_.with-label (function (_ @handler))
- (|>> (_.try @from @to @handler (descriptor.class "java.lang.Exception"))
+ (|>> (_.try @from @to @handler (type.class "java.lang.Exception" (list)))
(_.label @from)
unsafeI
someI
@@ -97,23 +99,23 @@
(def: #export string-concatI
Inst
- (_.INVOKEVIRTUAL $Text "concat" (descriptor.method [(list $Text) $Text]) #0))
+ (_.INVOKEVIRTUAL $Text "concat" (type.method [(list $Text) $Text (list)]) #0))
(def: #export partials-field Text "partials")
(def: #export apply-method Text "apply")
(def: #export num-apply-variants Nat 8)
(def: #export (apply-signature arity)
- (-> Arity (Descriptor descriptor.Method))
- (descriptor.method [(list.repeat arity $Value) $Value]))
+ (-> Arity [(Signature Method) (Descriptor Method)])
+ (type.method [(list.repeat arity $Value) $Value (list)]))
(def: adt-methods
Def
- (let [store-tagI (|>> _.DUP (_.int +0) (_.ILOAD 0) (_.wrap descriptor.int) _.AASTORE)
+ (let [store-tagI (|>> _.DUP (_.int +0) (_.ILOAD 0) (_.wrap type.int) _.AASTORE)
store-flagI (|>> _.DUP (_.int +1) (_.ALOAD 1) _.AASTORE)
store-valueI (|>> _.DUP (_.int +2) (_.ALOAD 2) _.AASTORE)]
(|>> ($d.method #$.Public $.staticM "variant_make"
- (descriptor.method [(list $Tag $Flag $Value) //.$Variant])
+ (type.method [(list $Tag $Flag $Value) //.$Variant (list)])
(|>> (_.int +3)
(_.array //.$Variant)
store-tagI
@@ -125,11 +127,11 @@
(def: frac-methods
Def
- (|>> ($d.method #$.Public $.staticM "decode_frac" (descriptor.method [(list $Text) //.$Variant])
+ (|>> ($d.method #$.Public $.staticM "decode_frac" (type.method [(list $Text) //.$Variant (list)])
(try-methodI
(|>> (_.ALOAD 0)
- (_.INVOKESTATIC (descriptor.class "java.lang.Double") "parseDouble" (descriptor.method [(list $Text) descriptor.double]) #0)
- (_.wrap descriptor.double))))
+ (_.INVOKESTATIC (type.class "java.lang.Double" (list)) "parseDouble" (type.method [(list $Text) type.double (list)]) #0)
+ (_.wrap type.double))))
))
(def: #export popI
@@ -143,11 +145,11 @@
(def: (illegal-state-exception message)
(-> Text Inst)
- (let [IllegalStateException (descriptor.class "java.lang.IllegalStateException")]
+ (let [IllegalStateException (type.class "java.lang.IllegalStateException" (list))]
(|>> (_.NEW IllegalStateException)
_.DUP
(_.string message)
- (_.INVOKESPECIAL IllegalStateException "<init>" (descriptor.method [(list $Text) descriptor.void]) #0))))
+ (_.INVOKESPECIAL IllegalStateException "<init>" (type.method [(list $Text) type.void (list)]) #0))))
(def: pm-methods
Def
@@ -170,7 +172,7 @@
($d.method #$.Public $.staticM "apply_fail" throw-methodT
(|>> (illegal-state-exception "Error while applying function.")
_.ATHROW))
- ($d.method #$.Public $.staticM "pm_push" (descriptor.method [(list $Stack $Value) $Stack])
+ ($d.method #$.Public $.staticM "pm_push" (type.method [(list $Stack $Value) $Stack (list)])
(|>> (_.int +2)
(_.ANEWARRAY $Stack)
_.DUP
@@ -182,7 +184,7 @@
(_.ALOAD 1)
_.AASTORE
_.ARETURN))
- ($d.method #$.Public $.staticM "pm_variant" (descriptor.method [(list //.$Variant $Tag $Flag) $Value])
+ ($d.method #$.Public $.staticM "pm_variant" (type.method [(list //.$Variant $Tag $Flag) $Value (list)])
(<| _.with-label (function (_ @loop))
_.with-label (function (_ @just-return))
_.with-label (function (_ @then))
@@ -193,7 +195,7 @@
(function (_ idx)
(|>> (_.int (.int idx)) _.AALOAD)))
tagI (: Inst
- (|>> (variant-partI 0) (_.unwrap descriptor.int)))
+ (|>> (variant-partI 0) (_.unwrap type.int)))
flagI (variant-partI 1)
datumI (variant-partI 2)
shortenI (|>> (_.ALOAD 0) tagI ## Get tag
@@ -234,7 +236,7 @@
(_.label @wrong) ## tag, sumT
## _.POP2
failureI)))
- ($d.method #$.Public $.staticM "tuple_left" (descriptor.method [(list //.$Tuple $Index) $Value])
+ ($d.method #$.Public $.staticM "tuple_left" (type.method [(list //.$Tuple $Index) $Value (list)])
(<| _.with-label (function (_ @loop))
_.with-label (function (_ @recursive))
(let [left-accessI (|>> (_.ALOAD 0) left-indexI _.AALOAD)])
@@ -245,7 +247,7 @@
(_.label @recursive)
## Recursive
(recurI @loop))))
- ($d.method #$.Public $.staticM "tuple_right" (descriptor.method [(list //.$Tuple $Index) $Value])
+ ($d.method #$.Public $.staticM "tuple_right" (type.method [(list //.$Tuple $Index) $Value (list)])
(<| _.with-label (function (_ @loop))
_.with-label (function (_ @not-tail))
_.with-label (function (_ @slice))
@@ -258,9 +260,10 @@
sub-rightI (|>> (_.ALOAD 0)
right-indexI
tuple-sizeI
- (_.INVOKESTATIC (descriptor.class "java.util.Arrays") "copyOfRange"
- (descriptor.method [(list //.$Tuple $Index $Index)
- //.$Tuple])
+ (_.INVOKESTATIC (type.class "java.util.Arrays" (list)) "copyOfRange"
+ (type.method [(list //.$Tuple $Index $Index)
+ //.$Tuple
+ (list)])
#0))])
(|>> (_.label @loop)
last-rightI right-indexI
@@ -280,8 +283,8 @@
(def: io-methods
Def
- (let [StringWriter (descriptor.class "java.io.StringWriter")
- PrintWriter (descriptor.class "java.io.PrintWriter")
+ (let [StringWriter (type.class "java.io.StringWriter" (list))
+ PrintWriter (type.class "java.io.PrintWriter" (list))
string-writerI (|>> (_.NEW StringWriter)
_.DUP
(_.INVOKESPECIAL StringWriter "<init>" nullary-init-methodT #0))
@@ -291,9 +294,9 @@
_.POP
_.SWAP
(_.boolean true)
- (_.INVOKESPECIAL PrintWriter "<init>" (descriptor.method [(list (descriptor.class "java.io.Writer") descriptor.boolean) descriptor.void]) #0)
+ (_.INVOKESPECIAL PrintWriter "<init>" (type.method [(list (type.class "java.io.Writer" (list)) type.boolean) type.void (list)]) #0)
)]
- (|>> ($d.method #$.Public $.staticM "try" (descriptor.method [(list //.$Function) //.$Variant])
+ (|>> ($d.method #$.Public $.staticM "try" (type.method [(list //.$Function) //.$Variant (list)])
(<| _.with-label (function (_ @from))
_.with-label (function (_ @to))
_.with-label (function (_ @handler))
@@ -309,15 +312,15 @@
string-writerI ## TW
_.DUP2 ## TWTW
print-writerI ## TWTP
- (_.INVOKEVIRTUAL $Throwable "printStackTrace" (descriptor.method [(list (descriptor.class "java.io.PrintWriter")) descriptor.void]) #0) ## TW
- (_.INVOKEVIRTUAL StringWriter "toString" (descriptor.method [(list) $Text]) #0) ## TS
+ (_.INVOKEVIRTUAL $Throwable "printStackTrace" (type.method [(list (type.class "java.io.PrintWriter" (list))) type.void (list)]) #0) ## TW
+ (_.INVOKEVIRTUAL StringWriter "toString" (type.method [(list) $Text (list)]) #0) ## TS
_.SWAP _.POP leftI
_.ARETURN)))
)))
(def: translate-runtime
(Operation ByteCode)
- (let [bytecode ($d.class #$.V1_6 #$.Public $.finalC //.runtime-class (list) ["java.lang.Object" (list)] (list)
+ (let [bytecode ($d.class #$.V1_6 #$.Public $.finalC //.runtime-class (list) (type.class "java.lang.Object" (list)) (list)
(|>> adt-methods
frac-methods
pm-methods
@@ -342,14 +345,15 @@
_.ARETURN)))))
(list& ($d.abstract-method #$.Public $.noneM apply-method (apply-signature 1)))
$d.fuse)
- bytecode ($d.abstract #$.V1_6 #$.Public $.noneC //.function-class (list) ["java.lang.Object" (list)] (list)
- (|>> ($d.field #$.Public $.finalF partials-field descriptor.int)
- ($d.method #$.Public $.noneM "<init>" (descriptor.method [(list descriptor.int) descriptor.void])
+ $Object (type.class "java.lang.Object" (list))
+ bytecode ($d.abstract #$.V1_6 #$.Public $.noneC //.function-class (list) $Object (list)
+ (|>> ($d.field #$.Public $.finalF partials-field type.int)
+ ($d.method #$.Public $.noneM "<init>" (type.method [(list type.int) type.void (list)])
(|>> (_.ALOAD 0)
- (_.INVOKESPECIAL (descriptor.class "java.lang.Object") "<init>" nullary-init-methodT #0)
+ (_.INVOKESPECIAL $Object "<init>" nullary-init-methodT #0)
(_.ALOAD 0)
(_.ILOAD 1)
- (_.PUTFIELD //.$Function partials-field descriptor.int)
+ (_.PUTFIELD //.$Function partials-field type.int)
_.RETURN))
applyI))]
(do phase.monad
diff --git a/new-luxc/source/luxc/lang/translation/jvm/structure.lux b/new-luxc/source/luxc/lang/translation/jvm/structure.lux
index e224f1f2f..81730e6bf 100644
--- a/new-luxc/source/luxc/lang/translation/jvm/structure.lux
+++ b/new-luxc/source/luxc/lang/translation/jvm/structure.lux
@@ -13,8 +13,10 @@
["." list]]]
[target
[jvm
- [type
- ["." descriptor]]]]
+ ["." type (#+ Type)
+ ["." category (#+ Void Value Return Primitive Object Class Array Var Parameter Method)]
+ ["." descriptor (#+ Descriptor)]
+ ["." signature (#+ Signature)]]]]
[tool
[compiler
[synthesis (#+ Synthesis)]
@@ -66,8 +68,9 @@
lefts)))
(flagI right?)
memberI
- (_.INVOKESTATIC (descriptor.class //.runtime-class)
+ (_.INVOKESTATIC (type.class //.runtime-class (list))
"variant_make"
- (descriptor.method [(list //runtime.$Tag //runtime.$Flag //runtime.$Value)
- //.$Variant])
+ (type.method [(list //runtime.$Tag //runtime.$Flag //runtime.$Value)
+ //.$Variant
+ (list)])
#0)))))
diff --git a/new-luxc/source/program.lux b/new-luxc/source/program.lux
index 1311392a9..8e372f77f 100644
--- a/new-luxc/source/program.lux
+++ b/new-luxc/source/program.lux
@@ -92,7 +92,8 @@
(def: #export (program programI)
(-> _.Inst _.Definition)
- (let [nilI runtime.noneI
+ (let [$Object ($t.class "java.lang.Object" (list))
+ nilI runtime.noneI
num-inputsI (|>> ($i.ALOAD 0) $i.ARRAYLENGTH)
decI (|>> ($i.int +1) $i.ISUB)
headI (|>> $i.DUP
@@ -103,7 +104,7 @@
$i.DUP_X2
$i.POP)
pairI (|>> ($i.int +2)
- ($i.ANEWARRAY "java.lang.Object")
+ ($i.ANEWARRAY $Object)
$i.DUP_X1
$i.SWAP
($i.int +0)
@@ -135,18 +136,19 @@
($i.label @end)
$i.POP
($i.ASTORE 0)))
- run-ioI (|>> ($i.CHECKCAST jvm.function-class)
+ $Function ($t.class jvm.function-class (list))
+ run-ioI (|>> ($i.CHECKCAST $Function)
$i.NULL
- ($i.INVOKEVIRTUAL jvm.function-class runtime.apply-method (runtime.apply-signature 1) #0))
- main-type ($t.method (list ($t.array 1 ($t.class "java.lang.String" (list))))
- #.None
- (list))
+ ($i.INVOKEVIRTUAL $Function runtime.apply-method (runtime.apply-signature 1) #0))
+ main-type ($t.method [(list ($t.array ($t.class "java.lang.String" (list))))
+ $t.void
+ (list)])
bytecode-name "_"]
[bytecode-name
($d.class #_.V1_6
#_.Public _.finalC
bytecode-name
- (list) ["java.lang.Object" (list)]
+ (list) $Object
(list)
(|>> ($d.method #_.Public _.staticM "main" main-type
(|>> prepare-input-listI
diff --git a/stdlib/source/lux/control/parser/code.lux b/stdlib/source/lux/control/parser/code.lux
index b20f707a3..5ea2247d6 100644
--- a/stdlib/source/lux/control/parser/code.lux
+++ b/stdlib/source/lux/control/parser/code.lux
@@ -156,17 +156,6 @@
#.Nil (#try.Success [tokens #1])
_ (#try.Success [tokens #0]))))
-(def: #export (lift outcome)
- (All [a] (-> (Try a) (Parser a)))
- (function (_ input)
- (case outcome
- (#try.Failure error)
- (#try.Failure error)
-
- (#try.Success value)
- (#try.Success [input value])
- )))
-
(def: #export (run syntax inputs)
(All [a] (-> (Parser a) (List Code) (Try a)))
(case (syntax inputs)
diff --git a/stdlib/source/lux/control/parser/text.lux b/stdlib/source/lux/control/parser/text.lux
index bec295f39..44d568eaf 100644
--- a/stdlib/source/lux/control/parser/text.lux
+++ b/stdlib/source/lux/control/parser/text.lux
@@ -345,7 +345,7 @@
{#.doc "Run a parser with the given input, instead of the real one."}
(All [a] (-> Text (Parser a) (Parser a)))
(function (_ real-input)
- (case (run parser local-input)
+ (case (..run parser local-input)
(#try.Failure error)
(#try.Failure error)
@@ -363,3 +363,12 @@
#.None
(exception.throw ..cannot-slice [])))))
+
+(def: #export (embed structured text)
+ (All [s a]
+ (-> (Parser a)
+ (//.Parser s Text)
+ (//.Parser s a)))
+ (do //.monad
+ [raw text]
+ (//.lift (..run structured raw))))
diff --git a/stdlib/source/lux/control/try.lux b/stdlib/source/lux/control/try.lux
index 20d4dcab7..3b27fd6a3 100644
--- a/stdlib/source/lux/control/try.lux
+++ b/stdlib/source/lux/control/try.lux
@@ -110,6 +110,15 @@
(#Failure message)
(error! message)))
+(def: #export (maybe try)
+ (All [a] (-> (Try a) (Maybe a)))
+ (case try
+ (#Success value)
+ (#.Some value)
+
+ (#Failure message)
+ #.None))
+
(macro: #export (default tokens compiler)
{#.doc (doc "Allows you to provide a default value that will be used"
"if a (Try x) value turns out to be #Failure."
diff --git a/stdlib/source/lux/macro/syntax/common/reader.lux b/stdlib/source/lux/macro/syntax/common/reader.lux
index bd8e3953b..02d947e47 100644
--- a/stdlib/source/lux/macro/syntax/common/reader.lux
+++ b/stdlib/source/lux/macro/syntax/common/reader.lux
@@ -108,7 +108,7 @@
me-definition-raw (|> definition-raw
////.expand-all
(////.run compiler)
- s.lift)]
+ p.lift)]
(s.local me-definition-raw
(s.form (do @
[_ (s.text! "lux def")
diff --git a/stdlib/source/lux/target/jvm/reflection.lux b/stdlib/source/lux/target/jvm/reflection.lux
index e6ee7e630..992ac9977 100644
--- a/stdlib/source/lux/target/jvm/reflection.lux
+++ b/stdlib/source/lux/target/jvm/reflection.lux
@@ -20,10 +20,13 @@
["." dictionary]]]]
["." // #_
[encoding
- ["#." name]]
+ ["#." name (#+ External)]]
["/" type
+ [category (#+ Void Value Return Method Primitive Object Class Array Parameter)]
["#." lux (#+ Mapping)]
- ["." reflection]]])
+ ["#." descriptor]
+ ["#." reflection]
+ ["#." parser]]])
(import: #long java/lang/String)
@@ -88,7 +91,7 @@
(getConstructors [] [(java/lang/reflect/Constructor java/lang/Object)])
(getDeclaredMethods [] [java/lang/reflect/Method]))
-(exception: #export (unknown-class {class Text})
+(exception: #export (unknown-class {class External})
(exception.report
["Class" (%.text class)]))
@@ -103,7 +106,7 @@
)
(def: #export (load name)
- (-> Text (Try (java/lang/Class java/lang/Object)))
+ (-> External (Try (java/lang/Class java/lang/Object)))
(case (java/lang/Class::forName name)
(#try.Success class)
(#try.Success class)
@@ -112,17 +115,63 @@
(exception.throw ..unknown-class name)))
(def: #export (sub? super sub)
- (-> Text Text (Try Bit))
+ (-> External External (Try Bit))
(do try.monad
[super (..load super)
sub (..load sub)]
(wrap (java/lang/Class::isAssignableFrom sub super))))
-(def: #export (generic reflection)
- (-> java/lang/reflect/Type (Try /.Generic))
+(def: (class' parameter reflection)
+ (-> (-> java/lang/reflect/Type (Try (/.Type Parameter)))
+ java/lang/reflect/Type
+ (Try (/.Type Class)))
+ (<| (case (host.check java/lang/Class reflection)
+ (#.Some class)
+ (let [class-name (|> class
+ (:coerce (java/lang/Class java/lang/Object))
+ java/lang/Class::getName)]
+ (`` (if (or (~~ (template [<reflection>]
+ [(text@= (/reflection.reflection <reflection>)
+ class-name)]
+
+ [/reflection.boolean]
+ [/reflection.byte]
+ [/reflection.short]
+ [/reflection.int]
+ [/reflection.long]
+ [/reflection.float]
+ [/reflection.double]
+ [/reflection.char]))
+ (text.starts-with? /descriptor.array-prefix class-name))
+ (exception.throw ..not-a-class reflection)
+ (#try.Success (/.class class-name (list))))))
+ _)
+ (case (host.check java/lang/reflect/ParameterizedType reflection)
+ (#.Some reflection)
+ (let [raw (java/lang/reflect/ParameterizedType::getRawType reflection)]
+ (case (host.check java/lang/Class raw)
+ (#.Some raw)
+ (do try.monad
+ [paramsT (|> reflection
+ java/lang/reflect/ParameterizedType::getActualTypeArguments
+ array.to-list
+ (monad.map @ parameter))]
+ (wrap (/.class (|> raw
+ (:coerce (java/lang/Class java/lang/Object))
+ java/lang/Class::getName)
+ paramsT)))
+
+ _
+ (exception.throw ..not-a-class raw)))
+ _)
+ ## else
+ (exception.throw ..cannot-convert-to-a-lux-type reflection)))
+
+(def: #export (parameter reflection)
+ (-> java/lang/reflect/Type (Try (/.Type Parameter)))
(<| (case (host.check java/lang/reflect/TypeVariable reflection)
(#.Some reflection)
- (#try.Success (#/.Var (java/lang/reflect/TypeVariable::getName reflection)))
+ (#try.Success (/.var (java/lang/reflect/TypeVariable::getName reflection)))
_)
(case (host.check java/lang/reflect/WildcardType reflection)
(#.Some reflection)
@@ -136,105 +185,69 @@
(#.Some _)
## TODO: Array bounds should not be "erased" as they
## are right now.
- (#try.Success (#/.Wildcard #.None))
+ (#try.Success /.wildcard)
_
- (:: try.monad map
- (|>> [<kind>] #.Some #/.Wildcard)
- (generic bound))))
- ([[_ (#.Some bound)] #/.Upper]
- [[(#.Some bound) _] #/.Lower])
+ (:: try.monad map <kind> (..class' parameter bound))))
+ ([[_ (#.Some bound)] /.upper]
+ [[(#.Some bound) _] /.lower])
_
- (#try.Success (#/.Wildcard #.None)))
- _)
- (case (host.check java/lang/Class reflection)
- (#.Some class)
- (let [class-name (|> class
- (:coerce (java/lang/Class java/lang/Object))
- java/lang/Class::getName)]
- (case class-name
- (^template [<reflection>]
- (^ (static <reflection>))
- (exception.throw ..not-a-class reflection))
- ([reflection.boolean] [reflection.byte] [reflection.short] [reflection.int]
- [reflection.long] [reflection.float] [reflection.double] [reflection.char])
-
- _
- (if (text.starts-with? /.array-prefix class-name)
- (exception.throw ..not-a-class reflection)
- (#try.Success (#/.Class class-name (list))))))
+ (#try.Success /.wildcard))
_)
- (case (host.check java/lang/reflect/ParameterizedType reflection)
- (#.Some reflection)
- (let [raw (java/lang/reflect/ParameterizedType::getRawType reflection)]
- (case (host.check java/lang/Class raw)
- (#.Some raw)
- (do try.monad
- [paramsT (|> reflection
- java/lang/reflect/ParameterizedType::getActualTypeArguments
- array.to-list
- (monad.map @ generic))]
- (wrap (#/.Class (|> raw
- (:coerce (java/lang/Class java/lang/Object))
- java/lang/Class::getName)
- paramsT)))
+ (..class' parameter reflection)))
- _
- (exception.throw ..not-a-class raw)))
- _)
- ## else
- (exception.throw ..cannot-convert-to-a-lux-type reflection)))
+(def: #export class
+ (-> java/lang/reflect/Type
+ (Try (/.Type Class)))
+ (..class' ..parameter))
(def: #export (type reflection)
- (-> java/lang/reflect/Type (Try /.Type))
+ (-> java/lang/reflect/Type (Try (/.Type Value)))
(<| (case (host.check java/lang/Class reflection)
(#.Some reflection)
- (case (|> reflection
- (:coerce (java/lang/Class java/lang/Object))
- java/lang/Class::getName)
- (^template [<reflection> <type>]
- (^ (static <reflection>))
- (#try.Success <type>))
- ([reflection.boolean /.boolean]
- [reflection.byte /.byte]
- [reflection.short /.short]
- [reflection.int /.int]
- [reflection.long /.long]
- [reflection.float /.float]
- [reflection.double /.double]
- [reflection.char /.char])
-
- class-name
- (if (text.starts-with? /.array-prefix class-name)
- (<t>.run /.parse-signature (|> class-name //name.internal //name.read))
- (#try.Success (/.class class-name (list)))))
+ (let [class-name (|> reflection
+ (:coerce (java/lang/Class java/lang/Object))
+ java/lang/Class::getName)]
+ (`` (cond (~~ (template [<reflection> <type>]
+ [(text@= (/reflection.reflection <reflection>)
+ class-name)
+ (#try.Success <type>)]
+
+ [/reflection.boolean /.boolean]
+ [/reflection.byte /.byte]
+ [/reflection.short /.short]
+ [/reflection.int /.int]
+ [/reflection.long /.long]
+ [/reflection.float /.float]
+ [/reflection.double /.double]
+ [/reflection.char /.char]))
+ (if (text.starts-with? /descriptor.array-prefix class-name)
+ (<t>.run /parser.value (|> class-name //name.internal //name.read))
+ (#try.Success (/.class class-name (list)))))))
_)
(case (host.check java/lang/reflect/GenericArrayType reflection)
(#.Some reflection)
(|> reflection
java/lang/reflect/GenericArrayType::getGenericComponentType
type
- (:: try.monad map (/.array 1)))
+ (:: try.monad map /.array))
_)
## else
- (:: try.monad map (|>> #/.Generic)
- (..generic reflection))))
+ (..parameter reflection)))
(def: #export (return reflection)
- (-> java/lang/reflect/Type (Try /.Return))
- (with-expansions [<else> (as-is (:: try.monad map (|>> #.Some)
- (..type reflection)))]
+ (-> java/lang/reflect/Type (Try (/.Type Return)))
+ (with-expansions [<else> (as-is (..type reflection))]
(case (host.check java/lang/Class reflection)
(#.Some class)
- (case (|> class
- (:coerce (java/lang/Class java/lang/Object))
- java/lang/Class::getName)
- (^ (static reflection.void))
- (#try.Success #.None)
-
- _
- <else>)
+ (let [class-name (|> reflection
+ (:coerce (java/lang/Class java/lang/Object))
+ java/lang/Class::getName)]
+ (if (text@= (/reflection.reflection /reflection.void)
+ class-name)
+ (#try.Success /.void)
+ <else>))
#.None
<else>)))
@@ -327,7 +340,7 @@
(template [<name> <exception> <then?> <else?>]
[(def: #export (<name> field class)
- (-> Text (java/lang/Class java/lang/Object) (Try [Bit /.Type]))
+ (-> Text (java/lang/Class java/lang/Object) (Try [Bit (/.Type Value)]))
(do try.monad
[fieldJ (..field field class)
#let [modifiers (java/lang/reflect/Field::getModifiers fieldJ)]]
diff --git a/stdlib/source/lux/target/jvm/type.lux b/stdlib/source/lux/target/jvm/type.lux
index d1af2ec02..d8b21a829 100644
--- a/stdlib/source/lux/target/jvm/type.lux
+++ b/stdlib/source/lux/target/jvm/type.lux
@@ -1,15 +1,12 @@
(.module:
[lux (#- Type int char)
[abstract
- [equivalence (#+ Equivalence)]
- [monad (#+ do)]]
- [control
- ["." function]
- ["<>" parser ("#@." monad)
- ["<t>" text (#+ Parser)]]]
+ [equivalence (#+ Equivalence)]]
[data
- ["." text ("#@." equivalence)
- ["%" format (#+ format)]]
+ ["." maybe]
+ ["." text]
+ [number
+ ["n" nat]]
[collection
["." list ("#@." functor)]]]
[type
@@ -18,7 +15,7 @@
[encoding
["#." name (#+ External)]]]
["." / #_
- [category (#+ Void Value Return Method Primitive Object Class Array Parameter)]
+ [category (#+ Void Value Return Method Primitive Object Class Array Var Parameter)]
["#." signature (#+ Signature)]
["#." descriptor (#+ Descriptor)]
["#." reflection (#+ Reflection)]])
@@ -28,6 +25,17 @@
[(Signature category) (Descriptor category) (Reflection category)]
+ (type: #export Argument
+ [Text (Type Value)])
+
+ (type: #export (Typed a)
+ [(Type Value) a])
+
+ (type: #export Constraint
+ {#name Text
+ #super-class (Type Class)
+ #super-interfaces (List (Type Class))})
+
(template [<name> <style>]
[(def: #export (<name> type)
(All [category] (-> (Type category) (<style> category)))
@@ -77,7 +85,7 @@
/reflection.wildcard]))
(def: #export (var name)
- (-> Text (Type Parameter))
+ (-> Text (Type Var))
(:abstraction
[(/signature.var name)
/descriptor.var
@@ -116,141 +124,43 @@
(:: /signature.equivalence =
(..signature parameter)
(..signature subject))))
- )
-(template [<category> <name> <signature> <type>]
- [(def: <name>
- (Parser (Type <category>))
- (<>.after (<t>.this (/signature.signature <signature>))
- (<>@wrap <type>)))]
-
- [Void void-parser /signature.void ..void]
- [Primitive boolean-parser /signature.boolean ..boolean]
- [Primitive byte-parser /signature.byte ..byte]
- [Primitive short-parser /signature.short ..short]
- [Primitive int-parser /signature.int ..int]
- [Primitive long-parser /signature.long ..long]
- [Primitive float-parser /signature.float ..float]
- [Primitive double-parser /signature.double ..double]
- [Primitive char-parser /signature.char ..char]
- [Parameter wildcard-parser /signature.wildcard ..wildcard]
+ (def: #export (primitive? type)
+ (-> (Type Value) (Either (Type Object)
+ (Type Primitive)))
+ (if (`` (or (~~ (template [<type>]
+ [(:: ..equivalence = (: (Type Value) <type>) type)]
+
+ [..boolean]
+ [..byte]
+ [..short]
+ [..int]
+ [..long]
+ [..float]
+ [..double]
+ [..char]))))
+ (|> type (:coerce (Type Primitive)) #.Right)
+ (|> type (:coerce (Type Object)) #.Left)))
+
+ (def: #export (void? type)
+ (-> (Type Return) (Either (Type Value)
+ (Type Void)))
+ (if (`` (or (~~ (template [<type>]
+ [(:: ..equivalence = (: (Type Return) <type>) type)]
+
+ [..void]))))
+ (|> type (:coerce (Type Void)) #.Right)
+ (|> type (:coerce (Type Value)) #.Left)))
)
-(def: primitive-parser
- (Parser (Type Primitive))
- ($_ <>.either
- ..boolean-parser
- ..byte-parser
- ..short-parser
- ..int-parser
- ..long-parser
- ..float-parser
- ..double-parser
- ..char-parser))
-
-(def: valid-var-characters/head
- (format "abcdefghijklmnopqrstuvwxyz"
- "ABCDEFGHIJKLMNOPQRSTUVWXYZ"
- "_"))
-
-(def: valid-var-characters/tail
- (format valid-var-characters/head
- "0123456789"))
-
-(def: valid-class-characters/head
- (format valid-var-characters/head //name.internal-separator))
-
-(def: valid-class-characters/tail
- (format valid-var-characters/tail //name.internal-separator))
-
-(template [<type> <name> <head> <tail> <adapter>]
- [(def: #export <name>
- (Parser <type>)
- (:: <>.functor map <adapter>
- (<t>.slice (<t>.and! (<t>.one-of! <head>)
- (<t>.some! (<t>.one-of! <tail>))))))]
-
- [External class-name-parser valid-class-characters/head valid-class-characters/tail (|>> //name.internal //name.external)]
- [Text var-name-parser valid-var-characters/head valid-var-characters/tail function.identity]
- )
-
-(def: #export var-parser
- (Parser Text)
- (|> ..var-name-parser
- (<>.after (<t>.this /signature.var-prefix))
- (<>.before (<t>.this /descriptor.class-suffix))))
-
-(def: var-parser'
- (Parser (Type Parameter))
- (<>@map ..var ..var-parser))
-
-(template [<name> <prefix> <constructor>]
- [(def: <name>
- (-> (Parser (Type Class)) (Parser (Type Parameter)))
- (|>> (<>.after (<t>.this <prefix>))
- (<>@map <constructor>)))]
-
- [lower-parser /signature.lower-prefix ..lower]
- [upper-parser /signature.upper-prefix ..upper]
- )
-
-(def: (class-parser parameter-parser)
- (-> (Parser (Type Parameter)) (Parser (Type Class)))
- (|> (do <>.monad
- [_ (<t>.this /descriptor.class-prefix)
- name ..class-name-parser
- parameters (|> (<>.some parameter-parser)
- (<>.after (<t>.this /signature.parameters-start))
- (<>.before (<t>.this /signature.parameters-end))
- (<>.default (list)))
- _ (<t>.this /descriptor.class-suffix)]
- (wrap (..class name parameters)))
- (<>.after (<t>.this /descriptor.class-prefix))
- (<>.before (<t>.this /descriptor.class-suffix))))
-
-(def: generic-parser
- (Parser (Type Parameter))
- (<>.rec
- (function (_ generic-parser)
- (let [class-parser (..class-parser generic-parser)]
- ($_ <>.either
- ..var-parser'
- ..wildcard-parser
- (..lower-parser class-parser)
- (..upper-parser class-parser)
- class-parser
- )))))
-
-(def: array-parser
- (-> (Parser (Type Value)) (Parser (Type Array)))
- (|>> (<>.after (<t>.this /descriptor.array-prefix))
- (<>@map ..array)))
-
-(def: #export value-parser
- (Parser (Type Value))
- (<>.rec
- (function (_ parser)
- ($_ <>.either
- ..primitive-parser
- ..generic-parser
- (..array-parser parser)
- ))))
-
-(def: #export method-parser
- (Parser [(Signature Method)
- (Descriptor Method)])
- (let [parameters-parser (: (Parser (List (Type Value)))
- (|> (<>.some ..value-parser)
- (<>.after (<t>.this /signature.arguments-start))
- (<>.before (<t>.this /signature.arguments-end))))
- return-parser (: (Parser (Type Return))
- (<>.either ..void-parser
- ..value-parser))
- exception-parser (: (Parser (Type Class))
- (|> (..class-parser ..generic-parser)
- (<>.after (<t>.this /signature.exception-prefix))))]
- (do <>.monad
- [parameters parameters-parser
- return return-parser
- exceptions (<>.some exception-parser)]
- (wrap (..method [parameters return exceptions])))))
+(def: #export (class? type)
+ (-> (Type Value) (Maybe External))
+ (let [repr (|> type ..descriptor /descriptor.descriptor)]
+ (if (and (text.starts-with? /descriptor.class-prefix repr)
+ (text.ends-with? /descriptor.class-suffix repr))
+ (|> repr
+ (text.clip (text.size /descriptor.class-prefix)
+ (n.- (text.size /descriptor.class-suffix)
+ (text.size repr)))
+ (:: maybe.monad map (|>> //name.internal //name.external)))
+ #.None)))
diff --git a/stdlib/source/lux/target/jvm/type/alias.lux b/stdlib/source/lux/target/jvm/type/alias.lux
new file mode 100644
index 000000000..dfa1e4356
--- /dev/null
+++ b/stdlib/source/lux/target/jvm/type/alias.lux
@@ -0,0 +1,112 @@
+(.module:
+ [lux (#- Type int char type primitive)
+ [abstract
+ ["." monad (#+ do)]]
+ [control
+ ["." try]
+ ["." exception (#+ exception:)]
+ ["<>" parser ("#@." monad)
+ ["<t>" text (#+ Parser)]]]
+ [data
+ ["." product]
+ ["." maybe]
+ ["." text
+ ["%" format (#+ format)]]
+ [collection
+ [array (#+ Array)]
+ ["." dictionary (#+ Dictionary)]]]]
+ ["." // (#+ Type)
+ [category (#+ Void Value Return Method Primitive Object Class Array Var Parameter)]
+ ["#." descriptor]
+ ["#." signature (#+ Signature)]
+ ["#." reflection]
+ ["#." parser]
+ ["/#" // #_
+ [encoding
+ ["#." name]]]])
+
+(type: #export Aliasing
+ (Dictionary Text Text))
+
+(def: #export fresh
+ Aliasing
+ (dictionary.new text.hash))
+
+(def: (var aliasing)
+ (-> Aliasing (Parser (Type Var)))
+ (do <>.monad
+ [var //parser.var']
+ (wrap (|> aliasing
+ (dictionary.get var)
+ (maybe.default var)
+ //.var))))
+
+(def: (class parameter)
+ (-> (Parser (Type Parameter)) (Parser (Type Class)))
+ (|> (do <>.monad
+ [_ (<t>.this //descriptor.class-prefix)
+ name //parser.class-name
+ parameters (|> (<>.some parameter)
+ (<>.after (<t>.this //signature.parameters-start))
+ (<>.before (<t>.this //signature.parameters-end))
+ (<>.default (list)))
+ _ (<t>.this //descriptor.class-suffix)]
+ (wrap (//.class name parameters)))
+ (<>.after (<t>.this //descriptor.class-prefix))
+ (<>.before (<t>.this //descriptor.class-suffix))))
+
+(template [<name> <prefix> <constructor>]
+ [(def: <name>
+ (-> (Parser (Type Class)) (Parser (Type Parameter)))
+ (<>.after (<t>.this <prefix>)))]
+
+ [lower //signature.lower-prefix ..Lower]
+ [upper //signature.upper-prefix ..Upper]
+ )
+
+(def: (parameter aliasing)
+ (-> Aliasing (Parser (Type Parameter)))
+ (<>.rec
+ (function (_ parameter)
+ (let [class (..class parameter)]
+ ($_ <>.either
+ (..var aliasing)
+ //parser.wildcard
+ (..lower class)
+ (..upper class)
+ class
+ )))))
+
+(def: (value aliasing)
+ (-> Aliasing (Parser (Type Value)))
+ (<>.rec
+ (function (_ value)
+ ($_ <>.either
+ //parser.primitive
+ (parameter aliasing)
+ (//parser.array' value)
+ ))))
+
+(def: (return aliasing)
+ (-> Aliasing (Parser (Type Return)))
+ ($_ <>.either
+ //parser.void
+ (..value aliasing)
+ ))
+
+(def: #export (method aliasing signature)
+ (-> Aliasing (Signature Method) (Signature Method))
+ (let [parameters (: (Parser (List (Type Value)))
+ (|> (<>.some (..value aliasing))
+ (<>.after (<t>.this //signature.arguments-start))
+ (<>.before (<t>.this //signature.arguments-end))))
+ exception (: (Parser (Type Class))
+ (|> (..class (..parameter aliasing))
+ (<>.after (<t>.this //signature.exception-prefix))))]
+ (|> (//signature.signature signature)
+ (<t>.run (do <>.monad
+ [parameters parameters
+ return (..return aliasing)
+ exceptions (<>.some exception)]
+ (wrap (product.left (//.method [parameters return exceptions])))))
+ try.assume)))
diff --git a/stdlib/source/lux/target/jvm/type/box.lux b/stdlib/source/lux/target/jvm/type/box.lux
index 37f160458..65816b487 100644
--- a/stdlib/source/lux/target/jvm/type/box.lux
+++ b/stdlib/source/lux/target/jvm/type/box.lux
@@ -1,8 +1,11 @@
(.module:
- [lux (#- int char)])
+ [lux (#- int char)]
+ [///
+ [encoding
+ [name (#+ External)]]])
(template [<name> <box>]
- [(def: #export <name> <box>)]
+ [(def: #export <name> External <box>)]
[boolean "java.lang.Boolean"]
[byte "java.lang.Byte"]
diff --git a/stdlib/source/lux/target/jvm/type/category.lux b/stdlib/source/lux/target/jvm/type/category.lux
index 3bbf03783..cbeaa53ef 100644
--- a/stdlib/source/lux/target/jvm/type/category.lux
+++ b/stdlib/source/lux/target/jvm/type/category.lux
@@ -27,6 +27,7 @@
(`` (<| Return' Value' (~~ (template.splice <parents>)) <raw>))))]
[[] Primitive]
+ [[Object' Parameter'] Var]
[[Object' Parameter'] Class]
[[Object'] Array]
)
diff --git a/stdlib/source/lux/target/jvm/type/descriptor.lux b/stdlib/source/lux/target/jvm/type/descriptor.lux
index e16693ff4..367f3338d 100644
--- a/stdlib/source/lux/target/jvm/type/descriptor.lux
+++ b/stdlib/source/lux/target/jvm/type/descriptor.lux
@@ -13,10 +13,10 @@
[type
abstract]]
["." // #_
- [category (#+ Void Value Return Method Primitive Object Class Array Parameter)]
+ [category (#+ Void Value Return Method Primitive Object Class Array Var Parameter)]
["/#" // #_
[encoding
- ["#." name (#+ External)]]]])
+ ["#." name (#+ Internal External)]]]])
(abstract: #export (Descriptor category)
{}
@@ -53,14 +53,14 @@
(text.enclose [..class-prefix ..class-suffix])
:abstraction))
- (template [<name>]
+ (template [<name> <category>]
[(def: #export <name>
- (Descriptor Parameter)
+ (Descriptor <category>)
(:transmutation
(..class "java.lang.Object")))]
- [var]
- [wildcard]
+ [var Var]
+ [wildcard Parameter]
)
(def: #export (lower descriptor)
@@ -97,49 +97,18 @@
(def: (= parameter subject)
(text@= (:representation parameter) (:representation subject))))
- (def: #export (primitive? descriptor)
- (-> (Descriptor Value) (Either (Descriptor Object)
- (Descriptor Primitive)))
- (if (`` (or (~~ (template [<descriptor>]
- [(:: ..equivalence = <descriptor> descriptor)]
-
- [..boolean]
- [..byte]
- [..short]
- [..int]
- [..long]
- [..float]
- [..double]
- [..char]))))
- (|> descriptor :transmutation #.Right)
- (|> descriptor :transmutation #.Left)))
-
- (def: binary-name (|>> ///name.internal ///name.external))
-
- (def: #export (class? descriptor)
- (-> (Descriptor Value) (Maybe External))
- (let [repr (:representation descriptor)]
- (if (and (text.starts-with? ..class-prefix repr)
- (text.ends-with? ..class-suffix repr))
- (|> repr
- (text.clip (text.size ..class-prefix)
- (n.- (text.size ..class-suffix)
- (text.size repr)))
- (:: maybe.monad map ..binary-name))
- #.None)))
-
(def: #export class-name
- (-> (Descriptor Object) External)
+ (-> (Descriptor Object) Internal)
(let [prefix-size (text.size ..class-prefix)
suffix-size (text.size ..class-suffix)]
(function (_ descriptor)
(let [repr (:representation descriptor)]
(if (text.starts-with? ..array-prefix repr)
- repr
+ (///name.internal repr)
(|> repr
(text.clip prefix-size
(n.- suffix-size
(text.size repr)))
- (:: maybe.monad map ..binary-name)
+ (:: maybe.monad map ///name.internal)
maybe.assume))))))
)
diff --git a/stdlib/source/lux/target/jvm/type/lux.lux b/stdlib/source/lux/target/jvm/type/lux.lux
index 06cd81ec0..56203d32b 100644
--- a/stdlib/source/lux/target/jvm/type/lux.lux
+++ b/stdlib/source/lux/target/jvm/type/lux.lux
@@ -1,8 +1,9 @@
(.module:
- [lux (#- type)
+ [lux (#- int char type primitive)
[abstract
["." monad (#+ do)]]
[control
+ ["." try]
["." exception (#+ exception:)]
["<>" parser ("#@." monad)
["<t>" text (#+ Parser)]]]
@@ -17,9 +18,11 @@
abstract
["." check (#+ Check) ("#@." monad)]]]
["." //
+ [category (#+ Void Value Return Method Primitive Object Class Array Var Parameter)]
["#." descriptor]
["#." signature]
["#." reflection]
+ ["#." parser]
["/#" // #_
[encoding
["#." name]]]])
@@ -41,62 +44,63 @@
(exception.report
["Var" (%.text var)]))
-(def: void-parser
+(def: void
(Parser (Check Type))
- (<>.after (<t>.this (//signature.signature //signature.void))
+ (<>.after //parser.void
(<>@wrap (check@wrap .Any))))
-(template [<name> <signature> <reflection>]
+(template [<name> <parser> <reflection>]
[(def: <name>
(Parser (Check Type))
- (<>.after (<t>.this (//signature.signature <signature>))
+ (<>.after <parser>
(<>@wrap (check@wrap (#.Primitive (//reflection.reflection <reflection>) #.Nil)))))]
- [boolean-parser //signature.boolean //reflection.boolean]
- [byte-parser //signature.byte //reflection.byte]
- [short-parser //signature.short //reflection.short]
- [int-parser //signature.int //reflection.int]
- [long-parser //signature.long //reflection.long]
- [float-parser //signature.float //reflection.float]
- [double-parser //signature.double //reflection.double]
- [char-parser //signature.char //reflection.char]
+ [boolean //parser.boolean //reflection.boolean]
+ [byte //parser.byte //reflection.byte]
+ [short //parser.short //reflection.short]
+ [int //parser.int //reflection.int]
+ [long //parser.long //reflection.long]
+ [float //parser.float //reflection.float]
+ [double //parser.double //reflection.double]
+ [char //parser.char //reflection.char]
)
-(def: primitive-parser
+(def: primitive
(Parser (Check Type))
($_ <>.either
- ..boolean-parser
- ..byte-parser
- ..short-parser
- ..int-parser
- ..long-parser
- ..float-parser
- ..double-parser
- ..char-parser))
-
-(def: wildcard-parser
+ ..boolean
+ ..byte
+ ..short
+ ..int
+ ..long
+ ..float
+ ..double
+ ..char
+ ))
+
+(def: wildcard
(Parser (Check Type))
- (<>.after (<t>.this (//signature.signature //signature.wildcard))
+ (<>.after //parser.wildcard
(<>@wrap (check@map product.right
check.existential))))
-(def: (var-parser mapping)
+(def: (var mapping)
(-> Mapping (Parser (Check Type)))
(do <>.monad
- [var //.var-parser]
- (<>@wrap (case (dictionary.get var mapping)
- #.None
- (check.throw ..unknown-var [var])
-
- (#.Some type)
- (check@wrap type)))))
-
-(def: (class-parser parameter-parser)
+ [var //parser.var']
+ (wrap (case (dictionary.get var mapping)
+ #.None
+ (check.throw ..unknown-var [var])
+
+ (#.Some type)
+ (check@wrap type)))))
+
+(def: (class' parameter)
(-> (Parser (Check Type)) (Parser (Check Type)))
(|> (do <>.monad
[_ (<t>.this //descriptor.class-prefix)
- name //.class-name-parser
- parameters (|> (<>.some parameter-parser)
+ name //parser.class-name
+ parameters (|> (<>.some parameter)
(<>.after (<t>.this //signature.parameters-start))
(<>.before (<t>.this //signature.parameters-end))
(<>.default (list)))
@@ -110,27 +114,33 @@
(template [<name> <prefix> <constructor>]
[(def: <name>
(-> (Parser (Check Type)) (Parser (Check Type)))
- ## TODO: Re-enable Lower and Upper, instead of using the simplified limit.
- ## (<>@map (check@map (|>> <ctor> .type)))
- (<>.after (<t>.this <prefix>)))]
+ (|> (<>.after (<t>.this <prefix>))
+ ## TODO: Re-enable Lower and Upper, instead of using the simplified limit.
+ ## (<>@map (check@map (|>> <ctor> .type)))
+ ))]
- [lower-parser //signature.lower-prefix ..Lower]
- [upper-parser //signature.upper-prefix ..Upper]
+ [lower //signature.lower-prefix ..Lower]
+ [upper //signature.upper-prefix ..Upper]
)
-(def: (generic-parser mapping)
+(def: (parameter mapping)
(-> Mapping (Parser (Check Type)))
(<>.rec
- (function (_ generic-parser)
- (let [class-parser (..class-parser generic-parser)]
+ (function (_ parameter)
+ (let [class (..class' parameter)]
($_ <>.either
- (..var-parser mapping)
- ..wildcard-parser
- (..lower-parser class-parser)
- (..upper-parser class-parser)
- class-parser)))))
+ (..var mapping)
+ ..wildcard
+ (..lower class)
+ (..upper class)
+ class
+ )))))
+
+(def: #export class
+ (-> Mapping (Parser (Check Type)))
+ (|>> ..parameter ..class'))
-(def: array-parser
+(def: array
(-> (Parser (Check Type)) (Parser (Check Type)))
(|>> (<>@map (check@map (function (_ elementT)
(case elementT
@@ -141,18 +151,28 @@
(|> elementT Array .type)))))
(<>.after (<t>.this //descriptor.array-prefix))))
-(def: #export (type-parser mapping)
+(def: #export (type mapping)
(-> Mapping (Parser (Check Type)))
(<>.rec
- (function (_ type-parser)
+ (function (_ type)
($_ <>.either
- ..primitive-parser
- (generic-parser mapping)
- (..array-parser type-parser)))))
+ ..primitive
+ (parameter mapping)
+ (..array type)
+ ))))
-(def: #export (return-parser mapping)
+(def: #export (return mapping)
(-> Mapping (Parser (Check Type)))
($_ <>.either
- ..void-parser
- (..type-parser mapping)
+ ..void
+ (..type mapping)
))
+
+(def: #export (check operation input)
+ (All [a] (-> (Parser (Check a)) Text (Check a)))
+ (case (<t>.run operation input)
+ (#try.Success check)
+ check
+
+ (#try.Failure error)
+ (check.fail error)))
diff --git a/stdlib/source/lux/target/jvm/type/parser.lux b/stdlib/source/lux/target/jvm/type/parser.lux
new file mode 100644
index 000000000..fd29e4856
--- /dev/null
+++ b/stdlib/source/lux/target/jvm/type/parser.lux
@@ -0,0 +1,195 @@
+(.module:
+ [lux (#- Type int char primitive)
+ [abstract
+ [monad (#+ do)]]
+ [control
+ ["." try]
+ ["." function]
+ ["<>" parser ("#@." monad)
+ ["<t>" text (#+ Parser)]]]
+ [data
+ ["." product]
+ [text
+ ["%" format (#+ format)]]]]
+ ["." // (#+ Type)
+ [category (#+ Void Value Return Method Primitive Object Class Array Var Parameter)]
+ ["#." signature (#+ Signature)]
+ ["#." descriptor (#+ Descriptor)]
+ ["#." reflection (#+ Reflection)]
+ ["." // #_
+ [encoding
+ ["#." name (#+ External)]]]])
+
+(template [<category> <name> <signature> <type>]
+ [(def: #export <name>
+ (Parser (Type <category>))
+ (<>.after (<t>.this (//signature.signature <signature>))
+ (<>@wrap <type>)))]
+
+ [Void void //signature.void //.void]
+ [Primitive boolean //signature.boolean //.boolean]
+ [Primitive byte //signature.byte //.byte]
+ [Primitive short //signature.short //.short]
+ [Primitive int //signature.int //.int]
+ [Primitive long //signature.long //.long]
+ [Primitive float //signature.float //.float]
+ [Primitive double //signature.double //.double]
+ [Primitive char //signature.char //.char]
+ [Parameter wildcard //signature.wildcard //.wildcard]
+ )
+
+(def: #export primitive
+ (Parser (Type Primitive))
+ ($_ <>.either
+ ..boolean
+ ..byte
+ ..short
+ ..int
+ ..long
+ ..float
+ ..double
+ ..char
+ ))
+
+(def: var/head
+ (format "abcdefghijklmnopqrstuvwxyz"
+ "ABCDEFGHIJKLMNOPQRSTUVWXYZ"
+ "_"))
+
+(def: var/tail
+ (format var/head
+ "0123456789"))
+
+(def: class/head
+ (format var/head //name.internal-separator))
+
+(def: class/tail
+ (format var/tail //name.internal-separator))
+
+(template [<type> <name> <head> <tail> <adapter>]
+ [(def: #export <name>
+ (Parser <type>)
+ (:: <>.functor map <adapter>
+ (<t>.slice (<t>.and! (<t>.one-of! <head>)
+ (<t>.some! (<t>.one-of! <tail>))))))]
+
+ [External class-name class/head class/tail (|>> //name.internal //name.external)]
+ [Text var-name var/head var/tail function.identity]
+ )
+
+(def: #export var'
+ (Parser Text)
+ (|> ..var-name
+ (<>.after (<t>.this //signature.var-prefix))
+ (<>.before (<t>.this //descriptor.class-suffix))))
+
+(def: #export var
+ (Parser (Type Var))
+ (<>@map //.var ..var'))
+
+(def: #export var?
+ (-> (Type Parameter) (Maybe Text))
+ (|>> //.signature
+ //signature.signature
+ (<t>.run ..var')
+ try.maybe))
+
+(def: #export name
+ (-> (Type Var) Text)
+ (|>> //.signature
+ //signature.signature
+ (<t>.run ..var')
+ try.assume))
+
+(template [<name> <prefix> <constructor>]
+ [(def: <name>
+ (-> (Parser (Type Class)) (Parser (Type Parameter)))
+ (|>> (<>.after (<t>.this <prefix>))
+ (<>@map <constructor>)))]
+
+ [lower //signature.lower-prefix //.lower]
+ [upper //signature.upper-prefix //.upper]
+ )
+
+(def: (class'' parameter)
+ (-> (Parser (Type Parameter)) (Parser [External (List (Type Parameter))]))
+ (|> (do <>.monad
+ [_ (<t>.this //descriptor.class-prefix)
+ name ..class-name
+ parameters (|> (<>.some parameter)
+ (<>.after (<t>.this //signature.parameters-start))
+ (<>.before (<t>.this //signature.parameters-end))
+ (<>.default (list)))
+ _ (<t>.this //descriptor.class-suffix)]
+ (wrap [name parameters]))
+ (<>.after (<t>.this //descriptor.class-prefix))
+ (<>.before (<t>.this //descriptor.class-suffix))))
+
+(def: class'
+ (-> (Parser (Type Parameter)) (Parser (Type Class)))
+ (|>> ..class''
+ (:: <>.monad map (product.uncurry //.class))))
+
+(def: #export parameter
+ (Parser (Type Parameter))
+ (<>.rec
+ (function (_ parameter)
+ (let [class (..class' parameter)]
+ ($_ <>.either
+ ..var
+ ..wildcard
+ (..lower class)
+ (..upper class)
+ class
+ )))))
+
+(def: #export array'
+ (-> (Parser (Type Value)) (Parser (Type Array)))
+ (|>> (<>.after (<t>.this //descriptor.array-prefix))
+ (<>@map //.array)))
+
+(def: #export class
+ (Parser (Type Class))
+ (..class' ..parameter))
+
+(def: #export read-class
+ (-> (Type Class) [External (List (Type Parameter))])
+ (|>> //.signature
+ //signature.signature
+ (<t>.run (..class'' ..parameter))
+ try.assume))
+
+(def: #export value
+ (Parser (Type Value))
+ (<>.rec
+ (function (_ value)
+ ($_ <>.either
+ ..primitive
+ ..parameter
+ (..array' value)
+ ))))
+
+(def: #export array
+ (Parser (Type Array))
+ (..array' ..value))
+
+(def: #export return
+ (Parser (Type Return))
+ (<>.either ..void
+ ..value))
+
+(def: #export method
+ (Parser [(Signature Method)
+ (Descriptor Method)])
+ (let [parameters (: (Parser (List (Type Value)))
+ (|> (<>.some ..value)
+ (<>.after (<t>.this //signature.arguments-start))
+ (<>.before (<t>.this //signature.arguments-end))))
+ exception (: (Parser (Type Class))
+ (|> (..class' ..parameter)
+ (<>.after (<t>.this //signature.exception-prefix))))]
+ (do <>.monad
+ [parameters parameters
+ return ..return
+ exceptions (<>.some exception)]
+ (wrap (//.method [parameters return exceptions])))))
diff --git a/stdlib/source/lux/target/jvm/type/reflection.lux b/stdlib/source/lux/target/jvm/type/reflection.lux
index 65ee1aa90..ffc26fb8b 100644
--- a/stdlib/source/lux/target/jvm/type/reflection.lux
+++ b/stdlib/source/lux/target/jvm/type/reflection.lux
@@ -6,7 +6,7 @@
[type
abstract]]
["." // #_
- [category (#+ Void Value Return Method Primitive Object Class Array Parameter)]
+ [category (#+ Void Value Return Method Primitive Object Class Array Var Parameter)]
["#." descriptor]
[//
[encoding
@@ -47,14 +47,14 @@
(format //descriptor.array-prefix)
:abstraction))
- (template [<name>]
+ (template [<name> <category>]
[(def: #export <name>
- (Reflection Parameter)
+ (Reflection <category>)
(:transmutation
(..class "java.lang.Object")))]
- [var]
- [wildcard]
+ [var Var]
+ [wildcard Parameter]
)
(def: #export (lower reflection)
diff --git a/stdlib/source/lux/target/jvm/type/signature.lux b/stdlib/source/lux/target/jvm/type/signature.lux
index 260c564db..56fb04da6 100644
--- a/stdlib/source/lux/target/jvm/type/signature.lux
+++ b/stdlib/source/lux/target/jvm/type/signature.lux
@@ -10,7 +10,7 @@
[type
abstract]]
["." // #_
- [category (#+ Void Value Return Method Primitive Object Class Array Parameter)]
+ [category (#+ Void Value Return Method Primitive Object Class Array Var Parameter)]
["#." descriptor]
["/#" // #_
[encoding
@@ -54,7 +54,7 @@
(def: #export var-prefix "T")
(def: #export var
- (-> Text (Signature Parameter))
+ (-> Text (Signature Var))
(|>> (text.enclose [..var-prefix //descriptor.class-suffix])
:abstraction))
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 af85ebf1c..98f09019e 100644
--- a/stdlib/source/lux/tool/compiler/phase/extension/analysis/jvm.lux
+++ b/stdlib/source/lux/tool/compiler/phase/extension/analysis/jvm.lux
@@ -27,10 +27,16 @@
[target
["." jvm #_
[".!" reflection]
- ["#" type (#+ Var Bound Primitive Generic Class Type Argument Return Method Typed)
- ("method@." method-equivalence)
+ [encoding
+ [name (#+ External)]]
+ ["#" type (#+ Type Argument Typed)
+ ["." category (#+ Void Value Return Primitive Object Class Array Var Parameter Method)]
["." box]
["." reflection]
+ ["." descriptor (#+ Descriptor)]
+ ["." signature (#+ Signature) ("#@." equivalence)]
+ ["#-." parser]
+ ["#-." alias (#+ Aliasing)]
[".T" lux (#+ Mapping)]]]]]
["." // #_
["#." lux (#+ custom)]
@@ -46,6 +52,11 @@
["#." analysis (#+ Analysis Operation Phase Handler Bundle)]
["#." synthesis]]]]])
+(def: reflection (|>> jvm.reflection reflection.reflection))
+(def: signature (|>> jvm.signature signature.signature))
+
+(def: object-class "java.lang.Object")
+
(def: inheritance-relationship-type-name "_jvm_inheritance")
(def: #export (inheritance-relationship-type class super-class super-interfaces)
(-> .Type .Type (List .Type) .Type)
@@ -69,14 +80,14 @@
[String "java.lang.String"]
## Primitives
- [boolean reflection.boolean]
- [byte reflection.byte]
- [short reflection.short]
- [int reflection.int]
- [long reflection.long]
- [float reflection.float]
- [double reflection.double]
- [char reflection.char]
+ [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
@@ -98,6 +109,7 @@
[non-object]
[non-array]
+ [non-parameter]
)
(template [<name>]
@@ -179,7 +191,7 @@
(template [<name> <prefix> <type>]
[(def: <name>
Bundle
- (<| (///bundle.prefix <prefix>)
+ (<| (///bundle.prefix (reflection.reflection <prefix>))
(|> ///bundle.empty
(///bundle.install "+" (//lux.binary <type> <type> <type>))
(///bundle.install "-" (//lux.binary <type> <type> <type>))
@@ -203,7 +215,7 @@
(template [<name> <prefix> <type>]
[(def: <name>
Bundle
- (<| (///bundle.prefix <prefix>)
+ (<| (///bundle.prefix (reflection.reflection <prefix>))
(|> ///bundle.empty
(///bundle.install "+" (//lux.binary <type> <type> <type>))
(///bundle.install "-" (//lux.binary <type> <type> <type>))
@@ -220,7 +232,7 @@
(def: bundle::char
Bundle
- (<| (///bundle.prefix reflection.char)
+ (<| (///bundle.prefix (reflection.reflection reflection.char))
(|> ///bundle.empty
(///bundle.install "=" (//lux.binary ..char ..char Bit))
(///bundle.install "<" (//lux.binary ..char ..char Bit))
@@ -228,14 +240,14 @@
(def: #export boxes
(Dictionary Text Text)
- (|> (list [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])
+ (|> (list [(reflection.reflection reflection.boolean) box.boolean]
+ [(reflection.reflection reflection.byte) box.byte]
+ [(reflection.reflection reflection.short) box.short]
+ [(reflection.reflection reflection.int) box.int]
+ [(reflection.reflection reflection.long) box.long]
+ [(reflection.reflection reflection.float) box.float]
+ [(reflection.reflection reflection.double) box.double]
+ [(reflection.reflection reflection.char) box.char])
(dictionary.from-list text.hash)))
(def: (array-type-info allow-primitives? arrayT)
@@ -269,19 +281,20 @@
(////@wrap [level class]))
(#.Ex _)
- (////@wrap [level "java.lang.Object"])
+ (////@wrap [level ..object-class])
_
(/////analysis.throw ..non-array arrayT))))
(def: (primitive-array-length-handler primitive-type)
- (-> Type Handler)
+ (-> (Type Primitive) Handler)
(function (_ extension-name analyse args)
(case args
(^ (list arrayC))
(do ////.monad
[_ (typeA.infer ..int)
- arrayA (typeA.with-type (#.Primitive (reflection.class (jvm.array 1 primitive-type)) (list))
+ arrayA (typeA.with-type (#.Primitive (|> (jvm.array primitive-type) ..reflection)
+ (list))
(analyse arrayC))]
(wrap (#/////analysis.Extension extension-name (list arrayA))))
@@ -308,14 +321,15 @@
(/////analysis.throw ///.incorrect-arity [extension-name 1 (list.size args)]))))
(def: (new-primitive-array-handler primitive-type)
- (-> Type Handler)
+ (-> (Type Primitive) Handler)
(function (_ extension-name analyse args)
(case args
(^ (list lengthC))
(do ////.monad
[lengthA (typeA.with-type ..int
(analyse lengthC))
- _ (typeA.infer (#.Primitive (reflection.class (jvm.array 1 primitive-type)) (list)))]
+ _ (typeA.infer (#.Primitive (|> (jvm.array primitive-type) ..reflection)
+ (list)))]
(wrap (#/////analysis.Extension extension-name (list lengthA))))
_
@@ -341,52 +355,99 @@
_
(/////analysis.throw ///.incorrect-arity [extension-name 1 (list.size args)]))))
+(def: (check-parameter objectT)
+ (-> .Type (Operation (Type Parameter)))
+ (case objectT
+ (^ (#.Primitive (static array.type-name)
+ (list elementT)))
+ (/////analysis.throw ..non-parameter objectT)
+
+ (#.Primitive name parameters)
+ (`` (cond (~~ (template [<reflection>]
+ [(text@= (reflection.reflection <reflection>)
+ name)
+ (/////analysis.throw ..non-parameter objectT)]
+
+ [reflection.boolean]
+ [reflection.byte]
+ [reflection.short]
+ [reflection.int]
+ [reflection.long]
+ [reflection.float]
+ [reflection.double]
+ [reflection.char]))
+
+ (text.starts-with? descriptor.array-prefix name)
+ (/////analysis.throw ..non-parameter objectT)
+
+ ## else
+ (////@wrap (jvm.class name (list)))))
+
+ (#.Named name anonymous)
+ (check-parameter anonymous)
+
+ (^template [<tag>]
+ (<tag> id)
+ (////@wrap (jvm.class ..object-class (list))))
+ ([#.Var]
+ [#.Ex])
+
+ (^template [<tag>]
+ (<tag> env unquantified)
+ (check-parameter unquantified))
+ ([#.UnivQ]
+ [#.ExQ])
+
+ (#.Apply inputT abstractionT)
+ (case (type.apply (list inputT) abstractionT)
+ (#.Some outputT)
+ (check-parameter outputT)
+
+ #.None
+ (/////analysis.throw ..non-parameter objectT))
+
+ _
+ (/////analysis.throw ..non-parameter objectT)))
+
(def: (check-jvm objectT)
- (-> .Type (Operation Type))
+ (-> .Type (Operation (Type Value)))
(case objectT
(#.Primitive name #.Nil)
- (case name
- (^ (static reflection.boolean)) (////@wrap jvm.boolean)
- (^ (static reflection.byte)) (////@wrap jvm.byte)
- (^ (static reflection.short)) (////@wrap jvm.short)
- (^ (static reflection.int)) (////@wrap jvm.int)
- (^ (static reflection.long)) (////@wrap jvm.long)
- (^ (static reflection.float)) (////@wrap jvm.float)
- (^ (static reflection.double)) (////@wrap jvm.double)
- (^ (static reflection.char)) (////@wrap jvm.char)
- _ (if (text.starts-with? jvm.array-prefix name)
- (////.lift (<t>.run jvm.parse-signature name))
- (////@wrap (jvm.class name (list)))))
-
+ (`` (cond (~~ (template [<reflection> <type>]
+ [(text@= (reflection.reflection <reflection>)
+ name)
+ (////@wrap <type>)]
+
+ [reflection.boolean jvm.boolean]
+ [reflection.byte jvm.byte]
+ [reflection.short jvm.short]
+ [reflection.int jvm.int]
+ [reflection.long jvm.long]
+ [reflection.float jvm.float]
+ [reflection.double jvm.double]
+ [reflection.char jvm.char]))
+
+ (text.starts-with? descriptor.array-prefix name)
+ (////.lift (<t>.run jvm-parser.value name))
+
+ ## else
+ (////@wrap (jvm.class name (list)))))
+
(^ (#.Primitive (static array.type-name)
(list elementT)))
(|> elementT
check-jvm
- (////@map (jvm.array 1)))
+ (////@map jvm.array))
(#.Primitive name parameters)
(do ////.monad
- [parameters (monad.map @ check-jvm parameters)
- parameters (monad.map @ (function (_ parameter)
- (case parameter
- (#jvm.Generic generic)
- (wrap generic)
-
- _
- (/////analysis.throw ..primitives-cannot-have-type-parameters name)))
- parameters)]
+ [parameters (monad.map @ check-parameter parameters)]
(////@wrap (jvm.class name parameters)))
(#.Named name anonymous)
(check-jvm anonymous)
(^template [<tag>]
- (<tag> id)
- (////@wrap (jvm.class "java.lang.Object" (list))))
- ([#.Var]
- [#.Ex])
-
- (^template [<tag>]
(<tag> env unquantified)
(check-jvm unquantified))
([#.UnivQ]
@@ -401,24 +462,24 @@
(/////analysis.throw ..non-object objectT))
_
- (/////analysis.throw ..non-object objectT)))
+ (check-parameter objectT)))
(def: (check-object objectT)
- (-> .Type (Operation Text))
+ (-> .Type (Operation External))
(do ////.monad
- [name (:: @ map reflection.class (check-jvm objectT))]
+ [name (:: @ map ..reflection (check-jvm objectT))]
(if (dictionary.contains? name ..boxes)
(/////analysis.throw ..primitives-are-not-objects [name])
(////@wrap name))))
(def: (check-return type)
- (-> .Type (Operation Text))
+ (-> .Type (Operation (Type Return)))
(if (is? .Any type)
- (////@wrap jvm.void-descriptor)
- (////@map reflection.class (check-jvm type))))
+ (////@wrap jvm.void)
+ (check-jvm type)))
(def: (read-primitive-array-handler lux-type jvm-type)
- (-> .Type Type Handler)
+ (-> .Type (Type Primitive) Handler)
(function (_ extension-name analyse args)
(case args
(^ (list idxC arrayC))
@@ -426,7 +487,8 @@
[_ (typeA.infer lux-type)
idxA (typeA.with-type ..int
(analyse idxC))
- arrayA (typeA.with-type (#.Primitive (reflection.class (jvm.array 1 jvm-type)) (list))
+ arrayA (typeA.with-type (#.Primitive (|> (jvm.array jvm-type) ..reflection)
+ (list))
(analyse arrayC))]
(wrap (#/////analysis.Extension extension-name (list idxA arrayA))))
@@ -457,8 +519,9 @@
(/////analysis.throw ///.incorrect-arity [extension-name 2 (list.size args)]))))
(def: (write-primitive-array-handler lux-type jvm-type)
- (-> .Type Type Handler)
- (let [array-type (#.Primitive (reflection.class (jvm.array 1 jvm-type)) (list))]
+ (-> .Type (Type Primitive) Handler)
+ (let [array-type (#.Primitive (|> (jvm.array jvm-type) ..reflection)
+ (list))]
(function (_ extension-name analyse args)
(case args
(^ (list idxC valueC arrayC))
@@ -509,47 +572,47 @@
(|> ///bundle.empty
(dictionary.merge (<| (///bundle.prefix "length")
(|> ///bundle.empty
- (///bundle.install reflection.boolean (primitive-array-length-handler jvm.boolean))
- (///bundle.install reflection.byte (primitive-array-length-handler jvm.byte))
- (///bundle.install reflection.short (primitive-array-length-handler jvm.short))
- (///bundle.install reflection.int (primitive-array-length-handler jvm.int))
- (///bundle.install reflection.long (primitive-array-length-handler jvm.long))
- (///bundle.install reflection.float (primitive-array-length-handler jvm.float))
- (///bundle.install reflection.double (primitive-array-length-handler jvm.double))
- (///bundle.install reflection.char (primitive-array-length-handler jvm.char))
+ (///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.merge (<| (///bundle.prefix "new")
(|> ///bundle.empty
- (///bundle.install reflection.boolean (new-primitive-array-handler jvm.boolean))
- (///bundle.install reflection.byte (new-primitive-array-handler jvm.byte))
- (///bundle.install reflection.short (new-primitive-array-handler jvm.short))
- (///bundle.install reflection.int (new-primitive-array-handler jvm.int))
- (///bundle.install reflection.long (new-primitive-array-handler jvm.long))
- (///bundle.install reflection.float (new-primitive-array-handler jvm.float))
- (///bundle.install reflection.double (new-primitive-array-handler jvm.double))
- (///bundle.install reflection.char (new-primitive-array-handler jvm.char))
+ (///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.merge (<| (///bundle.prefix "read")
(|> ///bundle.empty
- (///bundle.install reflection.boolean (read-primitive-array-handler ..boolean jvm.boolean))
- (///bundle.install reflection.byte (read-primitive-array-handler ..byte jvm.byte))
- (///bundle.install reflection.short (read-primitive-array-handler ..short jvm.short))
- (///bundle.install reflection.int (read-primitive-array-handler ..int jvm.int))
- (///bundle.install reflection.long (read-primitive-array-handler ..long jvm.long))
- (///bundle.install reflection.float (read-primitive-array-handler ..float jvm.float))
- (///bundle.install reflection.double (read-primitive-array-handler ..double jvm.double))
- (///bundle.install reflection.char (read-primitive-array-handler ..char jvm.char))
+ (///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.merge (<| (///bundle.prefix "write")
(|> ///bundle.empty
- (///bundle.install reflection.boolean (write-primitive-array-handler ..boolean jvm.boolean))
- (///bundle.install reflection.byte (write-primitive-array-handler ..byte jvm.byte))
- (///bundle.install reflection.short (write-primitive-array-handler ..short jvm.short))
- (///bundle.install reflection.int (write-primitive-array-handler ..int jvm.int))
- (///bundle.install reflection.long (write-primitive-array-handler ..long jvm.long))
- (///bundle.install reflection.float (write-primitive-array-handler ..float jvm.float))
- (///bundle.install reflection.double (write-primitive-array-handler ..double jvm.double))
- (///bundle.install reflection.char (write-primitive-array-handler ..char jvm.char))
+ (///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))))
)))
@@ -693,18 +756,26 @@
(getDeclaredMethods [] [java/lang/reflect/Method]))
(def: (reflection-type mapping typeJ)
- (-> Mapping Type (Operation .Type))
- (typeA.with-env
- (luxT.type mapping typeJ)))
-
-(def: (reflection-return mapping return)
- (-> Mapping Return (Operation .Type))
- (case return
- #.None
- (////@wrap .Any)
-
- (#.Some return)
- (..reflection-type mapping return)))
+ (-> Mapping (Type Value) (Operation .Type))
+ (case (|> typeJ jvm.signature signature.signature
+ (<t>.run (luxT.type mapping)))
+ (#try.Success check)
+ (typeA.with-env
+ check)
+
+ (#try.Failure error)
+ (////.fail error)))
+
+(def: (reflection-return mapping typeJ)
+ (-> Mapping (Type Return) (Operation .Type))
+ (case (|> typeJ jvm.signature signature.signature
+ (<t>.run (luxT.return mapping)))
+ (#try.Success check)
+ (typeA.with-env
+ check)
+
+ (#try.Failure error)
+ (////.fail error)))
(def: (class-candidate-parents from-name fromT to-name to-class)
(-> Text .Type Text (java/lang/Class java/lang/Object) (Operation (List [[Text .Type] Bit])))
@@ -715,9 +786,9 @@
(function (_ superJT)
(do @
[superJT (////.lift (reflection!.type superJT))
- #let [super-name (reflection.class superJT)]
+ #let [super-name (|> superJT ..reflection)]
super-class (////.lift (reflection!.load super-name))
- superT (typeA.with-env (luxT.type mapping superJT))]
+ superT (reflection-type mapping superJT)]
(wrap [[super-name superT] (java/lang/Class::isAssignableFrom super-class to-class)])))
(case (java/lang/Class::getGenericSuperclass from-class)
(#.Some super)
@@ -736,7 +807,7 @@
(monad.map ////.monad
(function (_ superT)
(do ////.monad
- [super-name (:: @ map reflection.class (check-jvm superT))
+ [super-name (:: @ map ..reflection (check-jvm superT))
super-class (////.lift (reflection!.load super-name))]
(wrap [[super-name superT]
(java/lang/Class::isAssignableFrom super-class to-class)])))
@@ -752,56 +823,59 @@
(^ (list fromC))
(do ////.monad
[toT (///.lift macro.expected-type)
- to-name (:: @ map reflection.class (check-jvm toT))
+ to-name (:: @ map ..reflection (check-jvm toT))
[fromT fromA] (typeA.with-inference
(analyse fromC))
- from-name (:: @ map reflection.class (check-jvm fromT))
+ from-name (:: @ map ..reflection (check-jvm fromT))
can-cast? (: (Operation Bit)
- (case [from-name to-name]
- (^template [<primitive> <object>]
- (^or (^ [(static <primitive>) (static <object>)])
- (^ [(static <object>) (static <primitive>)])
- (^ [(static <primitive>) (static <primitive>)]))
- (wrap #1))
- ([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])
-
- _
- (do @
- [_ (////.assert ..primitives-are-not-objects [from-name]
- (not (dictionary.contains? from-name boxes)))
- _ (////.assert ..primitives-are-not-objects [to-name]
- (not (dictionary.contains? to-name boxes)))
- to-class (////.lift (reflection!.load to-name))
- _ (if (text@= ..inheritance-relationship-type-name from-name)
- (wrap [])
- (do @
- [from-class (////.lift (reflection!.load from-name))]
- (////.assert cannot-cast [fromT toT fromC]
- (java/lang/Class::isAssignableFrom from-class to-class))))]
- (loop [[current-name currentT] [from-name fromT]]
- (if (text@= to-name current-name)
- (wrap #1)
- (do @
- [candidate-parents (: (Operation (List [[Text .Type] Bit]))
- (if (text@= ..inheritance-relationship-type-name current-name)
- (inheritance-candidate-parents currentT to-class toT fromC)
- (class-candidate-parents current-name currentT to-name to-class)))]
- (case (|> candidate-parents
- (list.filter product.right)
- (list@map product.left))
- (#.Cons [next-name nextT] _)
- (recur [next-name nextT])
-
- #.Nil
- (/////analysis.throw cannot-cast [fromT toT fromC]))
- ))))))]
+ (`` (cond (~~ (template [<primitive> <object>]
+ [(let [=primitive (reflection.reflection <primitive>)]
+ (or (and (text@= =primitive from-name)
+ (or (text@= <object> to-name)
+ (text@= =primitive to-name)))
+ (and (text@= <object> from-name)
+ (text@= =primitive to-name))))
+ (wrap 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 @
+ [_ (////.assert ..primitives-are-not-objects [from-name]
+ (not (dictionary.contains? from-name boxes)))
+ _ (////.assert ..primitives-are-not-objects [to-name]
+ (not (dictionary.contains? to-name boxes)))
+ to-class (////.lift (reflection!.load to-name))
+ _ (if (text@= ..inheritance-relationship-type-name from-name)
+ (wrap [])
+ (do @
+ [from-class (////.lift (reflection!.load from-name))]
+ (////.assert cannot-cast [fromT toT fromC]
+ (java/lang/Class::isAssignableFrom from-class to-class))))]
+ (loop [[current-name currentT] [from-name fromT]]
+ (if (text@= to-name current-name)
+ (wrap true)
+ (do @
+ [candidate-parents (: (Operation (List [[Text .Type] Bit]))
+ (if (text@= ..inheritance-relationship-type-name current-name)
+ (inheritance-candidate-parents currentT to-class toT fromC)
+ (class-candidate-parents current-name currentT to-name to-class)))]
+ (case (|> candidate-parents
+ (list.filter product.right)
+ (list@map product.left))
+ (#.Cons [next-name nextT] _)
+ (recur [next-name nextT])
+
+ #.Nil
+ (/////analysis.throw cannot-cast [fromT toT fromC]))
+ )))))))]
(if can-cast?
(wrap (#/////analysis.Extension extension-name (list (/////analysis.text from-name)
(/////analysis.text to-name)
@@ -839,7 +913,7 @@
(wrap (<| (#/////analysis.Extension extension-name)
(list (/////analysis.text class)
(/////analysis.text field)
- (/////analysis.text (reflection.class fieldJT)))))))]))
+ (/////analysis.text (|> fieldJT ..reflection)))))))]))
(def: static::put
Handler
@@ -876,8 +950,7 @@
[final? fieldJT] (reflection!.virtual-field field class)
mapping (reflection!.correspond class objectT)]
(wrap [mapping fieldJT])))
- fieldT (typeA.with-env
- (luxT.type mapping fieldJT))
+ fieldT (reflection-type mapping fieldJT)
_ (typeA.infer fieldT)]
(wrap (<| (#/////analysis.Extension extension-name)
(list (/////analysis.text class)
@@ -899,8 +972,7 @@
[final? fieldJT] (reflection!.virtual-field field class)
mapping (reflection!.correspond class objectT)]
(wrap [final? mapping fieldJT])))
- fieldT (typeA.with-env
- (luxT.type mapping fieldJT))
+ fieldT (reflection-type mapping fieldJT)
_ (////.assert cannot-set-a-final-field [class field]
(not final?))
valueA (typeA.with-type fieldT
@@ -924,7 +996,7 @@
[parameters (|> (java/lang/reflect/Method::getGenericParameterTypes method)
array.to-list
(monad.map try.monad reflection!.type)
- (:: try.monad map (list@map reflection.class))
+ (:: try.monad map (list@map ..reflection))
////.lift)
#let [modifiers (java/lang/reflect/Method::getModifiers method)
correct-class? (java/lang/Object::equals class (java/lang/reflect/Method::getDeclaringClass method))
@@ -961,7 +1033,7 @@
[parameters (|> (java/lang/reflect/Constructor::getGenericParameterTypes constructor)
array.to-list
(monad.map try.monad reflection!.type)
- (:: try.monad map (list@map reflection.class))
+ (:: try.monad map (list@map ..reflection))
////.lift)]
(wrap (and (java/lang/Object::equals class (java/lang/reflect/Constructor::getDeclaringClass constructor))
(n.= (list.size arg-classes) (list.size parameters))
@@ -1150,7 +1222,7 @@
outputJC (check-return outputT)]
(wrap (#/////analysis.Extension extension-name (list& (/////analysis.text class)
(/////analysis.text method)
- (/////analysis.text outputJC)
+ (/////analysis.text (..signature outputJC))
(decorate-inputs argsT argsA))))))]))
(def: invoke::virtual
@@ -1171,7 +1243,7 @@
outputJC (check-return outputT)]
(wrap (#/////analysis.Extension extension-name (list& (/////analysis.text class)
(/////analysis.text method)
- (/////analysis.text outputJC)
+ (/////analysis.text (..signature outputJC))
objectA
(decorate-inputs argsT argsA))))))]))
@@ -1187,7 +1259,7 @@
outputJC (check-return outputT)]
(wrap (#/////analysis.Extension extension-name (list& (/////analysis.text class)
(/////analysis.text method)
- (/////analysis.text outputJC)
+ (/////analysis.text (..signature outputJC))
(decorate-inputs argsT argsA))))))]))
(def: invoke::interface
@@ -1212,7 +1284,7 @@
(wrap (#/////analysis.Extension extension-name
(list& (/////analysis.text class-name)
(/////analysis.text method)
- (/////analysis.text outputJC)
+ (/////analysis.text (..signature outputJC))
objectA
(decorate-inputs argsT argsA))))))]))
@@ -1249,54 +1321,16 @@
)))
)))
-(def: #export var
- (Parser Var)
- <c>.text)
-
-(def: bound
- (Parser Bound)
- (<>.or (<c>.identifier! ["" ">"])
- (<c>.identifier! ["" "<"])))
-
-(def: generic
- (Parser Generic)
- (<>.rec
- (function (_ generic)
- (let [wildcard (: (Parser (Maybe [Bound Generic]))
- (<>.or (<c>.identifier! ["" "?"])
- (<c>.form (<>.and ..bound generic))))
- class (: (Parser Class)
- (<c>.form (<>.and <c>.text (<>.some generic))))]
- ($_ <>.or
- ..var
- wildcard
- class)))))
-
-(def: #export class
- (Parser Class)
- (<c>.form (<>.and <c>.text (<>.some ..generic))))
-
-(def: primitive
- (Parser Primitive)
- ($_ <>.or
- (<c>.identifier! ["" reflection.boolean])
- (<c>.identifier! ["" reflection.byte])
- (<c>.identifier! ["" reflection.short])
- (<c>.identifier! ["" reflection.int])
- (<c>.identifier! ["" reflection.long])
- (<c>.identifier! ["" reflection.float])
- (<c>.identifier! ["" reflection.double])
- (<c>.identifier! ["" reflection.char])
- ))
-
-(def: #export type
- (Parser Type)
- (<>.rec
- (function (_ type)
- ($_ <>.or
- ..primitive
- ..generic
- (<c>.tuple type)))))
+(template [<name> <category> <parser>]
+ [(def: #export <name>
+ (Parser (Type <category>))
+ (<t>.embed <parser> <c>.text))]
+
+ [var Var jvm-parser.var]
+ [class Class jvm-parser.class]
+ [type Value jvm-parser.value]
+ [return Return jvm-parser.return]
+ )
(def: #export typed
(Parser (Typed Code))
@@ -1320,40 +1354,6 @@
(Parser Argument)
(<c>.tuple (<>.and <c>.text ..type)))
-(def: #export return
- (Parser Return)
- (<>.or (<c>.identifier! ["" reflection.void])
- ..type))
-
-(def: (generic-analysis generic)
- (-> Generic Analysis)
- (case generic
- (#jvm.Var var)
- (/////analysis.text var)
-
- (#jvm.Wildcard wildcard)
- (case wildcard
- #.None
- (/////analysis.constant ["" "?"])
-
- (#.Some [bound limit])
- (/////analysis.tuple (list (case bound
- #jvm.Lower
- (/////analysis.constant ["" ">"])
-
- #jvm.Upper
- (/////analysis.constant ["" "<"]))
- (generic-analysis limit))))
-
- (#jvm.Class name parameters)
- (/////analysis.tuple (list& (/////analysis.text name)
- (list@map generic-analysis parameters)))))
-
-(def: (class-analysis [name parameters])
- (-> Class Analysis)
- (/////analysis.tuple (list& (/////analysis.text name)
- (list@map generic-analysis parameters))))
-
(def: (annotation-parameter-analysis [name value])
(-> (Annotation-Parameter Analysis) Analysis)
(/////analysis.tuple (list (/////analysis.text name) value)))
@@ -1363,47 +1363,31 @@
(/////analysis.tuple (list& (/////analysis.text name)
(list@map annotation-parameter-analysis parameters))))
-(def: var-analysis
- (-> Var Analysis)
- (|>> /////analysis.text))
-
-(def: (type-analysis type)
- (-> Type Analysis)
- (case type
- (#jvm.Primitive primitive)
- (case primitive
- #jvm.Boolean (/////analysis.constant ["" reflection.boolean])
- #jvm.Byte (/////analysis.constant ["" reflection.byte])
- #jvm.Short (/////analysis.constant ["" reflection.short])
- #jvm.Int (/////analysis.constant ["" reflection.int])
- #jvm.Long (/////analysis.constant ["" reflection.long])
- #jvm.Float (/////analysis.constant ["" reflection.float])
- #jvm.Double (/////analysis.constant ["" reflection.double])
- #jvm.Char (/////analysis.constant ["" reflection.char]))
-
- (#jvm.Generic generic)
- (generic-analysis generic)
-
- (#jvm.Array type)
- (/////analysis.tuple (list (type-analysis type)))))
-
-(def: (return-analysis return)
- (-> Return Analysis)
- (case return
- #.None
- (/////analysis.constant ["" jvm.void-descriptor])
-
- (#.Some type)
- (type-analysis type)))
+(template [<name> <category>]
+ [(def: <name>
+ (-> (Type <category>) 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 (type-analysis type) term)))
+ (/////analysis.tuple (list (value-analysis type) term)))
+
+(def: (argument-analysis [argument argumentJT])
+ (-> Argument Analysis)
+ (/////analysis.tuple
+ (list (/////analysis.text argument)
+ (value-analysis argumentJT))))
(template [<name> <filter>]
[(def: <name>
(-> (java/lang/Class java/lang/Object)
- (Try (List [Text Method])))
+ (Try (List [Text (Signature Method)])))
(|>> java/lang/Class::getDeclaredMethods
array.to-list
<filter>
@@ -1418,9 +1402,9 @@
reflection!.return)
exceptions (|> (java/lang/reflect/Method::getGenericExceptionTypes method)
array.to-list
- (monad.map @ reflection!.generic))]
+ (monad.map @ reflection!.class))]
(wrap [(java/lang/reflect/Method::getName method)
- (jvm.method inputs return exceptions)]))))))]
+ (product.left (jvm.method [inputs return exceptions]))]))))))]
[abstract-methods (list.filter (|>> java/lang/reflect/Method::getModifiers java/lang/reflect/Modifier::isAbstract))]
[methods (<|)]
@@ -1430,8 +1414,8 @@
(template [<name> <methods>]
[(def: <name>
- (-> (List Class) (Try (List [Text Method])))
- (|>> (monad.map try.monad (|>> product.left reflection!.load))
+ (-> (List (Type Class)) (Try (List [Text (Signature Method)])))
+ (|>> (monad.map try.monad (|>> ..reflection reflection!.load))
(try@map (monad.map try.monad <methods>))
try@join
(try@map list@join)))]
@@ -1441,11 +1425,11 @@
)
(template [<name>]
- [(exception: #export (<name> {methods (List [Text Method])})
+ [(exception: #export (<name> {methods (List [Text (Signature Method)])})
(exception.report
["Methods" (exception.enumerate
- (function (_ [name method])
- (format (%.text name) " " (jvm.method-signature method)))
+ (function (_ [name signature])
+ (format (%.text name) " " (signature.signature signature)))
methods)]))]
[missing-abstract-methods]
@@ -1453,10 +1437,10 @@
)
(type: #export Visibility
- #PublicV
- #PrivateV
- #ProtectedV
- #DefaultV)
+ #Public
+ #Private
+ #Protected
+ #Default)
(type: #export Finality Bit)
(type: #export Strictness Bit)
@@ -1474,12 +1458,20 @@
(<c>.text! ..protected-tag)
(<c>.text! ..default-tag)))
+(def: #export (visibility-analysis visibility)
+ (-> Visibility Analysis)
+ (/////analysis.text (case visibility
+ #Public ..public-tag
+ #Private ..private-tag
+ #Protected ..protected-tag
+ #Default ..default-tag)))
+
(type: #export (Constructor a)
[Visibility
Strictness
(List (Annotation a))
- (List Var)
- (List Class) ## Exceptions
+ (List (Type Var))
+ (List (Type Class)) ## Exceptions
Text
(List Argument)
(List (Typed a))
@@ -1519,19 +1511,17 @@
annotations)
super-arguments (monad.map @ (function (_ [jvmT super-argC])
(do @
- [luxT (typeA.with-env
- (luxT.type mapping jvmT))
+ [luxT (reflection-type mapping jvmT)
super-argA (typeA.with-type luxT
(analyse super-argC))]
(wrap [jvmT super-argA])))
super-arguments)
- arguments' (typeA.with-env
- (monad.map check.monad
- (function (_ [name jvmT])
- (do check.monad
- [luxT (luxT.type mapping jvmT)]
- (wrap [name luxT])))
- arguments))
+ arguments' (monad.map @
+ (function (_ [name jvmT])
+ (do @
+ [luxT (reflection-type mapping jvmT)]
+ (wrap [name luxT])))
+ arguments)
[scope bodyA] (|> arguments'
(#.Cons [self-name selfT])
list.reverse
@@ -1539,24 +1529,14 @@
(typeA.with-type .Any)
/////analysis.with-scope)]
(wrap (/////analysis.tuple (list (/////analysis.text ..constructor-tag)
- (/////analysis.text (case visibility
- #PublicV ..public-tag
- #PrivateV ..private-tag
- #ProtectedV ..protected-tag
- #DefaultV ..default-tag))
+ (visibility-analysis visibility)
(/////analysis.bit strict-fp?)
(/////analysis.tuple (list@map annotation-analysis annotationsA))
(/////analysis.tuple (list@map var-analysis vars))
(/////analysis.text self-name)
- (/////analysis.tuple (list@map (function (_ [argument argumentJT])
- (/////analysis.tuple
- (list (/////analysis.text argument)
- (type-analysis argumentJT))))
- arguments))
- (/////analysis.tuple (list@map class-analysis
- exceptions))
- (/////analysis.tuple (list@map typed-analysis
- super-arguments))
+ (/////analysis.tuple (list@map ..argument-analysis arguments))
+ (/////analysis.tuple (list@map class-analysis exceptions))
+ (/////analysis.tuple (list@map typed-analysis super-arguments))
(#/////analysis.Function
(scope.environment scope)
(/////analysis.tuple (list bodyA)))
@@ -1568,11 +1548,11 @@
Finality
Strictness
(List (Annotation a))
- (List Var)
+ (List (Type Var))
Text
(List Argument)
- Return
- (List Class) ## Exceptions
+ (Type Return)
+ (List (Type Class)) ## Exceptions
a])
(def: virtual-tag "virtual")
@@ -1610,15 +1590,13 @@
parameters)]
(wrap [name parametersA])))
annotations)
- returnT (typeA.with-env
- (luxT.return mapping return))
- arguments' (typeA.with-env
- (monad.map check.monad
- (function (_ [name jvmT])
- (do check.monad
- [luxT (luxT.type mapping jvmT)]
- (wrap [name luxT])))
- arguments))
+ returnT (reflection-return mapping return)
+ arguments' (monad.map @
+ (function (_ [name jvmT])
+ (do @
+ [luxT (reflection-type mapping jvmT)]
+ (wrap [name luxT])))
+ arguments)
[scope bodyA] (|> arguments'
(#.Cons [self-name selfT])
list.reverse
@@ -1627,24 +1605,15 @@
/////analysis.with-scope)]
(wrap (/////analysis.tuple (list (/////analysis.text ..virtual-tag)
(/////analysis.text method-name)
- (/////analysis.text (case visibility
- #PublicV ..public-tag
- #PrivateV ..private-tag
- #ProtectedV ..protected-tag
- #DefaultV ..default-tag))
+ (visibility-analysis visibility)
(/////analysis.bit final?)
(/////analysis.bit strict-fp?)
(/////analysis.tuple (list@map annotation-analysis annotationsA))
(/////analysis.tuple (list@map var-analysis vars))
(/////analysis.text self-name)
- (/////analysis.tuple (list@map (function (_ [argument argumentJT])
- (/////analysis.tuple
- (list (/////analysis.text argument)
- (type-analysis argumentJT))))
- arguments))
+ (/////analysis.tuple (list@map ..argument-analysis arguments))
(return-analysis return)
- (/////analysis.tuple (list@map class-analysis
- exceptions))
+ (/////analysis.tuple (list@map class-analysis exceptions))
(#/////analysis.Function
(scope.environment scope)
(/////analysis.tuple (list bodyA)))
@@ -1655,10 +1624,10 @@
Visibility
Strictness
(List (Annotation a))
- (List Var)
- (List Class) ## Exceptions
+ (List (Type Var))
+ (List (Type Class)) ## Exceptions
(List Argument)
- Return
+ (Type Return)
a])
(def: #export static-tag "static")
@@ -1694,15 +1663,13 @@
parameters)]
(wrap [name parametersA])))
annotations)
- returnT (typeA.with-env
- (luxT.return mapping return))
- arguments' (typeA.with-env
- (monad.map check.monad
- (function (_ [name jvmT])
- (do check.monad
- [luxT (luxT.type mapping jvmT)]
- (wrap [name luxT])))
- arguments))
+ returnT (reflection-return mapping return)
+ arguments' (monad.map @
+ (function (_ [name jvmT])
+ (do @
+ [luxT (reflection-type mapping jvmT)]
+ (wrap [name luxT])))
+ arguments)
[scope bodyA] (|> arguments'
list.reverse
(list@fold scope.with-local (analyse body))
@@ -1710,19 +1677,11 @@
/////analysis.with-scope)]
(wrap (/////analysis.tuple (list (/////analysis.text ..static-tag)
(/////analysis.text method-name)
- (/////analysis.text (case visibility
- #PublicV ..public-tag
- #PrivateV ..private-tag
- #ProtectedV ..protected-tag
- #DefaultV ..default-tag))
+ (visibility-analysis visibility)
(/////analysis.bit strict-fp?)
(/////analysis.tuple (list@map annotation-analysis annotationsA))
(/////analysis.tuple (list@map var-analysis vars))
- (/////analysis.tuple (list@map (function (_ [argument argumentJT])
- (/////analysis.tuple
- (list (/////analysis.text argument)
- (type-analysis argumentJT))))
- arguments))
+ (/////analysis.tuple (list@map ..argument-analysis arguments))
(return-analysis return)
(/////analysis.tuple (list@map class-analysis
exceptions))
@@ -1732,15 +1691,15 @@
))))))
(type: #export (Overriden-Method a)
- [Class
+ [(Type Class)
Text
Bit
(List (Annotation a))
- (List Var)
+ (List (Type Var))
Text
(List Argument)
- Return
- (List Class)
+ (Type Return)
+ (List (Type Class))
a])
(def: #export overriden-tag "override")
@@ -1778,15 +1737,13 @@
parameters)]
(wrap [name parametersA])))
annotations)
- returnT (typeA.with-env
- (luxT.return mapping return))
- arguments' (typeA.with-env
- (monad.map check.monad
- (function (_ [name jvmT])
- (do check.monad
- [luxT (luxT.type mapping jvmT)]
- (wrap [name luxT])))
- arguments))
+ returnT (reflection-return mapping return)
+ arguments' (monad.map @
+ (function (_ [name jvmT])
+ (do @
+ [luxT (reflection-type mapping jvmT)]
+ (wrap [name luxT])))
+ arguments)
[scope bodyA] (|> arguments'
(#.Cons [self-name selfT])
list.reverse
@@ -1800,11 +1757,7 @@
(/////analysis.tuple (list@map annotation-analysis annotationsA))
(/////analysis.tuple (list@map var-analysis vars))
(/////analysis.text self-name)
- (/////analysis.tuple (list@map (function (_ [argument argumentJT])
- (/////analysis.tuple
- (list (/////analysis.text argument)
- (type-analysis argumentJT))))
- arguments))
+ (/////analysis.tuple (list@map ..argument-analysis arguments))
(return-analysis return)
(/////analysis.tuple (list@map class-analysis
exceptions))
@@ -1817,7 +1770,7 @@
(#Overriden-Method (Overriden-Method a)))
(def: #export parameter-types
- (-> (List Var) (Check (List [Var .Type])))
+ (-> (List (Type Var)) (Check (List [(Type Var) .Type])))
(monad.map check.monad
(function (_ parameterJ)
(do check.monad
@@ -1825,31 +1778,30 @@
(wrap [parameterJ parameterT])))))
(def: (mismatched-methods super-set sub-set)
- (-> (List [Text Method]) (List [Text Method]) (List [Text Method]))
+ (-> (List [Text (Signature Method)]) (List [Text (Signature Method)]) (List [Text (Signature Method)]))
(list.filter (function (_ [sub-name subJT])
(|> super-set
(list.filter (function (_ [super-name superJT])
(and (text@= super-name sub-name)
- (method@= superJT subJT))))
+ (signature@= superJT subJT))))
list.size
(n.= 1)
not))
sub-set))
(exception: #export (class-parameter-mismatch {expected (List Text)}
- {actual (List jvm.Generic)})
+ {actual (List (Type Parameter))})
(exception.report
["Expected (amount)" (%.nat (list.size expected))]
["Expected (parameters)" (exception.enumerate %.text expected)]
["Actual (amount)" (%.nat (list.size actual))]
- ["Actual (parameters)" (exception.enumerate (|>> #jvm.Generic jvm.signature) actual)]))
+ ["Actual (parameters)" (exception.enumerate ..signature actual)]))
-(type: Renamer (Dictionary Text Text))
-
-(def: (re-map-super [name actual-parameters])
- (-> Class (Operation Renamer))
+(def: (super-aliasing class)
+ (-> (Type Class) (Operation Aliasing))
(do ////.monad
- [class (////.lift (reflection!.load name))
+ [#let [[name actual-parameters] (jvm-parser.read-class class)]
+ class (////.lift (reflection!.load name))
#let [expected-parameters (|> (java/lang/Class::getTypeParameters class)
array.to-list
(list@map (|>> java/lang/reflect/TypeVariable::getName)))]
@@ -1858,57 +1810,13 @@
(list.size actual-parameters)))]
(wrap (|> (list.zip2 expected-parameters actual-parameters)
(list@fold (function (_ [expected actual] mapping)
- (case actual
- (#jvm.Var actual)
+ (case (jvm-parser.var? actual)
+ (#.Some actual)
(dictionary.put actual expected mapping)
- _
+ #.None
mapping))
- (dictionary.new text.hash))))))
-
-(def: (re-map-generic mapping generic)
- (-> Renamer jvm.Generic jvm.Generic)
- (case generic
- (#jvm.Var var)
- (#jvm.Var (|> mapping (dictionary.get var) (maybe.default var)))
-
- (#jvm.Wildcard wildcard)
- (case wildcard
- #.None
- generic
-
- (#.Some [bound limit])
- (#jvm.Wildcard (#.Some [bound (re-map-generic mapping limit)])))
-
- (#jvm.Class name parameters)
- (#jvm.Class name (list@map (re-map-generic mapping) parameters))))
-
-(def: (re-map-type mapping type)
- (-> Renamer jvm.Type jvm.Type)
- (case type
- (#jvm.Primitive primitive)
- type
-
- (#jvm.Generic generic)
- (#jvm.Generic (re-map-generic mapping generic))
-
- (#jvm.Array type)
- (#jvm.Array (re-map-type mapping type))))
-
-(def: (re-map-return mapping return)
- (-> Renamer jvm.Return jvm.Return)
- (case return
- #.None
- return
-
- (#.Some return)
- (#.Some (re-map-type mapping return))))
-
-(def: (re-map-method mapping [inputs output exceptions])
- (-> Renamer jvm.Method jvm.Method)
- [(list@map (re-map-type mapping) inputs)
- (re-map-return mapping output)
- (list@map (re-map-generic mapping) exceptions)])
+ jvm-alias.fresh)))))
(def: class::anonymous
Handler
@@ -1928,7 +1836,9 @@
[parameters (typeA.with-env
(..parameter-types parameters))
#let [mapping (list@fold (function (_ [parameterJ parameterT] mapping)
- (dictionary.put parameterJ parameterT mapping))
+ (dictionary.put (jvm-parser.name parameterJ)
+ parameterT
+ mapping))
luxT.fresh
parameters)]
name (///.lift (do macro.monad
@@ -1938,18 +1848,17 @@
..jvm-package-separator
"anonymous-class" (%.nat id)))))
super-classT (typeA.with-env
- (luxT.class mapping super-class))
+ (luxT.check (luxT.class mapping) (..signature super-class)))
super-interfaceT+ (typeA.with-env
(monad.map check.monad
- (luxT.class mapping)
+ (|>> ..signature (luxT.check (luxT.class mapping)))
super-interfaces))
#let [selfT (inheritance-relationship-type (#.Primitive name (list))
super-classT
super-interfaceT+)]
constructor-argsA+ (monad.map @ (function (_ [type term])
(do @
- [argT (typeA.with-env
- (luxT.type mapping type))
+ [argT (reflection-type mapping type)
termA (typeA.with-type argT
(analyse term))]
(wrap [type termA])))
@@ -1962,11 +1871,12 @@
self-name arguments return exceptions
body])
(do @
- [re-mapping (re-map-super parent-type)]
- (wrap [method-name (re-map-method re-mapping
- (jvm.method (list@map product.right arguments)
- return
- (list@map (|>> #jvm.Class) exceptions)))])))
+ [aliasing (super-aliasing parent-type)]
+ (wrap [method-name (|> (jvm.method [(list@map product.right arguments)
+ return
+ exceptions])
+ product.left
+ (jvm-alias.method aliasing))])))
methods)
#let [missing-abstract-methods (mismatched-methods overriden-methods required-abstract-methods)
invalid-overriden-methods (mismatched-methods available-methods overriden-methods)]
@@ -1980,8 +1890,7 @@
(class-analysis super-class)
(/////analysis.tuple (list@map class-analysis super-interfaces))
(/////analysis.tuple (list@map typed-analysis constructor-argsA+))
- (/////analysis.tuple methodsA))))
- ))]))
+ (/////analysis.tuple methodsA))))))]))
(def: bundle::class
Bundle
diff --git a/stdlib/source/lux/tool/compiler/phase/extension/statement/lux.lux b/stdlib/source/lux/tool/compiler/phase/extension/statement/lux.lux
index 56067c845..eef4731d2 100644
--- a/stdlib/source/lux/tool/compiler/phase/extension/statement/lux.lux
+++ b/stdlib/source/lux/tool/compiler/phase/extension/statement/lux.lux
@@ -14,7 +14,6 @@
[text
["%" format (#+ format)]]
[collection
- ["." list ("#;." functor)]
["." dictionary]]]
["." macro
["." code]]
@@ -152,11 +151,10 @@
[current-module (/////statement.lift-analysis
(///.lift macro.current-module-name))
#let [full-name [current-module short-name]]
- [_ annotationsT annotations] (evaluate! Code annotationsC)
- #let [annotations (:coerce Code annotations)]
[type valueT valueN value] (..definition full-name #.None valueC)
+ [_ annotationsT annotations] (evaluate! Code annotationsC)
_ (/////statement.lift-analysis
- (module.define short-name (#.Right [exported? type annotations value])))
+ (module.define short-name (#.Right [exported? type (:coerce Code annotations) value])))
#let [_ (log! (format "Definition " (%.name full-name)))]
_ (/////statement.lift-generation
(////generation.learn full-name valueN))