diff options
Diffstat (limited to '')
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)) ))) |