aboutsummaryrefslogtreecommitdiff
path: root/stdlib/source
diff options
context:
space:
mode:
Diffstat (limited to 'stdlib/source')
-rw-r--r--stdlib/source/library/lux/target/js.lux8
-rw-r--r--stdlib/source/library/lux/target/ruby.lux42
-rw-r--r--stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/generation/ruby/common.lux23
-rw-r--r--stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/ruby/runtime.lux293
-rw-r--r--stdlib/source/test/lux.lux10
-rw-r--r--stdlib/source/test/lux/math/number/frac.lux48
6 files changed, 308 insertions, 116 deletions
diff --git a/stdlib/source/library/lux/target/js.lux b/stdlib/source/library/lux/target/js.lux
index 88ad9ff5e..6ee7a793c 100644
--- a/stdlib/source/library/lux/target/js.lux
+++ b/stdlib/source/library/lux/target/js.lux
@@ -243,14 +243,14 @@
[bit_and "&"]
)
- (template [<name> <prefix>]
+ (template [<prefix> <name>]
[(def: .public <name>
(-> Expression Computation)
(|>> :representation (text.prefix <prefix>) ..expression :abstraction))]
- [not "!"]
- [bit_not "~"]
- [opposite "-"]
+ ["!" not]
+ ["~" bit_not]
+ ["-" opposite]
)
(template [<name> <input> <format>]
diff --git a/stdlib/source/library/lux/target/ruby.lux b/stdlib/source/library/lux/target/ruby.lux
index eb0f542ac..3280ac134 100644
--- a/stdlib/source/library/lux/target/ruby.lux
+++ b/stdlib/source/library/lux/target/ruby.lux
@@ -221,18 +221,30 @@
(format content
\n+ "end" ..statement_suffix))
- (def: .public (apply/* arguments block_lambda func)
- (-> (List Expression) (Maybe Expression) Expression Computation)
+ (type: .public Block
+ [(List LVar)
+ Statement])
+
+ (def: .public (apply/* arguments block func)
+ (-> (List Expression) (Maybe Block) Expression Computation)
(let [arguments (|> arguments
(list#each (|>> :representation))
(text.interposed ..input_separator)
(text.enclosed ["(" ")"]))
- block (case block_lambda
+ block (case block
{.#None}
""
- {.#Some lambda}
- (format " &" (:representation lambda)))]
+ {.#Some [inputs block]}
+ (|> block
+ :representation
+ nested
+ control_structure
+ (format " do "
+ (|> inputs
+ (list#each (|>> :representation))
+ (text.interposed ..input_separator)
+ (text.enclosed' "|")))))]
(:abstraction (format (:representation func) arguments block))))
(def: .public (the field object)
@@ -413,6 +425,7 @@
(:abstraction (format "(" <unary> (:representation subject) ")")))]
["!" not]
+ ["~" bit_not]
["-" opposite]
)
@@ -420,11 +433,24 @@
(All (_ brand) (-> Text (Code brand) (Code brand)))
(:abstraction (format "# " (..safe commentary) \n+
(:representation on))))
+
+ (def: .public (class name definition)
+ (-> LVar Statement Statement)
+ (:abstraction
+ (format "class " (:representation name)
+ (control_structure
+ (nested
+ (:representation definition))))))
+
+ (def: .public (attribute_readers attributes)
+ (-> (List Text) Statement)
+ (..statement
+ (..apply/* (list#each ..string attributes) {.#None} (..local "attr_reader"))))
)
-(def: .public (do method arguments block_lambda object)
- (-> Text (List Expression) (Maybe Expression) Expression Computation)
- (|> object (..the method) (..apply/* arguments block_lambda)))
+(def: .public (do method arguments block object)
+ (-> Text (List Expression) (Maybe Block) Expression Computation)
+ (|> object (..the method) (..apply/* arguments block)))
(def: .public (apply_lambda/* args lambda)
(-> (List Expression) Expression Computation)
diff --git a/stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/generation/ruby/common.lux b/stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/generation/ruby/common.lux
index 9ea3621e3..c9136a9dd 100644
--- a/stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/generation/ruby/common.lux
+++ b/stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/generation/ruby/common.lux
@@ -147,27 +147,22 @@
(_.do "equal?" (list reference) {.#None} subject))))
(/.install "try" (unary //runtime.lux//try))))
-(def: (capped operation parameter subject)
- (-> (-> Expression Expression Expression)
- (-> Expression Expression Expression))
- (//runtime.i64//64 (operation parameter subject)))
-
(def: i64_procs
Bundle
(<| (/.prefix "i64")
(|> /.empty
- (/.install "and" (binary (product.uncurried //runtime.i64//and)))
- (/.install "or" (binary (product.uncurried //runtime.i64//or)))
- (/.install "xor" (binary (product.uncurried //runtime.i64//xor)))
- (/.install "left-shift" (binary (product.uncurried //runtime.i64//left_shifted)))
- (/.install "right-shift" (binary (product.uncurried //runtime.i64//right_shifted)))
+ (/.install "and" (binary (product.uncurried //runtime.i64##and)))
+ (/.install "or" (binary (product.uncurried //runtime.i64##or)))
+ (/.install "xor" (binary (product.uncurried //runtime.i64##xor)))
+ (/.install "left-shift" (binary (product.uncurried //runtime.i64##left_shifted)))
+ (/.install "right-shift" (binary (product.uncurried //runtime.i64##right_shifted)))
(/.install "<" (binary (product.uncurried _.<)))
(/.install "=" (binary (product.uncurried _.=)))
- (/.install "+" (binary (product.uncurried (..capped _.+))))
- (/.install "-" (binary (product.uncurried (..capped _.-))))
- (/.install "*" (binary (product.uncurried (..capped _.*))))
- (/.install "/" (binary (product.uncurried //runtime.i64//division)))
+ (/.install "+" (binary (product.uncurried //runtime.i64##+)))
+ (/.install "-" (binary (product.uncurried //runtime.i64##-)))
+ (/.install "*" (binary (product.uncurried //runtime.i64##*)))
+ (/.install "/" (binary (product.uncurried //runtime.i64##/)))
(/.install "%" (binary (function (_ [parameter subject])
(_.do "remainder" (list parameter) {.#None} subject))))
diff --git a/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/ruby/runtime.lux b/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/ruby/runtime.lux
index e3d1e8dff..19ef21fbf 100644
--- a/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/ruby/runtime.lux
+++ b/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/ruby/runtime.lux
@@ -1,6 +1,6 @@
(.using
[library
- [lux "*"
+ [lux {"-" i64}
["[0]" meta]
[abstract
["[0]" monad {"+" do}]]
@@ -250,76 +250,245 @@
@lux//program_args
))
-(def: i64//+limit (_.manual "+0x7FFFFFFFFFFFFFFF"))
-(def: i64//-limit (_.manual "-0x8000000000000000"))
-(def: i64//+iteration (_.manual "+0x10000000000000000"))
-(def: i64//-iteration (_.manual "-0x10000000000000000"))
-(def: i64//+cap (_.manual "+0x8000000000000000"))
-(def: i64//-cap (_.manual "-0x8000000000000001"))
-
-(runtime: (i64//64 input)
- (with_vars [temp]
- (`` (<| (~~ (template [<scenario> <iteration> <cap> <entrance>]
- [(_.if (|> input <scenario>)
- ($_ _.then
- (_.set (list temp) (_.% <iteration> input))
- (_.return (_.? (|> temp <scenario>)
- (|> temp (_.- <cap>) (_.+ <entrance>))
- temp))))]
-
- [(_.> ..i64//+limit) ..i64//+iteration ..i64//+cap ..i64//-limit]
- [(_.< ..i64//-limit) ..i64//-iteration ..i64//-cap ..i64//+limit]
- ))
- (_.return input)))))
-
-(runtime: i64//nat_top
- (|> (_.int +1)
- (_.bit_shl (_.int +64))
- (_.- (_.int +1))))
-
-(def: as_nat
- (_.% (_.manual "0x10000000000000000")))
-
-(runtime: (i64//left_shifted param subject)
- (_.return (|> subject
- (_.bit_shl (_.% (_.int +64) param))
- ..i64//64)))
-
-(runtime: (i64//right_shifted param subject)
- ($_ _.then
- (_.set (list param) (_.% (_.int +64) param))
- (_.return (_.? (_.= (_.int +0) param)
- subject
- (|> subject
- ..as_nat
- (_.bit_shr param))))))
+... (def: i64##+limit (_.manual "+0x7FFFFFFFFFFFFFFF"))
+... (def: i64##-limit (_.manual "-0x8000000000000000"))
+... (def: i64##+iteration (_.manual "+0x10000000000000000"))
+... (def: i64##-iteration (_.manual "-0x10000000000000000"))
+... (def: i64##+cap (_.manual "+0x8000000000000000"))
+... (def: i64##-cap (_.manual "-0x8000000000000001"))
+
+... (runtime: (i64##64 input)
+... (with_vars [temp]
+... (`` (<| (~~ (template [<scenario> <iteration> <cap> <entrance>]
+... [(_.if (|> input <scenario>)
+... ($_ _.then
+... (_.set (list temp) (_.% <iteration> input))
+... (_.return (_.? (|> temp <scenario>)
+... (|> temp (_.- <cap>) (_.+ <entrance>))
+... temp))))]
+
+... [(_.> ..i64##+limit) ..i64##+iteration ..i64##+cap ..i64##-limit]
+... [(_.< ..i64##-limit) ..i64##-iteration ..i64##-cap ..i64##+limit]
+... ))
+... (_.return input)))))
+
+(def: i32##low
+ (|>> (_.bit_and (_.manual "+0xFFFFFFFF"))))
+
+(def: i32##high
+ (|>> (_.bit_shr (_.int +32))
+ ..i32##low))
+
+(def: i32##positive?
+ (|>> (_.bit_and (_.manual "+0x80000000"))
+ (_.= (_.int +0))))
+
+(template: (i64 @high @low)
+ [(|> (_.? (i32##positive? @high)
+ @high
+ (|> (_.manual "+0xFFFFFFFF")
+ (_.- @high)
+ _.bit_not))
+ (_.bit_shl (_.int +32))
+ (_.bit_or @low))])
(template [<runtime> <host>]
[(runtime: (<runtime> left right)
- (_.return (..i64//64 (<host> (..as_nat left) (..as_nat right)))))]
-
- [i64//and _.bit_and]
- [i64//or _.bit_or]
- [i64//xor _.bit_xor]
+ (with_vars [high low]
+ ($_ _.then
+ (_.set (list high) (<host> (i32##high left) (..i32##high right)))
+ (_.set (list low) (<host> (i32##low left) (..i32##low right)))
+ (_.return (..i64 high low)))))]
+
+ [i64##and _.bit_and]
+ [i64##or _.bit_or]
+ [i64##xor _.bit_xor]
)
-(runtime: (i64//division parameter subject)
+(def: (cap_shift! shift)
+ (-> LVar Statement)
+ (_.set (list shift) (|> shift (_.bit_and (_.int +63)))))
+
+(def: (handle_no_shift! shift input)
+ (-> LVar LVar (-> Statement Statement))
+ (_.if (|> shift (_.= (_.int +0)))
+ (_.return input)))
+
+(def: small_shift?
+ (-> LVar Expression)
+ (|>> (_.< (_.int +32))))
+
+(runtime: (i64##left_shifted shift input)
+ (with_vars [high low]
+ ($_ _.then
+ (..cap_shift! shift)
+ (<| (..handle_no_shift! shift input)
+ (_.if (..small_shift? shift)
+ ($_ _.then
+ (_.set (list high) (_.bit_or (|> input i32##high (_.bit_shl shift))
+ (|> input i32##low (_.bit_shr (_.- shift (_.int +32))))))
+ (_.set (list low) (|> input i32##low (_.bit_shl shift)))
+ (_.return (..i64 (i32##low high)
+ (i32##low low)))))
+ ($_ _.then
+ (_.set (list high) (|> input i32##low (_.bit_shl (_.- (_.int +32) shift))))
+ (_.return (..i64 (i32##low high)
+ (_.int +0)))))
+ )))
+
+(runtime: (i64##right_shifted shift input)
+ (with_vars [high low]
+ ($_ _.then
+ (..cap_shift! shift)
+ (<| (..handle_no_shift! shift input)
+ (_.if (..small_shift? shift)
+ ($_ _.then
+ (_.set (list high) (|> input i32##high (_.bit_shr shift)))
+ (_.set (list low) (|> input i32##low (_.bit_shr shift)
+ (_.bit_or (|> input i32##high (_.bit_shl (_.- shift (_.int +32)))))))
+ (_.return (..i64 high low))))
+ ($_ _.then
+ (_.set (list low) (_.? (|> shift (_.= (_.int +32)))
+ (i32##high input)
+ (|> input i32##high (_.bit_shr (_.- (_.int +32) shift)))))
+ (_.return (..i64 (_.int +0) low)))))))
+
+(runtime: (i64##/ parameter subject)
(let [extra (_.do "remainder" (list parameter) {.#None} subject)]
(_.return (|> subject
(_.- extra)
(_./ parameter)))))
+(def: i16##high
+ (_.bit_shr (_.int +16)))
+
+(def: i16##low
+ (_.bit_and (_.manual "+0xFFFF")))
+
+(def: i16##up
+ (_.bit_shl (_.int +16)))
+
+(runtime: (i64##+ parameter subject)
+ ... (_.return (i64##64 (_.+ parameter subject)))
+ (let [hh (|>> i32##high i16##high)
+ hl (|>> i32##high i16##low)
+ lh (|>> i32##low i16##high)
+ ll (|>> i32##low i16##low)]
+ (with_vars [l48 l32 l16 l00
+ r48 r32 r16 r00
+ x48 x32 x16 x00
+ high low]
+ ($_ _.then
+ (_.set (list l48) (hh subject))
+ (_.set (list l32) (hl subject))
+ (_.set (list l16) (lh subject))
+ (_.set (list l00) (ll subject))
+
+ (_.set (list r48) (hh parameter))
+ (_.set (list r32) (hl parameter))
+ (_.set (list r16) (lh parameter))
+ (_.set (list r00) (ll parameter))
+
+ (_.set (list x00) (_.+ l00 r00))
+
+ (_.set (list x16) (|> (i16##high x00)
+ (_.+ l16)
+ (_.+ r16)))
+ (_.set (list x00) (i16##low x00))
+
+ (_.set (list x32) (|> (i16##high x16)
+ (_.+ l32)
+ (_.+ r32)))
+ (_.set (list x16) (i16##low x16))
+
+ (_.set (list x48) (|> (i16##high x32)
+ (_.+ l48)
+ (_.+ r48)
+ i16##low))
+ (_.set (list x32) (i16##low x32))
+
+ (_.set (list high) (_.bit_or (i16##up x48) x32))
+ (_.set (list low) (_.bit_or (i16##up x16) x00))
+ (_.return (..i64 high low))
+ )))
+ )
+
+(def: i64##min
+ (_.manual "-0x8000000000000000"))
+
+(def: (i64##opposite value)
+ (_.? (_.= i64##min value)
+ i64##min
+ (i64##+ (_.int +1) (_.bit_not value))))
+
+(runtime: (i64##- parameter subject)
+ ... (_.return (i64##64 (_.- parameter subject)))
+ (_.return (i64##+ (i64##opposite parameter) subject))
+ )
+
+(runtime: (i64##* parameter subject)
+ ... (_.return (i64##64 (_.* parameter subject)))
+ (let [hh (|>> i32##high i16##high)
+ hl (|>> i32##high i16##low)
+ lh (|>> i32##low i16##high)
+ ll (|>> i32##low i16##low)]
+ (with_vars [l48 l32 l16 l00
+ r48 r32 r16 r00
+ x48 x32 x16 x00
+ high low]
+ ($_ _.then
+ (_.set (list l48) (hh subject))
+ (_.set (list l32) (hl subject))
+ (_.set (list l16) (lh subject))
+ (_.set (list l00) (ll subject))
+
+ (_.set (list r48) (hh parameter))
+ (_.set (list r32) (hl parameter))
+ (_.set (list r16) (lh parameter))
+ (_.set (list r00) (ll parameter))
+
+ (_.set (list x00) (_.* l00 r00))
+ (_.set (list x16) (i16##high x00))
+ (_.set (list x00) (i16##low x00))
+
+ (_.set (list x16) (|> x16 (_.+ (_.* l16 r00))))
+ (_.set (list x32) (i16##high x16)) (_.set (list x16) (i16##low x16))
+ (_.set (list x16) (|> x16 (_.+ (_.* l00 r16))))
+ (_.set (list x32) (|> x32 (_.+ (i16##high x16)))) (_.set (list x16) (i16##low x16))
+
+ (_.set (list x32) (|> x32 (_.+ (_.* l32 r00))))
+ (_.set (list x48) (i16##high x32)) (_.set (list x32) (i16##low x32))
+ (_.set (list x32) (|> x32 (_.+ (_.* l16 r16))))
+ (_.set (list x48) (|> x48 (_.+ (i16##high x32)))) (_.set (list x32) (i16##low x32))
+ (_.set (list x32) (|> x32 (_.+ (_.* l00 r32))))
+ (_.set (list x48) (|> x48 (_.+ (i16##high x32)))) (_.set (list x32) (i16##low x32))
+
+ (_.set (list x48) (|> x48
+ (_.+ (_.* l48 r00))
+ (_.+ (_.* l32 r16))
+ (_.+ (_.* l16 r32))
+ (_.+ (_.* l00 r48))
+ i16##low))
+
+ (_.set (list high) (_.bit_or (i16##up x48) x32))
+ (_.set (list low) (_.bit_or (i16##up x16) x00))
+ (_.return (..i64 high low))
+ )))
+ )
+
(def: runtime//i64
Statement
($_ _.then
- @i64//64
- @i64//nat_top
- @i64//left_shifted
- @i64//right_shifted
- @i64//and
- @i64//or
- @i64//xor
- @i64//division
+ ... @i64##64
+ @i64##left_shifted
+ @i64##right_shifted
+ @i64##and
+ @i64##or
+ @i64##xor
+ @i64##+
+ @i64##-
+ @i64##*
+ @i64##/
))
(runtime: (f64//decode inputG)
@@ -392,10 +561,10 @@
(_.local "Numeric")))
... We're in DragonRuby territory.
(_.statement
- (_.do "class_eval" (list) {.#Some (_.lambda {.#None} (list (_.local "_"))
- (_.statement
- (_.alias_method/2 (_.string "remainder")
- (_.string "remainder_of_divide"))))}
+ (_.do "class_eval" (list) {.#Some [(list (_.local "_"))
+ (_.statement
+ (_.alias_method/2 (_.string "remainder")
+ (_.string "remainder_of_divide")))]}
(_.local "Numeric"))))
runtime//adt
runtime//lux
diff --git a/stdlib/source/test/lux.lux b/stdlib/source/test/lux.lux
index 84353e082..7026c0a48 100644
--- a/stdlib/source/test/lux.lux
+++ b/stdlib/source/test/lux.lux
@@ -865,10 +865,12 @@
(hide left))
true)))))
(_.cover [/.same?]
- (let [not_left (|> left ++ --)]
- (and (/.same? left left)
- (and (n.= not_left left)
- (not (/.same? not_left left))))))
+ (let [not_left (|> left ++ -- %.nat)
+ left (%.nat left)]
+ (and (and (/.same? left left)
+ (/.same? not_left not_left))
+ (and (text#= left not_left)
+ (not (/.same? left not_left))))))
(_.cover [/.Rec]
(let [list (: (/.Rec NList
(Maybe [Nat NList]))
diff --git a/stdlib/source/test/lux/math/number/frac.lux b/stdlib/source/test/lux/math/number/frac.lux
index 2b960b43e..bc77f1f32 100644
--- a/stdlib/source/test/lux/math/number/frac.lux
+++ b/stdlib/source/test/lux/math/number/frac.lux
@@ -1,28 +1,28 @@
(.using
- [library
- [lux "*"
- ["_" test {"+" Test}]
- ["@" target]
- ["[0]" ffi]
- [abstract
- [monad {"+" do}]
- [\\specification
- ["$[0]" equivalence]
- ["$[0]" hash]
- ["$[0]" order]
- ["$[0]" monoid]
- ["$[0]" codec]]]
- [data
- ["[0]" bit ("[1]#[0]" equivalence)]]
- [math
- ["[0]" random {"+" Random}]]]]
- [\\library
- ["[0]" /
- [// "*"
- ["n" nat]
- ["i" int]
- ["r" rev]
- ["[0]" i64]]]])
+ [library
+ [lux "*"
+ ["_" test {"+" Test}]
+ ["@" target]
+ ["[0]" ffi]
+ [abstract
+ [monad {"+" do}]
+ [\\specification
+ ["$[0]" equivalence]
+ ["$[0]" hash]
+ ["$[0]" order]
+ ["$[0]" monoid]
+ ["$[0]" codec]]]
+ [data
+ ["[0]" bit ("[1]#[0]" equivalence)]]
+ [math
+ ["[0]" random {"+" Random}]]]]
+ [\\library
+ ["[0]" /
+ [// "*"
+ ["n" nat]
+ ["i" int]
+ ["r" rev]
+ ["[0]" i64]]]])
(def: random
(Random Frac)