From b63ac226cc2ea843f08f7c72b18d22602462c624 Mon Sep 17 00:00:00 2001 From: Eduardo Julian Date: Sat, 7 Sep 2019 01:50:37 -0400 Subject: Modified compiler's machinery to use the new abstractions for descriptors and signatures. --- documentation/research/Memory Management.md | 4 + .../research/Type theory/Dependent types.md | 4 + documentation/research/distributed_programming.md | 1 + documentation/research/game_programming.md | 146 ++++ documentation/research/machine_learning.md | 4 + documentation/research/math.md | 4 + documentation/research/operating_system.md | 1 + .../paradigm/Ambient-Oriented Programming.md | 5 + .../research/paradigm/logic_programming.md | 1 + documentation/research/tool/build_system.md | 1 + new-luxc/source/luxc/lang/host/jvm.lux | 9 +- new-luxc/source/luxc/lang/host/jvm/def.lux | 107 +-- new-luxc/source/luxc/lang/host/jvm/inst.lux | 115 +-- new-luxc/source/luxc/lang/statement/jvm.lux | 52 +- new-luxc/source/luxc/lang/translation/jvm.lux | 16 +- new-luxc/source/luxc/lang/translation/jvm/case.lux | 34 +- .../source/luxc/lang/translation/jvm/function.lux | 47 +- .../source/luxc/lang/translation/jvm/primitive.lux | 9 +- .../luxc/lang/translation/jvm/procedure/common.lux | 109 ++- .../luxc/lang/translation/jvm/procedure/host.lux | 675 ++++++++--------- .../source/luxc/lang/translation/jvm/reference.lux | 7 +- .../source/luxc/lang/translation/jvm/runtime.lux | 102 +-- .../source/luxc/lang/translation/jvm/structure.lux | 13 +- new-luxc/source/program.lux | 18 +- stdlib/source/lux/control/parser/code.lux | 11 - stdlib/source/lux/control/parser/text.lux | 11 +- stdlib/source/lux/control/try.lux | 9 + stdlib/source/lux/macro/syntax/common/reader.lux | 2 +- stdlib/source/lux/target/jvm/reflection.lux | 185 ++--- stdlib/source/lux/target/jvm/type.lux | 200 ++--- stdlib/source/lux/target/jvm/type/alias.lux | 112 +++ stdlib/source/lux/target/jvm/type/box.lux | 7 +- stdlib/source/lux/target/jvm/type/category.lux | 1 + stdlib/source/lux/target/jvm/type/descriptor.lux | 49 +- stdlib/source/lux/target/jvm/type/lux.lux | 138 ++-- stdlib/source/lux/target/jvm/type/parser.lux | 195 +++++ stdlib/source/lux/target/jvm/type/reflection.lux | 10 +- stdlib/source/lux/target/jvm/type/signature.lux | 4 +- .../tool/compiler/phase/extension/analysis/jvm.lux | 823 +++++++++------------ .../compiler/phase/extension/statement/lux.lux | 6 +- 40 files changed, 1757 insertions(+), 1490 deletions(-) create mode 100644 documentation/research/Memory Management.md create mode 100644 documentation/research/paradigm/Ambient-Oriented Programming.md create mode 100644 stdlib/source/lux/target/jvm/type/alias.lux create mode 100644 stdlib/source/lux/target/jvm/type/parser.lux 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 [ ] - [(def: #export ( version visibility config name parameters super interfaces + [(def: #export ( 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 ) - (host.null) + (..descriptor ) + (..signature ) ( 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 [ ] [(def: #export ( 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 () (descriptor.class-name class) field (descriptor.descriptor type)))))] + (org/objectweb/asm/MethodVisitor::visitFieldInsn () (..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 [ ] - [(def: #export ( class) - (-> (Descriptor descriptor.Object) Inst) - (function (_ visitor) - (do-to visitor - (org/objectweb/asm/MethodVisitor::visitTypeInsn () (descriptor.class-name class)))))] +(template [ +] + [(`` (template [ ] + [(def: #export ( class) + (-> (Type ) Inst) + (function (_ visitor) + (do-to visitor + (org/objectweb/asm/MethodVisitor::visitTypeInsn () (..class-name class)))))] + + (~~ (template.splice +))))] + + [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@= type) ()] + [(type@= type) ()] - [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 [ ] - [(def: #export ( class method-name type interface?) - (-> (Descriptor descriptor.Class) Text (Descriptor descriptor.Method) Bit Inst) + [(def: #export ( 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 () (descriptor.class-name class) method-name (descriptor.descriptor type) interface?))))] + (org/objectweb/asm/MethodVisitor::visitMethodInsn () + (..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 [ ] [(def: ( type) - (-> (Descriptor Primitive) Text) + (-> (Type Primitive) Text) (`` (cond (~~ (template [ ] - [(descriptor@= type) ] + [(type@= type) ] - [descriptor.boolean ] - [descriptor.byte ] - [descriptor.short ] - [descriptor.int ] - [descriptor.long ] - [descriptor.float ] - [descriptor.double ] - [descriptor.char ])) + [type.boolean ] + [type.byte ] + [type.short ] + [type.int ] + [type.long ] + [type.float ] + [type.double ] + [type.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 - ["" code (#+ Parser)]]] + ["" code (#+ Parser)] + ["" 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) - (.form (<>.and .text (<>.some .text)))) + (.form (<>.and .text (<>.some jvm.var)))) (type: Inheritance #FinalI @@ -75,14 +81,12 @@ (Parser Annotation) .any) -(def: field-descriptor - (Parser (Descriptor descriptor.Field)) - (:: <>.monad map - (|>> (:coerce (Descriptor descriptor.Field))) - .text)) +(def: field-type + (Parser (Type Value)) + (.embed parser.value .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 .text (.tuple (<>.some ..annotation)) - ..field-descriptor + ..field-type .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 (.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) "" - (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 ( idx))) - (_.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 (descriptor.method [(list //.$Tuple runtime.$Index) //.$Value]) #0) + (_.INVOKESTATIC $Runtime (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-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 "" 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 )] (operation@wrap (|>> loadI ))))] - [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 [ ] [(def: ( [maskI inputI]) (Binary Inst) - (|>> inputI (_.unwrap descriptor.long) - maskI (_.unwrap descriptor.long) - (_.wrap descriptor.long)))] + (|>> inputI (_.unwrap type.long) + maskI (_.unwrap type.long) + (_.wrap type.long)))] [i64::and _.LAND] [i64::or _.LOR] @@ -148,10 +147,10 @@ (template [ ] [(def: ( [shiftI inputI]) (Binary Inst) - (|>> inputI (_.unwrap descriptor.long) + (|>> inputI (_.unwrap type.long) shiftI jvm-intI - (_.wrap descriptor.long)))] + (_.wrap type.long)))] [i64::left-shift _.LSHL] [i64::arithmetic-right-shift _.LSHR] @@ -163,9 +162,9 @@ (Nullary Inst) (|>> (_.wrap )))] - [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 [ ] @@ -176,25 +175,25 @@ (_.wrap )))] - [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 [ ] +(template [ ] [(template [ ] [(def: ( [paramI subjectI]) (Binary Inst) - (|>> subjectI (_.unwrap ) - paramI (_.unwrap ) + (|>> subjectI (_.unwrap ) + paramI (_.unwrap ) (_.int ) (predicateI _.IF_ICMPEQ)))] @@ -202,8 +201,8 @@ [ +0] [ -1])] - [i64::= i64::< descriptor.long _.LCMP] - [f64::= f64::< descriptor.double _.DCMPG] + [i64::= i64::< type.long _.LCMP] + [f64::= f64::< type.double _.DCMPG] ) (template [ ] @@ -211,22 +210,22 @@ (Unary Inst) (|>> inputI ))] - [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 [ ] @@ -237,13 +236,13 @@ ))] [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 [ ] [(def: 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 [] + [(text@= (reflection.reflection (type.reflection )) + elem-class) + ] + + [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 [.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 [ ] - (^ [(static ) (static )]) - (wrap (|>> valueI (_.wrap ))) - - (^ [(static ) (static )]) - (wrap (|>> valueI (_.unwrap )))) - ([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 [ ] + [(and (text@= (reflection.reflection (type.reflection )) + from) + (text@= + to)) + (wrap (|>> valueI (_.wrap ))) + + (and (text@= + from) + (text@= (reflection.reflection (type.reflection )) + to)) + (wrap (|>> valueI (_.unwrap )))] + + [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 .text .text .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 .text .text .text .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 .text .text .text .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 .text .text .text .any .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 [ ] + [(def: #export + (Parser (Type )) + (.embed .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 (.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) + (.tuple (<>.and ..value .any))) - _ - (|> description - (.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 .text .text .text (<>.some .any)) - (function (_ extension-name generate [class method unboxed argsS]) + [($_ <>.and ..class .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 [ ] [(def: Handler (..custom - [($_ <>.and .text .text .text .any (<>.some .any)) - (function (_ extension-name generate [class method unboxed objectS argsS]) + [($_ <>.and ..class .text ..return .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)) ( class method - (descriptor.method [(list@map product.left argsTI) - returnT]) + (type.method [(list@map product.left inputsTI) + outputT + (list)]) ) - (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 "" - (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 "" + (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) - .text) - -(def: bound - (Parser Bound) - (<>.or (.constant! ["" ">"]) - (.constant! ["" "<"]))) - -(def: (class' generic) - (-> (Parser Generic) (Parser Class)) - (.tuple (<>.and .text (<>.some generic)))) - -(def: generic - (Parser Generic) - (<>.rec - (function (_ generic) - (let [wildcard (<>.or (.constant! ["" "?"]) - (.tuple (<>.and ..bound generic)))] - ($_ <>.or - ..var - wildcard - (class' generic)))))) - -(def: class - (Parser Class) - (class' ..generic)) - -(def: primitive - (Parser (Descriptor Primitive)) - ($_ <>.or - (<>.after (.constant! ["" reflection.boolean]) - (<>@wrap descriptor.boolean)) - (<>.after (.constant! ["" reflection.byte]) - (<>@wrap descriptor.byte)) - (<>.after (.constant! ["" reflection.short]) - (<>@wrap descriptor.short)) - (<>.after (.constant! ["" reflection.int]) - (<>@wrap descriptor.int)) - (<>.after (.constant! ["" reflection.long]) - (<>@wrap descriptor.long)) - (<>.after (.constant! ["" reflection.float]) - (<>@wrap descriptor.float)) - (<>.after (.constant! ["" reflection.double]) - (<>@wrap descriptor.double)) - (<>.after (.constant! ["" reflection.char]) - (<>@wrap descriptor.char)) - )) - -(def: jvm-type - (Parser Type) - (<>.rec - (function (_ jvm-type) - ($_ <>.or - ..primitive - ..generic - (.tuple jvm-type))))) - -(def: constructor-arg - (Parser (Typed Synthesis)) - (.tuple (<>.and ..jvm-type .any))) - (def: annotation-parameter (Parser (/.Annotation-Parameter Synthesis)) (.tuple (<>.and .text .any))) @@ -888,12 +814,7 @@ (def: argument (Parser Argument) - (.tuple (<>.and .text ..jvm-type))) - -(def: return - (Parser Return) - (<>.or (.constant! ["" (descriptor.descriptor descriptor.void)]) - ..jvm-type)) + (.tuple (<>.and .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 "" (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 "" - (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 "" (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 @@ .text ..class (.tuple (<>.some ..class)) - (.tuple (<>.some ..constructor-arg)) + (.tuple (<>.some ..input)) (.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 "" (descriptor.method [(list $Text) descriptor.void]) #0)))) + (_.INVOKESPECIAL IllegalStateException "" (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 "" nullary-init-methodT #0)) @@ -291,9 +294,9 @@ _.POP _.SWAP (_.boolean true) - (_.INVOKESPECIAL PrintWriter "" (descriptor.method [(list (descriptor.class "java.io.Writer") descriptor.boolean) descriptor.void]) #0) + (_.INVOKESPECIAL PrintWriter "" (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 "" (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 "" (type.method [(list type.int) type.void (list)]) (|>> (_.ALOAD 0) - (_.INVOKESPECIAL (descriptor.class "java.lang.Object") "" nullary-init-methodT #0) + (_.INVOKESPECIAL $Object "" 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 [] + [(text@= (/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 - (|>> [] #.Some #/.Wildcard) - (generic bound)))) - ([[_ (#.Some bound)] #/.Upper] - [[(#.Some bound) _] #/.Lower]) + (:: try.monad map (..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 [] - (^ (static )) - (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 [ ] - (^ (static )) - (#try.Success )) - ([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) - (.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 [ ] + [(text@= (/reflection.reflection ) + class-name) + (#try.Success )] + + [/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) + (.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 [ (as-is (:: try.monad map (|>> #.Some) - (..type reflection)))] + (-> java/lang/reflect/Type (Try (/.Type Return))) + (with-expansions [ (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) - - _ - ) + (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) + )) #.None ))) @@ -327,7 +340,7 @@ (template [ ] [(def: #export ( 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) - ["" 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 [