aboutsummaryrefslogtreecommitdiff
path: root/new-luxc/source
diff options
context:
space:
mode:
Diffstat (limited to '')
-rw-r--r--new-luxc/source/luxc/lang/host/jvm.lux4
-rw-r--r--new-luxc/source/luxc/lang/host/jvm/def.lux12
-rw-r--r--new-luxc/source/luxc/lang/host/jvm/inst.lux14
-rw-r--r--new-luxc/source/luxc/lang/host/jvm/type.lux2
-rw-r--r--new-luxc/source/luxc/lang/translation/jvm.lux49
-rw-r--r--new-luxc/source/luxc/lang/translation/jvm/case.jvm.lux25
-rw-r--r--new-luxc/source/luxc/lang/translation/jvm/common.jvm.lux10
-rw-r--r--new-luxc/source/luxc/lang/translation/jvm/expression.jvm.lux4
-rw-r--r--new-luxc/source/luxc/lang/translation/jvm/function.jvm.lux28
-rw-r--r--new-luxc/source/luxc/lang/translation/jvm/loop.jvm.lux13
-rw-r--r--new-luxc/source/luxc/lang/translation/jvm/primitive.jvm.lux4
-rw-r--r--new-luxc/source/luxc/lang/translation/jvm/procedure/common.jvm.lux8
-rw-r--r--new-luxc/source/luxc/lang/translation/jvm/procedure/host.jvm.lux64
-rw-r--r--new-luxc/source/luxc/lang/translation/jvm/reference.jvm.lux8
-rw-r--r--new-luxc/source/luxc/lang/translation/jvm/runtime.jvm.lux10
-rw-r--r--new-luxc/source/luxc/lang/translation/jvm/structure.jvm.lux6
-rw-r--r--new-luxc/source/program.lux62
17 files changed, 166 insertions, 157 deletions
diff --git a/new-luxc/source/luxc/lang/host/jvm.lux b/new-luxc/source/luxc/lang/host/jvm.lux
index 656d07d21..32a24452d 100644
--- a/new-luxc/source/luxc/lang/host/jvm.lux
+++ b/new-luxc/source/luxc/lang/host/jvm.lux
@@ -5,14 +5,14 @@
["p" parser]]
[data
[collection
- [list ("list/." Functor<List>)]]]
+ ["." list ("#/." functor)]]]
[macro
["." code]
["s" syntax (#+ syntax:)]]
[host (#+ import:)]
[world
[binary (#+ Binary)]]
- [platform
+ [tool
[compiler
[reference (#+ Register)]
[phase
diff --git a/new-luxc/source/luxc/lang/host/jvm/def.lux b/new-luxc/source/luxc/lang/host/jvm/def.lux
index e8efe306b..db6bfe07b 100644
--- a/new-luxc/source/luxc/lang/host/jvm/def.lux
+++ b/new-luxc/source/luxc/lang/host/jvm/def.lux
@@ -6,7 +6,7 @@
["." product]
[collection
["." array (#+ Array)]
- ["." list ("list/." Functor<List>)]]]
+ ["." list ("#/." functor)]]]
["." host (#+ import: do-to)]
["." function]]
["$" //
@@ -266,22 +266,22 @@
(FieldVisitor::visitEnd))]
writer)))]
- [boolean-field Bit $t.boolean id]
+ [boolean-field Bit $t.boolean function.identity]
[byte-field Int $t.byte host.long-to-byte]
[short-field Int $t.short host.long-to-short]
[int-field Int $t.int host.long-to-int]
- [long-field Int $t.long id]
+ [long-field Int $t.long function.identity]
[float-field Frac $t.float host.double-to-float]
- [double-field Frac $t.double id]
+ [double-field Frac $t.double function.identity]
[char-field Nat $t.char (|>> .int host.long-to-int host.int-to-char)]
- [string-field Text ($t.class "java.lang.String" (list)) id]
+ [string-field Text ($t.class "java.lang.String" (list)) function.identity]
)
(def: #export (fuse defs)
(-> (List $.Def) $.Def)
(case defs
#.Nil
- id
+ function.identity
(#.Cons singleton #.Nil)
singleton
diff --git a/new-luxc/source/luxc/lang/host/jvm/inst.lux b/new-luxc/source/luxc/lang/host/jvm/inst.lux
index 9a26f8df0..5311f39d9 100644
--- a/new-luxc/source/luxc/lang/host/jvm/inst.lux
+++ b/new-luxc/source/luxc/lang/host/jvm/inst.lux
@@ -9,13 +9,13 @@
[text
format]
[collection
- ["." list ("list/." Functor<List>)]]]
+ ["." list ("#/." functor)]]]
["." host (#+ import: do-to)]
[macro
["." code]
["s" syntax (#+ syntax:)]]
["." function]
- [platform
+ [tool
[compiler
[phase (#+ Operation)]]]]
["." // (#+ Primitive Inst)
@@ -134,12 +134,12 @@
(do-to visitor
(MethodVisitor::visitLdcInsn (<prepare> value)))))]
- [boolean Bit id]
+ [boolean Bit function.identity]
[int Int host.long-to-int]
- [long Int id]
- [double Frac id]
+ [long Int function.identity]
+ [double Frac function.identity]
[char Nat (|>> .int host.long-to-int host.int-to-char)]
- [string Text id]
+ [string Text function.identity]
)
(syntax: (prefix {base s.local-identifier})
@@ -380,7 +380,7 @@
(-> (List Inst) Inst)
(case insts
#.Nil
- id
+ function.identity
(#.Cons singleton #.Nil)
singleton
diff --git a/new-luxc/source/luxc/lang/host/jvm/type.lux b/new-luxc/source/luxc/lang/host/jvm/type.lux
index 57374337d..523944b44 100644
--- a/new-luxc/source/luxc/lang/host/jvm/type.lux
+++ b/new-luxc/source/luxc/lang/host/jvm/type.lux
@@ -4,7 +4,7 @@
["." text
format]
[collection
- ["." list ("list/." Functor<List>)]]]]
+ ["." list ("#/." functor)]]]]
["." //])
## Types
diff --git a/new-luxc/source/luxc/lang/translation/jvm.lux b/new-luxc/source/luxc/lang/translation/jvm.lux
index 9a6eb25ed..88e607217 100644
--- a/new-luxc/source/luxc/lang/translation/jvm.lux
+++ b/new-luxc/source/luxc/lang/translation/jvm.lux
@@ -1,26 +1,26 @@
(.module:
[lux (#- Definition)
[control
+ pipe
[monad (#+ do)]
["ex" exception (#+ exception:)]
- pipe]
- [concurrency
- ["." atom (#+ Atom atom)]]
+ [concurrency
+ ["." atom (#+ Atom atom)]]]
[data
["." error (#+ Error)]
- ["." text ("text/." Hash<Text>)
+ ["." text ("#/." hash)
format]
[collection
["." array]
- [list ("list/." Functor<List>)]
+ [list ("#/." functor)]
["." dictionary (#+ Dictionary)]]]
["." host (#+ import: do-to object)
[jvm
- ["." loader]]]
+ ["." loader (#+ Library)]]]
["." io (#+ IO io)]
[world
[binary (#+ Binary)]]
- [platform
+ [tool
[compiler
["." name]
[phase
@@ -76,18 +76,17 @@
#.None
(ex.throw invalid-value class-name))
- (#error.Error error)
+ (#error.Failure error)
(ex.throw cannot-load [class-name error]))
- (#error.Error error)
+ (#error.Failure error)
(ex.throw invalid-field [class-name ..value-field error])))
-(def: module-separator "/")
(def: class-path-separator ".")
-(def: (evaluate! store loader eval-class valueI)
- (-> Store ClassLoader Text Inst (Error Any))
- (let [bytecode-name (text.replace-all class-path-separator module-separator eval-class)
+(def: (evaluate! library loader eval-class valueI)
+ (-> Library ClassLoader Text Inst (Error Any))
+ (let [bytecode-name (text.replace-all class-path-separator .module-separator eval-class)
bytecode (def.class #jvm.V1_6
#jvm.Public jvm.noneC
bytecode-name
@@ -101,24 +100,24 @@
(|>> valueI
(inst.PUTSTATIC bytecode-name ..value-field ..$Object)
inst.RETURN))))]
- (io.run (do (error.ErrorT io.Monad<IO>)
- [_ (loader.store eval-class bytecode store)
+ (io.run (do (error.with-error io.monad)
+ [_ (loader.store eval-class bytecode library)
class (loader.load eval-class loader)]
- (:: io.Monad<IO> wrap (class-value eval-class class))))))
+ (:: io.monad wrap (class-value eval-class class))))))
-(def: (execute! store loader temp-label [class-name class-bytecode])
- (-> Store ClassLoader Text Definition (Error Any))
- (io.run (do (error.ErrorT io.Monad<IO>)
- [_ (loader.store class-name class-bytecode store)]
+(def: (execute! library loader temp-label [class-name class-bytecode])
+ (-> Library ClassLoader Text Definition (Error Any))
+ (io.run (do (error.with-error io.monad)
+ [_ (loader.store class-name class-bytecode library)]
(loader.load class-name loader))))
-(def: (define! store loader [module name] valueI)
- (-> Store ClassLoader Name Inst (Error [Text Any]))
- (let [class-name (format (text.replace-all module-separator class-path-separator module)
+(def: (define! library loader [module name] valueI)
+ (-> Library ClassLoader Name Inst (Error [Text Any]))
+ (let [class-name (format (text.replace-all .module-separator class-path-separator module)
class-path-separator (name.normalize name)
"___" (%n (text/hash name)))]
- (do error.Monad<Error>
- [value (evaluate! store loader class-name valueI)]
+ (do error.monad
+ [value (evaluate! library loader class-name valueI)]
(wrap [class-name value]))))
(def: #export init
diff --git a/new-luxc/source/luxc/lang/translation/jvm/case.jvm.lux b/new-luxc/source/luxc/lang/translation/jvm/case.jvm.lux
index 78ef508e8..72c316d83 100644
--- a/new-luxc/source/luxc/lang/translation/jvm/case.jvm.lux
+++ b/new-luxc/source/luxc/lang/translation/jvm/case.jvm.lux
@@ -1,14 +1,15 @@
(.module:
[lux (#- if let case)
+ ["." function]
[control
[monad (#+ do)]
["ex" exception (#+ exception:)]]
[data
[text
format]]
- [platform
+ [tool
[compiler
- ["." phase ("operation/." Monad<Operation>)
+ ["." phase ("operation/." monad)
["." synthesis (#+ Path Synthesis)]]]]]
[luxc
[lang
@@ -22,7 +23,7 @@
(def: (pop-altI stack-depth)
(-> Nat Inst)
(.case stack-depth
- 0 id
+ 0 function.identity
1 _.POP
2 _.POP2
_ ## (n/> 2)
@@ -99,7 +100,7 @@
(_.IFEQ @else)))
(#synthesis.Then bodyS)
- (do phase.Monad<Operation>
+ (do phase.monad
[bodyI (phase bodyS)]
(wrap (|>> (pop-altI stack-depth)
bodyI
@@ -127,7 +128,7 @@
(_.GOTO @else)
(_.label @success)
pushI))))
- ([synthesis.side/left _.NULL .id]
+ ([synthesis.side/left _.NULL function.identity]
[synthesis.side/right (_.string "") .inc])
(^template [<pattern> <method> <prepare>]
@@ -151,11 +152,11 @@
(list))
#0)
pushI))))
- ([synthesis.member/left "pm_left" id]
+ ([synthesis.member/left "pm_left" function.identity]
[synthesis.member/right "pm_right" inc])
(#synthesis.Alt leftP rightP)
- (do phase.Monad<Operation>
+ (do phase.monad
[@alt-else _.make-label
leftI (path' phase (inc stack-depth) @alt-else @end leftP)
rightI (path' phase stack-depth @else @end rightP)]
@@ -166,7 +167,7 @@
rightI)))
(#synthesis.Seq leftP rightP)
- (do phase.Monad<Operation>
+ (do phase.monad
[leftI (path' phase stack-depth @else @end leftP)
rightI (path' phase stack-depth @else @end rightP)]
(wrap (|>> leftI
@@ -175,7 +176,7 @@
(def: (path phase path @end)
(-> Phase Path Label (Operation Inst))
- (do phase.Monad<Operation>
+ (do phase.monad
[@else _.make-label
pathI (..path' phase 1 @else @end path)]
(wrap (|>> pathI
@@ -190,7 +191,7 @@
(def: #export (if phase testS thenS elseS)
(-> Phase Synthesis Synthesis Synthesis (Operation Inst))
- (do phase.Monad<Operation>
+ (do phase.monad
[testI (phase testS)
thenI (phase thenS)
elseI (phase elseS)]
@@ -207,7 +208,7 @@
(def: #export (let phase inputS register exprS)
(-> Phase Synthesis Nat Synthesis (Operation Inst))
- (do phase.Monad<Operation>
+ (do phase.monad
[inputI (phase inputS)
exprI (phase exprS)]
(wrap (|>> inputI
@@ -216,7 +217,7 @@
(def: #export (case phase valueS path)
(-> Phase Synthesis Path (Operation Inst))
- (do phase.Monad<Operation>
+ (do phase.monad
[@end _.make-label
valueI (phase valueS)
pathI (..path phase path @end)]
diff --git a/new-luxc/source/luxc/lang/translation/jvm/common.jvm.lux b/new-luxc/source/luxc/lang/translation/jvm/common.jvm.lux
index f0b73ac23..57fc576fa 100644
--- a/new-luxc/source/luxc/lang/translation/jvm/common.jvm.lux
+++ b/new-luxc/source/luxc/lang/translation/jvm/common.jvm.lux
@@ -6,7 +6,7 @@
["." io]
[data
["." error (#+ Error)]
- ["." text ("text/." Hash<Text>)
+ ["." text ("#/." hash)
format]
[collection
["." dictionary (#+ Dictionary)]]]
@@ -14,7 +14,7 @@
[host (#+ import:)]
[world
[binary (#+ Binary)]]
- [platform
+ [tool
[compiler
["." name]
[reference (#+ Register)]
@@ -31,7 +31,7 @@
## (function (_ state)
## (case (action (update@ #.host
## (|>> (:coerce Host)
-## (set@ #artifacts (dictionary.new text.Hash<Text>))
+## (set@ #artifacts (dictionary.new text.hash))
## (:coerce Nothing))
## state))
## (#error.Success [state' output])
@@ -52,10 +52,10 @@
## (let [normal-name (format (name.normalize def-name) (%n (text/hash def-name)))
## class-name (format (text.replace-all "/" "." def-module) "." normal-name)]
## (<| (macro.run state)
-## (do macro.Monad<Meta>
+## (do macro.monad
## [_ (..store-class class-name def-bytecode)
## class (..load-class class-name)]
-## (case (do error.Monad<Error>
+## (case (do error.monad
## [field (Class::getField [..value-field] class)]
## (Field::get [#.None] field))
## (#error.Success (#.Some def-value))
diff --git a/new-luxc/source/luxc/lang/translation/jvm/expression.jvm.lux b/new-luxc/source/luxc/lang/translation/jvm/expression.jvm.lux
index 7af459900..ba96731a8 100644
--- a/new-luxc/source/luxc/lang/translation/jvm/expression.jvm.lux
+++ b/new-luxc/source/luxc/lang/translation/jvm/expression.jvm.lux
@@ -1,6 +1,6 @@
(.module:
[lux #*
- [platform
+ [tool
[compiler
[phase
["." synthesis]
@@ -67,4 +67,4 @@
(function.function translate abstraction)
(#synthesis.Extension extension)
- (extension.apply "Translation" translate extension)))
+ (extension.apply translate extension)))
diff --git a/new-luxc/source/luxc/lang/translation/jvm/function.jvm.lux b/new-luxc/source/luxc/lang/translation/jvm/function.jvm.lux
index 8e5fe30b3..65a66e65a 100644
--- a/new-luxc/source/luxc/lang/translation/jvm/function.jvm.lux
+++ b/new-luxc/source/luxc/lang/translation/jvm/function.jvm.lux
@@ -1,13 +1,15 @@
(.module:
[lux (#- function)
+ ["." function]
[control
+ [pipe (#+ when> new>)]
["." monad (#+ do)]]
[data
["." text
format]
[collection
- ["." list ("list/." Functor<List> Monoid<List>)]]]
- [platform
+ ["." list ("#/." functor monoid)]]]
+ [tool
[compiler
["_." reference (#+ Register Variable)]
["." phase
@@ -75,7 +77,7 @@
(let [max-args (n/min amount runtime.num-apply-variants)
later-applysI (if (n/> runtime.num-apply-variants amount)
(applysI (n/+ runtime.num-apply-variants start) (n/- runtime.num-apply-variants amount))
- id)]
+ function.identity)]
(|>> (_.CHECKCAST //.function-class)
(inputsI start max-args)
(_.INVOKEVIRTUAL //.function-class runtime.apply-method (runtime.apply-signature max-args) #0)
@@ -106,17 +108,17 @@
(list/map (.function (_ idx)
(def.field #$.Private $.finalF (reference.partial-name idx) $Object)))
def.fuse)
- id))
+ function.identity))
(def: (instance class arity env)
(-> Text Arity (List Variable) (Operation Inst))
- (do phase.Monad<Operation>
+ (do phase.monad
[captureI+ (monad.map @ reference.variable env)
#let [argsI (if (poly-arg? arity)
(|> (nullsI (dec arity))
(list (_.int +0))
_.fuse)
- id)]]
+ function.identity)]]
(wrap (|>> (_.NEW class)
_.DUP
(_.fuse captureI+)
@@ -187,7 +189,7 @@
(_.ALOAD (inc register))
(_.PUTFIELD class (reference.partial-name idx) $Object)))))
_.fuse)
- id)]
+ function.identity)]
(def.method #$.Public $.noneM "<init>" (init-method env arity)
(|>> (_.ALOAD 0)
(function-init arity env-size)
@@ -209,12 +211,12 @@
(|> (list.n/range 0 (dec stage))
(list/map (|>> reference.partial-name (load-fieldI class)))
_.fuse)
- id)]
+ function.identity)]
(cond (i/= arity-over-extent (.int stage))
(|>> (_.label @label)
(_.ALOAD 0)
- (when (n/> 0 stage)
- (_.INVOKEVIRTUAL class "reset" (reset-method class) #0))
+ (when> [(new> (n/> 0 stage) [])]
+ [(_.INVOKEVIRTUAL class "reset" (reset-method class) #0)])
load-partialsI
(inputsI 1 apply-arity)
(_.INVOKEVIRTUAL class "impl" (implementation-method function-arity) #0)
@@ -285,13 +287,13 @@
(with-reset class arity env)
applyD
))]
- (do phase.Monad<Operation>
+ (do phase.monad
[instanceI (instance class arity env)]
(wrap [functionD instanceI]))))
(def: #export (function translate [env arity bodyS])
(-> Phase Abstraction (Operation Inst))
- (do phase.Monad<Operation>
+ (do phase.monad
[@begin _.make-label
[function-class bodyI] (translation.with-context
(translation.with-anchor [@begin 1]
@@ -314,7 +316,7 @@
(def: #export (call translate [functionS argsS])
(-> Phase Apply (Operation Inst))
- (do phase.Monad<Operation>
+ (do phase.monad
[functionI (translate functionS)
argsI (monad.map @ translate argsS)
#let [applyI (|> (segment runtime.num-apply-variants argsI)
diff --git a/new-luxc/source/luxc/lang/translation/jvm/loop.jvm.lux b/new-luxc/source/luxc/lang/translation/jvm/loop.jvm.lux
index 40f4decd9..5e01a4ea0 100644
--- a/new-luxc/source/luxc/lang/translation/jvm/loop.jvm.lux
+++ b/new-luxc/source/luxc/lang/translation/jvm/loop.jvm.lux
@@ -1,13 +1,14 @@
(.module:
[lux #*
+ ["." function]
[control
["." monad (#+ do)]]
[data
["." text
format]
[collection
- ["." list ("list/." Functor<List> Monoid<List>)]]]
- [platform
+ ["." list ("#/." functor monoid)]]]
+ [tool
[compiler
[reference (#+ Register)]
["." phase
@@ -31,7 +32,7 @@
(def: #export (recur translate argsS)
(-> Phase (List Synthesis) (Operation Inst))
- (do phase.Monad<Operation>
+ (do phase.monad
[[@begin start] translation.anchor
#let [end (|> argsS list.size dec (n/+ start))
pairs (list.zip2 (list.n/range start end)
@@ -47,13 +48,13 @@
valuesI+ (monad.map @ (function (_ [register argS])
(: (Operation Inst)
(if (constant? register argS)
- (wrap id)
+ (wrap function.identity)
(translate argS))))
pairs)
#let [storesI+ (list/map (function (_ [register argS])
(: Inst
(if (constant? register argS)
- id
+ function.identity
(_.ASTORE register))))
(list.reverse pairs))]]
(wrap (|>> (_.fuse valuesI+)
@@ -62,7 +63,7 @@
(def: #export (scope translate [start initsS+ iterationS])
(-> Phase [Nat (List Synthesis) Synthesis] (Operation Inst))
- (do phase.Monad<Operation>
+ (do phase.monad
[@begin _.make-label
initsI+ (monad.map @ translate initsS+)
iterationI (translation.with-anchor [@begin start]
diff --git a/new-luxc/source/luxc/lang/translation/jvm/primitive.jvm.lux b/new-luxc/source/luxc/lang/translation/jvm/primitive.jvm.lux
index 7129a3887..628edff49 100644
--- a/new-luxc/source/luxc/lang/translation/jvm/primitive.jvm.lux
+++ b/new-luxc/source/luxc/lang/translation/jvm/primitive.jvm.lux
@@ -5,9 +5,9 @@
[data
[text
format]]
- [platform
+ [tool
[compiler
- [phase ("operation/." Monad<Operation>)]]]]
+ [phase ("operation/." monad)]]]]
[luxc
[lang
[host
diff --git a/new-luxc/source/luxc/lang/translation/jvm/procedure/common.jvm.lux b/new-luxc/source/luxc/lang/translation/jvm/procedure/common.jvm.lux
index 154dcbdcf..afd140997 100644
--- a/new-luxc/source/luxc/lang/translation/jvm/procedure/common.jvm.lux
+++ b/new-luxc/source/luxc/lang/translation/jvm/procedure/common.jvm.lux
@@ -8,12 +8,12 @@
["." text
format]
[collection
- ["." list ("list/." Functor<List>)]
+ ["." list ("#/." functor)]
["." dictionary]]]
["." macro (#+ with-gensyms)
["." code]
["s" syntax (#+ syntax:)]]
- [platform
+ [tool
[compiler
["." phase
[synthesis (#+ Synthesis)]
@@ -58,7 +58,7 @@
(function ((~ g!_) (~ g!extension-name) (~ g!phase) (~ g!inputs))
(case (~ g!inputs)
(^ (list (~+ g!inputC+)))
- (do phase.Monad<Operation>
+ (do phase.monad
[(~+ (|> g!inputC+
(list/map (function (_ g!input)
(list g!input (` ((~ g!phase) (~ g!input))))))
@@ -77,7 +77,7 @@
(def: #export (variadic extension)
(-> Variadic Handler)
(function (_ extension-name phase inputsS)
- (do phase.Monad<Operation>
+ (do phase.monad
[inputsH (monad.map @ phase inputsS)]
(wrap (extension inputsH)))))
diff --git a/new-luxc/source/luxc/lang/translation/jvm/procedure/host.jvm.lux b/new-luxc/source/luxc/lang/translation/jvm/procedure/host.jvm.lux
index 370f07f82..483f810e2 100644
--- a/new-luxc/source/luxc/lang/translation/jvm/procedure/host.jvm.lux
+++ b/new-luxc/source/luxc/lang/translation/jvm/procedure/host.jvm.lux
@@ -1,16 +1,16 @@
(.module:
lux
(lux (control [monad #+ do]
- ["p" parser "parser/" Monad<Parser>]
+ ["p" parser ("#/." monad)]
["ex" exception #+ exception:])
(data [product]
["e" error]
- [text "text/" Eq<Text>]
+ [text ("#/." equivalence)]
(text format
["l" lexer])
- (coll [list "list/" Functor<List>]
+ (coll [list ("#/." functor)]
(dictionary ["dict" unordered #+ Dict])))
- [macro "macro/" Monad<Meta>]
+ [macro ("#/." monad)]
(macro [code]
["s" syntax #+ syntax:])
[host])
@@ -84,7 +84,7 @@
(def: conversion-procs
@.Bundle
(<| (@.prefix "convert")
- (|> (dict.new text.Hash<Text>)
+ (|> (dict.new text.hash)
(@.install "double-to-float" (@.unary convert//double-to-float))
(@.install "double-to-int" (@.unary convert//double-to-int))
(@.install "double-to-long" (@.unary convert//double-to-long))
@@ -209,7 +209,7 @@
(def: int-procs
@.Bundle
(<| (@.prefix "int")
- (|> (dict.new text.Hash<Text>)
+ (|> (dict.new text.hash)
(@.install "+" (@.binary int//+))
(@.install "-" (@.binary int//-))
(@.install "*" (@.binary int//*))
@@ -228,7 +228,7 @@
(def: long-procs
@.Bundle
(<| (@.prefix "long")
- (|> (dict.new text.Hash<Text>)
+ (|> (dict.new text.hash)
(@.install "+" (@.binary long//+))
(@.install "-" (@.binary long//-))
(@.install "*" (@.binary long//*))
@@ -247,7 +247,7 @@
(def: float-procs
@.Bundle
(<| (@.prefix "float")
- (|> (dict.new text.Hash<Text>)
+ (|> (dict.new text.hash)
(@.install "+" (@.binary float//+))
(@.install "-" (@.binary float//-))
(@.install "*" (@.binary float//*))
@@ -260,7 +260,7 @@
(def: double-procs
@.Bundle
(<| (@.prefix "double")
- (|> (dict.new text.Hash<Text>)
+ (|> (dict.new text.hash)
(@.install "+" (@.binary double//+))
(@.install "-" (@.binary double//-))
(@.install "*" (@.binary double//*))
@@ -273,7 +273,7 @@
(def: char-procs
@.Bundle
(<| (@.prefix "char")
- (|> (dict.new text.Hash<Text>)
+ (|> (dict.new text.hash)
(@.install "=" (@.binary char//=))
(@.install "<" (@.binary char//<))
)))
@@ -289,7 +289,7 @@
(-> Text @.Proc)
(case inputs
(^ (list [_ (#.Nat level)] [_ (#.Text class)] lengthS))
- (do macro.Monad<Meta>
+ (do macro.monad
[lengthI (translate lengthS)
#let [arrayJT ($t.array level (case class
"boolean" $t.boolean
@@ -313,7 +313,7 @@
(-> Text @.Proc)
(case inputs
(^ (list [_ (#.Text class)] idxS arrayS))
- (do macro.Monad<Meta>
+ (do macro.monad
[arrayI (translate arrayS)
idxI (translate idxS)
#let [loadI (case class
@@ -339,7 +339,7 @@
(-> Text @.Proc)
(case inputs
(^ (list [_ (#.Text class)] idxS valueS arrayS))
- (do macro.Monad<Meta>
+ (do macro.monad
[arrayI (translate arrayS)
idxI (translate idxS)
valueI (translate valueS)
@@ -367,7 +367,7 @@
(def: array-procs
@.Bundle
(<| (@.prefix "array")
- (|> (dict.new text.Hash<Text>)
+ (|> (dict.new text.hash)
(@.install "length" (@.unary array//length))
(@.install "new" array//new)
(@.install "read" array//read)
@@ -408,7 +408,7 @@
(-> Text @.Proc)
(case inputs
(^ (list [_ (#.Text class)]))
- (do macro.Monad<Meta>
+ (do macro.monad
[]
(wrap (|>> (_.string class)
(_.INVOKESTATIC "java.lang.Class" "forName"
@@ -424,7 +424,7 @@
(-> Text @.Proc)
(case inputs
(^ (list [_ (#.Text class)] objectS))
- (do macro.Monad<Meta>
+ (do macro.monad
[objectI (translate objectS)]
(wrap (|>> objectI
(_.INSTANCEOF class)
@@ -437,7 +437,7 @@
(-> Text @.Proc)
(case inputs
(^ (list [_ (#.Text from)] [_ (#.Text to)] valueS))
- (do macro.Monad<Meta>
+ (do macro.monad
[valueI (translate valueS)]
(case [from to]
## Wrap
@@ -465,7 +465,7 @@
(def: object-procs
@.Bundle
(<| (@.prefix "object")
- (|> (dict.new text.Hash<Text>)
+ (|> (dict.new text.hash)
(@.install "null" (@.nullary object//null))
(@.install "null?" (@.unary object//null?))
(@.install "synchronized" (@.binary object//synchronized))
@@ -485,13 +485,13 @@
["float" #$.Float]
["double" #$.Double]
["char" #$.Char])
- (dict.from-list text.Hash<Text>)))
+ (dict.from-list text.hash)))
(def: (static//get proc translate inputs)
(-> Text @.Proc)
(case inputs
(^ (list [_ (#.Text class)] [_ (#.Text field)] [_ (#.Text unboxed)]))
- (do macro.Monad<Meta>
+ (do macro.monad
[]
(case (dict.get unboxed primitives)
(#.Some primitive)
@@ -518,7 +518,7 @@
(-> Text @.Proc)
(case inputs
(^ (list [_ (#.Text class)] [_ (#.Text field)] [_ (#.Text unboxed)] valueS))
- (do macro.Monad<Meta>
+ (do macro.monad
[valueI (translate valueS)]
(case (dict.get unboxed primitives)
(#.Some primitive)
@@ -550,7 +550,7 @@
(-> Text @.Proc)
(case inputs
(^ (list [_ (#.Text class)] [_ (#.Text field)] [_ (#.Text unboxed)] objectS))
- (do macro.Monad<Meta>
+ (do macro.monad
[objectI (translate objectS)]
(case (dict.get unboxed primitives)
(#.Some primitive)
@@ -581,7 +581,7 @@
(-> Text @.Proc)
(case inputs
(^ (list [_ (#.Text class)] [_ (#.Text field)] [_ (#.Text unboxed)] valueS objectS))
- (do macro.Monad<Meta>
+ (do macro.monad
[valueI (translate valueS)
objectI (translate objectS)]
(case (dict.get unboxed primitives)
@@ -632,7 +632,7 @@
(def: java-type
(l.Lexer $.Type)
- (do p.Monad<Parser>
+ (do p.monad
[raw base-type
nesting (p.some (l.this "[]"))]
(wrap ($t.array (list.size nesting) raw))))
@@ -651,7 +651,7 @@
(Meta [$.Type $.Inst]))
(case argS
(^ [_ (#.Tuple (list [_ (#.Text argD)] argS))])
- (do macro.Monad<Meta>
+ (do macro.monad
[argT (translate-type argD)
argI (translate argS)]
(wrap [argT argI]))
@@ -673,7 +673,7 @@
(case inputs
(^ (list& [_ (#.Text class)] [_ (#.Text method)]
[_ (#.Text unboxed)] argsS))
- (do macro.Monad<Meta>
+ (do macro.monad
[argsTI (monad.map @ (translate-arg translate) argsS)
returnT (method-return-type unboxed)]
(wrap (|>> (_.fuse (list/map product.right argsTI))
@@ -690,7 +690,7 @@
(case inputs
(^ (list& [_ (#.Text class)] [_ (#.Text method)]
[_ (#.Text unboxed)] objectS argsS))
- (do macro.Monad<Meta>
+ (do macro.monad
[objectI (translate objectS)
argsTI (monad.map @ (translate-arg translate) argsS)
returnT (method-return-type unboxed)]
@@ -713,7 +713,7 @@
(-> Text @.Proc)
(case inputs
(^ (list& [_ (#.Text class)] argsS))
- (do macro.Monad<Meta>
+ (do macro.monad
[argsTI (monad.map @ (translate-arg translate) argsS)]
(wrap (|>> (_.NEW class)
_.DUP
@@ -728,17 +728,17 @@
(def: member-procs
@.Bundle
(<| (@.prefix "member")
- (|> (dict.new text.Hash<Text>)
+ (|> (dict.new text.hash)
(dict.merge (<| (@.prefix "static")
- (|> (dict.new text.Hash<Text>)
+ (|> (dict.new text.hash)
(@.install "get" static//get)
(@.install "put" static//put))))
(dict.merge (<| (@.prefix "virtual")
- (|> (dict.new text.Hash<Text>)
+ (|> (dict.new text.hash)
(@.install "get" virtual//get)
(@.install "put" virtual//put))))
(dict.merge (<| (@.prefix "invoke")
- (|> (dict.new text.Hash<Text>)
+ (|> (dict.new text.hash)
(@.install "static" invoke//static)
(@.install "virtual" invoke//virtual)
(@.install "special" invoke//special)
diff --git a/new-luxc/source/luxc/lang/translation/jvm/reference.jvm.lux b/new-luxc/source/luxc/lang/translation/jvm/reference.jvm.lux
index 175338ba4..fe4a58b36 100644
--- a/new-luxc/source/luxc/lang/translation/jvm/reference.jvm.lux
+++ b/new-luxc/source/luxc/lang/translation/jvm/reference.jvm.lux
@@ -5,11 +5,11 @@
[data
[text
format]]
- [platform
+ [tool
[compiler
["." name]
["." reference (#+ Register Variable)]
- ["." phase ("operation/." Monad<Operation>)
+ ["." phase ("operation/." monad)
["." translation]]]]]
[luxc
[lang
@@ -30,7 +30,7 @@
(def: (foreign variable)
(-> Register (Operation Inst))
- (do phase.Monad<Operation>
+ (do phase.monad
[function-class translation.context]
(wrap (|>> (_.ALOAD 0)
(_.GETFIELD function-class
@@ -52,6 +52,6 @@
(def: #export (constant name)
(-> Name (Operation Inst))
- (do phase.Monad<Operation>
+ (do phase.monad
[bytecode-name (translation.remember name)]
(operation/wrap (_.GETSTATIC bytecode-name //.value-field //.$Object))))
diff --git a/new-luxc/source/luxc/lang/translation/jvm/runtime.jvm.lux b/new-luxc/source/luxc/lang/translation/jvm/runtime.jvm.lux
index a22ed2b07..81bae4cd2 100644
--- a/new-luxc/source/luxc/lang/translation/jvm/runtime.jvm.lux
+++ b/new-luxc/source/luxc/lang/translation/jvm/runtime.jvm.lux
@@ -6,9 +6,9 @@
[text
format]
[collection
- ["." list ("list/." Functor<List>)]]]
+ ["." list ("#/." functor)]]]
["." math]
- [platform
+ [tool
[compiler
["." phase
[analysis (#+ Arity)]
@@ -309,7 +309,7 @@
frac-methods
pm-methods
io-methods))]
- (do phase.Monad<Operation>
+ (do phase.monad
[_ (translation.execute! //.runtime-class [//.runtime-class bytecode])]
(wrap bytecode))))
@@ -339,13 +339,13 @@
(_.PUTFIELD //.function-class partials-field $t.int)
_.RETURN))
applyI))]
- (do phase.Monad<Operation>
+ (do phase.monad
[_ (translation.execute! //.function-class [//.function-class bytecode])]
(wrap bytecode))))
(def: #export translate
(Operation Any)
- (do phase.Monad<Operation>
+ (do phase.monad
[runtime-bc translate-runtime
function-bc translate-function]
(wrap [])))
diff --git a/new-luxc/source/luxc/lang/translation/jvm/structure.jvm.lux b/new-luxc/source/luxc/lang/translation/jvm/structure.jvm.lux
index 9f69b1edd..a8d135f7a 100644
--- a/new-luxc/source/luxc/lang/translation/jvm/structure.jvm.lux
+++ b/new-luxc/source/luxc/lang/translation/jvm/structure.jvm.lux
@@ -8,7 +8,7 @@
format]
[collection
["." list]]]
- [platform
+ [tool
[compiler
["." phase
[synthesis (#+ Synthesis)]]]]]
@@ -28,7 +28,7 @@
(def: #export (tuple translate members)
(-> Phase (List Synthesis) (Operation Inst))
- (do phase.Monad<Operation>
+ (do phase.monad
[#let [size (list.size members)]
_ (phase.assert not-a-tuple size
(n/>= 2 size))
@@ -54,7 +54,7 @@
(def: #export (variant translate lefts right? member)
(-> Phase Nat Bit Synthesis (Operation Inst))
- (do phase.Monad<Operation>
+ (do phase.monad
[memberI (translate member)]
(wrap (|>> (_.int (.int (if right?
(.inc lefts)
diff --git a/new-luxc/source/program.lux b/new-luxc/source/program.lux
index 4fa032f7f..cee627708 100644
--- a/new-luxc/source/program.lux
+++ b/new-luxc/source/program.lux
@@ -1,19 +1,19 @@
(.module:
[lux #*
+ [cli (#+ program:)]
[control
[monad (#+ do)]]
[data
- ["." error]
+ ["." error (#+ Error)]
["." text
format]]
- ["." io (#+ IO Process io)]
+ ["." io (#+ IO io)]
[time
- ["." instant]]
- [cli (#+ program:)]
+ ["." instant (#+ Instant)]]
[world
["." file (#+ File)]
["." console]]
- [platform
+ [tool
["." compiler
["." cli (#+ Configuration)]
[meta
@@ -26,9 +26,9 @@
[default
["." platform (#+ Platform)]
["." init]
- ["." syntax]]]]
- ## ["." interpreter]
- ]
+ ["." syntax]]]
+ ## ["." interpreter]
+ ]]
[luxc
[lang
["." host/jvm]
@@ -41,11 +41,11 @@
(def: (or-crash! failure-description action)
(All [a]
- (-> Text (Process a) (IO a)))
- (do io.Monad<IO>
+ (-> Text (IO (Error a)) (IO a)))
+ (do io.monad
[?output action]
(case ?output
- (#error.Error error)
+ (#error.Failure error)
(exec (log! (format text.new-line
failure-description text.new-line
error text.new-line))
@@ -56,38 +56,44 @@
(def: (timed action)
(All [a]
- (-> (-> Any (Process a)) (Process a)))
- (do io.Monad<Process>
- [start (io.from-io instant.now)
+ (-> (-> Any (IO (Error a))) (IO (Error a))))
+ (do (error.with-error io.monad)
+ [start (: (IO (Error Instant))
+ (error.lift io.monad instant.now))
result (action [])
- finish (io.from-io instant.now)
+ finish (: (IO (Error Instant))
+ (error.lift io.monad instant.now))
#let [elapsed-time (instant.span start finish)
_ (log! (format text.new-line
"Elapsed time: " (%duration elapsed-time)))]]
(wrap result)))
(def: jvm-platform
- (IO (Platform Process host/jvm.Anchor host/jvm.Inst host/jvm.Definition))
- (do io.Monad<IO>
+ (IO (Platform IO host/jvm.Anchor host/jvm.Inst host/jvm.Definition))
+ (do io.monad
[host jvm.init]
- (wrap {#platform.host host
+ (wrap {#platform.&monad io.monad
+ #platform.&file-system file.system
+ #platform.host host
#platform.phase expression.translate
- #platform.runtime runtime.translate
- #platform.file-system file.JVM@System})))
+ #platform.runtime runtime.translate})))
(program: [{service cli.service}]
- (do io.Monad<IO>
- [platform ..jvm-platform
- console (:: @ map error.assume console.open)]
+ (do io.monad
+ [platform (: (IO (Platform IO host/jvm.Anchor host/jvm.Inst host/jvm.Definition))
+ ..jvm-platform)
+ console (:: @ map error.assume console.system)]
(case service
(#cli.Compilation configuration)
(<| (or-crash! "Compilation failed:")
..timed
(function (_ _)
- (do (:: (get@ #platform.file-system platform) &monad)
- [state (platform.initialize platform common.bundle)
- _ (platform.compile platform (set@ #cli.module syntax.prelude configuration) state)
- ## _ (compile platform configuration state)
+ (do (error.with-error io.monad)
+ [state (: (IO (Error (statement.State+ host/jvm.Anchor host/jvm.Inst host/jvm.Definition)))
+ (platform.initialize platform common.bundle))
+ ## _ (platform.compile platform (set@ #cli.module syntax.prelude configuration) state)
+ _ (: (IO (Error Any))
+ (platform.compile platform configuration state))
## _ (cache/io.clean target ...)
]
(wrap (log! "Compilation complete!")))))
@@ -96,5 +102,5 @@
## TODO: Fix the interpreter...
(undefined)
## (<| (or-crash! "Interpretation failed:")
- ## (interpreter.run io.Monad<Process> console platform configuration common.bundle))
+ ## (interpreter.run (error.with-error io.monad) console platform configuration common.bundle))
)))