From 68a17d42bab808290de0d975f4083b52b37d0706 Mon Sep 17 00:00:00 2001 From: Eduardo Julian Date: Thu, 13 Jan 2022 03:52:02 -0400 Subject: Fixes for the pure-Lux JVM compiler machinery. [Part 6] --- stdlib/source/library/lux/math/number.lux | 4 +- stdlib/source/library/lux/math/random.lux | 16 +-- .../library/lux/target/jvm/encoding/signed.lux | 4 +- stdlib/source/library/lux/target/ruby.lux | 16 ++- .../tool/compiler/language/lux/phase/directive.lux | 4 +- .../language/lux/phase/extension/directive/jvm.lux | 2 +- .../language/lux/phase/extension/directive/lux.lux | 24 ++--- .../language/lux/phase/generation/jvm/runtime.lux | 2 +- .../lux/tool/compiler/language/lux/version.lux | 2 +- stdlib/source/library/lux/tool/compiler/phase.lux | 107 +++++++++++---------- stdlib/source/library/lux/tool/interpreter.lux | 4 +- 11 files changed, 93 insertions(+), 92 deletions(-) (limited to 'stdlib/source/library') diff --git a/stdlib/source/library/lux/math/number.lux b/stdlib/source/library/lux/math/number.lux index 48ce42fbe..d52fc62e0 100644 --- a/stdlib/source/library/lux/math/number.lux +++ b/stdlib/source/library/lux/math/number.lux @@ -62,6 +62,6 @@ {try.#Failure }))] [bin /nat.binary /int.binary /rev.binary /frac.binary "Invalid binary syntax."] - [oct /nat.octal /int.octal /rev.octal /frac.octal "Invalid octal syntax."] - [hex /nat.hex /int.hex /rev.hex /frac.hex "Invalid hexadecimal syntax."] + [oct /nat.octal /int.octal /rev.octal /frac.octal "Invalid octal syntax."] + [hex /nat.hex /int.hex /rev.hex /frac.hex "Invalid hexadecimal syntax."] ) diff --git a/stdlib/source/library/lux/math/random.lux b/stdlib/source/library/lux/math/random.lux index 6eab77fef..13bac71cf 100644 --- a/stdlib/source/library/lux/math/random.lux +++ b/stdlib/source/library/lux/math/random.lux @@ -126,7 +126,7 @@ (template [ ] [(def: .public (Random ) - (# ..monad each ..i64))] + (# ..functor each ..i64))] [nat Nat .nat] [int Int .int] @@ -135,13 +135,13 @@ (def: .public frac (Random Frac) - (# ..monad each (|>> .i64 f.of_bits) ..nat)) + (# ..functor each (|>> .i64 f.of_bits) ..nat)) (def: .public safe_frac (Random Frac) (let [mantissa_range (.int (i64.left_shifted 53 1)) mantissa_max (i.frac (-- mantissa_range))] - (# ..monad each + (# ..functor each (|>> (i.% mantissa_range) i.frac (f./ mantissa_max)) @@ -155,7 +155,7 @@ in_range (: (-> Char Char) (|>> (n.% size) (n.+ start)))] (|> ..nat - (# ..monad each in_range) + (# ..functor each in_range) (..only (unicode.member? set))))) (def: .public (text char_gen size) @@ -297,19 +297,19 @@ (def: .public instant (Random Instant) - (# ..monad each instant.of_millis ..int)) + (# ..functor each instant.of_millis ..int)) (def: .public date (Random Date) - (# ..monad each instant.date ..instant)) + (# ..functor each instant.date ..instant)) (def: .public time (Random Time) - (# ..monad each instant.time ..instant)) + (# ..functor each instant.time ..instant)) (def: .public duration (Random Duration) - (# ..monad each duration.of_millis ..int)) + (# ..functor each duration.of_millis ..int)) (def: .public month (Random Month) diff --git a/stdlib/source/library/lux/target/jvm/encoding/signed.lux b/stdlib/source/library/lux/target/jvm/encoding/signed.lux index dee539eae..027174fd1 100644 --- a/stdlib/source/library/lux/target/jvm/encoding/signed.lux +++ b/stdlib/source/library/lux/target/jvm/encoding/signed.lux @@ -60,8 +60,8 @@ (def: .public (-> Int (Try )) - (let [positive (|> (n.* i64.bits_per_byte) i64.mask) - negative (|> positive .int (i.right_shifted 1) i64.not)] + (let [positive (:representation ) + negative (|> (n.* i64.bits_per_byte) i64.mask i64.not)] (function (_ value) (if (i.= (if (i.< +0 value) (i64.or negative value) diff --git a/stdlib/source/library/lux/target/ruby.lux b/stdlib/source/library/lux/target/ruby.lux index df112f23f..22cad3f00 100644 --- a/stdlib/source/library/lux/target/ruby.lux +++ b/stdlib/source/library/lux/target/ruby.lux @@ -469,13 +469,10 @@ (arity_inputs ) (arity_types ) (template.spliced +)] - (def: .public ( function ) - (-> Expression Computation) - (..apply/* (.list ) {.#None} function)) - (template [] - [(`` (def: .public (~~ (template.symbol [ "/" ])) - ( (..local ))))] + [(`` (def: .public ((~~ (template.symbol [ "/" ])) ) + (-> Computation) + (..apply/* (.list ) {.#None} (..local ))))] ))] @@ -490,11 +487,10 @@ ["alias_method"]]] ) -(def: .public throw/1 +(def: .public (throw/1 error) (-> Expression Statement) - (|>> (..apply/1 (..local "throw")) - ..statement)) + (..statement (..apply/* (list error) {.#None} (..local "throw")))) (def: .public (throw/2 tag value) (-> Expression Expression Statement) - (..statement (..apply/2 (..local "throw") tag value))) + (..statement (..apply/* (list tag value) {.#None} (..local "throw")))) diff --git a/stdlib/source/library/lux/tool/compiler/language/lux/phase/directive.lux b/stdlib/source/library/lux/tool/compiler/language/lux/phase/directive.lux index 23123a8c5..fefafe199 100644 --- a/stdlib/source/library/lux/tool/compiler/language/lux/phase/directive.lux +++ b/stdlib/source/library/lux/tool/compiler/language/lux/phase/directive.lux @@ -80,7 +80,7 @@ (let [analysis (//analysis.phase expander)] (function (again archive code) (do [! //.monad] - [state //.get_state + [state //.state .let [compiler_eval (meta_eval archive (value@ [//extension.#state /.#analysis /.#state //extension.#bundle] state) (evaluation.evaluator expander @@ -88,7 +88,7 @@ (value@ [//extension.#state /.#generation /.#state] state) (value@ [//extension.#state /.#generation /.#phase] state))) extension_eval (:as Eval (wrapper (:expected compiler_eval)))] - _ (//.set_state (with@ [//extension.#state /.#analysis /.#state //extension.#state .#eval] extension_eval state))] + _ (//.with (with@ [//extension.#state /.#analysis /.#state //extension.#state .#eval] extension_eval state))] (case code (^ [_ {.#Form (list& [_ {.#Text name}] inputs)}]) (//extension.apply archive again [name inputs]) diff --git a/stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/directive/jvm.lux b/stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/directive/jvm.lux index 5b49ae38a..b7693e24b 100644 --- a/stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/directive/jvm.lux +++ b/stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/directive/jvm.lux @@ -287,7 +287,7 @@ .let [selfT (jvm.inheritance_relationship_type {.#Primitive name (list#each product.right parameters)} super_classT super_interfaceT+)] - state (extension.lifted phase.get_state) + state (extension.lifted phase.state) .let [analyse (value@ [directive.#analysis directive.#phase] state) synthesize (value@ [directive.#synthesis directive.#phase] state) generate (value@ [directive.#generation directive.#phase] state)] diff --git a/stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/directive/lux.lux b/stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/directive/lux.lux index 49e889381..965a9e641 100644 --- a/stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/directive/lux.lux +++ b/stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/directive/lux.lux @@ -93,7 +93,7 @@ (All (_ anchor expression directive) (-> Archive Type Code (Operation anchor expression directive [Type expression Any]))) (do phase.monad - [state (///.lifted phase.get_state) + [state (///.lifted phase.state) .let [analyse (value@ [/////directive.#analysis /////directive.#phase] state) synthesize (value@ [/////directive.#synthesis /////directive.#phase] state) generate (value@ [/////directive.#generation /////directive.#phase] state)] @@ -131,7 +131,7 @@ (-> Archive Symbol (Maybe Type) Code (Operation anchor expression directive [Type expression Any]))) (do [! phase.monad] - [state (///.lifted phase.get_state) + [state (///.lifted phase.state) .let [analyse (value@ [/////directive.#analysis /////directive.#phase] state) synthesize (value@ [/////directive.#synthesis /////directive.#phase] state) generate (value@ [/////directive.#generation /////directive.#phase] state)] @@ -185,7 +185,7 @@ (-> Archive Text Type Code (Operation anchor expression directive [expression Any]))) (do phase.monad - [state (///.lifted phase.get_state) + [state (///.lifted phase.state) .let [analyse (value@ [/////directive.#analysis /////directive.#phase] state) synthesize (value@ [/////directive.#synthesis /////directive.#phase] state) generate (value@ [/////directive.#generation /////directive.#phase] state)] @@ -209,19 +209,19 @@ (All (_ anchor expression directive) (-> Expander /////analysis.Bundle (Operation anchor expression directive Any))) (do phase.monad - [[bundle state] phase.get_state + [[bundle state] phase.state .let [eval (/////analysis/evaluation.evaluator expander (value@ [/////directive.#synthesis /////directive.#state] state) (value@ [/////directive.#generation /////directive.#state] state) (value@ [/////directive.#generation /////directive.#phase] state)) previous_analysis_extensions (value@ [/////directive.#analysis /////directive.#state ///.#bundle] state)]] - (phase.set_state [bundle - (revised@ [/////directive.#analysis /////directive.#state] - (: (-> /////analysis.State+ /////analysis.State+) - (|>> product.right - [(|> previous_analysis_extensions - (dictionary.merged (///analysis.bundle eval host_analysis)))])) - state)]))) + (phase.with [bundle + (revised@ [/////directive.#analysis /////directive.#state] + (: (-> /////analysis.State+ /////analysis.State+) + (|>> product.right + [(|> previous_analysis_extensions + (dictionary.merged (///analysis.bundle eval host_analysis)))])) + state)]))) (def: (announce_definition! short type) (All (_ anchor expression directive) @@ -509,7 +509,7 @@ (case inputsC+ (^ (list programC)) (do phase.monad - [state (///.lifted phase.get_state) + [state (///.lifted phase.state) .let [analyse (value@ [/////directive.#analysis /////directive.#phase] state) synthesize (value@ [/////directive.#synthesis /////directive.#phase] state) generate (value@ [/////directive.#generation /////directive.#phase] state)] diff --git a/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/jvm/runtime.lux b/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/jvm/runtime.lux index ece1fa89e..b59f57dc5 100644 --- a/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/jvm/runtime.lux +++ b/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/jvm/runtime.lux @@ -98,7 +98,7 @@ 0) (def: .public class - (type.class (%.nat ..artifact_id) (list))) + (type.class (class_name [0 ..artifact_id]) (list))) (def: procedure (-> Text (Type category.Method) (Bytecode Any)) diff --git a/stdlib/source/library/lux/tool/compiler/language/lux/version.lux b/stdlib/source/library/lux/tool/compiler/language/lux/version.lux index 25f68450d..cc044938c 100644 --- a/stdlib/source/library/lux/tool/compiler/language/lux/version.lux +++ b/stdlib/source/library/lux/tool/compiler/language/lux/version.lux @@ -6,4 +6,4 @@ (def: .public version Version - 00,07,00) + 00,06,06) diff --git a/stdlib/source/library/lux/tool/compiler/phase.lux b/stdlib/source/library/lux/tool/compiler/phase.lux index 9815f9eb7..a52f8b796 100644 --- a/stdlib/source/library/lux/tool/compiler/phase.lux +++ b/stdlib/source/library/lux/tool/compiler/phase.lux @@ -1,35 +1,58 @@ (.using - [library - [lux "*" - ["[0]" debug] - [abstract - [monad {"+" Monad do}]] - [control - ["[0]" state] - ["[0]" try {"+" Try} ("[1]#[0]" functor)] - ["ex" exception {"+" Exception exception:}] - ["[0]" io] - [parser - ["<[0]>" code]]] - [data - ["[0]" product] - ["[0]" text - ["%" format {"+" format}]]] - [time - ["[0]" instant] - ["[0]" duration]] - [macro - [syntax {"+" syntax:}]]]] - [// - [meta - [archive {"+" Archive}]]]) + [library + [lux "*" + ["[0]" debug] + [abstract + [functor {"+" Functor}] + [monad {"+" Monad do}]] + [control + ["[0]" state] + ["[0]" try {"+" Try} ("[1]#[0]" functor)] + ["[0]" exception {"+" Exception}] + ["[0]" io]] + [data + ["[0]" product] + [text + ["%" format {"+" format}]]] + [time + ["[0]" instant] + ["[0]" duration]]]] + [// + [meta + [archive {"+" Archive}]]]) (type: .public (Operation s o) (state.+State Try s o)) -(def: .public monad +(implementation: .public functor + (All (_ s) (Functor (Operation s))) + + (def: (each f it) + (function (_ state) + (case (it state) + {try.#Success [state' output]} + {try.#Success [state' (f output)]} + + {try.#Failure error} + {try.#Failure error})))) + +(implementation: .public monad (All (_ s) (Monad (Operation s))) - (state.with try.monad)) + + (def: &functor ..functor) + + (def: (in it) + (function (_ state) + {try.#Success [state it]})) + + (def: (conjoint it) + (function (_ state) + (case (it state) + {try.#Success [state' it']} + (it' state') + + {try.#Failure error} + {try.#Failure error})))) (type: .public (Phase s i o) (-> Archive i (Operation s o))) @@ -49,13 +72,13 @@ operation (# try.monad each product.right))) -(def: .public get_state +(def: .public state (All (_ s o) (Operation s s)) (function (_ state) {try.#Success [state state]})) -(def: .public (set_state state) +(def: .public (with state) (All (_ s o) (-> s (Operation s Any))) (function (_ _) @@ -77,19 +100,17 @@ (def: .public (except exception parameters) (All (_ e) (-> (Exception e) e Operation)) - (..failure (ex.error exception parameters))) + (..failure (exception.error exception parameters))) (def: .public (lifted error) (All (_ s a) (-> (Try a) (Operation s a))) (function (_ state) (try#each (|>> [state]) error))) -(syntax: .public (assertion [exception .any - message .any - test .any]) - (in (list (` (if (~ test) - (# ..monad (~' in) []) - (..except (~ exception) (~ message))))))) +(template: .public (assertion exception message test) + [(if test + (# ..monad in []) + (..except exception message))]) (def: .public identity (All (_ s a) (Phase s a a)) @@ -106,19 +127,3 @@ [[pre/state' temp] (pre archive input pre/state) [post/state' output] (post archive temp post/state)] (in [[pre/state' post/state'] output])))) - -(def: .public (timed definition description operation) - (All (_ s a) - (-> Symbol Text (Operation s a) (Operation s a))) - (do ..monad - [_ (in []) - .let [pre (io.run! instant.now)] - output operation - .let [_ (|> instant.now - io.run! - instant.relative - (duration.difference (instant.relative pre)) - %.duration - (format (%.symbol definition) " [" description "]: ") - debug.log!)]] - (in output))) diff --git a/stdlib/source/library/lux/tool/interpreter.lux b/stdlib/source/library/lux/tool/interpreter.lux index abd53a54b..8cf01011c 100644 --- a/stdlib/source/library/lux/tool/interpreter.lux +++ b/stdlib/source/library/lux/tool/interpreter.lux @@ -101,7 +101,7 @@ (All (_ anchor expression directive) (-> Code )) (do [! phase.monad] - [state (extension.lifted phase.get_state) + [state (extension.lifted phase.state) .let [analyse (value@ [directive.#analysis directive.#phase] state) synthesize (value@ [directive.#synthesis directive.#phase] state) generate (value@ [directive.#generation directive.#phase] state)] @@ -155,7 +155,7 @@ (-> Configuration Code (Operation anchor expression directive Text))) (do phase.monad [[codeT codeV] (interpret configuration code) - state phase.get_state] + state phase.state] (in (/type.represent (value@ [extension.#state directive.#analysis directive.#state extension.#state] -- cgit v1.2.3