aboutsummaryrefslogtreecommitdiff
path: root/stdlib/source/library
diff options
context:
space:
mode:
Diffstat (limited to 'stdlib/source/library')
-rw-r--r--stdlib/source/library/lux.lux61
-rw-r--r--stdlib/source/library/lux/target/jvm/class.lux27
-rw-r--r--stdlib/source/library/lux/target/jvm/field.lux25
-rw-r--r--stdlib/source/library/lux/target/jvm/method.lux31
-rw-r--r--stdlib/source/library/lux/target/jvm/modifier.lux2
-rw-r--r--stdlib/source/library/lux/target/jvm/modifier/inner.lux27
-rw-r--r--stdlib/source/library/lux/type/unit.lux137
-rw-r--r--stdlib/source/library/lux/type/unit/scale.lux79
8 files changed, 204 insertions, 185 deletions
diff --git a/stdlib/source/library/lux.lux b/stdlib/source/library/lux.lux
index ee78bcc4b..483362c7d 100644
--- a/stdlib/source/library/lux.lux
+++ b/stdlib/source/library/lux.lux
@@ -5048,19 +5048,56 @@
=refers)
=refers)}))))
-(with_expansions [<Immediate_UnQuote> "#Macro/Immediate_UnQuote"]
- (these (type: .public Immediate_UnQuote
- (Primitive <Immediate_UnQuote>))
+(def: (symbol#= [moduleL shortL] [moduleR shortR])
+ (-> Symbol Symbol Bit)
+ (and (text#= moduleL moduleR)
+ (text#= shortL shortR)))
+
+(def: (type#= left right)
+ (-> Type Type Bit)
+ (case [left right]
+ [{#Primitive nameL parametersL} {#Primitive nameR parametersR}]
+ (and (text#= nameL nameR)
+ ("lux i64 =" (list#size parametersL) (list#size parametersR))
+ (every? (function (_ [itL itR])
+ (type#= itL itR))
+ (zipped_2 parametersL parametersR)))
- (def: .private (immediate_unquote_type? it)
- (-> Type Bit)
- (case it
- (pattern {#Named [(static ..prelude) "Immediate_UnQuote"]
- {#Primitive <Immediate_UnQuote> {#End}}})
- #1
+ (with_template#pattern [<tag>]
+ [[{<tag> leftL rightL} {<tag> leftR rightR}]
+ (and (type#= leftL leftR)
+ (type#= rightL rightR))])
+ ([#Sum]
+ [#Product]
+ [#Function]
+ [#Apply])
- _
- #0))))
+ (with_template#pattern [<tag>]
+ [[{<tag> idL} {<tag> idR}]
+ ("lux i64 =" idL idR)])
+ ([#Parameter]
+ [#Var]
+ [#Ex])
+
+ (with_template#pattern [<tag>]
+ [[{<tag> envL bodyL} {<tag> envR bodyR}]
+ (and ("lux i64 =" (list#size envL) (list#size envR))
+ (every? (function (_ [itL itR])
+ (type#= itL itR))
+ (zipped_2 envL envR))
+ (type#= bodyL bodyR))])
+ ([#UnivQ]
+ [#ExQ])
+
+ [{#Named nameL anonL} {#Named nameR anonR}]
+ (and (symbol#= nameL nameR)
+ (type#= anonL anonR))
+
+ _
+ #0))
+
+(type: .public Immediate_UnQuote
+ (Primitive "#Macro/Immediate_UnQuote"))
(def: .public immediate_unquote
(-> Macro Immediate_UnQuote)
@@ -5120,7 +5157,7 @@
<failure>
{#Right [type value]}
- (if (immediate_unquote_type? type)
+ (if (type#= ..Immediate_UnQuote type)
(do meta#monad
[bound ((immediate_unquote_macro (as Immediate_UnQuote value)) parameters)
g!expansion (..generated_symbol "g!expansion")]
diff --git a/stdlib/source/library/lux/target/jvm/class.lux b/stdlib/source/library/lux/target/jvm/class.lux
index 2f5e274e7..f93320b4c 100644
--- a/stdlib/source/library/lux/target/jvm/class.lux
+++ b/stdlib/source/library/lux/target/jvm/class.lux
@@ -14,7 +14,7 @@
[collection
["[0]" sequence (.only Sequence)]]]]]
["[0]" //
- ["[1][0]" modifier (.only Modifier modifiers:)]
+ ["[1][0]" modifier (.only Modifier modifiers)]
["[1][0]" version (.only Version Minor Major)]
["[1][0]" magic (.only Magic)]
["[1][0]" index (.only Index)]
@@ -45,16 +45,17 @@
#methods (Sequence Method)
#attributes (Sequence Attribute)])))
-(modifiers: Class
- ["0001" public]
- ["0010" final]
- ["0020" super]
- ["0200" interface]
- ["0400" abstract]
- ["1000" synthetic]
- ["2000" annotation]
- ["4000" enum]
- )
+(modifiers
+ Class
+ ["0001" public]
+ ["0010" final]
+ ["0020" super]
+ ["0200" interface]
+ ["0400" abstract]
+ ["1000" synthetic]
+ ["2000" annotation]
+ ["4000" enum]
+ )
(def: .public equivalence
(Equivalence Class)
@@ -87,8 +88,8 @@
(in [@this @super @interfaces])))
(def: .public (class version modifier
- this signature super interfaces
- fields methods attributes)
+ this signature super interfaces
+ fields methods attributes)
(-> Major (Modifier Class)
Internal (Maybe (Signature Inheritance)) Internal (List Internal)
(List (Resource Field))
diff --git a/stdlib/source/library/lux/target/jvm/field.lux b/stdlib/source/library/lux/target/jvm/field.lux
index 28b414914..b41782db2 100644
--- a/stdlib/source/library/lux/target/jvm/field.lux
+++ b/stdlib/source/library/lux/target/jvm/field.lux
@@ -11,7 +11,7 @@
[collection
["[0]" sequence (.only Sequence)]]]]]
["[0]" //
- ["[0]" modifier (.only Modifier modifiers:)]
+ ["[0]" modifier (.only Modifier modifiers)]
["[1][0]" constant (.only UTF8)
["[1]/[0]" pool (.only Pool Resource)]]
["[1][0]" index (.only Index)]
@@ -28,17 +28,18 @@
#descriptor (Index (Descriptor Value))
#attributes (Sequence Attribute)])))
-(modifiers: Field
- ["0001" public]
- ["0002" private]
- ["0004" protected]
- ["0008" static]
- ["0010" final]
- ["0040" volatile]
- ["0080" transient]
- ["1000" synthetic]
- ["4000" enum]
- )
+(modifiers
+ Field
+ ["0001" public]
+ ["0002" private]
+ ["0004" protected]
+ ["0008" static]
+ ["0010" final]
+ ["0040" volatile]
+ ["0080" transient]
+ ["1000" synthetic]
+ ["4000" enum]
+ )
(def: .public equivalence
(Equivalence Field)
diff --git a/stdlib/source/library/lux/target/jvm/method.lux b/stdlib/source/library/lux/target/jvm/method.lux
index 6e7dfa4bf..bdbe58f87 100644
--- a/stdlib/source/library/lux/target/jvm/method.lux
+++ b/stdlib/source/library/lux/target/jvm/method.lux
@@ -14,7 +14,7 @@
["[0]" sequence (.only Sequence)]
["[0]" list]]]]]
["[0]" //
- ["[1][0]" modifier (.only Modifier modifiers:)]
+ ["[1][0]" modifier (.only Modifier modifiers)]
["[1][0]" index (.only Index)]
["[1][0]" attribute (.only Attribute)
["[2][0]" code]]
@@ -36,20 +36,21 @@
#descriptor (Index (Descriptor //category.Method))
#attributes (Sequence Attribute)])))
-(modifiers: Method
- ["0001" public]
- ["0002" private]
- ["0004" protected]
- ["0008" static]
- ["0010" final]
- ["0020" synchronized]
- ["0040" bridge]
- ["0080" var_args]
- ["0100" native]
- ["0400" abstract]
- ["0800" strict]
- ["1000" synthetic]
- )
+(modifiers
+ Method
+ ["0001" public]
+ ["0002" private]
+ ["0004" protected]
+ ["0008" static]
+ ["0010" final]
+ ["0020" synchronized]
+ ["0040" bridge]
+ ["0080" var_args]
+ ["0100" native]
+ ["0400" abstract]
+ ["0800" strict]
+ ["1000" synthetic]
+ )
(def: .public (method modifier name with_signature? type attributes code)
(-> (Modifier Method) UTF8 Bit (Type //category.Method) (List (Resource Attribute)) (Maybe (Bytecode Any))
diff --git a/stdlib/source/library/lux/target/jvm/modifier.lux b/stdlib/source/library/lux/target/jvm/modifier.lux
index 4213dd66d..b76886f54 100644
--- a/stdlib/source/library/lux/target/jvm/modifier.lux
+++ b/stdlib/source/library/lux/target/jvm/modifier.lux
@@ -80,7 +80,7 @@
(|>> !wrap))
)
-(def: .public modifiers:
+(def: .public modifiers
(syntax (_ [ofT <code>.any
options (<>.many <code>.any)])
(with_symbols [g!modifier g!code]
diff --git a/stdlib/source/library/lux/target/jvm/modifier/inner.lux b/stdlib/source/library/lux/target/jvm/modifier/inner.lux
index 9ca1ce443..ee47de449 100644
--- a/stdlib/source/library/lux/target/jvm/modifier/inner.lux
+++ b/stdlib/source/library/lux/target/jvm/modifier/inner.lux
@@ -3,19 +3,20 @@
[lux (.except static)
[type
abstract]]]
- [// (.only modifiers:)])
+ [// (.only modifiers)])
(abstract: .public Inner Any)
-(modifiers: Inner
- ["0001" public]
- ["0002" private]
- ["0004" protected]
- ["0008" static]
- ["0010" final]
- ["0200" interface]
- ["0400" abstract]
- ["1000" synthetic]
- ["2000" annotation]
- ["4000" enum]
- )
+(modifiers
+ Inner
+ ["0001" public]
+ ["0002" private]
+ ["0004" protected]
+ ["0008" static]
+ ["0010" final]
+ ["0200" interface]
+ ["0400" abstract]
+ ["1000" synthetic]
+ ["2000" annotation]
+ ["4000" enum]
+ )
diff --git a/stdlib/source/library/lux/type/unit.lux b/stdlib/source/library/lux/type/unit.lux
index 6c6fec8a3..1d2cc20ca 100644
--- a/stdlib/source/library/lux/type/unit.lux
+++ b/stdlib/source/library/lux/type/unit.lux
@@ -1,53 +1,40 @@
(.using
[library
[lux (.except type)
- ["[0]" meta]
[abstract
- [monad (.only Monad do)]
[equivalence (.only Equivalence)]
[order (.only Order)]
[enum (.only Enum)]]
[control
- ["<>" parser (.open: "[1]#[0]" monad)
- ["<[0]>" code (.only Parser)]]]
- [data
- ["[0]" text (.only)
- ["%" \\format (.only format)]]]
+ [parser
+ ["<[0]>" code]]]
["[0]" macro (.only)
- ["[0]" code]
- ["[0]" template]
- [syntax (.only syntax)
- ["|[0]|" export]]]
+ [syntax (.only syntax)]]
[math
[number
- ["n" nat]
- ["i" int]
- ["[0]" ratio (.only Ratio)]]]]]
+ ["i" int]]]]]
["[0]" // (.only)
[primitive (.except)]])
-(primitive: .public (Qty unit)
+(primitive: .public (Qty scale unit)
Int
- (type: .public Pure
- (Qty Any))
-
- (def: .public pure
- (-> Int Pure)
+ (def: .public quantity
+ (All (_ scale unit) (-> Int (Qty scale unit)))
(|>> abstraction))
(def: .public number
- (-> Pure Int)
+ (All (_ scale unit) (-> (Qty scale unit) Int))
(|>> representation))
(def: .public equivalence
- (All (_ unit) (Equivalence (Qty unit)))
+ (All (_ scale unit) (Equivalence (Qty scale unit)))
(implementation
(def: (= reference sample)
(i.= (representation reference) (representation sample)))))
(def: .public order
- (All (_ unit) (Order (Qty unit)))
+ (All (_ scale unit) (Order (Qty scale unit)))
(implementation
(def: equivalence ..equivalence)
@@ -55,7 +42,7 @@
(i.< (representation reference) (representation sample)))))
(def: .public enum
- (All (_ unit) (Enum (Qty unit)))
+ (All (_ scale unit) (Enum (Qty scale unit)))
(implementation
(def: order ..order)
(def: succ (|>> representation ++ abstraction))
@@ -63,7 +50,7 @@
(with_template [<name> <op>]
[(def: .public (<name> param subject)
- (All (_ unit) (-> (Qty unit) (Qty unit) (Qty unit)))
+ (All (_ scale unit) (-> (Qty scale unit) (Qty scale unit) (Qty scale unit)))
(abstraction (<op> (representation param)
(representation subject))))]
@@ -73,7 +60,7 @@
(with_template [<name> <op> <p> <s> <p*s>]
[(def: .public (<name> param subject)
- (All (_ p s) (-> (Qty <p>) (Qty <s>) (Qty <p*s>)))
+ (All (_ scale p s) (-> (Qty scale <p>) (Qty scale <s>) (Qty scale <p*s>)))
(abstraction (<op> (representation param)
(representation subject))))]
@@ -83,31 +70,23 @@
(type: .public (Unit a)
(Interface
- (is (-> Int (Qty a))
+ (is (-> Int (Qty Any a))
in)
- (is (-> (Qty a) Int)
+ (is (-> (Qty Any a) Int)
out)))
(def: .public (unit _)
(Ex (_ a) (-> Any (Unit a)))
(implementation
- (def: in (|>> abstraction))
- (def: out (|>> representation))))
-
- (def: in'
- (All (_ unit) (-> Int (Qty unit)))
- (|>> abstraction))
-
- (def: out'
- (All (_ unit) (-> (Qty unit) Int))
- (|>> representation))
+ (def: in ..quantity)
+ (def: out ..number)))
)
(def: .public type
(syntax (_ [it <code>.any])
(macro.with_symbols [g!a]
(in (list (` ((~! //.by_example) [(~ g!a)]
- (Unit (~ g!a))
+ (..Unit (~ g!a))
(~ it)
(~ g!a))))))))
@@ -124,83 +103,3 @@
[litre Litre]
[second Second]
)
-
-(type: .public (Scale s)
- (Interface
- (is (All (_ u) (-> (Qty u) (Qty (s u))))
- scale)
- (is (All (_ u) (-> (Qty (s u)) (Qty u)))
- de_scale)
- (is Ratio
- ratio)))
-
-(def: scaleP
- (Parser Ratio)
- (<code>.tuple (do <>.monad
- [numerator <code>.nat
- _ (<>.assertion (format "Numerator must be positive: " (%.nat numerator))
- (n.> 0 numerator))
- denominator <code>.nat
- _ (<>.assertion (format "Denominator must be positive: " (%.nat denominator))
- (n.> 0 denominator))]
- (in [numerator denominator]))))
-
-(def: .public scale:
- (syntax (_ [[export_policy type_name scale_name ratio]
- (|export|.parser
- (all <>.and
- <code>.local
- <code>.local
- ..scaleP))])
- (do meta.monad
- [.let [(open "_[0]") ratio]
- @ meta.current_module_name
- .let [g!scale (code.local type_name)]]
- (in (list (` (type: (~ export_policy) ((~ g!scale) (~' u))
- (Primitive (~ (code.text (%.symbol [@ type_name]))) [(~' u)])))
-
- (` (def: (~ export_policy) (~ (code.local scale_name))
- (..Scale (~ g!scale))
- (implementation
- (def: (~' scale)
- (|>> ((~! ..out'))
- (i.* (~ (code.int (.int _#numerator))))
- (i./ (~ (code.int (.int _#denominator))))
- ((~! ..in'))))
- (def: (~' de_scale)
- (|>> ((~! ..out'))
- (i.* (~ (code.int (.int _#denominator))))
- (i./ (~ (code.int (.int _#numerator))))
- ((~! ..in'))))
- (def: (~' ratio)
- [(~ (code.nat _#numerator))
- (~ (code.nat _#denominator))]))))
- )))))
-
-(def: .public (re_scaled from to quantity)
- (All (_ si so u) (-> (Scale si) (Scale so) (Qty (si u)) (Qty (so u))))
- (let [[numerator denominator] (ratio./ (at from ratio)
- (at to ratio))]
- (|> quantity
- out'
- (i.* (.int numerator))
- (i./ (.int denominator))
- in')))
-
-(def: implementation_name
- (syntax (_ [type_name <code>.local])
- (in (list (code.local (text.lower_cased type_name))))))
-
-(with_template [<type> <from> <to>]
- [(`` (scale: .public <type>
- (~~ (implementation_name <type>))
- [<from> <to>]))]
-
- [Kilo 1 1,000]
- [Mega 1 1,000,000]
- [Giga 1 1,000,000,000]
-
- [Milli 1,000 1]
- [Micro 1,000,000 1]
- [Nano 1,000,000,000 1]
- )
diff --git a/stdlib/source/library/lux/type/unit/scale.lux b/stdlib/source/library/lux/type/unit/scale.lux
new file mode 100644
index 000000000..3a956baf0
--- /dev/null
+++ b/stdlib/source/library/lux/type/unit/scale.lux
@@ -0,0 +1,79 @@
+(.using
+ [library
+ [lux (.except type)
+ [control
+ [parser
+ ["<[0]>" code]]]
+ ["[0]" macro (.only)
+ [syntax (.only syntax)]]
+ [math
+ [number
+ ["i" int]
+ ["[0]" ratio (.only Ratio)]]]]]
+ ["[0]" // (.only)
+ ["/[1]" //]])
+
+(type: .public (Scale s)
+ (Interface
+ (is (All (_ u) (-> (//.Qty Any u) (//.Qty s u)))
+ up)
+ (is (All (_ u) (-> (//.Qty s u) (//.Qty Any u)))
+ down)
+ (is Ratio
+ ratio)))
+
+(def: .public (scale ratio)
+ (Ex (_ s) (-> Ratio (Scale s)))
+ (let [(open "/[0]") ratio]
+ (implementation
+ (def: up
+ (|>> //.number
+ (i.* (.int /#numerator))
+ (i./ (.int /#denominator))
+ //.quantity))
+ (def: down
+ (|>> //.number
+ (i.* (.int /#denominator))
+ (i./ (.int /#numerator))
+ //.quantity))
+ (def: ratio
+ ratio))))
+
+(def: .public (re_scaled from to quantity)
+ (All (_ si so u) (-> (Scale si) (Scale so) (//.Qty si u) (//.Qty so u)))
+ (let [(open "/[0]") (ratio./ (at from ratio)
+ (at to ratio))]
+ (|> quantity
+ //.number
+ (i.* (.int /#numerator))
+ (i./ (.int /#denominator))
+ //.quantity)))
+
+(def: .public type
+ (syntax (_ [it <code>.any])
+ (macro.with_symbols [g!a]
+ (in (list (` ((~! ///.by_example) [(~ g!a)]
+ (..Scale (~ g!a))
+ (~ it)
+
+ (~ g!a))))))))
+
+(with_template [<order_of_magnitude> <up> <up_type> <down> <down_type>]
+ [(def: .public <up>
+ (scale [ratio.#numerator <order_of_magnitude>
+ ratio.#denominator 1]))
+
+ (type: .public <up_type>
+ (~ (..type <up>)))
+
+ (def: .public <down>
+ (scale [ratio.#numerator 1
+ ratio.#denominator <order_of_magnitude>]))
+
+ (type: .public <down_type>
+ (~ (..type <down>)))]
+
+ [ 1,000 kilo Kilo milli Milli]
+ [ 1,000,000 mega Mega micro Micro]
+ [1,000,000,000 giga Giga nano Nano ]
+ )
generated by cgit v1.2.3 (git 2.25.1) at 2024-12-23 08:25:54 +0000