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