From a84d15fb8e39d4b1050331194c2aff6d8fcc19fa Mon Sep 17 00:00:00 2001 From: Eduardo Julian Date: Mon, 1 Jan 2024 16:46:47 -0400 Subject: [PATCH] Slightly better syntax for defining runtime-level functions. --- stdlib/source/library/lux/meta.lux | 8 +- .../phase/translation/common_lisp/runtime.lux | 246 ++-- .../lux/phase/translation/js/runtime.lux | 1060 ++++++++-------- .../lux/phase/translation/lua/runtime.lux | 461 ++++--- .../lux/phase/translation/php/runtime.lux | 752 ++++++------ .../lux/phase/translation/python/runtime.lux | 459 ++++--- .../lux/phase/translation/r/runtime.lux | 1092 ++++++++--------- .../lux/phase/translation/ruby/runtime.lux | 607 +++++---- .../lux/phase/translation/scheme/runtime.lux | 378 +++--- .../target/jvm/bytecode/instruction.lux | 5 +- .../lux/meta/compiler/target/jvm/constant.lux | 42 +- .../compiler/target/jvm/constant/pool.lux | 5 +- .../target/jvm/constant/reference.lux | 39 + .../source/test/lux/abstract/equivalence.lux | 12 + .../source/test/lux/math/number/decimal.lux | 10 +- .../test/lux/meta/compiler/target/jvm.lux | 79 +- .../target/jvm/constant/name_and_type.lux | 3 +- .../target/jvm/constant/reference.lux | 50 + to_do.md | 2 +- 19 files changed, 2645 insertions(+), 2665 deletions(-) create mode 100644 stdlib/source/library/lux/meta/compiler/target/jvm/constant/reference.lux create mode 100644 stdlib/source/test/lux/meta/compiler/target/jvm/constant/reference.lux diff --git a/stdlib/source/library/lux/meta.lux b/stdlib/source/library/lux/meta.lux index 7d6952e718..14d7bb8456 100644 --- a/stdlib/source/library/lux/meta.lux +++ b/stdlib/source/library/lux/meta.lux @@ -10,7 +10,11 @@ [monad (.only Monad do)]] [control - ["[0]" try (.only Try)]]]] + ["[0]" try (.only Try)]] + [data + [collection + [list + ["[0]" property]]]]]] [/ ["[0]" location]]) @@ -182,7 +186,7 @@ [target [.#info .#target] Text] [version [.#info .#version] Text] - [configuration [.#info .#configuration] (List [Text Text])] + [configuration [.#info .#configuration] (property.List Text)] ) (the .public location diff --git a/stdlib/source/library/lux/meta/compiler/language/lux/phase/translation/common_lisp/runtime.lux b/stdlib/source/library/lux/meta/compiler/language/lux/phase/translation/common_lisp/runtime.lux index 50dffdc9eb..739e46be78 100644 --- a/stdlib/source/library/lux/meta/compiler/language/lux/phase/translation/common_lisp/runtime.lux +++ b/stdlib/source/library/lux/meta/compiler/language/lux/phase/translation/common_lisp/runtime.lux @@ -3,7 +3,8 @@ (.using [library - [lux (.except Location) + [lux (.except Location + the) [abstract ["[0]" monad (.only do)]] [control @@ -43,7 +44,7 @@ [archive (.only Output Archive) ["[0]" artifact (.only Registry)]]]]]]) -(the module_id +(.the module_id 0) (template.with [ ] @@ -59,40 +60,40 @@ (every .public (Translator i) (-> Phase Archive i (Operation (Expression Any)))) -(the .public unit +(.the .public unit (_.string /////synthesis.unit)) -(the (flag value) +(.the (flag value) (-> Bit Literal) (if value (_.string "") _.nil)) -(the (variant' tag last? value) +(.the (variant' tag last? value) (-> (Expression Any) (Expression Any) (Expression Any) (Computation Any)) (_.list/* (list tag last? value))) -(the .public (variant [lefts right? value]) +(.the .public (variant [lefts right? value]) (-> (Variant (Expression Any)) (Computation Any)) (variant' (_.int (.integer lefts)) (flag right?) value)) -(the .public none +(.the .public none (Computation Any) (|> ..unit [0 #0] ..variant)) -(the .public some +(.the .public some (-> (Expression Any) (Computation Any)) (|>> [1 #1] ..variant)) -(the .public left +(.the .public left (-> (Expression Any) (Computation Any)) (|>> [0 #0] ..variant)) -(the .public right +(.the .public right (-> (Expression Any) (Computation Any)) (|>> [1 #1] ..variant)) -(the .public with_vars +(.the .public with_vars (syntax.macro (_ [vars (.tuple (<>.some .local)) body .any]) (do [! meta.monad] @@ -105,7 +106,7 @@ list.together))] (, body)))))))) -(the runtime +(.the the (syntax.macro (_ [declaration (<>.or .local (.form (<>.and .local (<>.some .local)))) @@ -119,11 +120,11 @@ {.#Left name} (let [g!name (code.local name) code_nameC (code.local (%.message "@" name))] - (in (list (` (the .public (, g!name) + (in (list (` (.the .public (, g!name) _.Var/1 (, runtime_name))) - (` (the (, code_nameC) + (` (.the (, code_nameC) (_.Expression Any) (_.defparameter (, runtime_name) (, code))))))) @@ -134,161 +135,152 @@ inputsC (list#each code.local inputs) inputs_typesC (list#each (function.constant (` (_.Expression Any))) inputs)] - (in (list (` (the .public ((, g!name) (,* inputsC)) + (in (list (` (.the .public ((, g!name) (,* inputsC)) (-> (,* inputs_typesC) (_.Computation Any)) (_.call/* (, runtime_name) (list (,* inputsC))))) - (` (the (, code_nameC) + (` (.the (, code_nameC) (_.Expression Any) (..with_vars [(,* inputsC)] (_.defun (, runtime_name) (_.args (list (,* inputsC))) (, code)))))))))))))) -(runtime - (lux//try op) - (with_vars [error] - (_.handler_case - (list [(_.bool true) error - (..left (_.format/3 [_.nil (_.string "~A") error]))]) - (..right (_.funcall/+ [op (list ..unit)]))))) +(the (lux//try op) + (with_vars [error] + (_.handler_case + (list [(_.bool true) error + (..left (_.format/3 [_.nil (_.string "~A") error]))]) + (..right (_.funcall/+ [op (list ..unit)]))))) ... TODO: Use Common Lisp's swiss-army loop macro instead. -(runtime - (lux//program_args inputs) - (with_vars [loop input tail] - (_.labels (list [loop [(_.args (list input tail)) - (_.if (_.null/1 input) - tail - (_.funcall/+ [(_.function/1 loop) - (list (_.cdr/1 input) - (..some (_.vector/* (list (_.car/1 input) tail))))]))]]) - (_.funcall/+ [(_.function/1 loop) - (list (_.reverse/1 inputs) - ..none)])))) - -(the runtime//lux +(the (lux//program_args inputs) + (with_vars [loop input tail] + (_.labels (list [loop [(_.args (list input tail)) + (_.if (_.null/1 input) + tail + (_.funcall/+ [(_.function/1 loop) + (list (_.cdr/1 input) + (..some (_.vector/* (list (_.car/1 input) tail))))]))]]) + (_.funcall/+ [(_.function/1 loop) + (list (_.reverse/1 inputs) + ..none)])))) + +(.the runtime//lux (List (Expression Any)) (list @lux//try @lux//program_args)) -(the last_index +(.the last_index (|>> _.length/1 [(_.int +1)] _.-/2)) (expansion.let [ (these (all _.then (_.; (_.set lefts (_.-/2 [last_index_right lefts]))) (_.; (_.set tuple (_.nth last_index_right tuple)))))] - (these (the !recur + (these (.the !recur (template.macro (_ ) ( (_.-/2 [last_index_right lefts]) (_.elt/2 [tuple last_index_right])))) - (runtime - (tuple//left lefts tuple) - (with_vars [last_index_right] - (_.let (list [last_index_right (..last_index tuple)]) - (list (_.if (_.>/2 [lefts last_index_right]) - ... No need for recursion - (_.elt/2 [tuple lefts]) - ... Needs recursion - (!recur tuple//left)))))) - - (runtime - (tuple//right lefts tuple) - (with_vars [last_index_right right_index] - (_.let (list [last_index_right (..last_index tuple)] - [right_index (_.+/2 [(_.int +1) lefts])]) - (list (_.cond (list [(_.=/2 [last_index_right right_index]) - (_.elt/2 [tuple right_index])] - [(_.>/2 [last_index_right right_index]) - ... Needs recursion. - (!recur tuple//right)]) - (_.subseq/3 [tuple right_index (_.length/1 tuple)])))))))) + (the (tuple//left lefts tuple) + (with_vars [last_index_right] + (_.let (list [last_index_right (..last_index tuple)]) + (list (_.if (_.>/2 [lefts last_index_right]) + ... No need for recursion + (_.elt/2 [tuple lefts]) + ... Needs recursion + (!recur tuple//left)))))) + + (the (tuple//right lefts tuple) + (with_vars [last_index_right right_index] + (_.let (list [last_index_right (..last_index tuple)] + [right_index (_.+/2 [(_.int +1) lefts])]) + (list (_.cond (list [(_.=/2 [last_index_right right_index]) + (_.elt/2 [tuple right_index])] + [(_.>/2 [last_index_right right_index]) + ... Needs recursion. + (!recur tuple//right)]) + (_.subseq/3 [tuple right_index (_.length/1 tuple)])))))))) ... TODO: Find a way to extract parts of the sum without "nth", which ... does a linear search, and is thus expensive. -(runtime - (sum//get sum wantsLast wantedTag) - (with_vars [sum_tag sum_flag] - (let [no_match! (_.return sum) - sum_value (_.nth/2 [(_.int +2) sum]) - test_recursion! (_.if sum_flag - ... Must iterate. - (_.progn (list (_.setq wantedTag (_.-/2 [sum_tag wantedTag])) - (_.setq sum sum_value))) - no_match!)] - (_.while (_.bool true) - (_.let (list [sum_tag (_.nth/2 [(_.int +0) sum])] - [sum_flag (_.nth/2 [(_.int +1) sum])]) - (list (_.cond (list [(_.=/2 [sum_tag wantedTag]) - (_.if (_.equal/2 [wantsLast sum_flag]) - (_.return sum_value) - test_recursion!)] - - [(_.>/2 [sum_tag wantedTag]) - test_recursion!] - - [(_.and (_./2 [sum_tag wantedTag]) + test_recursion!] + + [(_.and (_. (_.int +1) - [anti_shift] _.ash/2 - [(_.int +1)] _.-/2)] - (|> input - [(_.*/2 [(_.int -1) shift])] _.ash/2 - [mask] _.logand/2)))) - -(the runtime//i64 +(the (i64//right_shifted shift input) + (_.if (_.=/2 [(_.int +0) shift]) + input + (let [anti_shift (_.-/2 [shift (_.int +64)]) + mask (|> (_.int +1) + [anti_shift] _.ash/2 + [(_.int +1)] _.-/2)] + (|> input + [(_.*/2 [(_.int -1) shift])] _.ash/2 + [mask] _.logand/2)))) + +(.the runtime//i64 (List (Expression Any)) (list @i64//right_shifted)) -(runtime - (text//clip offset length text) - (_.subseq/3 [text offset (_.+/2 [offset length])])) +(the (text//clip offset length text) + (_.subseq/3 [text offset (_.+/2 [offset length])])) -(runtime - (text//index offset sub text) - (with_vars [index] - (_.let (list [index (_.search/3 [sub text offset])]) - (list (_.if index - (..some index) - ..none))))) +(the (text//index offset sub text) + (with_vars [index] + (_.let (list [index (_.search/3 [sub text offset])]) + (list (_.if index + (..some index) + ..none))))) -(the runtime//text +(.the runtime//text (List (Expression Any)) (list @text//index @text//clip)) -(runtime - (io//exit code) - (_.progn (list (_.conditional+ (list "sbcl") - (_.call/* (_.var "sb-ext:quit") (list code))) - (_.conditional+ (list "clisp") - (_.call/* (_.var "ext:exit") (list code))) - (_.conditional+ (list "ccl") - (_.call/* (_.var "ccl:quit") (list code))) - (_.conditional+ (list "allegro") - (_.call/* (_.var "excl:exit") (list code))) - (_.call/* (_.var "cl-user::quit") (list code))))) - -(the runtime//io +(the (io//exit code) + (_.progn (list (_.conditional+ (list "sbcl") + (_.call/* (_.var "sb-ext:quit") (list code))) + (_.conditional+ (list "clisp") + (_.call/* (_.var "ext:exit") (list code))) + (_.conditional+ (list "ccl") + (_.call/* (_.var "ccl:quit") (list code))) + (_.conditional+ (list "allegro") + (_.call/* (_.var "excl:exit") (list code))) + (_.call/* (_.var "cl-user::quit") (list code))))) + +(.the runtime//io (List (Expression Any)) (list @io//exit)) -(the runtime +(.the runtime (_.progn (all list#composite runtime//adt runtime//lux @@ -296,7 +288,7 @@ runtime//text runtime//io))) -(the .public translate +(.the .public translate (Operation [Registry Output]) (do ///////phase.monad [_ (/////translation.execute! ..runtime) diff --git a/stdlib/source/library/lux/meta/compiler/language/lux/phase/translation/js/runtime.lux b/stdlib/source/library/lux/meta/compiler/language/lux/phase/translation/js/runtime.lux index 9f28661a83..ce545358d7 100644 --- a/stdlib/source/library/lux/meta/compiler/language/lux/phase/translation/js/runtime.lux +++ b/stdlib/source/library/lux/meta/compiler/language/lux/phase/translation/js/runtime.lux @@ -4,7 +4,8 @@ (.using [library [lux (.except Declaration - i64 variant) + i64 variant + the) [abstract ["[0]" monad (.only do)]] [control @@ -78,34 +79,34 @@ (-> Phase! Phase Archive of (Operation Statement))) -(the .public high +(.the .public high (-> (I64 Any) (I64 Any)) (i64.right_shifted 32)) -(the .public low +(.the .public low (-> (I64 Any) (I64 Any)) (let [mask (-- (i64.left_shifted 32 1))] (|>> (i64.and mask)))) -(the .public unit +(.the .public unit Computation (_.string synthesis.unit)) -(the .public (flag value) +(.the .public (flag value) (-> Bit Computation) (if value (_.string "") _.null)) -(the (feature name definition) +(.the (feature name definition) (-> Var (-> Var Expression) Statement) (_.define name (definition name))) -(the .public with_vars +(.the .public with_vars (syntax.macro (_ [vars (.tuple (<>.some .local)) body .any]) (do [! meta.monad] @@ -118,7 +119,7 @@ list.together))] (, body)))))))) -(the runtime +(.the the (syntax.macro (_ [declaration (<>.or .local (.form (<>.and .local (<>.some .local)))) @@ -128,11 +129,11 @@ (when declaration {.#Left name} (let [g!name (code.local name)] - (in (list (` (the .public (, g!name) + (in (list (` (.the .public (, g!name) Var (, runtime_name))) - (` (the (, (code.local (%.message "@" name))) + (` (.the (, (code.local (%.message "@" name))) Statement (..feature (, runtime_name) (function ((, g!_) (, g!name)) @@ -142,12 +143,12 @@ (let [g!name (code.local name) inputsC (list#each code.local inputs) inputs_typesC (list#each (function.constant (` _.Expression)) inputs)] - (in (list (` (the .public ((, g!name) (,* inputsC)) + (in (list (` (.the .public ((, g!name) (,* inputsC)) (-> (,* inputs_typesC) Computation) (_.apply (, runtime_name) (list (,* inputsC))))) - (` (the (, (code.local (%.message "@" name))) + (` (.the (, (code.local (%.message "@" name))) Statement (..feature (, runtime_name) (function ((, g!_) (, g!_)) @@ -155,118 +156,114 @@ (_.function (, g!_) (list (,* inputsC)) (, code))))))))))))))) -(the length +(.the length (-> Expression Computation) (_.its "length")) -(the last_index +(.the last_index (-> Expression Computation) (|>> ..length (_.- (_.i32 +1)))) -(the (last_element tuple) +(.the (last_element tuple) (_.at (..last_index tuple) tuple)) (expansion.let [ (these (all _.then (_.; (_.set lefts (_.- last_index_right lefts))) (_.; (_.set tuple (_.at last_index_right tuple)))))] - (these (runtime - (tuple//left lefts tuple) - (with_vars [last_index_right] - (<| (_.while (_.boolean true)) - (all _.then - (_.define last_index_right (..last_index tuple)) - (_.if (_.> lefts last_index_right) - ... No need for recursion - (_.return (_.at lefts tuple)) - ... Needs recursion - ))))) - - (runtime - (tuple//right lefts tuple) - (with_vars [last_index_right right_index] - (<| (_.while (_.boolean true)) - (all _.then - (_.define last_index_right (..last_index tuple)) - (_.define right_index (_.+ (_.i32 +1) lefts)) - (<| (_.if (_.= last_index_right right_index) - (_.return (_.at right_index tuple))) - (_.if (_.> last_index_right right_index) - ... Needs recursion. - ) - (_.return (_.do "slice" (list right_index) tuple))) - )))))) - -(the .public variant_tag_field script.variant_lefts) -(the .public variant_flag_field script.variant_right?) -(the .public variant_value_field script.variant_choice) - -(runtime - variant//new - (let [@this (_.var "this")] - (with_vars [tag is_last value] - (_.closure (list tag is_last value) - (all _.then - (_.; (_.set (_.its ..variant_tag_field @this) tag)) - (_.; (_.set (_.its ..variant_flag_field @this) is_last)) - (_.; (_.set (_.its ..variant_value_field @this) value)) - ))))) - -(the .public (variant tag last? value) + (these (the (tuple//left lefts tuple) + (with_vars [last_index_right] + (<| (_.while (_.boolean true)) + (all _.then + (_.define last_index_right (..last_index tuple)) + (_.if (_.> lefts last_index_right) + ... No need for recursion + (_.return (_.at lefts tuple)) + ... Needs recursion + ))))) + + (the (tuple//right lefts tuple) + (with_vars [last_index_right right_index] + (<| (_.while (_.boolean true)) + (all _.then + (_.define last_index_right (..last_index tuple)) + (_.define right_index (_.+ (_.i32 +1) lefts)) + (<| (_.if (_.= last_index_right right_index) + (_.return (_.at right_index tuple))) + (_.if (_.> last_index_right right_index) + ... Needs recursion. + ) + (_.return (_.do "slice" (list right_index) tuple))) + )))))) + +(.the .public variant_tag_field script.variant_lefts) +(.the .public variant_flag_field script.variant_right?) +(.the .public variant_value_field script.variant_choice) + +(the variant//new + (let [@this (_.var "this")] + (with_vars [tag is_last value] + (_.closure (list tag is_last value) + (all _.then + (_.; (_.set (_.its ..variant_tag_field @this) tag)) + (_.; (_.set (_.its ..variant_flag_field @this) is_last)) + (_.; (_.set (_.its ..variant_value_field @this) value)) + ))))) + +(.the .public (variant tag last? value) (-> Expression Expression Expression Computation) (_.new ..variant//new (list tag last? value))) -(runtime - (sum//get sum expected::right? expected::lefts) - (let [mismatch! (_.return _.null) - actual::lefts (|> sum (_.its ..variant_tag_field)) - actual::right? (|> sum (_.its ..variant_flag_field)) - actual::value (|> sum (_.its ..variant_value_field)) - recur! (all _.then - (_.; (_.set expected::lefts (|> expected::lefts - (_.- actual::lefts) - (_.- (_.i32 +1))))) - (_.; (_.set sum actual::value)))] - (<| (_.while (_.boolean true)) - (_.if (_.= expected::lefts actual::lefts) - (_.if (_.= expected::right? actual::right?) - (_.return actual::value) - mismatch!)) - (_.if (_.< expected::lefts actual::lefts) - (_.if (_.= ..unit actual::right?) - recur! - mismatch!)) - (_.if (_.= ..unit expected::right?) - (_.return (..variant (|> actual::lefts - (_.- expected::lefts) - (_.- (_.i32 +1))) - actual::right? - actual::value))) - mismatch!))) - -(the left +(the (sum//get sum expected::right? expected::lefts) + (let [mismatch! (_.return _.null) + actual::lefts (|> sum (_.its ..variant_tag_field)) + actual::right? (|> sum (_.its ..variant_flag_field)) + actual::value (|> sum (_.its ..variant_value_field)) + recur! (all _.then + (_.; (_.set expected::lefts (|> expected::lefts + (_.- actual::lefts) + (_.- (_.i32 +1))))) + (_.; (_.set sum actual::value)))] + (<| (_.while (_.boolean true)) + (_.if (_.= expected::lefts actual::lefts) + (_.if (_.= expected::right? actual::right?) + (_.return actual::value) + mismatch!)) + (_.if (_.< expected::lefts actual::lefts) + (_.if (_.= ..unit actual::right?) + recur! + mismatch!)) + (_.if (_.= ..unit expected::right?) + (_.return (..variant (|> actual::lefts + (_.- expected::lefts) + (_.- (_.i32 +1))) + actual::right? + actual::value))) + mismatch!))) + +(.the left (-> Expression Computation) (..variant (_.i32 +0) (flag #0))) -(the right +(.the right (-> Expression Computation) (..variant (_.i32 +0) (flag #1))) -(the none +(.the none Computation (..left ..unit)) -(the some +(.the some (-> Expression Computation) ..right) -(the runtime//structure +(.the runtime//structure Statement (all _.then @tuple//left @@ -275,131 +272,123 @@ @sum//get )) -(runtime - (lux//try op) - (with_vars [ex] - (_.try (_.return (..right (_.apply_1 op ..unit))) - [ex (_.return (..left (_.its "stack" ex)))]))) - -(runtime - (lux//program_args inputs) - (with_vars [output idx] - (all _.then - (_.define output ..none) - (_.for idx - (..last_index inputs) - (_.>= (_.i32 +0) idx) - (_.-- idx) - (_.; (_.set output (..some (_.array (list (_.at idx inputs) - output)))))) - (_.return output)))) - -(the runtime//lux +(the (lux//try op) + (with_vars [ex] + (_.try (_.return (..right (_.apply_1 op ..unit))) + [ex (_.return (..left (_.its "stack" ex)))]))) + +(the (lux//program_args inputs) + (with_vars [output idx] + (all _.then + (_.define output ..none) + (_.for idx + (..last_index inputs) + (_.>= (_.i32 +0) idx) + (_.-- idx) + (_.; (_.set output (..some (_.array (list (_.at idx inputs) + output)))))) + (_.return output)))) + +(.the runtime//lux Statement (all _.then @lux//try @lux//program_args )) -(the .public i64_low_field script.i64_low) -(the .public i64_high_field script.i64_high) +(.the .public i64_low_field script.i64_low) +(.the .public i64_high_field script.i64_high) -(runtime - i64::new - (let [@this (_.var "this")] - (with_vars [high low] - (_.closure (list high low) - (all _.then - (_.; (_.set (_.its ..i64_high_field @this) high)) - (_.; (_.set (_.its ..i64_low_field @this) low)) - ))))) +(the i64::new + (let [@this (_.var "this")] + (with_vars [high low] + (_.closure (list high low) + (all _.then + (_.; (_.set (_.its ..i64_high_field @this) high)) + (_.; (_.set (_.its ..i64_low_field @this) low)) + ))))) -(the .public (i64 high low) +(.the .public (i64 high low) (-> Expression Expression Computation) (_.new ..i64::new (list high low))) (template.with [ ] - [(runtime - ( subject parameter) - (_.return (..i64 ( (_.its ..i64_high_field subject) - (_.its ..i64_high_field parameter)) - ( (_.its ..i64_low_field subject) - (_.its ..i64_low_field parameter)))))] + [(the ( subject parameter) + (_.return (..i64 ( (_.its ..i64_high_field subject) + (_.its ..i64_high_field parameter)) + ( (_.its ..i64_low_field subject) + (_.its ..i64_low_field parameter)))))] [i64::xor _.bit_xor] [i64::or _.bit_or] [i64::and _.bit_and] ) -(runtime - (i64::not value) - (_.return (..i64 (_.bit_not (_.its ..i64_high_field value)) - (_.bit_not (_.its ..i64_low_field value))))) +(the (i64::not value) + (_.return (..i64 (_.bit_not (_.its ..i64_high_field value)) + (_.bit_not (_.its ..i64_low_field value))))) -(the (cap_shift! shift) +(.the (cap_shift! shift) (-> Var Statement) (_.; (_.set shift (|> shift (_.bit_and (_.i32 +63)))))) -(the (no_shift! shift input) +(.the (no_shift! shift input) (-> Var Var (-> Expression Expression)) (_.? (|> shift (_.= (_.i32 +0))) input)) -(the small_shift? +(.the small_shift? (-> Var Expression) (|>> (_.< (_.i32 +32)))) -(runtime - (i64::left_shifted input shift) - (all _.then - (..cap_shift! shift) - (_.return (<| (..no_shift! shift input) - (_.? (..small_shift? shift) - (let [high (_.bit_or (|> input (_.its ..i64_high_field) (_.left_shift shift)) - (|> input (_.its ..i64_low_field) (_.logic_right_shift (_.- shift (_.i32 +32))))) - low (|> input (_.its ..i64_low_field) (_.left_shift shift))] - (..i64 high low))) - (let [high (|> input (_.its ..i64_low_field) (_.left_shift (_.- (_.i32 +32) shift)))] - (..i64 high (_.i32 +0))))) - )) - -(runtime - (i64::arithmetic_right_shifted input shift) - (all _.then - (..cap_shift! shift) - (_.return (<| (..no_shift! shift input) - (_.? (..small_shift? shift) - (let [high (|> input (_.its ..i64_high_field) (_.arithmetic_right_shift shift)) - low (|> input (_.its ..i64_low_field) (_.logic_right_shift shift) - (_.bit_or (|> input (_.its ..i64_high_field) (_.left_shift (_.- shift (_.i32 +32))))))] - (..i64 high low))) - (let [high (_.? (|> input (_.its ..i64_high_field) (_.>= (_.i32 +0))) - (_.i32 +0) - (_.i32 -1)) - low (|> input (_.its ..i64_high_field) (_.arithmetic_right_shift (_.- (_.i32 +32) shift)))] - (..i64 high low)))))) - -(runtime - (i64::right_shifted input shift) - (all _.then - (..cap_shift! shift) - (_.return (<| (..no_shift! shift input) - (_.? (..small_shift? shift) - (let [high (|> input (_.its ..i64_high_field) (_.logic_right_shift shift)) - low (|> input (_.its ..i64_low_field) (_.logic_right_shift shift) - (_.bit_or (|> input (_.its ..i64_high_field) (_.left_shift (_.- shift (_.i32 +32))))))] - (..i64 high low))) - (_.? (|> shift (_.= (_.i32 +32))) - (..i64 (_.i32 +0) (|> input (_.its ..i64_high_field)))) - (..i64 (_.i32 +0) - (|> input (_.its ..i64_high_field) (_.logic_right_shift (_.- (_.i32 +32) shift)))))))) - -(the runtime//bit +(the (i64::left_shifted input shift) + (all _.then + (..cap_shift! shift) + (_.return (<| (..no_shift! shift input) + (_.? (..small_shift? shift) + (let [high (_.bit_or (|> input (_.its ..i64_high_field) (_.left_shift shift)) + (|> input (_.its ..i64_low_field) (_.logic_right_shift (_.- shift (_.i32 +32))))) + low (|> input (_.its ..i64_low_field) (_.left_shift shift))] + (..i64 high low))) + (let [high (|> input (_.its ..i64_low_field) (_.left_shift (_.- (_.i32 +32) shift)))] + (..i64 high (_.i32 +0))))) + )) + +(the (i64::arithmetic_right_shifted input shift) + (all _.then + (..cap_shift! shift) + (_.return (<| (..no_shift! shift input) + (_.? (..small_shift? shift) + (let [high (|> input (_.its ..i64_high_field) (_.arithmetic_right_shift shift)) + low (|> input (_.its ..i64_low_field) (_.logic_right_shift shift) + (_.bit_or (|> input (_.its ..i64_high_field) (_.left_shift (_.- shift (_.i32 +32))))))] + (..i64 high low))) + (let [high (_.? (|> input (_.its ..i64_high_field) (_.>= (_.i32 +0))) + (_.i32 +0) + (_.i32 -1)) + low (|> input (_.its ..i64_high_field) (_.arithmetic_right_shift (_.- (_.i32 +32) shift)))] + (..i64 high low)))))) + +(the (i64::right_shifted input shift) + (all _.then + (..cap_shift! shift) + (_.return (<| (..no_shift! shift input) + (_.? (..small_shift? shift) + (let [high (|> input (_.its ..i64_high_field) (_.logic_right_shift shift)) + low (|> input (_.its ..i64_low_field) (_.logic_right_shift shift) + (_.bit_or (|> input (_.its ..i64_high_field) (_.left_shift (_.- shift (_.i32 +32))))))] + (..i64 high low))) + (_.? (|> shift (_.= (_.i32 +32))) + (..i64 (_.i32 +0) (|> input (_.its ..i64_high_field)))) + (..i64 (_.i32 +0) + (|> input (_.its ..i64_high_field) (_.logic_right_shift (_.- (_.i32 +32) shift)))))))) + +(.the runtime//bit Statement (all _.then @i64::and @@ -411,292 +400,272 @@ @i64::right_shifted )) -(runtime - i64::2^16 - (_.left_shift (_.i32 +16) (_.i32 +1))) - -(runtime - i64::2^32 - (_.* i64::2^16 i64::2^16)) - -(runtime - i64::2^64 - (_.* i64::2^32 i64::2^32)) - -(runtime - i64::2^63 - (|> i64::2^64 (_./ (_.i32 +2)))) - -(runtime - (i64::unsigned_low i64) - (_.return (_.? (|> i64 (_.its ..i64_low_field) (_.>= (_.i32 +0))) - (|> i64 (_.its ..i64_low_field)) - (|> i64 (_.its ..i64_low_field) (_.+ i64::2^32))))) - -(runtime - (i64::number i64) - (_.return (|> i64 - (_.its ..i64_high_field) - (_.* i64::2^32) - (_.+ (i64::unsigned_low i64))))) - -(runtime - i64::zero - (..i64 (_.i32 +0) (_.i32 +0))) - -(runtime - i64::min - (..i64 (_.i32 (.integer (hex "80,00,00,00"))) - (_.i32 +0))) - -(runtime - i64::max - (..i64 (_.i32 (.integer (hex "7F,FF,FF,FF"))) - (_.i32 (.integer (hex "FF,FF,FF,FF"))))) - -(runtime - i64::one - (..i64 (_.i32 +0) (_.i32 +1))) - -(runtime - (i64::= expected actual) - (_.return (_.and (_.= (_.its ..i64_high_field expected) - (_.its ..i64_high_field actual)) - (_.= (_.its ..i64_low_field expected) - (_.its ..i64_low_field actual))))) - -(runtime - (i64::+ parameter subject) - (let [up_16 (_.left_shift (_.i32 +16)) - high_16 (_.logic_right_shift (_.i32 +16)) - low_16 (_.bit_and (_.i32 (.integer (hex "FFFF")))) - hh (|>> (_.its ..i64_high_field) high_16) - hl (|>> (_.its ..i64_high_field) low_16) - lh (|>> (_.its ..i64_low_field) high_16) - ll (|>> (_.its ..i64_low_field) low_16)] - (with_vars [l48 l32 l16 l00 - r48 r32 r16 r00 - x48 x32 x16 x00] - (all _.then - (_.define l48 (hh subject)) - (_.define l32 (hl subject)) - (_.define l16 (lh subject)) - (_.define l00 (ll subject)) - - (_.define r48 (hh parameter)) - (_.define r32 (hl parameter)) - (_.define r16 (lh parameter)) - (_.define r00 (ll parameter)) - - (_.define x00 (_.+ l00 r00)) - - (_.define x16 (|> (high_16 x00) - (_.+ l16) - (_.+ r16))) - (_.; (_.set x00 (low_16 x00))) - - (_.define x32 (|> (high_16 x16) - (_.+ l32) - (_.+ r32))) - (_.; (_.set x16 (low_16 x16))) - - (_.define x48 (|> (high_16 x32) - (_.+ l48) - (_.+ r48) - low_16)) - (_.; (_.set x32 (low_16 x32))) - - (_.return (..i64 (_.bit_or (up_16 x48) x32) - (_.bit_or (up_16 x16) x00))) - )))) - -(runtime - (i64::opposite value) - (_.return (_.? (i64::= i64::min value) - i64::min - (i64::+ i64::one (i64::not value))))) - -(runtime - i64::-one - (i64::opposite i64::one)) - -(runtime - (i64::of_number value) - (_.return (<| (_.? (_.not_a_number? value) - i64::zero) - (_.? (_.<= (_.opposite i64::2^63) value) - i64::min) - (_.? (|> value (_.+ (_.i32 +1)) (_.>= i64::2^63)) - i64::max) - (_.? (|> value (_.< (_.i32 +0))) - (|> value _.opposite i64::of_number i64::opposite)) - (..i64 (|> value (_./ i64::2^32) _.to_i32) - (|> value (_.% i64::2^32) _.to_i32))))) - -(runtime - (i64::- parameter subject) - (_.return (i64::+ (i64::opposite parameter) subject))) - -(runtime - (i64::* parameter subject) - (let [up_16 (_.left_shift (_.i32 +16)) - high_16 (_.logic_right_shift (_.i32 +16)) - low_16 (_.bit_and (_.i32 (.integer (hex "FFFF")))) - hh (|>> (_.its ..i64_high_field) high_16) - hl (|>> (_.its ..i64_high_field) low_16) - lh (|>> (_.its ..i64_low_field) high_16) - ll (|>> (_.its ..i64_low_field) low_16)] - (with_vars [l48 l32 l16 l00 - r48 r32 r16 r00 - x48 x32 x16 x00] - (all _.then - (_.define l48 (hh subject)) - (_.define l32 (hl subject)) - (_.define l16 (lh subject)) - (_.define l00 (ll subject)) - - (_.define r48 (hh parameter)) - (_.define r32 (hl parameter)) - (_.define r16 (lh parameter)) - (_.define r00 (ll parameter)) - - (_.define x00 (_.* l00 r00)) - (_.define x16 (|> (high_16 x00) - (_.+ (_.* l16 r00)))) - (_.; (_.set x00 (low_16 x00))) - - (_.define x32 (high_16 x16)) - (_.; (_.set x16 (|> x16 low_16 (_.+ (_.* l00 r16))))) - (_.; (_.set x32 (|> x32 (_.+ (high_16 x16))))) - (_.; (_.set x16 (low_16 x16))) - - (_.; (_.set x32 (|> x32 (_.+ (_.* l32 r00))))) - (_.define x48 (high_16 x32)) - (_.; (_.set x32 (|> x32 low_16 (_.+ (_.* l16 r16))))) - (_.; (_.set x48 (|> x48 (_.+ (high_16 x32))))) - (_.; (_.set x32 (|> x32 low_16 (_.+ (_.* l00 r32))))) - (_.; (_.set x48 (|> x48 (_.+ (high_16 x32))))) - (_.; (_.set x32 (low_16 x32))) - - (_.; (_.set x48 (|> x48 - (_.+ (_.* l48 r00)) - (_.+ (_.* l32 r16)) - (_.+ (_.* l16 r32)) - (_.+ (_.* l00 r48)) - low_16))) - - (_.return (..i64 (_.bit_or (up_16 x48) x32) - (_.bit_or (up_16 x16) x00))) - )))) - -(runtime - (i64::< parameter subject) - (let [negative? (|>> (_.its ..i64_high_field) (_.< (_.i32 +0)))] - (with_vars [-subject? -parameter?] - (all _.then - (_.define -subject? (negative? subject)) - (_.define -parameter? (negative? parameter)) - (_.return (<| (_.? (_.and -subject? (_.not -parameter?)) - (_.boolean true)) - (_.? (_.and (_.not -subject?) -parameter?) - (_.boolean false)) - (negative? (i64::- parameter subject)))) - )))) - -(the (i64::<= param subject) +(the i64::2^16 + (_.left_shift (_.i32 +16) (_.i32 +1))) + +(the i64::2^32 + (_.* i64::2^16 i64::2^16)) + +(the i64::2^64 + (_.* i64::2^32 i64::2^32)) + +(the i64::2^63 + (|> i64::2^64 (_./ (_.i32 +2)))) + +(the (i64::unsigned_low i64) + (_.return (_.? (|> i64 (_.its ..i64_low_field) (_.>= (_.i32 +0))) + (|> i64 (_.its ..i64_low_field)) + (|> i64 (_.its ..i64_low_field) (_.+ i64::2^32))))) + +(the (i64::number i64) + (_.return (|> i64 + (_.its ..i64_high_field) + (_.* i64::2^32) + (_.+ (i64::unsigned_low i64))))) + +(the i64::zero + (..i64 (_.i32 +0) (_.i32 +0))) + +(the i64::min + (..i64 (_.i32 (.integer (hex "80,00,00,00"))) + (_.i32 +0))) + +(the i64::max + (..i64 (_.i32 (.integer (hex "7F,FF,FF,FF"))) + (_.i32 (.integer (hex "FF,FF,FF,FF"))))) + +(the i64::one + (..i64 (_.i32 +0) (_.i32 +1))) + +(the (i64::= expected actual) + (_.return (_.and (_.= (_.its ..i64_high_field expected) + (_.its ..i64_high_field actual)) + (_.= (_.its ..i64_low_field expected) + (_.its ..i64_low_field actual))))) + +(the (i64::+ parameter subject) + (let [up_16 (_.left_shift (_.i32 +16)) + high_16 (_.logic_right_shift (_.i32 +16)) + low_16 (_.bit_and (_.i32 (.integer (hex "FFFF")))) + hh (|>> (_.its ..i64_high_field) high_16) + hl (|>> (_.its ..i64_high_field) low_16) + lh (|>> (_.its ..i64_low_field) high_16) + ll (|>> (_.its ..i64_low_field) low_16)] + (with_vars [l48 l32 l16 l00 + r48 r32 r16 r00 + x48 x32 x16 x00] + (all _.then + (_.define l48 (hh subject)) + (_.define l32 (hl subject)) + (_.define l16 (lh subject)) + (_.define l00 (ll subject)) + + (_.define r48 (hh parameter)) + (_.define r32 (hl parameter)) + (_.define r16 (lh parameter)) + (_.define r00 (ll parameter)) + + (_.define x00 (_.+ l00 r00)) + + (_.define x16 (|> (high_16 x00) + (_.+ l16) + (_.+ r16))) + (_.; (_.set x00 (low_16 x00))) + + (_.define x32 (|> (high_16 x16) + (_.+ l32) + (_.+ r32))) + (_.; (_.set x16 (low_16 x16))) + + (_.define x48 (|> (high_16 x32) + (_.+ l48) + (_.+ r48) + low_16)) + (_.; (_.set x32 (low_16 x32))) + + (_.return (..i64 (_.bit_or (up_16 x48) x32) + (_.bit_or (up_16 x16) x00))) + )))) + +(the (i64::opposite value) + (_.return (_.? (i64::= i64::min value) + i64::min + (i64::+ i64::one (i64::not value))))) + +(the i64::-one + (i64::opposite i64::one)) + +(the (i64::of_number value) + (_.return (<| (_.? (_.not_a_number? value) + i64::zero) + (_.? (_.<= (_.opposite i64::2^63) value) + i64::min) + (_.? (|> value (_.+ (_.i32 +1)) (_.>= i64::2^63)) + i64::max) + (_.? (|> value (_.< (_.i32 +0))) + (|> value _.opposite i64::of_number i64::opposite)) + (..i64 (|> value (_./ i64::2^32) _.to_i32) + (|> value (_.% i64::2^32) _.to_i32))))) + +(the (i64::- parameter subject) + (_.return (i64::+ (i64::opposite parameter) subject))) + +(the (i64::* parameter subject) + (let [up_16 (_.left_shift (_.i32 +16)) + high_16 (_.logic_right_shift (_.i32 +16)) + low_16 (_.bit_and (_.i32 (.integer (hex "FFFF")))) + hh (|>> (_.its ..i64_high_field) high_16) + hl (|>> (_.its ..i64_high_field) low_16) + lh (|>> (_.its ..i64_low_field) high_16) + ll (|>> (_.its ..i64_low_field) low_16)] + (with_vars [l48 l32 l16 l00 + r48 r32 r16 r00 + x48 x32 x16 x00] + (all _.then + (_.define l48 (hh subject)) + (_.define l32 (hl subject)) + (_.define l16 (lh subject)) + (_.define l00 (ll subject)) + + (_.define r48 (hh parameter)) + (_.define r32 (hl parameter)) + (_.define r16 (lh parameter)) + (_.define r00 (ll parameter)) + + (_.define x00 (_.* l00 r00)) + (_.define x16 (|> (high_16 x00) + (_.+ (_.* l16 r00)))) + (_.; (_.set x00 (low_16 x00))) + + (_.define x32 (high_16 x16)) + (_.; (_.set x16 (|> x16 low_16 (_.+ (_.* l00 r16))))) + (_.; (_.set x32 (|> x32 (_.+ (high_16 x16))))) + (_.; (_.set x16 (low_16 x16))) + + (_.; (_.set x32 (|> x32 (_.+ (_.* l32 r00))))) + (_.define x48 (high_16 x32)) + (_.; (_.set x32 (|> x32 low_16 (_.+ (_.* l16 r16))))) + (_.; (_.set x48 (|> x48 (_.+ (high_16 x32))))) + (_.; (_.set x32 (|> x32 low_16 (_.+ (_.* l00 r32))))) + (_.; (_.set x48 (|> x48 (_.+ (high_16 x32))))) + (_.; (_.set x32 (low_16 x32))) + + (_.; (_.set x48 (|> x48 + (_.+ (_.* l48 r00)) + (_.+ (_.* l32 r16)) + (_.+ (_.* l16 r32)) + (_.+ (_.* l00 r48)) + low_16))) + + (_.return (..i64 (_.bit_or (up_16 x48) x32) + (_.bit_or (up_16 x16) x00))) + )))) + +(the (i64::< parameter subject) + (let [negative? (|>> (_.its ..i64_high_field) (_.< (_.i32 +0)))] + (with_vars [-subject? -parameter?] + (all _.then + (_.define -subject? (negative? subject)) + (_.define -parameter? (negative? parameter)) + (_.return (<| (_.? (_.and -subject? (_.not -parameter?)) + (_.boolean true)) + (_.? (_.and (_.not -subject?) -parameter?) + (_.boolean false)) + (negative? (i64::- parameter subject)))) + )))) + +(.the (i64::<= param subject) (-> Expression Expression Expression) (|> (i64::< param subject) (_.or (i64::= param subject)))) -(the negative? +(.the negative? (i64::< i64::zero)) -(runtime - (i64::/ parameter subject) - (<| (_.if (i64::= i64::zero parameter) - (_.throw (_.string "Cannot divide by zero!"))) - (_.if (i64::= i64::zero subject) - (_.return i64::zero)) - (_.if (i64::= i64::min subject) - (<| (_.if (_.or (i64::= i64::one parameter) - (i64::= i64::-one parameter)) - (_.return i64::min)) - (_.if (i64::= i64::min parameter) - (_.return i64::one)) - (with_vars [approximation] - (let [subject/2 (..i64::arithmetic_right_shifted subject (_.i32 +1))] - (all _.then - (_.define approximation (i64::left_shifted (i64::/ parameter - subject/2) - (_.i32 +1))) - (_.if (i64::= i64::zero approximation) - (_.return (_.? (..negative? parameter) - i64::one - i64::-one)) - (let [remainder (i64::- (i64::* approximation - parameter) - subject)] - (_.return (i64::+ (i64::/ parameter - remainder) - approximation))))))))) - (_.if (i64::= i64::min parameter) - (_.return i64::zero)) - (_.if (..negative? subject) - (_.return (_.? (..negative? parameter) - (i64::/ (i64::opposite parameter) - (i64::opposite subject)) - (i64::opposite (i64::/ parameter - (i64::opposite subject)))))) - (_.if (..negative? parameter) - (_.return (i64::opposite (i64::/ (i64::opposite parameter) subject)))) - (with_vars [result remainder] - (all _.then - (_.define result i64::zero) - (_.define remainder subject) - (_.while (i64::<= remainder parameter) - (with_vars [approximate approximate_result approximate_remainder log2 delta] - (let [approximate_result' (i64::of_number approximate) - approx_remainder (i64::* parameter approximate_result)] - (all _.then - (_.define approximate (|> (i64::number remainder) - (_./ (i64::number parameter)) - (_.apply_1 (_.var "Math.floor")) - (_.apply_2 (_.var "Math.max") (_.i32 +1)))) - (_.define log2 (|> approximate - (_.apply_1 (_.var "Math.log")) - (_./ (_.var "Math.LN2")) - (_.apply_1 (_.var "Math.ceil")))) - (_.define delta (_.? (_.> (_.i32 +48) log2) - (_.apply_2 (_.var "Math.pow") - (_.i32 +2) - (_.- (_.i32 +48) - log2)) - (_.i32 +1))) - (_.define approximate_result approximate_result') - (_.define approximate_remainder approx_remainder) - (_.while (_.or (..negative? approximate_remainder) - (i64::< approximate_remainder - remainder)) - (all _.then - (_.; (_.set approximate (_.- delta approximate))) - (_.; (_.set approximate_result approximate_result')) - (_.; (_.set approximate_remainder approx_remainder)))) - (_.; (_.set result (i64::+ (_.? (i64::= i64::zero approximate_result) - i64::one - approximate_result) - result))) - (_.; (_.set remainder (i64::- approximate_remainder remainder))))))) - (_.return result))))) - -(runtime - (i64::% parameter subject) - (let [flat (|> subject - (i64::/ parameter) - (i64::* parameter))] - (_.return (i64::- flat subject)))) - -(the runtime//i64 +(the (i64::/ parameter subject) + (<| (_.if (i64::= i64::zero parameter) + (_.throw (_.string "Cannot divide by zero!"))) + (_.if (i64::= i64::zero subject) + (_.return i64::zero)) + (_.if (i64::= i64::min subject) + (<| (_.if (_.or (i64::= i64::one parameter) + (i64::= i64::-one parameter)) + (_.return i64::min)) + (_.if (i64::= i64::min parameter) + (_.return i64::one)) + (with_vars [approximation] + (let [subject/2 (..i64::arithmetic_right_shifted subject (_.i32 +1))] + (all _.then + (_.define approximation (i64::left_shifted (i64::/ parameter + subject/2) + (_.i32 +1))) + (_.if (i64::= i64::zero approximation) + (_.return (_.? (..negative? parameter) + i64::one + i64::-one)) + (let [remainder (i64::- (i64::* approximation + parameter) + subject)] + (_.return (i64::+ (i64::/ parameter + remainder) + approximation))))))))) + (_.if (i64::= i64::min parameter) + (_.return i64::zero)) + (_.if (..negative? subject) + (_.return (_.? (..negative? parameter) + (i64::/ (i64::opposite parameter) + (i64::opposite subject)) + (i64::opposite (i64::/ parameter + (i64::opposite subject)))))) + (_.if (..negative? parameter) + (_.return (i64::opposite (i64::/ (i64::opposite parameter) subject)))) + (with_vars [result remainder] + (all _.then + (_.define result i64::zero) + (_.define remainder subject) + (_.while (i64::<= remainder parameter) + (with_vars [approximate approximate_result approximate_remainder log2 delta] + (let [approximate_result' (i64::of_number approximate) + approx_remainder (i64::* parameter approximate_result)] + (all _.then + (_.define approximate (|> (i64::number remainder) + (_./ (i64::number parameter)) + (_.apply_1 (_.var "Math.floor")) + (_.apply_2 (_.var "Math.max") (_.i32 +1)))) + (_.define log2 (|> approximate + (_.apply_1 (_.var "Math.log")) + (_./ (_.var "Math.LN2")) + (_.apply_1 (_.var "Math.ceil")))) + (_.define delta (_.? (_.> (_.i32 +48) log2) + (_.apply_2 (_.var "Math.pow") + (_.i32 +2) + (_.- (_.i32 +48) + log2)) + (_.i32 +1))) + (_.define approximate_result approximate_result') + (_.define approximate_remainder approx_remainder) + (_.while (_.or (..negative? approximate_remainder) + (i64::< approximate_remainder + remainder)) + (all _.then + (_.; (_.set approximate (_.- delta approximate))) + (_.; (_.set approximate_result approximate_result')) + (_.; (_.set approximate_remainder approx_remainder)))) + (_.; (_.set result (i64::+ (_.? (i64::= i64::zero approximate_result) + i64::one + approximate_result) + result))) + (_.; (_.set remainder (i64::- approximate_remainder remainder))))))) + (_.return result))))) + +(the (i64::% parameter subject) + (let [flat (|> subject + (i64::/ parameter) + (i64::* parameter))] + (_.return (i64::- flat subject)))) + +(.the runtime//i64 Statement (all _.then ..runtime//bit @@ -724,31 +693,28 @@ @i64::% )) -(runtime - (text//index start part text) - (with_vars [idx] - (all _.then - (_.define idx (|> text (_.do "indexOf" (list part (i64::number start))))) - (_.return (_.? (_.= (_.i32 -1) idx) - ..none - (..some (i64::of_number idx))))))) - -(runtime - (text//clip offset length text) - (_.return (|> text (_.do "substring" (list (_.its ..i64_low_field offset) - (_.+ (_.its ..i64_low_field offset) - (_.its ..i64_low_field length))))))) - -(runtime - (text//char idx text) - (with_vars [result] - (all _.then - (_.define result (|> text (_.do "charCodeAt" (list (_.its ..i64_low_field idx))))) - (_.if (_.not_a_number? result) - (_.throw (_.string "[Lux Error] Cannot get char from text.")) - (_.return (i64::of_number result)))))) - -(the runtime//text +(the (text//index start part text) + (with_vars [idx] + (all _.then + (_.define idx (|> text (_.do "indexOf" (list part (i64::number start))))) + (_.return (_.? (_.= (_.i32 -1) idx) + ..none + (..some (i64::of_number idx))))))) + +(the (text//clip offset length text) + (_.return (|> text (_.do "substring" (list (_.its ..i64_low_field offset) + (_.+ (_.its ..i64_low_field offset) + (_.its ..i64_low_field length))))))) + +(the (text//char idx text) + (with_vars [result] + (all _.then + (_.define result (|> text (_.do "charCodeAt" (list (_.its ..i64_low_field idx))))) + (_.if (_.not_a_number? result) + (_.throw (_.string "[Lux Error] Cannot get char from text.")) + (_.return (i64::of_number result)))))) + +(.the runtime//text Statement (all _.then @text//index @@ -756,59 +722,54 @@ @text//char )) -(runtime - (io//log message) - (let [console (_.var "console") - print (_.var "print") - end! (_.return ..unit) - - has_console? (|> console _.type_of (_.= (_.string "undefined")) _.not) - node_or_browser? (|> has_console? - (_.and (_.its "log" console))) - nashorn? (|> print _.type_of (_.= (_.string "undefined")) _.not)] - (<| (_.if node_or_browser? - (all _.then - (_.; (|> console (_.do "log" (list message)))) - end!)) - (_.if nashorn? - (all _.then - (_.; (_.apply_1 print message)) - end!)) - end!))) - -(runtime - (io//error message) - (_.throw (_.new (_.var "Error") (list message)))) - -(the runtime//io +(the (io//log message) + (let [console (_.var "console") + print (_.var "print") + end! (_.return ..unit) + + has_console? (|> console _.type_of (_.= (_.string "undefined")) _.not) + node_or_browser? (|> has_console? + (_.and (_.its "log" console))) + nashorn? (|> print _.type_of (_.= (_.string "undefined")) _.not)] + (<| (_.if node_or_browser? + (all _.then + (_.; (|> console (_.do "log" (list message)))) + end!)) + (_.if nashorn? + (all _.then + (_.; (_.apply_1 print message)) + end!)) + end!))) + +(the (io//error message) + (_.throw (_.new (_.var "Error") (list message)))) + +(.the runtime//io Statement (all _.then @io//log @io//error )) -(runtime - (js//get object field) - (with_vars [temp] - (all _.then - (_.define temp (_.at field object)) - (_.return (_.? (_.= _.undefined temp) - ..none - (..some temp)))))) - -(runtime - (js//set object field input) - (all _.then - (_.; (_.set (_.at field object) input)) - (_.return object))) - -(runtime - (js//delete object field) - (all _.then - (_.; (_.delete (_.at field object))) - (_.return object))) - -(the runtime//js +(the (js//get object field) + (with_vars [temp] + (all _.then + (_.define temp (_.at field object)) + (_.return (_.? (_.= _.undefined temp) + ..none + (..some temp)))))) + +(the (js//set object field input) + (all _.then + (_.; (_.set (_.at field object) input)) + (_.return object))) + +(the (js//delete object field) + (all _.then + (_.; (_.delete (_.at field object))) + (_.return object))) + +(.the runtime//js Statement (all _.then @js//get @@ -816,24 +777,21 @@ @js//delete )) -(runtime - (array//write idx value array) - (all _.then - (_.; (_.set (_.at (_.its ..i64_low_field idx) array) value)) - (_.return array))) +(the (array//write idx value array) + (all _.then + (_.; (_.set (_.at (_.its ..i64_low_field idx) array) value)) + (_.return array))) -(runtime - (array//delete idx array) - (all _.then - (_.; (_.delete (_.at (_.its ..i64_low_field idx) array))) - (_.return array))) +(the (array//delete idx array) + (all _.then + (_.; (_.delete (_.at (_.its ..i64_low_field idx) array))) + (_.return array))) -(runtime - array#slice - (|> (_.array (list)) - (_.its "slice"))) +(the array#slice + (|> (_.array (list)) + (_.its "slice"))) -(the runtime//array +(.the runtime//array Statement (all _.then @array#slice @@ -841,7 +799,7 @@ @array//delete )) -(the full +(.the full Statement (all _.then runtime//structure @@ -853,10 +811,10 @@ runtime//lux )) -(the module_id +(.the module_id 0) -(the .public translate +(.the .public translate (Operation [Registry Output]) (do phase.monad [_ (translation.execute! ..full) diff --git a/stdlib/source/library/lux/meta/compiler/language/lux/phase/translation/lua/runtime.lux b/stdlib/source/library/lux/meta/compiler/language/lux/phase/translation/lua/runtime.lux index 059604847f..1ab06b9e32 100644 --- a/stdlib/source/library/lux/meta/compiler/language/lux/phase/translation/lua/runtime.lux +++ b/stdlib/source/library/lux/meta/compiler/language/lux/phase/translation/lua/runtime.lux @@ -4,7 +4,8 @@ (.using [library [lux (.except Label Location Declaration - variant) + variant + the) [abstract ["[0]" monad (.only do)]] [control @@ -78,59 +79,59 @@ (-> Phase! Phase Archive of (Operation Statement))) -(the .public unit +(.the .public unit (_.string synthesis.unit)) -(the (flag value) +(.the (flag value) (-> Bit Literal) (if value ..unit _.nil)) -(the .public variant_tag_field script.variant_lefts) -(the .public variant_flag_field script.variant_right?) -(the .public variant_value_field script.variant_choice) +(.the .public variant_tag_field script.variant_lefts) +(.the .public variant_flag_field script.variant_right?) +(.the .public variant_value_field script.variant_choice) -(the (variant' tag last? value) +(.the (variant' tag last? value) (-> Expression Expression Expression Literal) (_.table (list [..variant_tag_field tag] [..variant_flag_field last?] [..variant_value_field value]))) -(the .public (variant tag last? value) +(.the .public (variant tag last? value) (-> Natural Bit Expression Literal) (variant' (_.int (.integer tag)) (flag last?) value)) -(the .public left +(.the .public left (-> Expression Literal) (..variant 0 #0)) -(the .public right +(.the .public right (-> Expression Literal) (..variant 0 #1)) -(the .public none +(.the .public none Literal (..left ..unit)) -(the .public some +(.the .public some (-> Expression Literal) ..right) -(the (feature name definition) +(.the (feature name definition) (-> Var (-> Var Statement) Statement) (definition name)) -(the .public with_vars +(.the .public with_vars (syntax.macro (_ [vars (.tuple (<>.some .local)) body .any]) (do [! meta.monad] @@ -143,10 +144,10 @@ list.together))] (, body)))))))) -(the module_id +(.the module_id 0) -(the runtime +(.the the (syntax.macro (_ [declaration (<>.or .local (.form (<>.and .local (<>.some .local)))) @@ -160,11 +161,11 @@ {.#Left name} (macro.with_symbols [g!_] (let [g!name (code.local name)] - (in (list (` (the .public (, g!name) + (in (list (` (.the .public (, g!name) Var (, runtime_name))) - (` (the (, (code.local (%.message "@" name))) + (` (.the (, (code.local (%.message "@" name))) Statement (..feature (, runtime_name) (function ((, g!_) (, g!name)) @@ -176,12 +177,12 @@ inputsC (list#each code.local inputs) inputs_typesC (list#each (function.constant (` _.Expression)) inputs)] - (in (list (` (the .public ((, g!name) (,* inputsC)) + (in (list (` (.the .public ((, g!name) (,* inputsC)) (-> (,* inputs_typesC) Computation) (_.apply (list (,* inputsC)) (, runtime_name)))) - (` (the (, (code.local (%.message "@" name))) + (` (.the (, (code.local (%.message "@" name))) Statement (..feature (, runtime_name) (function ((, g!_) (, g!_)) @@ -189,78 +190,75 @@ (_.function (, g!_) (list (,* inputsC)) (, code))))))))))))))))) -(the (item index table) +(.the (item index table) (-> Expression Expression Location) (_.item (_.+ (_.int +1) index) table)) -(the last_index +(.the last_index (|>> _.length (_.- (_.int +1)))) (expansion.let [ (these (all _.then (_.set (list lefts) (_.- last_index_right lefts)) (_.set (list tuple) (..item last_index_right tuple))))] - (these (runtime - (tuple//left lefts tuple) - (with_vars [last_index_right] - (<| (_.while (_.boolean true)) - (all _.then - (_.local/1 last_index_right (..last_index tuple)) - (_.if (_.> lefts last_index_right) - ... No need for recursion - (_.return (..item lefts tuple)) - ... Needs recursion - ))))) - - (runtime - (tuple//right lefts tuple) - (with_vars [last_index_right right_index] - (<| (_.while (_.boolean true)) - (all _.then - (_.local/1 last_index_right (..last_index tuple)) - (_.local/1 right_index (_.+ (_.int +1) lefts)) - (<| (_.if (_.= last_index_right right_index) - (_.return (..item right_index tuple))) - (_.if (_.> last_index_right right_index) - ... Needs recursion. - ) - (_.return (_.apply (list tuple - (_.+ (_.int +1) right_index) - (_.length tuple) - (_.int +1) - (_.array (list))) - (_.var "table.move")))) - )))))) - -(runtime - (sum//get sum expected::right? expected::lefts) - (let [mismatch! (_.return _.nil) - actual::lefts (_.its ..variant_tag_field sum) - actual::right? (_.its ..variant_flag_field sum) - actual::value (_.its ..variant_value_field sum) - recur! (all _.then - (_.set (list expected::lefts) (|> expected::lefts - (_.- actual::lefts) - (_.- (_.int +1)))) - (_.set (list sum) actual::value))] - (<| (_.while (_.boolean true)) - (_.if (_.= expected::lefts actual::lefts) - (_.if (_.= expected::right? actual::right?) - (_.return actual::value) - mismatch!)) - (_.if (_.< expected::lefts actual::lefts) - (_.if (_.= ..unit actual::right?) - recur! - mismatch!)) - (_.if (_.= ..unit expected::right?) - (_.return (variant' (|> actual::lefts - (_.- expected::lefts) - (_.- (_.int +1))) - actual::right? - actual::value))) - mismatch!))) - -(the runtime//adt + (these (the (tuple//left lefts tuple) + (with_vars [last_index_right] + (<| (_.while (_.boolean true)) + (all _.then + (_.local/1 last_index_right (..last_index tuple)) + (_.if (_.> lefts last_index_right) + ... No need for recursion + (_.return (..item lefts tuple)) + ... Needs recursion + ))))) + + (the (tuple//right lefts tuple) + (with_vars [last_index_right right_index] + (<| (_.while (_.boolean true)) + (all _.then + (_.local/1 last_index_right (..last_index tuple)) + (_.local/1 right_index (_.+ (_.int +1) lefts)) + (<| (_.if (_.= last_index_right right_index) + (_.return (..item right_index tuple))) + (_.if (_.> last_index_right right_index) + ... Needs recursion. + ) + (_.return (_.apply (list tuple + (_.+ (_.int +1) right_index) + (_.length tuple) + (_.int +1) + (_.array (list))) + (_.var "table.move")))) + )))))) + +(the (sum//get sum expected::right? expected::lefts) + (let [mismatch! (_.return _.nil) + actual::lefts (_.its ..variant_tag_field sum) + actual::right? (_.its ..variant_flag_field sum) + actual::value (_.its ..variant_value_field sum) + recur! (all _.then + (_.set (list expected::lefts) (|> expected::lefts + (_.- actual::lefts) + (_.- (_.int +1)))) + (_.set (list sum) actual::value))] + (<| (_.while (_.boolean true)) + (_.if (_.= expected::lefts actual::lefts) + (_.if (_.= expected::right? actual::right?) + (_.return actual::value) + mismatch!)) + (_.if (_.< expected::lefts actual::lefts) + (_.if (_.= ..unit actual::right?) + recur! + mismatch!)) + (_.if (_.= ..unit expected::right?) + (_.return (variant' (|> actual::lefts + (_.- expected::lefts) + (_.- (_.int +1))) + actual::right? + actual::value))) + mismatch!))) + +(.the runtime//adt Statement (all _.then @tuple//left @@ -268,85 +266,79 @@ @sum//get )) -(runtime - (lux//try risky) - (let [closure (|> risky - (_.apply (list ..unit)) - _.return - (_.closure (list))) - $debug (_.var "debug") - $xpcall (_.var "xpcall")] - (with_vars [success value] - (_.if (_.and $debug $xpcall) - (all _.then - (_.let (list success value) (_.apply (list closure (_.its "traceback" $debug)) - $xpcall)) - (_.if success - (_.return (..right value)) - (_.return (..left value)))) - (all _.then - (_.let (list success value) (_.apply (list closure) - (_.var "pcall"))) - (_.if success - (_.return (..right value)) - (_.return (..left value)))))))) - -(runtime - (lux//program_args raw) - (with_vars [tail head idx] - (all _.then - (_.let (list tail) ..none) - (<| (_.for_step idx (_.length raw) (_.int +1) (_.int -1)) - (_.set (list tail) (..some (_.array (list (_.item idx raw) - tail))))) - (_.return tail)))) - -(the runtime//lux +(the (lux//try risky) + (let [closure (|> risky + (_.apply (list ..unit)) + _.return + (_.closure (list))) + $debug (_.var "debug") + $xpcall (_.var "xpcall")] + (with_vars [success value] + (_.if (_.and $debug $xpcall) + (all _.then + (_.let (list success value) (_.apply (list closure (_.its "traceback" $debug)) + $xpcall)) + (_.if success + (_.return (..right value)) + (_.return (..left value)))) + (all _.then + (_.let (list success value) (_.apply (list closure) + (_.var "pcall"))) + (_.if success + (_.return (..right value)) + (_.return (..left value)))))))) + +(the (lux//program_args raw) + (with_vars [tail head idx] + (all _.then + (_.let (list tail) ..none) + (<| (_.for_step idx (_.length raw) (_.int +1) (_.int -1)) + (_.set (list tail) (..some (_.array (list (_.item idx raw) + tail))))) + (_.return tail)))) + +(.the runtime//lux Statement (all _.then @lux//try @lux//program_args )) -(the cap_shift +(.the cap_shift (_.% (_.int +64))) -(runtime - (i64//left_shifted param subject) - (_.return (_.bit_shl (..cap_shift param) subject))) - -(runtime - (i64//right_shifted param subject) - (let [mask (|> (_.int +1) - (_.bit_shl (_.- param (_.int +64))) - (_.- (_.int +1)))] - (all _.then - (_.set (list param) (..cap_shift param)) - (_.return (|> subject - (_.bit_shr param) - (_.bit_and mask)))))) - -(runtime - (i64//division param subject) - (with_vars [floored] - (all _.then - (_.local/1 floored (_.// param subject)) - (let [potentially_floored? (_.< (_.int +0) floored) - inexact? (|> subject - (_.% param) - (_.= (_.int +0)) - _.not)] - (_.if (_.and potentially_floored? - inexact?) - (_.return (_.+ (_.int +1) floored)) - (_.return floored)))))) - -(runtime - (i64//remainder param subject) - (_.return (_.- (|> subject (..i64//division param) (_.* param)) - subject))) - -(the runtime//i64 +(the (i64//left_shifted param subject) + (_.return (_.bit_shl (..cap_shift param) subject))) + +(the (i64//right_shifted param subject) + (let [mask (|> (_.int +1) + (_.bit_shl (_.- param (_.int +64))) + (_.- (_.int +1)))] + (all _.then + (_.set (list param) (..cap_shift param)) + (_.return (|> subject + (_.bit_shr param) + (_.bit_and mask)))))) + +(the (i64//division param subject) + (with_vars [floored] + (all _.then + (_.local/1 floored (_.// param subject)) + (let [potentially_floored? (_.< (_.int +0) floored) + inexact? (|> subject + (_.% param) + (_.= (_.int +0)) + _.not)] + (_.if (_.and potentially_floored? + inexact?) + (_.return (_.+ (_.int +1) floored)) + (_.return floored)))))) + +(the (i64//remainder param subject) + (_.return (_.- (|> subject (..i64//division param) (_.* param)) + subject))) + +(.the runtime//i64 Statement (all _.then @i64//left_shifted @@ -355,103 +347,99 @@ @i64//remainder )) -(the (find_byte_index subject param start) +(.the (find_byte_index subject param start) (-> Expression Expression Expression Expression) (_.apply (list subject param start (_.boolean #1)) (_.var "string.find"))) -(the (char_index subject byte_index) +(.the (char_index subject byte_index) (-> Expression Expression Expression) (_.apply (list subject (_.int +1) byte_index) (_.var "utf8.len"))) -(the (byte_index subject char_index) +(.the (byte_index subject char_index) (-> Expression Expression Expression) (_.apply (list subject (_.+ (_.int +1) char_index)) (_.var "utf8.offset"))) -(the lux_index +(.the lux_index (-> Expression Expression) (_.- (_.int +1))) ... TODO: Remove this once the Lua compiler becomes self-hosted. -(the on_rembulan? +(.the on_rembulan? (_.= (_.string "Lua 5.3") (_.var "_VERSION"))) -(runtime - (text//index subject param start) - (expansion.let [ (all _.then - (_.local/1 byte_index (|> start - (_.+ (_.int +1)) - (..find_byte_index subject param))) - (_.if (_.= _.nil byte_index) - (_.return ..none) - (_.return (..some (..lux_index byte_index))))) - (all _.then - (_.local/1 byte_index (|> start - (..byte_index subject) - (..find_byte_index subject param))) - (_.if (_.= _.nil byte_index) - (_.return ..none) - (_.return (..some (|> byte_index - (..char_index subject) - ..lux_index)))))] - (with_vars [byte_index] - (for .lua - (_.if ..on_rembulan? - - ))))) - -(runtime - (text//clip text offset length) - (expansion.let [ (_.return (_.apply (list text (_.+ (_.int +1) offset) (_.+ offset length)) - (_.var "string.sub"))) - (_.return (_.apply (list text - (..byte_index text offset) - (|> (_.+ offset length) - ... (_.+ (_.int +1)) - (..byte_index text) - (_.- (_.int +1)))) - (_.var "string.sub")))] - (for .lua - (_.if ..on_rembulan? - - )))) - -(runtime - (text//size subject) - (expansion.let [ (_.return (_.apply (list subject) (_.var "string.len"))) - (_.return (_.apply (list subject) (_.var "utf8.len")))] - (for .lua - (_.if ..on_rembulan? - - )))) - -(runtime - (text//char idx text) - (expansion.let [ (with_vars [char] - (all _.then - (_.local/1 char (_.apply (list text idx) - (_.var "string.byte"))) - (_.if (_.= _.nil char) - (_.; (_.error/1 (_.string "[Lux Error] Cannot get char from text."))) - (_.return char)))) - (with_vars [offset char] - (all _.then - (_.local/1 offset (_.apply (list text idx) (_.var "utf8.offset"))) - (_.if (_.= _.nil offset) - (_.; (_.error/1 (_.string "[Lux Error] Cannot get char from text."))) - (_.return (_.apply (list text offset) (_.var "utf8.codepoint"))))))] - (for .lua - (_.if ..on_rembulan? - - )))) - -(the runtime//text +(the (text//index subject param start) + (expansion.let [ (all _.then + (_.local/1 byte_index (|> start + (_.+ (_.int +1)) + (..find_byte_index subject param))) + (_.if (_.= _.nil byte_index) + (_.return ..none) + (_.return (..some (..lux_index byte_index))))) + (all _.then + (_.local/1 byte_index (|> start + (..byte_index subject) + (..find_byte_index subject param))) + (_.if (_.= _.nil byte_index) + (_.return ..none) + (_.return (..some (|> byte_index + (..char_index subject) + ..lux_index)))))] + (with_vars [byte_index] + (for .lua + (_.if ..on_rembulan? + + ))))) + +(the (text//clip text offset length) + (expansion.let [ (_.return (_.apply (list text (_.+ (_.int +1) offset) (_.+ offset length)) + (_.var "string.sub"))) + (_.return (_.apply (list text + (..byte_index text offset) + (|> (_.+ offset length) + ... (_.+ (_.int +1)) + (..byte_index text) + (_.- (_.int +1)))) + (_.var "string.sub")))] + (for .lua + (_.if ..on_rembulan? + + )))) + +(the (text//size subject) + (expansion.let [ (_.return (_.apply (list subject) (_.var "string.len"))) + (_.return (_.apply (list subject) (_.var "utf8.len")))] + (for .lua + (_.if ..on_rembulan? + + )))) + +(the (text//char idx text) + (expansion.let [ (with_vars [char] + (all _.then + (_.local/1 char (_.apply (list text idx) + (_.var "string.byte"))) + (_.if (_.= _.nil char) + (_.; (_.error/1 (_.string "[Lux Error] Cannot get char from text."))) + (_.return char)))) + (with_vars [offset char] + (all _.then + (_.local/1 offset (_.apply (list text idx) (_.var "utf8.offset"))) + (_.if (_.= _.nil offset) + (_.; (_.error/1 (_.string "[Lux Error] Cannot get char from text."))) + (_.return (_.apply (list text offset) (_.var "utf8.codepoint"))))))] + (for .lua + (_.if ..on_rembulan? + + )))) + +(.the runtime//text Statement (all _.then @text//index @@ -460,19 +448,18 @@ @text//char )) -(runtime - (array//write idx value array) - (all _.then - (_.set (list (..item idx array)) value) - (_.return array))) +(the (array//write idx value array) + (all _.then + (_.set (list (..item idx array)) value) + (_.return array))) -(the runtime//array +(.the runtime//array Statement (all _.then @array//write )) -(the full +(.the full Statement (all _.then ..runtime//adt @@ -482,7 +469,7 @@ ..runtime//array )) -(the .public translate +(.the .public translate (Operation [Registry Output]) (do phase.monad [_ (translation.execute! ..full) diff --git a/stdlib/source/library/lux/meta/compiler/language/lux/phase/translation/php/runtime.lux b/stdlib/source/library/lux/meta/compiler/language/lux/phase/translation/php/runtime.lux index b844098b66..555dd44128 100644 --- a/stdlib/source/library/lux/meta/compiler/language/lux/phase/translation/php/runtime.lux +++ b/stdlib/source/library/lux/meta/compiler/language/lux/phase/translation/php/runtime.lux @@ -3,7 +3,8 @@ (.using [library - [lux (.except Location) + [lux (.except Location + the) [abstract ["[0]" monad (.only do)]] [control @@ -63,20 +64,20 @@ (every .public (Translator! i) (-> Phase! Phase Archive i (Operation Statement))) -(the .public unit +(.the .public unit (_.string /////synthesis.unit)) -(the (flag value) +(.the (flag value) (-> Bit Literal) (if value ..unit _.null)) -(the (feature name definition) +(.the (feature name definition) (-> Constant (-> Constant Statement) Statement) (definition name)) -(the .public with_vars +(.the .public with_vars (syntax.macro (_ [vars (.tuple (<>.some .local)) body .any]) (do [! meta.monad] @@ -89,10 +90,10 @@ list.together))] (, body)))))))) -(the module_id +(.the module_id 0) -(the runtime +(.the the (syntax.macro (_ [declaration (<>.or .local (.form (<>.and .local (<>.some .local)))) @@ -106,11 +107,11 @@ {.#Left name} (macro.with_symbols [g!_] (let [g!name (code.local name)] - (in (list (` (the .public (, g!name) + (in (list (` (.the .public (, g!name) Var (, runtime_name))) - (` (the (, (code.local (%.message "@" name))) + (` (.the (, (code.local (%.message "@" name))) Statement (..feature (, runtime_name) (function ((, g!_) (, g!name)) @@ -122,11 +123,11 @@ inputsC (list#each code.local inputs) inputs_typesC (list#each (function.constant (` _.Expression)) inputs)] - (in (list (` (the .public ((, g!name) (,* inputsC)) + (in (list (` (.the .public ((, g!name) (,* inputsC)) (-> (,* inputs_typesC) Computation) (_.apply (list (,* inputsC)) (, runtime_name)))) - (` (the (, (code.local (%.message "@" name))) + (` (.the (, (code.local (%.message "@" name))) Statement (..feature (, runtime_name) (function ((, g!_) (, g!_)) @@ -135,190 +136,180 @@ (list (,* (list#each (|>> (,) [false] (`)) inputsC))) (, code))))))))))))))))) -(runtime - (io//log! message) - (all _.then - (_.echo message) - (_.echo (_.string text.new_line)) - (_.return ..unit))) +(the (io//log! message) + (all _.then + (_.echo message) + (_.echo (_.string text.new_line)) + (_.return ..unit))) -(runtime - (io//throw! message) - (all _.then - (_.throw (_.new (_.constant "Exception") (list message))) - (_.return ..unit))) +(the (io//throw! message) + (all _.then + (_.throw (_.new (_.constant "Exception") (list message))) + (_.return ..unit))) -(the runtime//io +(.the runtime//io Statement (all _.then @io//log! @io//throw! )) -(the .public tuple_size_field +(.the .public tuple_size_field "_lux_size") -(the tuple_size +(.the tuple_size (_.item (_.string ..tuple_size_field))) -(the jphp? +(.the jphp? (_.=== (_.string "5.6.99") (_.phpversion/0 []))) -(runtime - (array//length array) - ... TODO: Get rid of this as soon as JPHP is no longer necessary. - (_.if ..jphp? - (_.return (..tuple_size array)) - (_.return (_.count/1 array)))) +(the (array//length array) + ... TODO: Get rid of this as soon as JPHP is no longer necessary. + (_.if ..jphp? + (_.return (..tuple_size array)) + (_.return (_.count/1 array)))) -(runtime - (array//write idx value array) - (all _.then - (_.set! (_.item idx array) value) - (_.return array))) +(the (array//write idx value array) + (all _.then + (_.set! (_.item idx array) value) + (_.return array))) -(the runtime//array +(.the runtime//array Statement (all _.then @array//length @array//write )) -(the jphp_last_index +(.the jphp_last_index (|>> ..tuple_size (_.- (_.int +1)))) -(the normal_last_index +(.the normal_last_index (|>> _.count/1 (_.- (_.int +1)))) (expansion.let [ (these (all _.then (_.set! lefts (_.- last_index_right lefts)) (_.set! tuple (_.item last_index_right tuple))))] - (runtime - (tuple//make size values) - (_.if ..jphp? - (all _.then - (_.set! (..tuple_size values) size) - (_.return values)) - ... https://www.php.net/manual/en/language.operators.assignment.php - ... https://www.php.net/manual/en/language.references.php - ... https://www.php.net/manual/en/functions.arguments.php - ... https://www.php.net/manual/en/language.oop5.references.php - ... https://www.php.net/manual/en/class.arrayobject.php - (_.return (_.new (_.constant "ArrayObject") (list values))))) - - (runtime - (tuple//left lefts tuple) - (with_vars [last_index_right] - (<| (_.while (_.bool true)) - (all _.then - (_.if ..jphp? - (_.set! last_index_right (..jphp_last_index tuple)) - (_.set! last_index_right (..normal_last_index tuple))) - (_.if (_.> lefts last_index_right) - ... No need for recursion - (_.return (_.item lefts tuple)) - ... Needs recursion - ))))) + (the (tuple//make size values) + (_.if ..jphp? + (all _.then + (_.set! (..tuple_size values) size) + (_.return values)) + ... https://www.php.net/manual/en/language.operators.assignment.php + ... https://www.php.net/manual/en/language.references.php + ... https://www.php.net/manual/en/functions.arguments.php + ... https://www.php.net/manual/en/language.oop5.references.php + ... https://www.php.net/manual/en/class.arrayobject.php + (_.return (_.new (_.constant "ArrayObject") (list values))))) + + (the (tuple//left lefts tuple) + (with_vars [last_index_right] + (<| (_.while (_.bool true)) + (all _.then + (_.if ..jphp? + (_.set! last_index_right (..jphp_last_index tuple)) + (_.set! last_index_right (..normal_last_index tuple))) + (_.if (_.> lefts last_index_right) + ... No need for recursion + (_.return (_.item lefts tuple)) + ... Needs recursion + ))))) ... TODO: Get rid of this as soon as JPHP is no longer necessary. - (runtime - (tuple//slice offset input) - (with_vars [size index output] - (all _.then - (_.set! size (..array//length input)) - (_.set! index (_.int +0)) - (_.set! output (_.array/* (list))) - (<| (_.while (|> index (_.+ offset) (_.< size))) - (all _.then - (_.set! (_.item index output) (_.item (_.+ offset index) input)) - (_.set! index (_.+ (_.int +1) index)) - )) - (_.return (..tuple//make (_.- offset size) output)) - ))) - - (runtime - (tuple//right lefts tuple) - (with_vars [last_index_right right_index] - (<| (_.while (_.bool true)) - (all _.then - (_.if ..jphp? - (_.set! last_index_right (..jphp_last_index tuple)) - (_.set! last_index_right (..normal_last_index tuple))) - (_.set! right_index (_.+ (_.int +1) lefts)) - (_.cond (list [(_.=== last_index_right right_index) - (_.return (_.item right_index tuple))] - [(_.> last_index_right right_index) - ... Needs recursion. - ]) - (_.if ..jphp? - (_.return (..tuple//make (_.- right_index (..tuple_size tuple)) - (..tuple//slice right_index tuple))) - (_.return (..tuple//make (_.- right_index (_.count/1 tuple)) - (_.array_slice/2 [(_.do "getArrayCopy" (list) tuple) right_index]))))) - ))))) - -(the .public variant_tag_field script.variant_lefts) -(the .public variant_flag_field script.variant_right?) -(the .public variant_value_field script.variant_choice) - -(runtime - (sum//make tag last? value) - (_.return (_.array/** (list [(_.string ..variant_tag_field) tag] - [(_.string ..variant_flag_field) last?] - [(_.string ..variant_value_field) value])))) - -(the .public (variant tag last? value) + (the (tuple//slice offset input) + (with_vars [size index output] + (all _.then + (_.set! size (..array//length input)) + (_.set! index (_.int +0)) + (_.set! output (_.array/* (list))) + (<| (_.while (|> index (_.+ offset) (_.< size))) + (all _.then + (_.set! (_.item index output) (_.item (_.+ offset index) input)) + (_.set! index (_.+ (_.int +1) index)) + )) + (_.return (..tuple//make (_.- offset size) output)) + ))) + + (the (tuple//right lefts tuple) + (with_vars [last_index_right right_index] + (<| (_.while (_.bool true)) + (all _.then + (_.if ..jphp? + (_.set! last_index_right (..jphp_last_index tuple)) + (_.set! last_index_right (..normal_last_index tuple))) + (_.set! right_index (_.+ (_.int +1) lefts)) + (_.cond (list [(_.=== last_index_right right_index) + (_.return (_.item right_index tuple))] + [(_.> last_index_right right_index) + ... Needs recursion. + ]) + (_.if ..jphp? + (_.return (..tuple//make (_.- right_index (..tuple_size tuple)) + (..tuple//slice right_index tuple))) + (_.return (..tuple//make (_.- right_index (_.count/1 tuple)) + (_.array_slice/2 [(_.do "getArrayCopy" (list) tuple) right_index]))))) + ))))) + +(.the .public variant_tag_field script.variant_lefts) +(.the .public variant_flag_field script.variant_right?) +(.the .public variant_value_field script.variant_choice) + +(the (sum//make tag last? value) + (_.return (_.array/** (list [(_.string ..variant_tag_field) tag] + [(_.string ..variant_flag_field) last?] + [(_.string ..variant_value_field) value])))) + +(.the .public (variant tag last? value) (-> Natural Bit Expression Computation) (sum//make (_.int (.integer tag)) (..flag last?) value)) -(the .public none +(.the .public none Computation (..variant 0 #0 ..unit)) -(the .public some +(.the .public some (-> Expression Computation) (..variant 1 #1)) -(the .public left +(.the .public left (-> Expression Computation) (..variant 0 #0)) -(the .public right +(.the .public right (-> Expression Computation) (..variant 1 #1)) -(runtime - (sum//get sum wantsLast wantedTag) - (let [no_match! (_.return _.null) - sum_tag (_.item (_.string ..variant_tag_field) sum) - ... sum_tag (_.item (_.int +0) sum) - sum_flag (_.item (_.string ..variant_flag_field) sum) - ... sum_flag (_.item (_.int +1) sum) - sum_value (_.item (_.string ..variant_value_field) sum) - ... sum_value (_.item (_.int +2) sum) - is_last? (_.=== ..unit sum_flag) - test_recursion! (_.if is_last? - ... Must recurse. - (all _.then - (_.set! wantedTag (_.- sum_tag wantedTag)) - (_.set! sum sum_value)) - no_match!)] - (<| (_.while (_.bool true)) - (_.cond (list [(_.=== sum_tag wantedTag) - (_.if (_.=== wantsLast sum_flag) - (_.return sum_value) - test_recursion!)] - - [(_.< wantedTag sum_tag) - test_recursion!] - - [(_.=== ..unit wantsLast) - (_.return (sum//make (_.- wantedTag sum_tag) sum_flag sum_value))]) - no_match!)))) - -(the runtime//adt +(the (sum//get sum wantsLast wantedTag) + (let [no_match! (_.return _.null) + sum_tag (_.item (_.string ..variant_tag_field) sum) + ... sum_tag (_.item (_.int +0) sum) + sum_flag (_.item (_.string ..variant_flag_field) sum) + ... sum_flag (_.item (_.int +1) sum) + sum_value (_.item (_.string ..variant_value_field) sum) + ... sum_value (_.item (_.int +2) sum) + is_last? (_.=== ..unit sum_flag) + test_recursion! (_.if is_last? + ... Must recurse. + (all _.then + (_.set! wantedTag (_.- sum_tag wantedTag)) + (_.set! sum sum_value)) + no_match!)] + (<| (_.while (_.bool true)) + (_.cond (list [(_.=== sum_tag wantedTag) + (_.if (_.=== wantsLast sum_flag) + (_.return sum_value) + test_recursion!)] + + [(_.< wantedTag sum_tag) + test_recursion!] + + [(_.=== ..unit wantsLast) + (_.return (sum//make (_.- wantedTag sum_tag) sum_flag sum_value))]) + no_match!)))) + +(.the runtime//adt Statement (all _.then @tuple//make @@ -329,193 +320,185 @@ @sum//get )) -(runtime - (lux//try op) - (with_vars [value] - (_.try (all _.then - (_.set! value (_.apply/1 op [..unit])) - (_.return (..right value))) - (list (with_vars [error] - [_.#class (_.constant "Exception") - _.#exception error - _.#handler (_.return (..left (_.do "getMessage" (list) error)))]))))) - -(runtime - (lux//program_args inputs) - (with_vars [head tail] - (all _.then - (_.set! tail ..none) - (<| (_.for_each (_.array_reverse/1 inputs) head) - (_.set! tail (..some (_.array/* (list head tail))))) - (_.return tail)))) - -(the runtime//lux +(the (lux//try op) + (with_vars [value] + (_.try (all _.then + (_.set! value (_.apply/1 op [..unit])) + (_.return (..right value))) + (list (with_vars [error] + [_.#class (_.constant "Exception") + _.#exception error + _.#handler (_.return (..left (_.do "getMessage" (list) error)))]))))) + +(the (lux//program_args inputs) + (with_vars [head tail] + (all _.then + (_.set! tail ..none) + (<| (_.for_each (_.array_reverse/1 inputs) head) + (_.set! tail (..some (_.array/* (list head tail))))) + (_.return tail)))) + +(.the runtime//lux Statement (all _.then @lux//try @lux//program_args )) -(the .public high +(.the .public high (-> (I64 Any) (I64 Any)) (i64.right_shifted 32)) -(the .public low +(.the .public low (-> (I64 Any) (I64 Any)) (let [mask (-- (i64.left_shifted 32 1))] (|>> (i64.and mask)))) -(runtime - (i64//right_shifted param subject) - (let [... The mask has to be calculated this way instead of in a more straightforward way - ... because in some languages, 1<<63 = max_negative_value - ... and max_negative_value-1 = max_positive_value. - ... And bitwise, max_positive_value works out to the mask that is desired when param = 0. - ... However, in PHP, max_negative_value-1 underflows and gets cast into a float. - ... And this messes up the computation. - ... This slightly more convoluted calculation avoids that problem. - mask (|> (_.int +1) - (_.bit_shl (_.- param (_.int +63))) - (_.- (_.int +1)) - (_.bit_shl (_.int +1)) - (_.+ (_.int +1)))] - (all _.then - (_.set! param (_.% (_.int +64) param)) - (_.if (_.=== (_.int +0) param) - (_.return subject) - (_.return (|> subject - (_.bit_shr param) - (_.bit_and mask))))))) - -(runtime - (i64//char code) - (_.if ..jphp? - (_.return (_.chr/1 [code])) - (_.return (|> code - [(_.string "V")] - _.pack/2 - [(_.string "UTF-32LE") (_.string "UTF-8")] - _.iconv/3)))) - -(runtime - (i64//+ parameter subject) - (let [high_16 (..i64//right_shifted (_.int +16)) - low_16 (_.bit_and (_.int (.integer (hex "FFFF")))) - - cap_16 low_16 - hh (..i64//right_shifted (_.int +48)) - hl (|>> (..i64//right_shifted (_.int +32)) cap_16) - lh (|>> (..i64//right_shifted (_.int +16)) cap_16) - ll cap_16 - - up_16 (_.bit_shl (_.int +16))] - (with_vars [l48 l32 l16 l00 - r48 r32 r16 r00 - x48 x32 x16 x00] - (all _.then - (_.set! l48 (hh subject)) - (_.set! l32 (hl subject)) - (_.set! l16 (lh subject)) - (_.set! l00 (ll subject)) - - (_.set! r48 (hh parameter)) - (_.set! r32 (hl parameter)) - (_.set! r16 (lh parameter)) - (_.set! r00 (ll parameter)) - - (_.set! x00 (_.+ l00 r00)) - - (_.set! x16 (|> (high_16 x00) - (_.+ l16) - (_.+ r16))) - (_.set! x00 (low_16 x00)) - - (_.set! x32 (|> (high_16 x16) - (_.+ l32) - (_.+ r32))) - (_.set! x16 (low_16 x16)) - - (_.set! x48 (|> (high_16 x32) - (_.+ l48) - (_.+ r48) - low_16)) - (_.set! x32 (low_16 x32)) - - (let [high32 (_.bit_or (up_16 x48) x32) - low32 (_.bit_or (up_16 x16) x00)] - (_.return (|> high32 - (_.bit_shl (_.int +32)) - (_.bit_or low32)))) - )))) - -(runtime - (i64//negate value) - (let [i64//min (_.int (.integer (hex "80,00,00,00,00,00,00,00")))] - (_.if (_.=== i64//min value) - (_.return i64//min) - (_.return (..i64//+ (_.int +1) (_.bit_not value)))))) - -(runtime - (i64//- parameter subject) - (_.return (..i64//+ (..i64//negate parameter) subject))) - -(runtime - (i64//* parameter subject) - (let [high_16 (..i64//right_shifted (_.int +16)) - low_16 (_.bit_and (_.int (.integer (hex "FFFF")))) - - cap_16 low_16 - hh (..i64//right_shifted (_.int +48)) - hl (|>> (..i64//right_shifted (_.int +32)) cap_16) - lh (|>> (..i64//right_shifted (_.int +16)) cap_16) - ll cap_16 - - up_16 (_.bit_shl (_.int +16))] - (with_vars [l48 l32 l16 l00 - r48 r32 r16 r00 - x48 x32 x16 x00] - (all _.then - (_.set! l48 (hh subject)) - (_.set! l32 (hl subject)) - (_.set! l16 (lh subject)) - (_.set! l00 (ll subject)) - - (_.set! r48 (hh parameter)) - (_.set! r32 (hl parameter)) - (_.set! r16 (lh parameter)) - (_.set! r00 (ll parameter)) - - (_.set! x00 (_.* l00 r00)) - (_.set! x16 (high_16 x00)) - (_.set! x00 (low_16 x00)) - - (_.set! x16 (|> x16 (_.+ (_.* l16 r00)))) - (_.set! x32 (high_16 x16)) (_.set! x16 (low_16 x16)) - (_.set! x16 (|> x16 (_.+ (_.* l00 r16)))) - (_.set! x32 (|> x32 (_.+ (high_16 x16)))) (_.set! x16 (low_16 x16)) - - (_.set! x32 (|> x32 (_.+ (_.* l32 r00)))) - (_.set! x48 (high_16 x32)) (_.set! x32 (low_16 x32)) - (_.set! x32 (|> x32 (_.+ (_.* l16 r16)))) - (_.set! x48 (|> x48 (_.+ (high_16 x32)))) (_.set! x32 (low_16 x32)) - (_.set! x32 (|> x32 (_.+ (_.* l00 r32)))) - (_.set! x48 (|> x48 (_.+ (high_16 x32)))) (_.set! x32 (low_16 x32)) - - (_.set! x48 (|> x48 - (_.+ (_.* l48 r00)) - (_.+ (_.* l32 r16)) - (_.+ (_.* l16 r32)) - (_.+ (_.* l00 r48)) - low_16)) - - (let [high32 (_.bit_or (up_16 x48) x32) - low32 (_.bit_or (up_16 x16) x00)] - (_.return (|> high32 - (_.bit_shl (_.int +32)) - (_.bit_or low32)))) - )))) - -(the runtime//i64 +(the (i64//right_shifted param subject) + (let [... The mask has to be calculated this way instead of in a more straightforward way + ... because in some languages, 1<<63 = max_negative_value + ... and max_negative_value-1 = max_positive_value. + ... And bitwise, max_positive_value works out to the mask that is desired when param = 0. + ... However, in PHP, max_negative_value-1 underflows and gets cast into a float. + ... And this messes up the computation. + ... This slightly more convoluted calculation avoids that problem. + mask (|> (_.int +1) + (_.bit_shl (_.- param (_.int +63))) + (_.- (_.int +1)) + (_.bit_shl (_.int +1)) + (_.+ (_.int +1)))] + (all _.then + (_.set! param (_.% (_.int +64) param)) + (_.if (_.=== (_.int +0) param) + (_.return subject) + (_.return (|> subject + (_.bit_shr param) + (_.bit_and mask))))))) + +(the (i64//char code) + (_.if ..jphp? + (_.return (_.chr/1 [code])) + (_.return (|> code + [(_.string "V")] + _.pack/2 + [(_.string "UTF-32LE") (_.string "UTF-8")] + _.iconv/3)))) + +(the (i64//+ parameter subject) + (let [high_16 (..i64//right_shifted (_.int +16)) + low_16 (_.bit_and (_.int (.integer (hex "FFFF")))) + + cap_16 low_16 + hh (..i64//right_shifted (_.int +48)) + hl (|>> (..i64//right_shifted (_.int +32)) cap_16) + lh (|>> (..i64//right_shifted (_.int +16)) cap_16) + ll cap_16 + + up_16 (_.bit_shl (_.int +16))] + (with_vars [l48 l32 l16 l00 + r48 r32 r16 r00 + x48 x32 x16 x00] + (all _.then + (_.set! l48 (hh subject)) + (_.set! l32 (hl subject)) + (_.set! l16 (lh subject)) + (_.set! l00 (ll subject)) + + (_.set! r48 (hh parameter)) + (_.set! r32 (hl parameter)) + (_.set! r16 (lh parameter)) + (_.set! r00 (ll parameter)) + + (_.set! x00 (_.+ l00 r00)) + + (_.set! x16 (|> (high_16 x00) + (_.+ l16) + (_.+ r16))) + (_.set! x00 (low_16 x00)) + + (_.set! x32 (|> (high_16 x16) + (_.+ l32) + (_.+ r32))) + (_.set! x16 (low_16 x16)) + + (_.set! x48 (|> (high_16 x32) + (_.+ l48) + (_.+ r48) + low_16)) + (_.set! x32 (low_16 x32)) + + (let [high32 (_.bit_or (up_16 x48) x32) + low32 (_.bit_or (up_16 x16) x00)] + (_.return (|> high32 + (_.bit_shl (_.int +32)) + (_.bit_or low32)))) + )))) + +(the (i64//negate value) + (let [i64//min (_.int (.integer (hex "80,00,00,00,00,00,00,00")))] + (_.if (_.=== i64//min value) + (_.return i64//min) + (_.return (..i64//+ (_.int +1) (_.bit_not value)))))) + +(the (i64//- parameter subject) + (_.return (..i64//+ (..i64//negate parameter) subject))) + +(the (i64//* parameter subject) + (let [high_16 (..i64//right_shifted (_.int +16)) + low_16 (_.bit_and (_.int (.integer (hex "FFFF")))) + + cap_16 low_16 + hh (..i64//right_shifted (_.int +48)) + hl (|>> (..i64//right_shifted (_.int +32)) cap_16) + lh (|>> (..i64//right_shifted (_.int +16)) cap_16) + ll cap_16 + + up_16 (_.bit_shl (_.int +16))] + (with_vars [l48 l32 l16 l00 + r48 r32 r16 r00 + x48 x32 x16 x00] + (all _.then + (_.set! l48 (hh subject)) + (_.set! l32 (hl subject)) + (_.set! l16 (lh subject)) + (_.set! l00 (ll subject)) + + (_.set! r48 (hh parameter)) + (_.set! r32 (hl parameter)) + (_.set! r16 (lh parameter)) + (_.set! r00 (ll parameter)) + + (_.set! x00 (_.* l00 r00)) + (_.set! x16 (high_16 x00)) + (_.set! x00 (low_16 x00)) + + (_.set! x16 (|> x16 (_.+ (_.* l16 r00)))) + (_.set! x32 (high_16 x16)) (_.set! x16 (low_16 x16)) + (_.set! x16 (|> x16 (_.+ (_.* l00 r16)))) + (_.set! x32 (|> x32 (_.+ (high_16 x16)))) (_.set! x16 (low_16 x16)) + + (_.set! x32 (|> x32 (_.+ (_.* l32 r00)))) + (_.set! x48 (high_16 x32)) (_.set! x32 (low_16 x32)) + (_.set! x32 (|> x32 (_.+ (_.* l16 r16)))) + (_.set! x48 (|> x48 (_.+ (high_16 x32)))) (_.set! x32 (low_16 x32)) + (_.set! x32 (|> x32 (_.+ (_.* l00 r32)))) + (_.set! x48 (|> x48 (_.+ (high_16 x32)))) (_.set! x32 (low_16 x32)) + + (_.set! x48 (|> x48 + (_.+ (_.* l48 r00)) + (_.+ (_.* l32 r16)) + (_.+ (_.* l16 r32)) + (_.+ (_.* l00 r48)) + low_16)) + + (let [high32 (_.bit_or (up_16 x48) x32) + low32 (_.bit_or (up_16 x16) x00)] + (_.return (|> high32 + (_.bit_shl (_.int +32)) + (_.bit_or low32)))) + )))) + +(.the runtime//i64 Statement (all _.then @i64//right_shifted @@ -526,54 +509,50 @@ @i64//* )) -(runtime - (text//size value) - (_.if ..jphp? - (_.return (_.strlen/1 [value])) - (_.return (_.iconv_strlen/1 [value])))) - -(runtime - (text//index subject param start) - (_.if (_.=== (_.string "") param) - (_.return (..some (_.int +0))) - (with_vars [idx] - (_.if ..jphp? - (all _.then - (_.set! idx (_.strpos/3 [subject param start])) - (_.if (_.=== (_.bool false) idx) - (_.return ..none) - (_.return (..some idx)))) - (all _.then - (_.set! idx (_.iconv_strpos/3 [subject param start])) - (_.if (_.=== (_.bool false) idx) - (_.return ..none) - (_.return (..some idx)))))))) - -(the (within? top value) +(the (text//size value) + (_.if ..jphp? + (_.return (_.strlen/1 [value])) + (_.return (_.iconv_strlen/1 [value])))) + +(the (text//index subject param start) + (_.if (_.=== (_.string "") param) + (_.return (..some (_.int +0))) + (with_vars [idx] + (_.if ..jphp? + (all _.then + (_.set! idx (_.strpos/3 [subject param start])) + (_.if (_.=== (_.bool false) idx) + (_.return ..none) + (_.return (..some idx)))) + (all _.then + (_.set! idx (_.iconv_strpos/3 [subject param start])) + (_.if (_.=== (_.bool false) idx) + (_.return ..none) + (_.return (..some idx)))))))) + +(.the (within? top value) (-> Expression Expression Computation) (_.and (|> value (_.>= (_.int +0))) (|> value (_.< top)))) -(runtime - (text//clip offset length text) - (_.if ..jphp? - (_.return (_.substr/3 [text offset length])) - (_.return (_.iconv_substr/3 [text offset length])))) - -(runtime - (text//char idx text) - (_.if (|> idx (within? (text//size text))) - (_.if ..jphp? - (_.return (_.ord/1 (_.substr/3 [text idx (_.int +1)]))) - (_.return (|> (_.iconv_substr/3 [text idx (_.int +1)]) - [(_.string "UTF-8") (_.string "UTF-32LE")] - _.iconv/3 - [(_.string "V")] - _.unpack/2 - (_.item (_.int +1))))) - (_.throw (_.new (_.constant "Exception") (list (_.string "[Lux Error] Cannot get char from text.")))))) - -(the runtime//text +(the (text//clip offset length text) + (_.if ..jphp? + (_.return (_.substr/3 [text offset length])) + (_.return (_.iconv_substr/3 [text offset length])))) + +(the (text//char idx text) + (_.if (|> idx (within? (text//size text))) + (_.if ..jphp? + (_.return (_.ord/1 (_.substr/3 [text idx (_.int +1)]))) + (_.return (|> (_.iconv_substr/3 [text idx (_.int +1)]) + [(_.string "UTF-8") (_.string "UTF-32LE")] + _.iconv/3 + [(_.string "V")] + _.unpack/2 + (_.item (_.int +1))))) + (_.throw (_.new (_.constant "Exception") (list (_.string "[Lux Error] Cannot get char from text.")))))) + +(.the runtime//text Statement (all _.then @text//size @@ -582,31 +561,30 @@ @text//char )) -(runtime - (f64//decode value) - (with_vars [output] - (all _.then - (_.set! output (_.floatval/1 value)) - (_.if (_.=== (_.float +0.0) output) - (_.if (all _.or - (_.=== (_.string "0.0") output) - (_.=== (_.string "+0.0") output) - (_.=== (_.string "-0.0") output) - (_.=== (_.string "0") output) - (_.=== (_.string "+0") output) - (_.=== (_.string "-0") output)) - (_.return (..some output)) - (_.return ..none)) - (_.return (..some output))) - ))) - -(the runtime//f64 +(the (f64//decode value) + (with_vars [output] + (all _.then + (_.set! output (_.floatval/1 value)) + (_.if (_.=== (_.float +0.0) output) + (_.if (all _.or + (_.=== (_.string "0.0") output) + (_.=== (_.string "+0.0") output) + (_.=== (_.string "-0.0") output) + (_.=== (_.string "0") output) + (_.=== (_.string "+0") output) + (_.=== (_.string "-0") output)) + (_.return (..some output)) + (_.return ..none)) + (_.return (..some output))) + ))) + +(.the runtime//f64 Statement (all _.then @f64//decode )) -(the check_necessary_conditions! +(.the check_necessary_conditions! Statement (let [i64_support? (_.=== (_.int +8) (_.constant "PHP_INT_SIZE")) i64_error (_.string (%.message "Cannot run program!" text.new_line @@ -614,7 +592,7 @@ (_.when (_.not i64_support?) (_.throw (_.new (_.constant "Exception") (list i64_error)))))) -(the runtime +(.the runtime Statement (all _.then check_necessary_conditions! @@ -627,7 +605,7 @@ runtime//io )) -(the .public translate +(.the .public translate (Operation [Registry Output]) (do ///////phase.monad [_ (translation.execute! ..runtime) diff --git a/stdlib/source/library/lux/meta/compiler/language/lux/phase/translation/python/runtime.lux b/stdlib/source/library/lux/meta/compiler/language/lux/phase/translation/python/runtime.lux index 9d20bca728..89513dc106 100644 --- a/stdlib/source/library/lux/meta/compiler/language/lux/phase/translation/python/runtime.lux +++ b/stdlib/source/library/lux/meta/compiler/language/lux/phase/translation/python/runtime.lux @@ -4,7 +4,8 @@ (.using [library [lux (.except Declaration - ++ variant) + ++ variant + the) [abstract ["[0]" monad (.only do)]] [control @@ -78,51 +79,51 @@ (-> Phase Archive of (Operation Expression))) -(the prefix +(.the prefix "LuxRuntime") -(the .public unit +(.the .public unit (_.unicode synthesis.unit)) -(the (flag value) +(.the (flag value) (-> Bit Literal) (if value ..unit _.none)) -(the (variant' tag last? value) +(.the (variant' tag last? value) (-> Expression Expression Expression Literal) (_.tuple (list tag last? value))) -(the .public (variant tag last? value) +(.the .public (variant tag last? value) (-> Natural Bit Expression Literal) (variant' (_.int (.integer tag)) (flag last?) value)) -(the .public left +(.the .public left (-> Expression Literal) (..variant 0 #0)) -(the .public right +(.the .public right (-> Expression Literal) (..variant 0 #1)) -(the .public none +(.the .public none Literal (..left ..unit)) -(the .public some +(.the .public some (-> Expression Literal) ..right) -(the (runtime_name name) +(.the (runtime_name name) (-> Text SVar) (let [symbol (%.message ..prefix @@ -130,12 +131,12 @@ "_" (%.natural (text#hash name)))] (_.var symbol))) -(the (feature name definition) +(.the (feature name definition) (-> SVar (-> SVar Statement) Statement) (definition name)) -(the .public with_vars +(.the .public with_vars (syntax.macro (_ [vars (.tuple (<>.some .local)) body .any]) (do [! meta.monad] @@ -148,7 +149,7 @@ list.together))] (, body)))))))) -(the runtime +(.the the (syntax.macro (_ [declaration (<>.or .local (.form (<>.and .local (<>.some .local)))) @@ -159,8 +160,8 @@ (let [nameC (code.local name) code_nameC (code.local (%.message "@" name)) runtime_nameC (` (runtime_name (, (code.text name))))] - (in (list (` (the .public (, nameC) SVar (, runtime_nameC))) - (` (the (, code_nameC) + (in (list (` (.the .public (, nameC) SVar (, runtime_nameC))) + (` (.the (, code_nameC) Statement (..feature (, runtime_nameC) (function ((, g!_) (, g!_)) @@ -174,11 +175,11 @@ inputsC (list#each code.local inputs) inputs_typesC (list#each (function.constant (` _.Expression)) inputs)] - (in (list (` (the .public ((, nameC) (,* inputsC)) + (in (list (` (.the .public ((, nameC) (,* inputsC)) (-> (,* inputs_typesC) Computation) (_.apply (list (,* inputsC)) (, runtime_nameC)))) - (` (the (, code_nameC) + (` (.the (, code_nameC) Statement (..feature (, runtime_nameC) (function ((, g!_) (, g!_)) @@ -186,35 +187,32 @@ (_.def (, g!_) (list (,* inputsC)) (, code)))))))))))))) -(runtime - (lux::try op) - (with_vars [exception] - (_.try (_.return (..right (_.apply (list ..unit) op))) - (list [(list "Exception") exception - (_.return (..left (_.do "join" - (list (_.do "format_exception_only" - (list (_.its "__class__" exception) - exception) - (_.__import__/1 (_.string "traceback")))) - (_.string ""))))])))) - -(runtime - (lux::program_args program_args) - (with_vars [inputs value] - (all _.then - (_.set (list inputs) ..none) - (<| (_.for_in value (_.apply (list program_args) (_.var "reversed"))) - (_.set (list inputs) - (..some (_.list (list value inputs))))) - (_.return inputs)))) - -(runtime - (lux::exec code globals) - (all _.then - (_.exec {.#Some globals} code) - (_.return ..unit))) - -(the runtime//lux +(the (lux::try op) + (with_vars [exception] + (_.try (_.return (..right (_.apply (list ..unit) op))) + (list [(list "Exception") exception + (_.return (..left (_.do "join" + (list (_.do "format_exception_only" + (list (_.its "__class__" exception) + exception) + (_.__import__/1 (_.string "traceback")))) + (_.string ""))))])))) + +(the (lux::program_args program_args) + (with_vars [inputs value] + (all _.then + (_.set (list inputs) ..none) + (<| (_.for_in value (_.apply (list program_args) (_.var "reversed"))) + (_.set (list inputs) + (..some (_.list (list value inputs))))) + (_.return inputs)))) + +(the (lux::exec code globals) + (all _.then + (_.exec {.#Some globals} code) + (_.return ..unit))) + +(.the runtime//lux Statement (all _.then @lux::try @@ -222,96 +220,91 @@ @lux::exec )) -(runtime - (io::log! message) - (all _.then - (_.print message) - (|> (_.__import__/1 (_.unicode "sys")) - (_.its "stdout") - (_.do "flush" (list)) - _.;) - (_.return ..unit))) - -(runtime - (io::throw! message) - (_.raise (_.Exception/1 (|> message - (_.+ (_.string text.\n)) - (_.+ (_.do "join" - (list (_.do "format_stack" (list) - (_.__import__/1 (_.string "traceback")))) - (_.string ""))))))) - -(the runtime//io +(the (io::log! message) + (all _.then + (_.print message) + (|> (_.__import__/1 (_.unicode "sys")) + (_.its "stdout") + (_.do "flush" (list)) + _.;) + (_.return ..unit))) + +(the (io::throw! message) + (_.raise (_.Exception/1 (|> message + (_.+ (_.string text.\n)) + (_.+ (_.do "join" + (list (_.do "format_stack" (list) + (_.__import__/1 (_.string "traceback")))) + (_.string ""))))))) + +(.the runtime//io Statement (all _.then @io::log! @io::throw! )) -(the last_index +(.the last_index (|>> _.len/1 (_.- (_.int +1)))) (expansion.let [ (these (all _.then (_.set (list lefts) (_.- last_index_right lefts)) (_.set (list tuple) (_.item last_index_right tuple))))] - (these (runtime - (tuple::left lefts tuple) - (with_vars [last_index_right] - (_.while (_.bool true) - (all _.then - (_.set (list last_index_right) (..last_index tuple)) - (_.if (_.> lefts last_index_right) - ... No need for recursion - (_.return (_.item lefts tuple)) - ... Needs recursion - )) - {.#None}))) - - (runtime - (tuple::right lefts tuple) - (with_vars [last_index_right right_index] - (_.while (_.bool true) - (all _.then - (_.set (list last_index_right) (..last_index tuple)) - (_.set (list right_index) (_.+ (_.int +1) lefts)) - (<| (_.if (_.= last_index_right right_index) - (_.return (_.item right_index tuple))) - (_.if (_.> last_index_right right_index) - ... Needs recursion. - ) - (_.return (_.slice_from right_index tuple)))) - {.#None}))))) - -(runtime - (sum::get sum expected::right? expected::lefts) - (let [mismatch! (_.return _.none) - actual::lefts (_.item (_.int +0) sum) - actual::right? (_.item (_.int +1) sum) - actual::value (_.item (_.int +2) sum) - recur! (all _.then - (_.set (list expected::lefts) (|> expected::lefts - (_.- actual::lefts) - (_.- (_.int +1)))) - (_.set (list sum) actual::value))] - (_.while (_.bool true) - (<| (_.if (_.= expected::lefts actual::lefts) - (_.if (_.= expected::right? actual::right?) - (_.return actual::value) - mismatch!)) - (_.if (_.< expected::lefts actual::lefts) - (_.if (_.= ..unit actual::right?) - recur! - mismatch!)) - (_.if (_.= ..unit expected::right?) - (_.return (variant' (|> actual::lefts - (_.- expected::lefts) - (_.- (_.int +1))) - actual::right? - actual::value))) - mismatch!) - {.#None}))) - -(the runtime//adt + (these (the (tuple::left lefts tuple) + (with_vars [last_index_right] + (_.while (_.bool true) + (all _.then + (_.set (list last_index_right) (..last_index tuple)) + (_.if (_.> lefts last_index_right) + ... No need for recursion + (_.return (_.item lefts tuple)) + ... Needs recursion + )) + {.#None}))) + + (the (tuple::right lefts tuple) + (with_vars [last_index_right right_index] + (_.while (_.bool true) + (all _.then + (_.set (list last_index_right) (..last_index tuple)) + (_.set (list right_index) (_.+ (_.int +1) lefts)) + (<| (_.if (_.= last_index_right right_index) + (_.return (_.item right_index tuple))) + (_.if (_.> last_index_right right_index) + ... Needs recursion. + ) + (_.return (_.slice_from right_index tuple)))) + {.#None}))))) + +(the (sum::get sum expected::right? expected::lefts) + (let [mismatch! (_.return _.none) + actual::lefts (_.item (_.int +0) sum) + actual::right? (_.item (_.int +1) sum) + actual::value (_.item (_.int +2) sum) + recur! (all _.then + (_.set (list expected::lefts) (|> expected::lefts + (_.- actual::lefts) + (_.- (_.int +1)))) + (_.set (list sum) actual::value))] + (_.while (_.bool true) + (<| (_.if (_.= expected::lefts actual::lefts) + (_.if (_.= expected::right? actual::right?) + (_.return actual::value) + mismatch!)) + (_.if (_.< expected::lefts actual::lefts) + (_.if (_.= ..unit actual::right?) + recur! + mismatch!)) + (_.if (_.= ..unit expected::right?) + (_.return (variant' (|> actual::lefts + (_.- expected::lefts) + (_.- (_.int +1))) + actual::right? + actual::value))) + mismatch!) + {.#None}))) + +(.the runtime//adt Statement (all _.then @tuple::left @@ -319,96 +312,89 @@ @sum::get )) -(the i64::+limit (_.manual "+0x7FFFFFFFFFFFFFFF")) -(the i64::-limit (_.manual "-0x8000000000000000")) -(the i64::+iteration (_.manual "+0x10000000000000000")) -(the i64::-iteration (_.manual "-0x10000000000000000")) -(the i64::+cap (_.manual "+0x8000000000000000")) -(the i64::-cap (_.manual "-0x8000000000000001")) - -(runtime - (i64::64 input) - (with_vars [temp] - (`` (<| (,, (template.with [ ] - [(_.if (|> input ) - (all _.then - (_.set (list temp) (_.% input)) - (_.return (_.? (|> temp ) - (|> temp (_.- ) (_.+ )) - temp))))] - - [(_.> ..i64::+limit) ..i64::+iteration ..i64::+cap ..i64::-limit] - [(_.< ..i64::-limit) ..i64::-iteration ..i64::-cap ..i64::+limit] - )) - (_.return (for .python input - ... This +- is only necessary to guarantee that values within the limits are always longs in Python 2 - (|> input (_.+ ..i64::+limit) (_.- ..i64::+limit)))))))) - -(the as_natural +(.the i64::+limit (_.manual "+0x7FFFFFFFFFFFFFFF")) +(.the i64::-limit (_.manual "-0x8000000000000000")) +(.the i64::+iteration (_.manual "+0x10000000000000000")) +(.the i64::-iteration (_.manual "-0x10000000000000000")) +(.the i64::+cap (_.manual "+0x8000000000000000")) +(.the i64::-cap (_.manual "-0x8000000000000001")) + +(the (i64::64 input) + (with_vars [temp] + (`` (<| (,, (template.with [ ] + [(_.if (|> input ) + (all _.then + (_.set (list temp) (_.% input)) + (_.return (_.? (|> temp ) + (|> temp (_.- ) (_.+ )) + temp))))] + + [(_.> ..i64::+limit) ..i64::+iteration ..i64::+cap ..i64::-limit] + [(_.< ..i64::-limit) ..i64::-iteration ..i64::-cap ..i64::+limit] + )) + (_.return (for .python input + ... This +- is only necessary to guarantee that values within the limits are always longs in Python 2 + (|> input (_.+ ..i64::+limit) (_.- ..i64::+limit)))))))) + +(.the as_natural (_.% ..i64::+iteration)) -(runtime - (i64::left_shifted param subject) - (_.return (|> subject - (_.bit_shl (_.% (_.int +64) param)) - ..i64::64))) - -(runtime - (i64::right_shifted param subject) - (all _.then - (_.set (list param) (_.% (_.int +64) param)) - (_.return (_.? (_.= (_.int +0) param) - subject - (|> subject - ..as_natural - (_.bit_shr param)))))) - -(runtime - (i64#/ param subject) - (with_vars [floored] - (all _.then - (_.set (list floored) (_.// param subject)) - (_.return (let [potentially_floored? (_.< (_.int +0) floored) - inexact? (|> subject - (_.% param) - (_.= (_.int +0)) - _.not)] - (<| (_.? (_.and potentially_floored? - inexact?) - (_.+ (_.int +1) floored)) - (_.? (_.= (_.manual "+9223372036854775808") - floored) - (_.manual "-9223372036854775808")) - floored)))))) - -(runtime - (i64::remainder param subject) - (_.return (_.- (|> subject (..i64#/ param) (_.* param)) - subject))) +(the (i64::left_shifted param subject) + (_.return (|> subject + (_.bit_shl (_.% (_.int +64) param)) + ..i64::64))) + +(the (i64::right_shifted param subject) + (all _.then + (_.set (list param) (_.% (_.int +64) param)) + (_.return (_.? (_.= (_.int +0) param) + subject + (|> subject + ..as_natural + (_.bit_shr param)))))) + +(the (i64#/ param subject) + (with_vars [floored] + (all _.then + (_.set (list floored) (_.// param subject)) + (_.return (let [potentially_floored? (_.< (_.int +0) floored) + inexact? (|> subject + (_.% param) + (_.= (_.int +0)) + _.not)] + (<| (_.? (_.and potentially_floored? + inexact?) + (_.+ (_.int +1) floored)) + (_.? (_.= (_.manual "+9223372036854775808") + floored) + (_.manual "-9223372036854775808")) + floored)))))) + +(the (i64::remainder param subject) + (_.return (_.- (|> subject (..i64#/ param) (_.* param)) + subject))) (template.with [ ] - [(runtime - ( left right) - (_.return (..i64::64 ( (..as_natural left) (..as_natural right)))))] + [(the ( left right) + (_.return (..i64::64 ( (..as_natural left) (..as_natural right)))))] [i64::and _.bit_and] [i64::or _.bit_or] [i64::xor _.bit_xor] ) -(the python_version +(.the python_version Expression (|> (_.__import__/1 (_.unicode "sys")) (_.its "version_info") (_.its "major"))) -(runtime - (i64::char value) - (_.return (_.? (_.= (_.int +3) ..python_version) - (_.chr/1 value) - (_.unichr/1 value)))) +(the (i64::char value) + (_.return (_.? (_.= (_.int +3) ..python_version) + (_.chr/1 value) + (_.unichr/1 value)))) -(the runtime//i64 +(.the runtime//i64 Statement (all _.then @i64::64 @@ -422,51 +408,47 @@ @i64::char )) -(runtime - (f64::/ parameter subject) - (_.return (_.? (_.= (_.float +0.0) parameter) - (<| (_.? (_.> (_.float +0.0) subject) - (_.float d.positive_infinity)) - (_.? (_.< (_.float +0.0) subject) - (_.float d.negative_infinity)) - (_.float d.not_a_number)) - (_./ parameter subject)))) - -(the runtime//f64 +(the (f64::/ parameter subject) + (_.return (_.? (_.= (_.float +0.0) parameter) + (<| (_.? (_.> (_.float +0.0) subject) + (_.float d.positive_infinity)) + (_.? (_.< (_.float +0.0) subject) + (_.float d.negative_infinity)) + (_.float d.not_a_number)) + (_./ parameter subject)))) + +(.the runtime//f64 Statement (all _.then @f64::/ )) -(runtime - (text::index start param subject) - (with_vars [idx] - (all _.then - (_.set (list idx) (|> subject (_.do "find" (list param start)))) - (_.return (_.? (_.= (_.int -1) idx) - ..none - (..some (..i64::64 idx))))))) +(the (text::index start param subject) + (with_vars [idx] + (all _.then + (_.set (list idx) (|> subject (_.do "find" (list param start)))) + (_.return (_.? (_.= (_.int -1) idx) + ..none + (..some (..i64::64 idx))))))) -(the ++ +(.the ++ (|>> (_.+ (_.int +1)))) -(the (within? top value) +(.the (within? top value) (-> Expression Expression Computation) (_.and (|> value (_.>= (_.int +0))) (|> value (_.< top)))) -(runtime - (text::clip @offset @length @text) - (_.return (|> @text (_.slice @offset (_.+ @offset @length))))) +(the (text::clip @offset @length @text) + (_.return (|> @text (_.slice @offset (_.+ @offset @length))))) -(runtime - (text::char idx text) - (_.if (|> idx (within? (_.len/1 text))) - (_.return (|> text (_.slice idx (..++ idx)) _.ord/1 ..i64::64)) - (_.raise (_.Exception/1 (_.unicode "[Lux Error] Cannot get char from text."))))) +(the (text::char idx text) + (_.if (|> idx (within? (_.len/1 text))) + (_.return (|> text (_.slice idx (..++ idx)) _.ord/1 ..i64::64)) + (_.raise (_.Exception/1 (_.unicode "[Lux Error] Cannot get char from text."))))) -(the runtime//text +(.the runtime//text Statement (all _.then @text::index @@ -474,19 +456,18 @@ @text::char )) -(runtime - (array::write idx value array) - (all _.then - (_.set (list (_.item idx array)) value) - (_.return array))) +(the (array::write idx value array) + (all _.then + (_.set (list (_.item idx array)) value) + (_.return array))) -(the runtime//array +(.the runtime//array Statement (all _.then @array::write )) -(the full_runtime +(.the full_runtime Statement (all _.then runtime//lux @@ -498,10 +479,10 @@ runtime//array )) -(the module_id +(.the module_id 0) -(the .public translate +(.the .public translate (Operation [Registry Output]) (do phase.monad [_ (/////translation.execute! ..full_runtime) diff --git a/stdlib/source/library/lux/meta/compiler/language/lux/phase/translation/r/runtime.lux b/stdlib/source/library/lux/meta/compiler/language/lux/phase/translation/r/runtime.lux index 458d20204c..c42cedd48a 100644 --- a/stdlib/source/library/lux/meta/compiler/language/lux/phase/translation/r/runtime.lux +++ b/stdlib/source/library/lux/meta/compiler/language/lux/phase/translation/r/runtime.lux @@ -4,7 +4,8 @@ (.using [library [lux (.except Location - ++ i64) + ++ i64 + the) [abstract ["[0]" monad (.only do)]] [control @@ -46,7 +47,7 @@ [archive (.only Output Archive) ["[0]" artifact (.only Registry)]]]]]]) -(the module_id +(.the module_id 0) (template.with [ ] @@ -62,15 +63,15 @@ (every .public (Translator i) (-> Phase Archive i (Operation Expression))) -(the .public unit +(.the .public unit Expression (_.string /////synthesis.unit)) -(the full_32 (hex "FFFFFFFF")) -(the half_32 (hex "7FFFFFFF")) -(the post_32 (hex "100000000")) +(.the full_32 (hex "FFFFFFFF")) +(.the half_32 (hex "7FFFFFFF")) +(.the post_32 (hex "100000000")) -(the (cap_32 input) +(.the (cap_32 input) (-> Natural Integer) (if (n.> full_32 input) (|> input (i64.and full_32) cap_32) @@ -81,7 +82,7 @@ ... else (.integer input))) -(the .public with_vars +(.the .public with_vars (syntax.macro (_ [vars (.tuple (<>.some .local)) body .any]) (do [! meta.monad] @@ -94,7 +95,7 @@ list.together))] (, body)))))))) -(the runtime +(.the the (syntax.macro (_ [declaration (<>.or .local (.form (<>.and .local (<>.some .local)))) @@ -107,11 +108,11 @@ (when declaration {.#Left name} (let [g!name (code.local name)] - (in (list (` (the .public (, g!name) + (in (list (` (.the .public (, g!name) _.SVar (, runtime_name))) - (` (the (, (code.local (%.message "@" name))) + (` (.the (, (code.local (%.message "@" name))) _.Expression (_.set! (, runtime_name) (, code))))))) @@ -120,119 +121,115 @@ inputsC (list#each code.local inputs) inputs_typesC (list#each (function.constant (` _.Expression)) inputs)] - (in (list (` (the .public ((, g!name) (,* inputsC)) + (in (list (` (.the .public ((, g!name) (,* inputsC)) (-> (,* inputs_typesC) _.Expression) (_.apply (list (,* inputsC)) (, runtime_name)))) - (` (the (, (code.local (%.message "@" name))) + (` (.the (, (code.local (%.message "@" name))) _.Expression (..with_vars [(,* inputsC)] (_.set! (, runtime_name) (_.function (list (,* inputsC)) (, code))))))))))))))) -(the .public variant_tag_field "luxVT") -(the .public variant_flag_field "luxVF") -(the .public variant_value_field "luxVV") +(.the .public variant_tag_field "luxVT") +(.the .public variant_flag_field "luxVF") +(.the .public variant_value_field "luxVV") -(the .public (flag value) +(.the .public (flag value) (-> Bit Expression) (if value (_.string "") _.null)) -(runtime - (adt::variant tag last? value) - (_.named_list (list [..variant_tag_field (_.as::integer tag)] - [..variant_flag_field last?] - [..variant_value_field value]))) +(the (adt::variant tag last? value) + (_.named_list (list [..variant_tag_field (_.as::integer tag)] + [..variant_flag_field last?] + [..variant_value_field value]))) -(the .public (variant tag last? value) +(.the .public (variant tag last? value) (-> Natural Bit Expression Expression) (adt::variant (_.int (.integer tag)) (flag last?) value)) -(the .public none +(.the .public none Expression (variant 0 #0 ..unit)) -(the .public some +(.the .public some (-> Expression Expression) (variant 1 #1)) -(the .public left +(.the .public left (-> Expression Expression) (variant 0 #0)) -(the .public right +(.the .public right (-> Expression Expression) (variant 1 #1)) -(the high_shift (_.bit_shl (_.int +32))) +(.the high_shift (_.bit_shl (_.int +32))) (template.with [ ] - [(runtime - (|> (_.as::integer (_.int +2)) (_.** (_.as::integer (_.int )))))] + [(the + (|> (_.as::integer (_.int +2)) + (_.** (_.as::integer (_.int )))))] [f2^32 +32] [f2^63 +63] ) -(the (as_double value) +(.the (as_double value) (-> Expression Expression) (_.apply (list value) (_.var "as.double"))) -(the .public i64_high_field "luxIH") -(the .public i64_low_field "luxIL") - -(runtime - (i64::unsigned_low input) - (with_vars [low] - (all _.then - (_.set! low (_.item (_.string ..i64_low_field) input)) - (_.if (_.< (_.int +0) low) - (_.+ f2^32 low) - low)))) - -(runtime - (i64::float input) - (let [high (|> input - (_.item (_.string ..i64_high_field)) - high_shift) - low (|> input - i64::unsigned_low)] - (|> high (_.+ low) as_double))) - -(runtime - (i64::new high low) - (_.named_list (list [..i64_high_field (_.as::integer high)] - [..i64_low_field (_.as::integer low)]))) - -(the high_32 +(.the .public i64_high_field "luxIH") +(.the .public i64_low_field "luxIL") + +(the (i64::unsigned_low input) + (with_vars [low] + (all _.then + (_.set! low (_.item (_.string ..i64_low_field) input)) + (_.if (_.< (_.int +0) low) + (_.+ f2^32 low) + low)))) + +(the (i64::float input) + (let [high (|> input + (_.item (_.string ..i64_high_field)) + high_shift) + low (|> input + i64::unsigned_low)] + (|> high (_.+ low) as_double))) + +(the (i64::new high low) + (_.named_list (list [..i64_high_field (_.as::integer high)] + [..i64_low_field (_.as::integer low)]))) + +(.the high_32 (-> Natural Natural) (i64.right_shifted 32)) -(the low_32 +(.the low_32 (-> Natural Natural) (|>> (i64.and (hex "FFFFFFFF")))) -(the .public (i64 value) +(.the .public (i64 value) (-> Integer Expression) (let [value (.natural value)] (i64::new (|> value ..high_32 ..cap_32 _.int) (|> value ..low_32 ..cap_32 _.int)))) -(the .public (lux_i64 high low) +(.the .public (lux_i64 high low) (-> Integer Integer Integer) (|> high (i64.left_shifted 32) (i64.or low))) (template.with [ ] - [(runtime - - (..i64 ))] + [(the + (..i64 ))] [i64::zero +0] [i64::one +1] @@ -240,427 +237,407 @@ [i64::max i#top] ) -(the .public i64_high (_.item (_.string ..i64_high_field))) -(the .public i64_low (_.item (_.string ..i64_low_field))) - -(runtime - (i64::not input) - (i64::new (|> input i64_high _.bit_not) - (|> input i64_low _.bit_not))) - -(runtime - (i64::+ param subject) - (with_vars [sH sL pH pL - x00 x16 x32 x48] - (all _.then - (_.set! sH (|> subject i64_high)) - (_.set! sL (|> subject i64_low)) - (_.set! pH (|> param i64_high)) - (_.set! pL (|> param i64_low)) - (let [bits16 (_.manual "0xFFFF") - move_top_16 (_.bit_shl (_.int +16)) - top_16 (_.bit_ushr (_.int +16)) - bottom_16 (_.bit_and bits16) - split_16 (function (_ source) - [(|> source top_16) - (|> source bottom_16)]) - split_integer (function (_ high low) - [(split_16 high) - (split_16 low)]) - - [[s48 s32] [s16 s00]] (split_integer sH sL) - [[p48 p32] [p16 p00]] (split_integer pH pL) - new_half (function (_ top bottom) - (|> top bottom_16 move_top_16 - (_.bit_or (bottom_16 bottom))))] - (all _.then - (_.set! x00 (|> s00 (_.+ p00))) - (_.set! x16 (|> x00 top_16 (_.+ s16) (_.+ p16))) - (_.set! x32 (|> x16 top_16 (_.+ s32) (_.+ p32))) - (_.set! x48 (|> x32 top_16 (_.+ s48) (_.+ p48))) - (i64::new (new_half x48 x32) - (new_half x16 x00))))))) - -(runtime - (i64::= expected actual) - (let [n/a? (function (_ value) - (_.apply (list value) (_.var "is.na"))) - isTRUE? (function (_ value) - (_.apply (list value) (_.var "isTRUE"))) - comparison (is (-> (-> Expression Expression) Expression) - (function (_ field) - (|> (|> (field actual) (_.= (field expected))) - (_.or (|> (n/a? (field actual)) - (_.and (n/a? (field expected))))))))] - (|> (comparison i64_high) - (_.and (comparison i64_low)) - isTRUE?))) - -(runtime - (i64::opposite input) - (_.if (|> input (i64::= i64::min)) - i64::min - (|> input i64::not (i64::+ i64::one)))) - -(runtime - i64::-one - (i64::opposite i64::one)) - -(runtime - (i64::- param subject) - (i64::+ (i64::opposite param) subject)) - -(runtime - (i64::< reference it) - (with_vars [r_? s_?] - (all _.then - (_.set! s_? (|> it ..i64_high (_.< (_.int +0)))) - (_.set! r_? (|> reference ..i64_high (_.< (_.int +0)))) - (|> (|> s_? (_.and (_.not r_?))) - (_.or (|> (_.not s_?) (_.and r_?) _.not)) - (_.or (|> it - (i64::- reference) - ..i64_high - (_.< (_.int +0)))))))) - -(runtime - (i64::of_float input) - (_.cond (list [(_.apply (list input) (_.var "is.nan")) - i64::zero] - [(|> input (_.<= (_.opposite f2^63))) - i64::min] - [(|> input (_.+ (_.float +1.0)) (_.>= f2^63)) - i64::max] - [(|> input (_.< (_.float +0.0))) - (|> input _.opposite i64::of_float i64::opposite)]) - (i64::new (|> input (_./ f2^32)) - (|> input (_.%% f2^32))))) - -(runtime - (i64::* param subject) - (with_vars [sH sL pH pL - x00 x16 x32 x48] - (all _.then - (_.set! sH (|> subject i64_high)) - (_.set! pH (|> param i64_high)) - (let [negative_subject? (|> sH (_.< (_.int +0))) - negative_param? (|> pH (_.< (_.int +0)))] - (_.cond (list [negative_subject? - (_.if negative_param? - (i64::* (i64::opposite param) - (i64::opposite subject)) - (i64::opposite (i64::* param - (i64::opposite subject))))] - - [negative_param? - (i64::opposite (i64::* (i64::opposite param) - subject))]) - (all _.then - (_.set! sL (|> subject i64_low)) - (_.set! pL (|> param i64_low)) - (let [bits16 (_.manual "0xFFFF") - move_top_16 (_.bit_shl (_.int +16)) - top_16 (_.bit_ushr (_.int +16)) - bottom_16 (_.bit_and bits16) - split_16 (function (_ source) - [(|> source top_16) - (|> source bottom_16)]) - split_integer (function (_ high low) - [(split_16 high) - (split_16 low)]) - new_half (function (_ top bottom) - (|> top bottom_16 move_top_16 - (_.bit_or (bottom_16 bottom)))) - x16_top (|> x16 top_16) - x32_top (|> x32 top_16)] - (with_vars [s48 s32 s16 s00 - p48 p32 p16 p00] - (let [[[_s48 _s32] [_s16 _s00]] (split_integer sH sL) - [[_p48 _p32] [_p16 _p00]] (split_integer pH pL) - set_subject_chunks! (all _.then (_.set! s48 _s48) (_.set! s32 _s32) (_.set! s16 _s16) (_.set! s00 _s00)) - set_param_chunks! (all _.then (_.set! p48 _p48) (_.set! p32 _p32) (_.set! p16 _p16) (_.set! p00 _p00))] - (all _.then - set_subject_chunks! - set_param_chunks! - (_.set! x00 (|> s00 (_.* p00))) - (_.set! x16 (|> x00 top_16 (_.+ (|> s16 (_.* p00))))) - (_.set! x32 x16_top) - (_.set! x16 (|> x16 bottom_16 (_.+ (|> s00 (_.* p16))))) - (_.set! x32 (|> x32 (_.+ x16_top) (_.+ (|> s32 (_.* p00))))) - (_.set! x48 x32_top) - (_.set! x32 (|> x32 bottom_16 (_.+ (|> s16 (_.* p16))))) - (_.set! x48 (|> x48 (_.+ x32_top))) - (_.set! x32 (|> x32 bottom_16 (_.+ (|> s00 (_.* p32))))) - (_.set! x48 (|> x48 (_.+ x32_top) - (_.+ (|> s48 (_.* p00))) - (_.+ (|> s32 (_.* p16))) - (_.+ (|> s16 (_.* p32))) - (_.+ (|> s00 (_.* p48))))) - (i64::new (new_half x48 x32) - (new_half x16 x00))))) - ))))))) - -(the (limit_shift! shift) +(.the .public i64_high (_.item (_.string ..i64_high_field))) +(.the .public i64_low (_.item (_.string ..i64_low_field))) + +(the (i64::not input) + (i64::new (|> input i64_high _.bit_not) + (|> input i64_low _.bit_not))) + +(the (i64::+ param subject) + (with_vars [sH sL pH pL + x00 x16 x32 x48] + (all _.then + (_.set! sH (|> subject i64_high)) + (_.set! sL (|> subject i64_low)) + (_.set! pH (|> param i64_high)) + (_.set! pL (|> param i64_low)) + (let [bits16 (_.manual "0xFFFF") + move_top_16 (_.bit_shl (_.int +16)) + top_16 (_.bit_ushr (_.int +16)) + bottom_16 (_.bit_and bits16) + split_16 (function (_ source) + [(|> source top_16) + (|> source bottom_16)]) + split_integer (function (_ high low) + [(split_16 high) + (split_16 low)]) + + [[s48 s32] [s16 s00]] (split_integer sH sL) + [[p48 p32] [p16 p00]] (split_integer pH pL) + new_half (function (_ top bottom) + (|> top bottom_16 move_top_16 + (_.bit_or (bottom_16 bottom))))] + (all _.then + (_.set! x00 (|> s00 (_.+ p00))) + (_.set! x16 (|> x00 top_16 (_.+ s16) (_.+ p16))) + (_.set! x32 (|> x16 top_16 (_.+ s32) (_.+ p32))) + (_.set! x48 (|> x32 top_16 (_.+ s48) (_.+ p48))) + (i64::new (new_half x48 x32) + (new_half x16 x00))))))) + +(the (i64::= expected actual) + (let [n/a? (function (_ value) + (_.apply (list value) (_.var "is.na"))) + isTRUE? (function (_ value) + (_.apply (list value) (_.var "isTRUE"))) + comparison (is (-> (-> Expression Expression) Expression) + (function (_ field) + (|> (|> (field actual) (_.= (field expected))) + (_.or (|> (n/a? (field actual)) + (_.and (n/a? (field expected))))))))] + (|> (comparison i64_high) + (_.and (comparison i64_low)) + isTRUE?))) + +(the (i64::opposite input) + (_.if (|> input (i64::= i64::min)) + i64::min + (|> input i64::not (i64::+ i64::one)))) + +(the i64::-one + (i64::opposite i64::one)) + +(the (i64::- param subject) + (i64::+ (i64::opposite param) subject)) + +(the (i64::< reference it) + (with_vars [r_? s_?] + (all _.then + (_.set! s_? (|> it ..i64_high (_.< (_.int +0)))) + (_.set! r_? (|> reference ..i64_high (_.< (_.int +0)))) + (|> (|> s_? (_.and (_.not r_?))) + (_.or (|> (_.not s_?) (_.and r_?) _.not)) + (_.or (|> it + (i64::- reference) + ..i64_high + (_.< (_.int +0)))))))) + +(the (i64::of_float input) + (_.cond (list [(_.apply (list input) (_.var "is.nan")) + i64::zero] + [(|> input (_.<= (_.opposite f2^63))) + i64::min] + [(|> input (_.+ (_.float +1.0)) (_.>= f2^63)) + i64::max] + [(|> input (_.< (_.float +0.0))) + (|> input _.opposite i64::of_float i64::opposite)]) + (i64::new (|> input (_./ f2^32)) + (|> input (_.%% f2^32))))) + +(the (i64::* param subject) + (with_vars [sH sL pH pL + x00 x16 x32 x48] + (all _.then + (_.set! sH (|> subject i64_high)) + (_.set! pH (|> param i64_high)) + (let [negative_subject? (|> sH (_.< (_.int +0))) + negative_param? (|> pH (_.< (_.int +0)))] + (_.cond (list [negative_subject? + (_.if negative_param? + (i64::* (i64::opposite param) + (i64::opposite subject)) + (i64::opposite (i64::* param + (i64::opposite subject))))] + + [negative_param? + (i64::opposite (i64::* (i64::opposite param) + subject))]) + (all _.then + (_.set! sL (|> subject i64_low)) + (_.set! pL (|> param i64_low)) + (let [bits16 (_.manual "0xFFFF") + move_top_16 (_.bit_shl (_.int +16)) + top_16 (_.bit_ushr (_.int +16)) + bottom_16 (_.bit_and bits16) + split_16 (function (_ source) + [(|> source top_16) + (|> source bottom_16)]) + split_integer (function (_ high low) + [(split_16 high) + (split_16 low)]) + new_half (function (_ top bottom) + (|> top bottom_16 move_top_16 + (_.bit_or (bottom_16 bottom)))) + x16_top (|> x16 top_16) + x32_top (|> x32 top_16)] + (with_vars [s48 s32 s16 s00 + p48 p32 p16 p00] + (let [[[_s48 _s32] [_s16 _s00]] (split_integer sH sL) + [[_p48 _p32] [_p16 _p00]] (split_integer pH pL) + set_subject_chunks! (all _.then (_.set! s48 _s48) (_.set! s32 _s32) (_.set! s16 _s16) (_.set! s00 _s00)) + set_param_chunks! (all _.then (_.set! p48 _p48) (_.set! p32 _p32) (_.set! p16 _p16) (_.set! p00 _p00))] + (all _.then + set_subject_chunks! + set_param_chunks! + (_.set! x00 (|> s00 (_.* p00))) + (_.set! x16 (|> x00 top_16 (_.+ (|> s16 (_.* p00))))) + (_.set! x32 x16_top) + (_.set! x16 (|> x16 bottom_16 (_.+ (|> s00 (_.* p16))))) + (_.set! x32 (|> x32 (_.+ x16_top) (_.+ (|> s32 (_.* p00))))) + (_.set! x48 x32_top) + (_.set! x32 (|> x32 bottom_16 (_.+ (|> s16 (_.* p16))))) + (_.set! x48 (|> x48 (_.+ x32_top))) + (_.set! x32 (|> x32 bottom_16 (_.+ (|> s00 (_.* p32))))) + (_.set! x48 (|> x48 (_.+ x32_top) + (_.+ (|> s48 (_.* p00))) + (_.+ (|> s32 (_.* p16))) + (_.+ (|> s16 (_.* p32))) + (_.+ (|> s00 (_.* p48))))) + (i64::new (new_half x48 x32) + (new_half x16 x00))))) + ))))))) + +(.the (limit_shift! shift) (-> SVar Expression) (_.set! shift (|> shift (_.bit_and (_.as::integer (_.int +63)))))) -(the (no_shift_clause shift input) +(.the (no_shift_clause shift input) (-> SVar SVar [Expression Expression]) [(|> shift (_.= (_.int +0))) input]) -(runtime - (i64::left_shifted shift input) - (all _.then - (limit_shift! shift) - (_.cond (list (no_shift_clause shift input) - [(|> shift (_.< (_.int +32))) - (let [mid (|> (i64_low input) (_.bit_ushr (|> (_.int +32) (_.- shift)))) - high (|> (i64_high input) - (_.bit_shl shift) - (_.bit_or mid)) - low (|> (i64_low input) - (_.bit_shl shift))] - (i64::new high low))]) - (let [high (|> (i64_high input) - (_.bit_shl (|> shift (_.- (_.int +32)))))] - (i64::new high (_.int +0)))))) - -(runtime - (i64::arithmetic_right_shifted_32 shift input) - (let [top_bit (|> input (_.bit_and (_.as::integer (_.int (hex "+80000000")))))] - (|> input - (_.bit_ushr shift) - (_.bit_or top_bit)))) - -(runtime - (i64::arithmetic_right_shifted shift input) - (all _.then - (limit_shift! shift) - (_.cond (list (no_shift_clause shift input) - [(|> shift (_.< (_.int +32))) - (let [mid (|> (i64_high input) (_.bit_shl (|> (_.int +32) (_.- shift)))) - high (|> (i64_high input) - (i64::arithmetic_right_shifted_32 shift)) - low (|> (i64_low input) - (_.bit_ushr shift) - (_.bit_or mid))] - (i64::new high low))]) - (let [low (|> (i64_high input) - (i64::arithmetic_right_shifted_32 (|> shift (_.- (_.int +32))))) - high (_.if (_.< (_.int +0) - (i64_high input)) - (_.int -1) - (_.int +0))] - (i64::new high low))))) - -(runtime - (i64::/ param subject) - (let [negative? (|>> (i64::< i64::zero)) - valid_division_check [(|> param (i64::= i64::zero)) - (_.stop (_.string "Cannot divide by zero!"))] - short_circuit_check [(|> subject (i64::= i64::zero)) - i64::zero]] - (_.cond (list valid_division_check - short_circuit_check - - [(|> subject (i64::= i64::min)) - (_.cond (list [(|> (|> param (i64::= i64::one)) - (_.or (|> param (i64::= i64::-one)))) - i64::min] - [(|> param (i64::= i64::min)) - i64::one]) - (with_vars [approximation] - (all _.then - (_.set! approximation - (|> subject - (i64::arithmetic_right_shifted (_.int +1)) - (i64::/ param) - (i64::left_shifted (_.int +1)))) - (_.if (|> approximation (i64::= i64::zero)) - (_.if (negative? param) - i64::one - i64::-one) - (let [remainder (i64::- (i64::* param approximation) - subject)] - (|> remainder - (i64::/ param) - (i64::+ approximation)))))))] - [(|> param (i64::= i64::min)) - i64::zero] - - [(negative? subject) - (_.if (negative? param) - (|> (i64::opposite subject) - (i64::/ (i64::opposite param))) - (|> (i64::opposite subject) - (i64::/ param) - i64::opposite))] - - [(negative? param) - (|> param - i64::opposite - (i64::/ subject) - i64::opposite)]) - (with_vars [result remainder approximate approximate_result log2 approximate_remainder] - (all _.then - (_.set! result i64::zero) - (_.set! remainder subject) - (_.while (|> (|> remainder (i64::< param)) - (_.or (|> remainder (i64::= param)))) - (let [calc_rough_estimate (_.apply (list (|> (i64::float remainder) (_./ (i64::float param)))) - (_.var "floor")) - calc_approximate_result (i64::of_float approximate) - calc_approximate_remainder (|> approximate_result (i64::* param)) - delta (_.if (_.> log2 (_.float +48.0)) - (_.** (|> log2 (_.- (_.float +48.0))) - (_.float +2.0)) - (_.float +1.0))] +(the (i64::left_shifted shift input) + (all _.then + (limit_shift! shift) + (_.cond (list (no_shift_clause shift input) + [(|> shift (_.< (_.int +32))) + (let [mid (|> (i64_low input) (_.bit_ushr (|> (_.int +32) (_.- shift)))) + high (|> (i64_high input) + (_.bit_shl shift) + (_.bit_or mid)) + low (|> (i64_low input) + (_.bit_shl shift))] + (i64::new high low))]) + (let [high (|> (i64_high input) + (_.bit_shl (|> shift (_.- (_.int +32)))))] + (i64::new high (_.int +0)))))) + +(the (i64::arithmetic_right_shifted_32 shift input) + (let [top_bit (|> input (_.bit_and (_.as::integer (_.int (hex "+80000000")))))] + (|> input + (_.bit_ushr shift) + (_.bit_or top_bit)))) + +(the (i64::arithmetic_right_shifted shift input) + (all _.then + (limit_shift! shift) + (_.cond (list (no_shift_clause shift input) + [(|> shift (_.< (_.int +32))) + (let [mid (|> (i64_high input) (_.bit_shl (|> (_.int +32) (_.- shift)))) + high (|> (i64_high input) + (i64::arithmetic_right_shifted_32 shift)) + low (|> (i64_low input) + (_.bit_ushr shift) + (_.bit_or mid))] + (i64::new high low))]) + (let [low (|> (i64_high input) + (i64::arithmetic_right_shifted_32 (|> shift (_.- (_.int +32))))) + high (_.if (_.< (_.int +0) + (i64_high input)) + (_.int -1) + (_.int +0))] + (i64::new high low))))) + +(the (i64::/ param subject) + (let [negative? (|>> (i64::< i64::zero)) + valid_division_check [(|> param (i64::= i64::zero)) + (_.stop (_.string "Cannot divide by zero!"))] + short_circuit_check [(|> subject (i64::= i64::zero)) + i64::zero]] + (_.cond (list valid_division_check + short_circuit_check + + [(|> subject (i64::= i64::min)) + (_.cond (list [(|> (|> param (i64::= i64::one)) + (_.or (|> param (i64::= i64::-one)))) + i64::min] + [(|> param (i64::= i64::min)) + i64::one]) + (with_vars [approximation] (all _.then - (_.set! approximate (_.apply (list (_.float +1.0) calc_rough_estimate) - (_.var "max"))) - (_.set! log2 (let [log (function (_ input) - (_.apply (list input) (_.var "log")))] - (_.apply (list (|> (log (_.int +2)) - (_./ (log approximate)))) - (_.var "ceil")))) - (_.set! approximate_result calc_approximate_result) - (_.set! approximate_remainder calc_approximate_remainder) - (_.while (|> (negative? approximate_remainder) - (_.or (|> approximate_remainder (i64::< remainder)))) - (all _.then - (_.set! approximate (|> delta (_.- approximate))) - (_.set! approximate_result calc_approximate_result) - (_.set! approximate_remainder calc_approximate_remainder))) - (_.set! result (|> (_.if (|> approximate_result (i64::= i64::zero)) - i64::one - approximate_result) - (i64::+ result))) - (_.set! remainder (|> remainder (i64::- approximate_remainder)))))) - result)) - ))) - -(runtime - (i64::% param subject) - (let [flat (|> subject (i64::/ param) (i64::* param))] - (|> subject (i64::- flat)))) - -(runtime - (lux::try op) - (with_vars [error value] - (_.try (all _.then - (_.set! value (_.apply (list ..unit) op)) - (..right value)) - {.#None} - {.#Some (_.function (list error) - (..left (_.item (_.string "message") - error)))} - {.#None}))) - -(runtime - (lux::program_args program_args) - (with_vars [inputs value] - (all _.then - (_.set! inputs ..none) - (<| (_.for_in value program_args) - (_.set! inputs (..some (_.list (list value inputs))))) - inputs))) - -(the runtime//lux + (_.set! approximation + (|> subject + (i64::arithmetic_right_shifted (_.int +1)) + (i64::/ param) + (i64::left_shifted (_.int +1)))) + (_.if (|> approximation (i64::= i64::zero)) + (_.if (negative? param) + i64::one + i64::-one) + (let [remainder (i64::- (i64::* param approximation) + subject)] + (|> remainder + (i64::/ param) + (i64::+ approximation)))))))] + [(|> param (i64::= i64::min)) + i64::zero] + + [(negative? subject) + (_.if (negative? param) + (|> (i64::opposite subject) + (i64::/ (i64::opposite param))) + (|> (i64::opposite subject) + (i64::/ param) + i64::opposite))] + + [(negative? param) + (|> param + i64::opposite + (i64::/ subject) + i64::opposite)]) + (with_vars [result remainder approximate approximate_result log2 approximate_remainder] + (all _.then + (_.set! result i64::zero) + (_.set! remainder subject) + (_.while (|> (|> remainder (i64::< param)) + (_.or (|> remainder (i64::= param)))) + (let [calc_rough_estimate (_.apply (list (|> (i64::float remainder) (_./ (i64::float param)))) + (_.var "floor")) + calc_approximate_result (i64::of_float approximate) + calc_approximate_remainder (|> approximate_result (i64::* param)) + delta (_.if (_.> log2 (_.float +48.0)) + (_.** (|> log2 (_.- (_.float +48.0))) + (_.float +2.0)) + (_.float +1.0))] + (all _.then + (_.set! approximate (_.apply (list (_.float +1.0) calc_rough_estimate) + (_.var "max"))) + (_.set! log2 (let [log (function (_ input) + (_.apply (list input) (_.var "log")))] + (_.apply (list (|> (log (_.int +2)) + (_./ (log approximate)))) + (_.var "ceil")))) + (_.set! approximate_result calc_approximate_result) + (_.set! approximate_remainder calc_approximate_remainder) + (_.while (|> (negative? approximate_remainder) + (_.or (|> approximate_remainder (i64::< remainder)))) + (all _.then + (_.set! approximate (|> delta (_.- approximate))) + (_.set! approximate_result calc_approximate_result) + (_.set! approximate_remainder calc_approximate_remainder))) + (_.set! result (|> (_.if (|> approximate_result (i64::= i64::zero)) + i64::one + approximate_result) + (i64::+ result))) + (_.set! remainder (|> remainder (i64::- approximate_remainder)))))) + result)) + ))) + +(the (i64::% param subject) + (let [flat (|> subject (i64::/ param) (i64::* param))] + (|> subject (i64::- flat)))) + +(the (lux::try op) + (with_vars [error value] + (_.try (all _.then + (_.set! value (_.apply (list ..unit) op)) + (..right value)) + {.#None} + {.#Some (_.function (list error) + (..left (_.item (_.string "message") + error)))} + {.#None}))) + +(the (lux::program_args program_args) + (with_vars [inputs value] + (all _.then + (_.set! inputs ..none) + (<| (_.for_in value program_args) + (_.set! inputs (..some (_.list (list value inputs))))) + inputs))) + +(.the runtime//lux Expression (all _.then @lux::try @lux::program_args )) -(the current_time_float +(.the current_time_float Expression (let [raw_time (_.apply (list) (_.var "Sys.time"))] (_.apply (list raw_time) (_.var "as.numeric")))) -(runtime - (io::current_time! _) - (|> current_time_float - (_.* (_.float +1,000.0)) - i64::of_float)) +(the (io::current_time! _) + (|> current_time_float + (_.* (_.float +1,000.0)) + i64::of_float)) -(the runtime//io +(.the runtime//io Expression (all _.then @io::current_time! )) -(the minimum_index_length +(.the minimum_index_length (-> SVar Expression) (|>> (_.+ (_.int +1)))) -(the (product_element product index) +(.the (product_element product index) (-> Expression Expression Expression) (|> product (_.item (|> index (_.+ (_.int +1)))))) -(the (product_tail product) +(.the (product_tail product) (-> SVar Expression) (|> product (_.item (_.length product)))) -(the (updated_index min_length product) +(.the (updated_index min_length product) (-> Expression Expression Expression) (|> min_length (_.- (_.length product)))) -(runtime - (tuple::left index product) - (let [$index_min_length (_.var "index_min_length")] - (all _.then - (_.set! $index_min_length (minimum_index_length index)) - (_.if (|> (_.length product) (_.> $index_min_length)) - ... No need for recursion - (product_element product index) - ... Needs recursion - (tuple::left (updated_index $index_min_length product) - (product_tail product)))))) - -(runtime - (tuple::right index product) - (let [$index_min_length (_.var "index_min_length")] - (all _.then - (_.set! $index_min_length (minimum_index_length index)) - (_.cond (list [... Last element. - (|> (_.length product) (_.= $index_min_length)) - (product_element product index)] - [... Needs recursion - (|> (_.length product) (_.< $index_min_length)) - (tuple::right (updated_index $index_min_length product) - (product_tail product))]) - ... Must slice - (|> product (_.slice_from index)))))) - -(runtime - (sum::get sum wants_last? wanted_tag) - (let [no_match _.null - sum_tag (|> sum (_.item (_.string ..variant_tag_field))) - sum_flag (|> sum (_.item (_.string ..variant_flag_field))) - sum_value (|> sum (_.item (_.string ..variant_value_field))) - is_last? (|> sum_flag (_.= (_.string ""))) - test_recursion (_.if is_last? - ... Must recurse. - (|> wanted_tag - (_.- sum_tag) - (sum::get sum_value wants_last?)) - no_match)] - (_.cond (list [(_.= sum_tag wanted_tag) - (_.if (_.= wants_last? sum_flag) - sum_value - test_recursion)] - - [(|> wanted_tag (_.> sum_tag)) - test_recursion] - - [(|> (|> wants_last? (_.= (_.string ""))) - (_.and (|> wanted_tag (_.< sum_tag)))) - (adt::variant (|> sum_tag (_.- wanted_tag)) sum_flag sum_value)]) - - no_match))) - -(the runtime//adt +(the (tuple::left index product) + (let [$index_min_length (_.var "index_min_length")] + (all _.then + (_.set! $index_min_length (minimum_index_length index)) + (_.if (|> (_.length product) (_.> $index_min_length)) + ... No need for recursion + (product_element product index) + ... Needs recursion + (tuple::left (updated_index $index_min_length product) + (product_tail product)))))) + +(the (tuple::right index product) + (let [$index_min_length (_.var "index_min_length")] + (all _.then + (_.set! $index_min_length (minimum_index_length index)) + (_.cond (list [... Last element. + (|> (_.length product) (_.= $index_min_length)) + (product_element product index)] + [... Needs recursion + (|> (_.length product) (_.< $index_min_length)) + (tuple::right (updated_index $index_min_length product) + (product_tail product))]) + ... Must slice + (|> product (_.slice_from index)))))) + +(the (sum::get sum wants_last? wanted_tag) + (let [no_match _.null + sum_tag (|> sum (_.item (_.string ..variant_tag_field))) + sum_flag (|> sum (_.item (_.string ..variant_flag_field))) + sum_value (|> sum (_.item (_.string ..variant_value_field))) + is_last? (|> sum_flag (_.= (_.string ""))) + test_recursion (_.if is_last? + ... Must recurse. + (|> wanted_tag + (_.- sum_tag) + (sum::get sum_value wants_last?)) + no_match)] + (_.cond (list [(_.= sum_tag wanted_tag) + (_.if (_.= wants_last? sum_flag) + sum_value + test_recursion)] + + [(|> wanted_tag (_.> sum_tag)) + test_recursion] + + [(|> (|> wants_last? (_.= (_.string ""))) + (_.and (|> wanted_tag (_.< sum_tag)))) + (adt::variant (|> sum_tag (_.- wanted_tag)) sum_flag sum_value)]) + + no_match))) + +(.the runtime//adt Expression (all _.then @tuple::left @@ -670,42 +647,40 @@ )) (template.with [ ] - [(runtime - ( mask input) - (i64::new ( (i64_high mask) - (i64_high input)) - ( (i64_low mask) - (i64_low input))))] + [(the ( mask input) + (i64::new ( (i64_high mask) + (i64_high input)) + ( (i64_low mask) + (i64_low input))))] [i64::and _.bit_and] [i64::or _.bit_or] [i64::xor _.bit_xor] ) -(runtime - (i64::right_shifted shift input) - (all _.then - (limit_shift! shift) - (_.cond (list (no_shift_clause shift input) - [(|> shift (_.< (_.int +32))) - (with_vars [$mid] - (let [mid (|> (i64_high input) (_.bit_shl (|> (_.int +32) (_.- shift)))) - high (|> (i64_high input) (_.bit_ushr shift)) - low (|> (i64_low input) - (_.bit_ushr shift) - (_.bit_or (_.if (_.apply (list $mid) (_.var "is.na")) - (_.as::integer (_.int +0)) - $mid)))] - (all _.then - (_.set! $mid mid) - (i64::new high low))))] - [(|> shift (_.= (_.int +32))) - (let [high (i64_high input)] - (i64::new (_.int +0) high))]) - (let [low (|> (i64_high input) (_.bit_ushr (|> shift (_.- (_.int +32)))))] - (i64::new (_.int +0) low))))) - -(the runtime//i64 +(the (i64::right_shifted shift input) + (all _.then + (limit_shift! shift) + (_.cond (list (no_shift_clause shift input) + [(|> shift (_.< (_.int +32))) + (with_vars [$mid] + (let [mid (|> (i64_high input) (_.bit_shl (|> (_.int +32) (_.- shift)))) + high (|> (i64_high input) (_.bit_ushr shift)) + low (|> (i64_low input) + (_.bit_ushr shift) + (_.bit_or (_.if (_.apply (list $mid) (_.var "is.na")) + (_.as::integer (_.int +0)) + $mid)))] + (all _.then + (_.set! $mid mid) + (i64::new high low))))] + [(|> shift (_.= (_.int +32))) + (let [high (i64_high input)] + (i64::new (_.int +0) high))]) + (let [low (|> (i64_high input) (_.bit_ushr (|> shift (_.- (_.int +32)))))] + (i64::new (_.int +0) low))))) + +(.the runtime//i64 Expression (all _.then @f2^32 @@ -740,79 +715,75 @@ @i64::% )) -(runtime - (decimal::decode input) - (with_vars [output] - (all _.then - (_.set! output (_.apply (list input) (_.var "as.numeric"))) - (_.if (|> output (_.= _.n/a)) - ..none - (..some output))))) +(the (decimal::decode input) + (with_vars [output] + (all _.then + (_.set! output (_.apply (list input) (_.var "as.numeric"))) + (_.if (|> output (_.= _.n/a)) + ..none + (..some output))))) -(the runtime//decimal +(.the runtime//decimal Expression (all _.then @decimal::decode )) -(the ++ +(.the ++ (-> Expression Expression) (|>> (_.+ (_.int +1)))) -(the (text_clip start end text) +(.the (text_clip start end text) (-> Expression Expression Expression Expression) (_.apply (list text start end) (_.var "substr"))) -(the (text_length text) +(.the (text_length text) (-> Expression Expression) (_.apply (list text) (_.var "nchar"))) -(runtime - (text::index subject param start) - (with_vars [idx startF subjectL] - (all _.then - (_.set! startF (i64::float start)) - (_.set! subjectL (text_length subject)) - (_.if (_.< subjectL startF) - (all _.then - (_.set! idx (|> (_.apply_kw (list param (_.if (|> startF (_.= (_.int +0))) - subject - (text_clip (++ startF) - (++ subjectL) - subject))) - (list ["fixed" (_.bool #1)]) - (_.var "regexpr")) - (_.item (_.int +1)))) - (_.if (|> idx (_.= (_.int -1))) - ..none - (..some (i64::of_float (|> idx (_.+ startF)))))) - ..none)))) - -(runtime - (text::clip text minimum additional) - (with_vars [length] - (all _.then - (_.set! length (_.length text)) - (_.set! to (_.+ additional minimum)) - (_.if (_.< length to) - (..some (text_clip (++ minimum) (++ to) text)) - ..none)))) - -(the (char_at idx text) +(the (text::index subject param start) + (with_vars [idx startF subjectL] + (all _.then + (_.set! startF (i64::float start)) + (_.set! subjectL (text_length subject)) + (_.if (_.< subjectL startF) + (all _.then + (_.set! idx (|> (_.apply_kw (list param (_.if (|> startF (_.= (_.int +0))) + subject + (text_clip (++ startF) + (++ subjectL) + subject))) + (list ["fixed" (_.bool #1)]) + (_.var "regexpr")) + (_.item (_.int +1)))) + (_.if (|> idx (_.= (_.int -1))) + ..none + (..some (i64::of_float (|> idx (_.+ startF)))))) + ..none)))) + +(the (text::clip text minimum additional) + (with_vars [length] + (all _.then + (_.set! length (_.length text)) + (_.set! to (_.+ additional minimum)) + (_.if (_.< length to) + (..some (text_clip (++ minimum) (++ to) text)) + ..none)))) + +(.the (char_at idx text) (-> Expression Expression Expression) (_.apply (list (text_clip idx idx text)) (_.var "utf8ToInt"))) -(runtime - (text::char text idx) - (_.if (_.< (_.length text) idx) - (all _.then - (_.set! idx (++ idx)) - (..some (i64::of_float (char_at idx text)))) - ..none)) +(the (text::char text idx) + (_.if (_.< (_.length text) idx) + (all _.then + (_.set! idx (++ idx)) + (..some (i64::of_float (char_at idx text)))) + ..none)) -(the runtime//text +(.the runtime//text Expression (all _.then @text::index @@ -820,40 +791,37 @@ @text::char )) -(the (check_index_out_of_bounds array idx body) +(.the (check_index_out_of_bounds array idx body) (-> Expression Expression Expression Expression) (_.if (_.> (_.length array) idx) (_.stop (_.string "Array index out of bounds!")) body)) -(runtime - (array::new size) - (with_vars [output] - (all _.then - (_.set! output (_.list (list))) - (_.set_item! (|> size (_.+ (_.int +1))) - _.null - output) - output))) - -(runtime - (array::get array idx) - (with_vars [temp] - (<| (check_index_out_of_bounds array idx) - (all _.then - (_.set! temp (|> array (_.item (_.+ (_.int +1) idx)))) - (_.if (|> temp (_.= _.null)) - ..none - (..some temp)))))) - -(runtime - (array::put array idx value) - (<| (check_index_out_of_bounds array idx) - (all _.then - (_.set_item! (_.+ (_.int +1) idx) value array) - array))) - -(the runtime//array +(the (array::new size) + (with_vars [output] + (all _.then + (_.set! output (_.list (list))) + (_.set_item! (|> size (_.+ (_.int +1))) + _.null + output) + output))) + +(the (array::get array idx) + (with_vars [temp] + (<| (check_index_out_of_bounds array idx) + (all _.then + (_.set! temp (|> array (_.item (_.+ (_.int +1) idx)))) + (_.if (|> temp (_.= _.null)) + ..none + (..some temp)))))) + +(the (array::put array idx value) + (<| (check_index_out_of_bounds array idx) + (all _.then + (_.set_item! (_.+ (_.int +1) idx) value array) + array))) + +(.the runtime//array Expression (all _.then @array::new @@ -861,7 +829,7 @@ @array::put )) -(the full_runtime +(.the full_runtime Expression (all _.then runtime//lux @@ -873,7 +841,7 @@ runtime//io )) -(the .public translate +(.the .public translate (Operation [Registry Output]) (do ///////phase.monad [_ (/////translation.execute! ..full_runtime) diff --git a/stdlib/source/library/lux/meta/compiler/language/lux/phase/translation/ruby/runtime.lux b/stdlib/source/library/lux/meta/compiler/language/lux/phase/translation/ruby/runtime.lux index 9c64693942..de582e9bd1 100644 --- a/stdlib/source/library/lux/meta/compiler/language/lux/phase/translation/ruby/runtime.lux +++ b/stdlib/source/library/lux/meta/compiler/language/lux/phase/translation/ruby/runtime.lux @@ -4,7 +4,8 @@ (.using [library [lux (.except Declaration - i64 variant) + i64 variant + the) [abstract ["[0]" monad (.only do)]] [control @@ -79,17 +80,17 @@ (-> Phase! Phase Archive of (Operation Statement))) -(the .public unit +(.the .public unit (_.string synthesis.unit)) -(the (flag value) +(.the (flag value) (-> Bit Literal) (if value ..unit _.nil)) -(the .public with_vars +(.the .public with_vars (syntax.macro (_ [vars (.tuple (<>.some .local)) body .any]) (do [! meta.monad] @@ -102,14 +103,14 @@ list.together))] (, body)))))))) -(the module_id +(.the module_id 0) -(the $Numeric +(.the $Numeric _.CVar (_.manual "Numeric")) -(the mruby? +(.the mruby? _.Expression (_.and (|> $Numeric (_.do "method_defined?" (list (_.string "remainder")) {.#None}) @@ -117,14 +118,14 @@ (|> $Numeric (_.do "method_defined?" (list (_.string "remainder_of_divide")) {.#None})))) -(the normal_ruby? +(.the normal_ruby? _.Expression (_.not ..mruby?) ... (|> (_.local "Object") ... (_.do "const_defined?" (list (_.string "Encoding")) {.#None})) ) -(the runtime +(.the the (syntax.macro (_ [declaration (<>.or .local (.form (<>.and .local (<>.some .local)))) @@ -139,8 +140,8 @@ (let [runtime (code.local (///reference.artifact [..module_id runtime_id])) runtime_name (` (_.constant (, (code.text (code.as_text runtime))))) g!name (code.local name)] - (in (list (` (the .public (, g!name) _.CVar (, runtime_name))) - (` (the (, (code.local (%.message "@" name))) + (in (list (` (.the .public (, g!name) _.CVar (, runtime_name))) + (` (.the (, (code.local (%.message "@" name))) Statement (, (list#mix (function (_ [when then] else) (` (_.if (, when) @@ -157,13 +158,13 @@ inputsC (list#each code.local inputs) inputs_typesC (list#each (function.constant (` _.Expression)) inputs)] - (in (list (` (the .public ((, g!name) (,* inputsC)) + (in (list (` (.the .public ((, g!name) (,* inputsC)) (-> (,* inputs_typesC) Computation) (_.apply (list (,* inputsC)) {.#None} (, runtime_name)))) - (` (the (, (code.local (%.message "@" name))) + (` (.the (, (code.local (%.message "@" name))) Statement (..with_vars [(,* inputsC)] (, (list#mix (function (_ [when then] else) @@ -175,106 +176,102 @@ (, default_implementation))) conditional_implementations)))))))))))))) -(the tuple_size +(.the tuple_size (_.its "length")) -(the last_index +(.the last_index (|>> ..tuple_size (_.- (_.int +1)))) (expansion.let [ (these (all _.then (_.; (_.set (list lefts) (_.- last_index_right lefts))) (_.; (_.set (list tuple) (_.item last_index_right tuple)))))] - (these (runtime - (tuple//left lefts tuple) - (with_vars [last_index_right] - (<| (_.while (_.bool true)) - (all _.then - (_.; (_.set (list last_index_right) (..last_index tuple))) - (_.if (_.> lefts last_index_right) - ... No need for recursion - (_.return (_.item lefts tuple)) - ... Needs recursion - ))))) - - (runtime - (tuple//right lefts tuple) - (with_vars [last_index_right right_index] - (<| (_.while (_.bool true)) - (all _.then - (_.; (_.set (list last_index_right) (..last_index tuple))) - (_.; (_.set (list right_index) (_.+ (_.int +1) lefts))) - (<| (_.if (_.= last_index_right right_index) - (_.return (_.item right_index tuple))) - (_.if (_.> last_index_right right_index) - ... Needs recursion. - ) - (_.return (_.array_range right_index (..tuple_size tuple) tuple))) - )))))) - -(the .public variant_tag_field script.variant_lefts) -(the .public variant_flag_field script.variant_right?) -(the .public variant_value_field script.variant_choice) - -(runtime - (sum//make tag last? value) - (_.return (_.hash (list [(_.string ..variant_tag_field) tag] - [(_.string ..variant_flag_field) last?] - [(_.string ..variant_value_field) value])))) - -(the .public (variant tag last? value) + (these (the (tuple//left lefts tuple) + (with_vars [last_index_right] + (<| (_.while (_.bool true)) + (all _.then + (_.; (_.set (list last_index_right) (..last_index tuple))) + (_.if (_.> lefts last_index_right) + ... No need for recursion + (_.return (_.item lefts tuple)) + ... Needs recursion + ))))) + + (the (tuple//right lefts tuple) + (with_vars [last_index_right right_index] + (<| (_.while (_.bool true)) + (all _.then + (_.; (_.set (list last_index_right) (..last_index tuple))) + (_.; (_.set (list right_index) (_.+ (_.int +1) lefts))) + (<| (_.if (_.= last_index_right right_index) + (_.return (_.item right_index tuple))) + (_.if (_.> last_index_right right_index) + ... Needs recursion. + ) + (_.return (_.array_range right_index (..tuple_size tuple) tuple))) + )))))) + +(.the .public variant_tag_field script.variant_lefts) +(.the .public variant_flag_field script.variant_right?) +(.the .public variant_value_field script.variant_choice) + +(the (sum//make tag last? value) + (_.return (_.hash (list [(_.string ..variant_tag_field) tag] + [(_.string ..variant_flag_field) last?] + [(_.string ..variant_value_field) value])))) + +(.the .public (variant tag last? value) (-> Natural Bit Expression Computation) (sum//make (_.int (.integer tag)) (..flag last?) value)) -(the .public left +(.the .public left (-> Expression Computation) (..variant 0 #0)) -(the .public right +(.the .public right (-> Expression Computation) (..variant 0 #1)) -(the .public none +(.the .public none Computation (..left ..unit)) -(the .public some +(.the .public some (-> Expression Computation) ..right) -(runtime - (sum//get sum expected::right? expected::lefts) - (let [mismatch! (_.return _.nil) - actual::lefts (_.item (_.string ..variant_tag_field) sum) - actual::right? (_.item (_.string ..variant_flag_field) sum) - actual::value (_.item (_.string ..variant_value_field) sum) - recur! (all _.then - (_.; (_.set (list expected::lefts) (|> expected::lefts - (_.- actual::lefts) - (_.- (_.int +1))))) - (_.; (_.set (list sum) actual::value)))] - (<| (_.while (_.bool true)) - (_.if (_.= expected::lefts actual::lefts) - (_.if (_.= expected::right? actual::right?) - (_.return actual::value) - mismatch!)) - (_.if (_.< expected::lefts actual::lefts) - (_.if (_.= ..unit actual::right?) - recur! - mismatch!)) - (_.if (_.= ..unit expected::right?) - (_.return (sum//make (|> actual::lefts - (_.- expected::lefts) - (_.- (_.int +1))) - actual::right? - actual::value))) - mismatch!))) - -(the runtime//adt +(the (sum//get sum expected::right? expected::lefts) + (let [mismatch! (_.return _.nil) + actual::lefts (_.item (_.string ..variant_tag_field) sum) + actual::right? (_.item (_.string ..variant_flag_field) sum) + actual::value (_.item (_.string ..variant_value_field) sum) + recur! (all _.then + (_.; (_.set (list expected::lefts) (|> expected::lefts + (_.- actual::lefts) + (_.- (_.int +1))))) + (_.; (_.set (list sum) actual::value)))] + (<| (_.while (_.bool true)) + (_.if (_.= expected::lefts actual::lefts) + (_.if (_.= expected::right? actual::right?) + (_.return actual::value) + mismatch!)) + (_.if (_.< expected::lefts actual::lefts) + (_.if (_.= ..unit actual::right?) + recur! + mismatch!)) + (_.if (_.= ..unit expected::right?) + (_.return (sum//make (|> actual::lefts + (_.- expected::lefts) + (_.- (_.int +1))) + actual::right? + actual::value))) + mismatch!))) + +(.the runtime//adt Statement (all _.then @tuple//left @@ -283,71 +280,71 @@ @sum//get )) -(runtime - (lux//try risky) - (with_vars [error value] - (_.begin (all _.then - (_.; (_.set (list value) (_.apply_lambda (list ..unit) risky))) - (_.return (..right value))) - (list [(list) error - (_.return (..left (_.its "message" error)))])))) - -(runtime - (lux//program_args raw) - (with_vars [tail head] - (all _.then - (_.; (_.set (list tail) ..none)) - (<| (_.for_in head raw) - (_.; (_.set (list tail) (..some (_.array (list head tail)))))) - (_.return tail)))) - -(the runtime//lux +(the (lux//try risky) + (with_vars [error value] + (_.begin (all _.then + (_.; (_.set (list value) (_.apply_lambda (list ..unit) risky))) + (_.return (..right value))) + (list [(list) error + (_.return (..left (_.its "message" error)))])))) + +(the (lux//program_args raw) + (with_vars [tail head] + (all _.then + (_.; (_.set (list tail) ..none)) + (<| (_.for_in head raw) + (_.; (_.set (list tail) (..some (_.array (list head tail)))))) + (_.return tail)))) + +(.the runtime//lux Statement (all _.then @lux//try @lux//program_args )) -(the i64::+limit (_.manual "+0x7FFFFFFFFFFFFFFF")) -(the i64::-limit (_.manual "-0x8000000000000000")) -(the i64::+cap (_.manual "+0x8000000000000000")) -(the i64::-cap (_.manual "-0x8000000000000001")) - -(runtime i64::+iteration (_.manual "(+1<<64)")) -(runtime i64::-iteration (_.manual "(-1<<64)")) - -(runtime - (i64::i64 input) - [..mruby? (_.return input)] - (with_vars [temp] - (`` (<| (,, (template.with [ ] - [(_.if (|> input ) - (all _.then - (_.; (_.set (list temp) (_.% input))) - (_.return (_.? (|> temp ) - (|> temp (_.- ) (_.+ )) - temp))))] - - [(_.> ..i64::+limit) ..i64::+iteration ..i64::+cap ..i64::-limit] - [(_.< ..i64::-limit) ..i64::-iteration ..i64::-cap ..i64::+limit] - )) - (_.return input))))) - -(the i32::low +(.the i64::+limit (_.manual "+0x7FFFFFFFFFFFFFFF")) +(.the i64::-limit (_.manual "-0x8000000000000000")) +(.the i64::+cap (_.manual "+0x8000000000000000")) +(.the i64::-cap (_.manual "-0x8000000000000001")) + +(the i64::+iteration + (_.manual "(+1<<64)")) + +(the i64::-iteration + (_.manual "(-1<<64)")) + +(the (i64::i64 input) + [..mruby? (_.return input)] + (with_vars [temp] + (`` (<| (,, (template.with [ ] + [(_.if (|> input ) + (all _.then + (_.; (_.set (list temp) (_.% input))) + (_.return (_.? (|> temp ) + (|> temp (_.- ) (_.+ )) + temp))))] + + [(_.> ..i64::+limit) ..i64::+iteration ..i64::+cap ..i64::-limit] + [(_.< ..i64::-limit) ..i64::-iteration ..i64::-cap ..i64::+limit] + )) + (_.return input))))) + +(.the i32::low (|>> (_.bit_and (_.manual "+0xFFFFFFFF")))) -(the i32::high +(.the i32::high (|>> (_.bit_shr (_.int +32)) ..i32::low)) -(the i32::positive? +(.the i32::positive? (|>> (_.bit_and (_.manual "+0x80000000")) (_.= (_.int +0)))) -(the i32::up +(.the i32::up (_.bit_shl (_.int +32))) -(the i64 +(.the i64 (template.macro (_ @high @low) [(|> (_.? (i32::positive? @high) @high @@ -357,190 +354,182 @@ i32::up (_.bit_or @low))])) -(the as_natural +(.the as_natural (_.% ..i64::+iteration)) (template.with [ ] - [(runtime - ( left right) - [..normal_ruby? (_.return (..i64::i64 ( (..as_natural left) (..as_natural right))))] - (with_vars [high low] - (all _.then - (_.; (_.set (list high) ( (i32::high left) (..i32::high right)))) - (_.; (_.set (list low) ( (i32::low left) (..i32::low right)))) - (_.return (..i64 high low)))))] + [(the ( left right) + [..normal_ruby? (_.return (..i64::i64 ( (..as_natural left) (..as_natural right))))] + (with_vars [high low] + (all _.then + (_.; (_.set (list high) ( (i32::high left) (..i32::high right)))) + (_.; (_.set (list low) ( (i32::low left) (..i32::low right)))) + (_.return (..i64 high low)))))] [i64::and _.bit_and] [i64::or _.bit_or] [i64::xor _.bit_xor] ) -(the (cap_shift! shift) +(.the (cap_shift! shift) (-> LVar Statement) (_.; (_.set (list shift) (|> shift (_.bit_and (_.int +63)))))) -(the (handle_no_shift! shift input) +(.the (handle_no_shift! shift input) (-> LVar LVar (-> Statement Statement)) (_.if (|> shift (_.= (_.int +0))) (_.return input))) -(the small_shift? +(.the small_shift? (-> LVar Expression) (|>> (_.< (_.int +32)))) -(runtime - (i64::left_shifted shift input) - [..normal_ruby? (_.return (|> input - (_.bit_shl (_.% (_.int +64) shift)) - ..i64::i64))] - (with_vars [high low] - (all _.then - (..cap_shift! shift) - (<| (..handle_no_shift! shift input) - (_.if (..small_shift? shift) - (all _.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))))) - (all _.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) - [..normal_ruby? (all _.then - (_.; (_.set (list shift) (_.% (_.int +64) shift))) - (_.return (_.? (_.= (_.int +0) shift) - input - (|> input - ..as_natural - (_.bit_shr shift)))))] - (with_vars [high low] - (all _.then - (..cap_shift! shift) - (<| (..handle_no_shift! shift input) - (_.if (..small_shift? shift) - (all _.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)))) - (_.return (_.? (|> shift (_.= (_.int +32))) - (i32::high input) - (|> input i32::high (_.bit_shr (_.- (_.int +32) shift))))))))) - -(runtime - (i64::/ parameter subject) - (_.return (_.? (_.and (_.= (_.int -1) parameter) - (_.= (_.int integer#bottom) subject)) - subject - (let [extra (_.do "remainder" (list parameter) {.#None} subject)] - (|> subject - (_.- extra) - (_./ parameter)))))) - -(runtime - (i64::+ parameter subject) - [..normal_ruby? (_.return (i64::i64 (_.+ parameter subject)))] - (with_vars [high low] - (all _.then - (_.; (_.set (list low) (_.+ (i32::low subject) - (i32::low parameter)))) - (_.; (_.set (list high) (|> (i32::high low) - (_.+ (i32::high subject)) - (_.+ (i32::high parameter)) - i32::low))) - - (_.return (..i64 high (i32::low low))) - ))) - -(the i64::min +(the (i64::left_shifted shift input) + [..normal_ruby? (_.return (|> input + (_.bit_shl (_.% (_.int +64) shift)) + ..i64::i64))] + (with_vars [high low] + (all _.then + (..cap_shift! shift) + (<| (..handle_no_shift! shift input) + (_.if (..small_shift? shift) + (all _.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))))) + (all _.then + (_.; (_.set (list high) (|> input i32::low (_.bit_shl (_.- (_.int +32) shift))))) + (_.return (..i64 (i32::low high) + (_.int +0))))) + ))) + +(the (i64::right_shifted shift input) + [..normal_ruby? (all _.then + (_.; (_.set (list shift) (_.% (_.int +64) shift))) + (_.return (_.? (_.= (_.int +0) shift) + input + (|> input + ..as_natural + (_.bit_shr shift)))))] + (with_vars [high low] + (all _.then + (..cap_shift! shift) + (<| (..handle_no_shift! shift input) + (_.if (..small_shift? shift) + (all _.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)))) + (_.return (_.? (|> shift (_.= (_.int +32))) + (i32::high input) + (|> input i32::high (_.bit_shr (_.- (_.int +32) shift))))))))) + +(the (i64::/ parameter subject) + (_.return (_.? (_.and (_.= (_.int -1) parameter) + (_.= (_.int integer#bottom) subject)) + subject + (let [extra (_.do "remainder" (list parameter) {.#None} subject)] + (|> subject + (_.- extra) + (_./ parameter)))))) + +(the (i64::+ parameter subject) + [..normal_ruby? (_.return (i64::i64 (_.+ parameter subject)))] + (with_vars [high low] + (all _.then + (_.; (_.set (list low) (_.+ (i32::low subject) + (i32::low parameter)))) + (_.; (_.set (list high) (|> (i32::high low) + (_.+ (i32::high subject)) + (_.+ (i32::high parameter)) + i32::low))) + + (_.return (..i64 high (i32::low low))) + ))) + +(.the i64::min (_.manual "-0x8000000000000000")) -(the (i64::opposite value) +(.the (i64::opposite value) (_.? (_.= i64::min value) i64::min (i64::+ (_.int +1) (_.bit_not value)))) -(runtime - (i64::- parameter subject) - [..normal_ruby? (_.return (i64::i64 (_.- parameter subject)))] - (_.return (i64::+ (i64::opposite parameter) subject))) +(the (i64::- parameter subject) + [..normal_ruby? (_.return (i64::i64 (_.- parameter subject)))] + (_.return (i64::+ (i64::opposite parameter) subject))) -(the i16::high +(.the i16::high (_.bit_shr (_.int +16))) -(the i16::low +(.the i16::low (_.bit_and (_.manual "+0xFFFF"))) -(the i16::up +(.the i16::up (_.bit_shl (_.int +16))) -(runtime - (i64::* parameter subject) - [..normal_ruby? (_.return (i64::i64 (_.* 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] - (all _.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)) - ))) - ) - -(runtime - (i64::char subject) - [..mruby? (_.return (_.do "chr" (list) {.#None} subject))] - (_.return (_.do "chr" (list (_.string "UTF-8")) {.#None} subject))) - -(the runtime//i64 +(the (i64::* parameter subject) + [..normal_ruby? (_.return (i64::i64 (_.* 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] + (all _.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)) + ))) + ) + +(the (i64::char subject) + [..mruby? (_.return (_.do "chr" (list) {.#None} subject))] + (_.return (_.do "chr" (list (_.string "UTF-8")) {.#None} subject))) + +(.the runtime//i64 Statement (all _.then @i64::+iteration @@ -558,34 +547,31 @@ @i64::char )) -(runtime - (text//index subject param start) - (with_vars [idx] - (all _.then - (_.; (_.set (list idx) (|> subject (_.do "index" (list param start) {.#None})))) - (_.if (_.= _.nil idx) - (_.return ..none) - (_.return (..some idx)))))) +(the (text//index subject param start) + (with_vars [idx] + (all _.then + (_.; (_.set (list idx) (|> subject (_.do "index" (list param start) {.#None})))) + (_.if (_.= _.nil idx) + (_.return ..none) + (_.return (..some idx)))))) -(the (within? top value) +(.the (within? top value) (-> Expression Expression Computation) (_.and (|> value (_.>= (_.int +0))) (|> value (_.< top)))) -(runtime - (text//clip offset length text) - (_.if (_.= (_.int +0) length) - (_.return (_.string "")) - (_.return (_.array_range offset (_.+ offset (_.- (_.int +1) length)) text)))) +(the (text//clip offset length text) + (_.if (_.= (_.int +0) length) + (_.return (_.string "")) + (_.return (_.array_range offset (_.+ offset (_.- (_.int +1) length)) text)))) -(runtime - (text//char idx text) - (_.if (|> idx (within? (_.its "length" text))) - (_.return (|> text (_.array_range idx idx) (_.do "ord" (list) {.#None}))) - (_.; (_.raise (_.string "[Lux Error] Cannot get char from text."))))) +(the (text//char idx text) + (_.if (|> idx (within? (_.its "length" text))) + (_.return (|> text (_.array_range idx idx) (_.do "ord" (list) {.#None}))) + (_.; (_.raise (_.string "[Lux Error] Cannot get char from text."))))) -(the runtime//text +(.the runtime//text Statement (all _.then @text//index @@ -593,19 +579,18 @@ @text//char )) -(runtime - (array//write idx value array) - (all _.then - (_.; (_.set (list (_.item idx array)) value)) - (_.return array))) +(the (array//write idx value array) + (all _.then + (_.; (_.set (list (_.item idx array)) value)) + (_.return array))) -(the runtime//array +(.the runtime//array Statement (all _.then @array//write )) -(the full +(.the full Statement (all _.then (_.when ..mruby? @@ -621,7 +606,7 @@ runtime//array )) -(the .public translate +(.the .public translate (Operation [Registry Output]) (do phase.monad [_ (translation.execute! ..full) diff --git a/stdlib/source/library/lux/meta/compiler/language/lux/phase/translation/scheme/runtime.lux b/stdlib/source/library/lux/meta/compiler/language/lux/phase/translation/scheme/runtime.lux index 0930a3050b..af4f7d39f7 100644 --- a/stdlib/source/library/lux/meta/compiler/language/lux/phase/translation/scheme/runtime.lux +++ b/stdlib/source/library/lux/meta/compiler/language/lux/phase/translation/scheme/runtime.lux @@ -3,7 +3,8 @@ (.using [library - [lux (.except Location) + [lux (.except Location + the) [abstract ["[0]" monad (.only do)]] [control @@ -44,7 +45,7 @@ [archive (.only Output Archive) ["[0]" artifact (.only Registry)]]]]]]) -(the module_id +(.the module_id 0) (template.with [ ] @@ -60,10 +61,10 @@ (every .public (Translator i) (-> Phase Archive i (Operation Expression))) -(the .public unit +(.the .public unit (_.string /////synthesis.unit)) -(the .public with_vars +(.the .public with_vars (syntax.macro (_ [vars (.tuple (<>.some .local)) body .any]) (do [! meta.monad] @@ -76,7 +77,7 @@ list.together))] (, body)))))))) -(the runtime +(.the the (syntax.macro (_ [declaration (<>.or .local (.form (<>.and .local (<>.some .local)))) @@ -89,11 +90,11 @@ (when declaration {.#Left name} (let [g!name (code.local name)] - (in (list (` (the .public (, g!name) + (in (list (` (.the .public (, g!name) Var (, runtime_name))) - (` (the (, (code.local (%.message "@" name))) + (` (.the (, (code.local (%.message "@" name))) _.Computation (_.define_constant (, runtime_name) (, code))))))) @@ -102,217 +103,205 @@ inputsC (list#each code.local inputs) inputs_typesC (list#each (function.constant (` _.Expression)) inputs)] - (in (list (` (the .public ((, g!name) (,* inputsC)) + (in (list (` (.the .public ((, g!name) (,* inputsC)) (-> (,* inputs_typesC) _.Computation) (_.apply (list (,* inputsC)) (, runtime_name)))) - (` (the (, (code.local (%.message "@" name))) + (` (.the (, (code.local (%.message "@" name))) _.Computation (..with_vars [(,* inputsC)] (_.define_function (, runtime_name) [(list (,* inputsC)) {.#None}] (, code)))))))))))))) -(the last_index +(.the last_index (-> Expression Computation) (|>> _.length/1 (_.-/2 (_.int +1)))) -(runtime - (tuple//left lefts tuple) - (with_vars [last_index_right] - (_.begin - (list (_.define_constant last_index_right (..last_index tuple)) - (_.if (_.>/2 lefts last_index_right) - ... No need for recursion - (_.vector_ref/2 tuple lefts) - ... Needs recursion - (tuple//left (_.-/2 last_index_right lefts) - (_.vector_ref/2 tuple last_index_right))))))) - -(runtime - (tuple//right lefts tuple) - (with_vars [last_index_right right_index @slice] - (_.begin - (list (_.define_constant last_index_right (..last_index tuple)) - (_.define_constant right_index (_.+/2 (_.int +1) lefts)) - (<| (_.if (_.=/2 last_index_right right_index) - (_.vector_ref/2 tuple right_index)) - (_.if (_.>/2 last_index_right right_index) - ... Needs recursion. - (tuple//right (_.-/2 last_index_right lefts) - (_.vector_ref/2 tuple last_index_right))) - (_.begin - (list (_.define_constant @slice (_.make_vector/1 (_.-/2 right_index (_.length/1 tuple)))) - (_.vector_copy!/5 @slice (_.int +0) tuple right_index (_.length/1 tuple)) - @slice)))) - ))) - -(the (variant' tag last? value) +(the (tuple//left lefts tuple) + (with_vars [last_index_right] + (_.begin + (list (_.define_constant last_index_right (..last_index tuple)) + (_.if (_.>/2 lefts last_index_right) + ... No need for recursion + (_.vector_ref/2 tuple lefts) + ... Needs recursion + (tuple//left (_.-/2 last_index_right lefts) + (_.vector_ref/2 tuple last_index_right))))))) + +(the (tuple//right lefts tuple) + (with_vars [last_index_right right_index @slice] + (_.begin + (list (_.define_constant last_index_right (..last_index tuple)) + (_.define_constant right_index (_.+/2 (_.int +1) lefts)) + (<| (_.if (_.=/2 last_index_right right_index) + (_.vector_ref/2 tuple right_index)) + (_.if (_.>/2 last_index_right right_index) + ... Needs recursion. + (tuple//right (_.-/2 last_index_right lefts) + (_.vector_ref/2 tuple last_index_right))) + (_.begin + (list (_.define_constant @slice (_.make_vector/1 (_.-/2 right_index (_.length/1 tuple)))) + (_.vector_copy!/5 @slice (_.int +0) tuple right_index (_.length/1 tuple)) + @slice)))) + ))) + +(.the (variant' tag last? value) (-> Expression Expression Expression Computation) (all _.cons/2 tag last? value)) -(runtime - (sum//make tag last? value) - (variant' tag last? value)) +(the (sum//make tag last? value) + (variant' tag last? value)) -(the .public (variant [lefts right? value]) +(.the .public (variant [lefts right? value]) (-> (Variant Expression) Computation) (..sum//make (_.int (.integer lefts)) (_.bool right?) value)) -(runtime - (sum//get sum last? wanted_tag) - (with_vars [sum_tag sum_flag sum_value sum_temp sum_dump] - (let [no_match _.nil - test_recursion (_.if sum_flag - ... Must recurse. - (sum//get sum_value - last? - (|> wanted_tag (_.-/2 sum_tag))) - no_match)] - (<| (_.let (list [sum_tag (_.car/1 sum)] - [sum_temp (_.cdr/1 sum)])) - (_.let (list [sum_flag (_.car/1 sum_temp)] - [sum_value (_.cdr/1 sum_temp)])) - (_.if (_.=/2 wanted_tag sum_tag) - (_.if (_.eqv?/2 last? sum_flag) - sum_value - test_recursion)) - (_.if (_. sum_tag (_.-/2 wanted_tag)) sum_flag sum_value)) - no_match)))) - -(the runtime//adt +(the (sum//get sum last? wanted_tag) + (with_vars [sum_tag sum_flag sum_value sum_temp sum_dump] + (let [no_match _.nil + test_recursion (_.if sum_flag + ... Must recurse. + (sum//get sum_value + last? + (|> wanted_tag (_.-/2 sum_tag))) + no_match)] + (<| (_.let (list [sum_tag (_.car/1 sum)] + [sum_temp (_.cdr/1 sum)])) + (_.let (list [sum_flag (_.car/1 sum_temp)] + [sum_value (_.cdr/1 sum_temp)])) + (_.if (_.=/2 wanted_tag sum_tag) + (_.if (_.eqv?/2 last? sum_flag) + sum_value + test_recursion)) + (_.if (_. sum_tag (_.-/2 wanted_tag)) sum_flag sum_value)) + no_match)))) + +(.the runtime//adt Computation (_.begin (list @tuple//left @tuple//right @sum//get @sum//make))) -(the .public none +(.the .public none Computation (|> ..unit [0 #0] variant)) -(the .public some +(.the .public some (-> Expression Computation) (|>> [1 #1] ..variant)) -(the .public left +(.the .public left (-> Expression Computation) (|>> [0 #0] ..variant)) -(the .public right +(.the .public right (-> Expression Computation) (|>> [1 #1] ..variant)) -(runtime - (slice offset length list) - (<| (_.if (_.null?/1 list) - list) - (_.if (|> offset (_.>/2 (_.int +0))) - (slice (|> offset (_.-/2 (_.int +1))) - length - (_.cdr/1 list))) - (_.if (|> length (_.>/2 (_.int +0))) - (_.cons/2 (_.car/1 list) - (slice offset - (|> length (_.-/2 (_.int +1))) - (_.cdr/1 list)))) - _.nil)) - -(runtime - (lux//try op) - (with_vars [error] - (_.with_exception_handler - (_.lambda [(list error) {.#None}] - (..left error)) - (_.lambda [(list) {.#None}] - (..right (_.apply (list ..unit) op)))))) - -(runtime - (lux//program_args program_args) - (with_vars [@loop @input @output] - (_.letrec (list [@loop (_.lambda [(list @input @output) {.#None}] - (_.if (_.null?/1 @input) - @output - (_.apply/2 @loop (_.cdr/1 @input) (..some (_.vector/* (list (_.car/1 @input) @output))))))]) - (_.apply/2 @loop (_.reverse/1 program_args) ..none)))) - -(the runtime//lux +(the (slice offset length list) + (<| (_.if (_.null?/1 list) + list) + (_.if (|> offset (_.>/2 (_.int +0))) + (slice (|> offset (_.-/2 (_.int +1))) + length + (_.cdr/1 list))) + (_.if (|> length (_.>/2 (_.int +0))) + (_.cons/2 (_.car/1 list) + (slice offset + (|> length (_.-/2 (_.int +1))) + (_.cdr/1 list)))) + _.nil)) + +(the (lux//try op) + (with_vars [error] + (_.with_exception_handler + (_.lambda [(list error) {.#None}] + (..left error)) + (_.lambda [(list) {.#None}] + (..right (_.apply (list ..unit) op)))))) + +(the (lux//program_args program_args) + (with_vars [@loop @input @output] + (_.letrec (list [@loop (_.lambda [(list @input @output) {.#None}] + (_.if (_.null?/1 @input) + @output + (_.apply/2 @loop (_.cdr/1 @input) (..some (_.vector/* (list (_.car/1 @input) @output))))))]) + (_.apply/2 @loop (_.reverse/1 program_args) ..none)))) + +(.the runtime//lux Computation (_.begin (list @lux//try @lux//program_args))) -(the i64//+limit (_.manual "+9223372036854775807" - ... "+0x7FFFFFFFFFFFFFFF" - )) -(the i64//-limit (_.manual "-9223372036854775808" - ... "-0x8000000000000000" - )) -(the i64//+iteration (_.manual "+18446744073709551616" - ... "+0x10000000000000000" - )) -(the i64//-iteration (_.manual "-18446744073709551616" - ... "-0x10000000000000000" - )) -(the i64//+cap (_.manual "+9223372036854775808" - ... "+0x8000000000000000" - )) -(the i64//-cap (_.manual "-9223372036854775809" - ... "-0x8000000000000001" - )) - -(runtime - (i64//64 input) - (with_vars [temp] - (`` (<| (,, (template.with [ ] - [(_.if (|> input ) - (_.let (list [temp (_.remainder/2 input)]) - (_.if (|> temp ) - (|> temp (_.-/2 ) (_.+/2 )) - temp)))] - - [(_.>/2 ..i64//+limit) ..i64//+iteration ..i64//+cap ..i64//-limit] - [(_. subject - (_.arithmetic_shift/2 (_.remainder/2 (_.int +64) param)) - ..i64//64)) - -(the as_natural +(.the i64//+limit (_.manual "+9223372036854775807" + ... "+0x7FFFFFFFFFFFFFFF" + )) +(.the i64//-limit (_.manual "-9223372036854775808" + ... "-0x8000000000000000" + )) +(.the i64//+iteration (_.manual "+18446744073709551616" + ... "+0x10000000000000000" + )) +(.the i64//-iteration (_.manual "-18446744073709551616" + ... "-0x10000000000000000" + )) +(.the i64//+cap (_.manual "+9223372036854775808" + ... "+0x8000000000000000" + )) +(.the i64//-cap (_.manual "-9223372036854775809" + ... "-0x8000000000000001" + )) + +(the (i64//64 input) + (with_vars [temp] + (`` (<| (,, (template.with [ ] + [(_.if (|> input ) + (_.let (list [temp (_.remainder/2 input)]) + (_.if (|> temp ) + (|> temp (_.-/2 ) (_.+/2 )) + temp)))] + + [(_.>/2 ..i64//+limit) ..i64//+iteration ..i64//+cap ..i64//-limit] + [(_. subject + (_.arithmetic_shift/2 (_.remainder/2 (_.int +64) param)) + ..i64//64)) + +(.the as_natural (_.remainder/2 ..i64//+iteration)) -(runtime - (i64//right_shifted shift subject) - (_.let (list [shift (_.remainder/2 (_.int +64) shift)]) - (_.if (_.=/2 (_.int +0) shift) - subject - (|> subject - ..as_natural - (_.arithmetic_shift/2 (_.-/2 shift (_.int +0))))))) +(the (i64//right_shifted shift subject) + (_.let (list [shift (_.remainder/2 (_.int +64) shift)]) + (_.if (_.=/2 (_.int +0) shift) + subject + (|> subject + ..as_natural + (_.arithmetic_shift/2 (_.-/2 shift (_.int +0))))))) (template.with [ ] - [(runtime - ( left right) - (..i64//64 ( (..as_natural left) (..as_natural right))))] + [(the ( left right) + (..i64//64 ( (..as_natural left) (..as_natural right))))] [i64//or _.bitwise_ior/2] [i64//xor _.bitwise_xor/2] [i64//and _.bitwise_and/2] ) -(runtime - (i64//division param subject) - (|> subject (_.//2 param) _.truncate/1 ..i64//64)) +(the (i64//division param subject) + (|> subject (_.//2 param) _.truncate/1 ..i64//64)) -(the runtime//i64 +(.the runtime//i64 Computation (_.begin (list @i64//64 @i64//left_shifted @@ -322,54 +311,49 @@ @i64//and @i64//division))) -(runtime - (f64//decode input) - (with_vars [@output] - (let [output_is_not_a_number? (_.not/1 (_.=/2 @output @output)) - input_is_not_a_number? (_.string=?/2 (_.string "+nan.0") input)] - (_.let (list [@output (_.string->number/1 input)]) - (_.if (_.and (list output_is_not_a_number? - (_.not/1 input_is_not_a_number?))) - ..none - (..some @output)))))) - -(the runtime//f64 +(the (f64//decode input) + (with_vars [@output] + (let [output_is_not_a_number? (_.not/1 (_.=/2 @output @output)) + input_is_not_a_number? (_.string=?/2 (_.string "+nan.0") input)] + (_.let (list [@output (_.string->number/1 input)]) + (_.if (_.and (list output_is_not_a_number? + (_.not/1 input_is_not_a_number?))) + ..none + (..some @output)))))) + +(.the runtime//f64 Computation (_.begin (list @f64//decode))) -(runtime - (text//index offset sub text) - (with_vars [index] - (_.let (list [index (_.string_contains/3 text sub offset)]) - (_.if index - (..some index) - ..none)))) +(the (text//index offset sub text) + (with_vars [index] + (_.let (list [index (_.string_contains/3 text sub offset)]) + (_.if index + (..some index) + ..none)))) -(runtime - (text//clip offset length text) - (_.substring/3 text offset (_.+/2 offset length))) +(the (text//clip offset length text) + (_.substring/3 text offset (_.+/2 offset length))) -(runtime - (text//char index text) - (_.char->integer/1 (_.string_ref/2 text index))) +(the (text//char index text) + (_.char->integer/1 (_.string_ref/2 text index))) -(the runtime//text +(.the runtime//text (_.begin (list @text//index @text//clip @text//char))) -(runtime - (array//write idx value array) - (_.begin (list (_.vector_set!/3 array idx value) - array))) +(the (array//write idx value array) + (_.begin (list (_.vector_set!/3 array idx value) + array))) -(the runtime//array +(.the runtime//array Computation (all _.then @array//write )) -(the runtime +(.the runtime Computation (_.begin (list @slice runtime//lux @@ -380,7 +364,7 @@ runtime//array ))) -(the .public translate +(.the .public translate (Operation [Registry Output]) (do ///////phase.monad [_ (/////translation.execute! ..runtime) diff --git a/stdlib/source/library/lux/meta/compiler/target/jvm/bytecode/instruction.lux b/stdlib/source/library/lux/meta/compiler/target/jvm/bytecode/instruction.lux index 138d65caec..6893096f93 100644 --- a/stdlib/source/library/lux/meta/compiler/target/jvm/bytecode/instruction.lux +++ b/stdlib/source/library/lux/meta/compiler/target/jvm/bytecode/instruction.lux @@ -36,8 +36,9 @@ [registry (.only Register)]]] ["/[1]" // ["[1][0]" index (.only Index)] - ["[1][0]" constant (.only Reference) - [class (.only Class)]] + ["[1][0]" constant (.only) + [class (.only Class)] + [reference (.only Reference)]] [encoding ["[1][0]" unsigned (.only U1 U2 U4)] ["[1][0]" signed (.only S1 S2 S4)]] diff --git a/stdlib/source/library/lux/meta/compiler/target/jvm/constant.lux b/stdlib/source/library/lux/meta/compiler/target/jvm/constant.lux index 0cd836d838..659eab833a 100644 --- a/stdlib/source/library/lux/meta/compiler/target/jvm/constant.lux +++ b/stdlib/source/library/lux/meta/compiler/target/jvm/constant.lux @@ -32,8 +32,9 @@ ["[0]" / ["[1][0]" tag] ["[1][0]" utf8 (.only UTF8)] - ["[0]" name_and_type (.only Name_And_Type)] ["[0]" class (.only Class)] + ["[0]" name_and_type (.only Name_And_Type)] + ["[0]" reference (.only Reference)] ["/[1]" // ["[1][0]" index (.only Index)] [type @@ -104,27 +105,6 @@ ) ) -(every .public (Reference of) - (Record - [#class (Index Class) - #name_and_type (Index (Name_And_Type of))])) - -(template.with [ ] - [(the .public - (Equivalence ( Any)) - (all product.equivalence - //index.equivalence - //index.equivalence)) - - (the - (Injection ( Any)) - (all binaryF.and - //index.injection - //index.injection))] - - [Reference reference_equivalence reference_injection] - ) - (every .public Constant (Variant {#UTF8 UTF8} @@ -167,9 +147,9 @@ [#Double (..value_equivalence decimal.equivalence)] [#Class class.equivalence] [#String (..value_equivalence //index.equivalence)] - [#Field ..reference_equivalence] - [#Method ..reference_equivalence] - [#Interface_Method ..reference_equivalence] + [#Field reference.equivalence] + [#Method reference.equivalence] + [#Interface_Method reference.equivalence] [#Name_And_Type name_and_type.equivalence])) _ @@ -186,11 +166,11 @@ ... ... #String ... (..value_equivalence //index.equivalence) ... ... #Field - ... ..reference_equivalence + ... reference.equivalence ... ... #Method - ... ..reference_equivalence + ... reference.equivalence ... ... #Interface_Method - ... ..reference_equivalence + ... reference.equivalence ... ... #Name_And_Type ... name_and_type.equivalence ... ) @@ -208,9 +188,9 @@ [#Double /tag.double ..double_injection] [#Class /tag.class class.as_binary] [#String /tag.string ..string_injection] - [#Field /tag.field ..reference_injection] - [#Method /tag.method ..reference_injection] - [#Interface_Method /tag.interface_method ..reference_injection] + [#Field /tag.field reference.as_binary] + [#Method /tag.method reference.as_binary] + [#Interface_Method /tag.interface_method reference.as_binary] [#Name_And_Type /tag.name_and_type name_and_type.as_binary] ... TODO: Method_Handle ... TODO: Method_Type diff --git a/stdlib/source/library/lux/meta/compiler/target/jvm/constant/pool.lux b/stdlib/source/library/lux/meta/compiler/target/jvm/constant/pool.lux index d53156985d..845078d4ea 100644 --- a/stdlib/source/library/lux/meta/compiler/target/jvm/constant/pool.lux +++ b/stdlib/source/library/lux/meta/compiler/target/jvm/constant/pool.lux @@ -30,10 +30,11 @@ [macro ["[0]" expansion] ["[0]" template]]]]] - ["[0]" // (.only String Integer Float Long Double Constant Reference) + ["[0]" // (.only String Integer Float Long Double Constant) [utf8 (.only UTF8)] ["[0]" name_and_type (.only Name_And_Type)] ["[0]" class (.only Class)] + ["[0]" reference (.only Reference)] [// ["[1][0]" index (.only Index)] [encoding @@ -206,7 +207,7 @@ (<| (/|do %) (/|each % @class (..class (//name.internal class))) (/|each % @name_and_type (name_and_type member)) - (!add % //.reference_equivalence [//.#class @class //.#name_and_type @name_and_type])))] + (!add % reference.equivalence [reference.#class @class reference.#name_and_type @name_and_type])))] [field //.#Field Value] [method //.#Method Method] diff --git a/stdlib/source/library/lux/meta/compiler/target/jvm/constant/reference.lux b/stdlib/source/library/lux/meta/compiler/target/jvm/constant/reference.lux new file mode 100644 index 0000000000..74e72f3c75 --- /dev/null +++ b/stdlib/source/library/lux/meta/compiler/target/jvm/constant/reference.lux @@ -0,0 +1,39 @@ +... This Source Code Form is subject to the terms of the Mozilla Public License, v. 2.0. +... If a copy of the MPL was not distributed with this file, You can obtain one at https://mozilla.org/MPL/2.0/. + +(.using + [library + [lux (.except) + [abstract + [equivalence (.only Equivalence)]] + [data + ["[0]" product] + ["[0]" binary + ["[1]" \\injection (.only Injection)]]]]] + ["[0]" // + [class (.only Class)] + [name_and_type (.only Name_And_Type)] + [// + ["[0]" index (.only Index)]]]) + +(every .public (Reference of) + (Record + [#class (Index Class) + #name_and_type (Index (Name_And_Type of))])) + +(the .public equivalence + (Equivalence (Reference Any)) + (all product.equivalence + index.equivalence + index.equivalence + )) + +(alias [=] + ..equivalence) + +(the .public as_binary + (Injection (Reference Any)) + (all binary.and + index.injection + index.injection + )) diff --git a/stdlib/source/test/lux/abstract/equivalence.lux b/stdlib/source/test/lux/abstract/equivalence.lux index 778032ce66..5b4f68e1e5 100644 --- a/stdlib/source/test/lux/abstract/equivalence.lux +++ b/stdlib/source/test/lux/abstract/equivalence.lux @@ -134,6 +134,18 @@ (all _.and (_.for [/.functor] (contravariantT.spec equivalence n.equivalence /.functor)) + + (_.coverage [/.sum] + (let [both (/.sum n.equivalence i.equivalence)] + (and (bit.= (of both = {.#Left leftN} {.#Left rightN}) + (of n.equivalence = leftN rightN)) + (bit.= (of both = {.#Right leftI} {.#Right rightI}) + (of i.equivalence = leftI rightI))))) + (_.coverage [/.product] + (let [both (/.product n.equivalence i.equivalence)] + (bit.= (of both = [leftN leftI] [rightN rightI]) + (and (of n.equivalence = leftN rightN) + (of i.equivalence = leftI rightI))))) (_.coverage [/.recursive] (let [equivalence (is (/.Equivalence (List Natural)) (/.recursive diff --git a/stdlib/source/test/lux/math/number/decimal.lux b/stdlib/source/test/lux/math/number/decimal.lux index 6be63179f0..07a3eea1dc 100644 --- a/stdlib/source/test/lux/math/number/decimal.lux +++ b/stdlib/source/test/lux/math/number/decimal.lux @@ -54,10 +54,9 @@ (do random.monad [magnitude (..positive range) positive? random.bit] - (in (/.* (if positive? - /.positive - /.negative) - magnitude)))) + (in (if positive? + magnitude + (/.opposite magnitude))))) (the constant Test @@ -133,7 +132,8 @@ (orderT.spec /.order random.unit_decimal)) (,, (template.with [ ] [(_.for [ ] - (monoidT.spec /.equivalence (..random 1,000,000)))] + (monoidT.spec (/.approximately? +0.000001) + (..random 1,000,000)))] [/.+ /.addition] [/.* /.multiplication] diff --git a/stdlib/source/test/lux/meta/compiler/target/jvm.lux b/stdlib/source/test/lux/meta/compiler/target/jvm.lux index 7a21a055dd..4420f66b3e 100644 --- a/stdlib/source/test/lux/meta/compiler/target/jvm.lux +++ b/stdlib/source/test/lux/meta/compiler/target/jvm.lux @@ -3,7 +3,7 @@ (.using [library - [lux (.except Type Label) + [lux (.except Type) ["[0]" ffi (.only import)] [abstract [equivalence (.only Equivalence)] @@ -15,7 +15,8 @@ ["[0]" function] ["[0]" io] ["[0]" maybe] - ["[0]" try] + ["[0]" try (.only Try)] + ["[0]" exception] [concurrency ["[0]" atom]]] [data @@ -60,7 +61,7 @@ ["[0]" name] ["[0]" signed] ["[0]" unsigned]] - ["[1]" bytecode (.only Label Bytecode) (.use "[1]#[0]" monad) + ["[1]" bytecode (.only Bytecode) (.use "[1]#[0]" monad) ["[1][0]" instruction] ["[0]" environment]] ["[0]" type (.only Type) @@ -80,7 +81,8 @@ ["[1][0]" tag] ["[1][0]" utf8] ["[1][0]" class] - ["[1][0]" name_and_type]]]) + ["[1][0]" name_and_type] + ["[1][0]" reference]]]) (the method_modifier (all /modifier#composite @@ -1315,7 +1317,7 @@ (do random.monad [expected ..$Long::random dummy ..$Long::random - .let [if! (is (-> (-> Label (Bytecode Any)) (Bytecode Any) (Random Bit)) + .let [if! (is (-> (-> /.Label (Bytecode Any)) (Bytecode Any) (Random Bit)) (function (_ instruction prelude) (<| (..bytecode ((!::= java/lang/Long .jvm_long_=#) expected)) (do /.monad @@ -1373,7 +1375,7 @@ (do random.monad [expected ..$Long::random dummy ..$Long::random - .let [jump (is (-> (-> Label (Bytecode Any)) (Random Bit)) + .let [jump (is (-> (-> /.Label (Bytecode Any)) (Random Bit)) (function (_ goto) (<| (..bytecode ((!::= java/lang/Long .jvm_long_=#) expected)) (do /.monad @@ -1387,12 +1389,68 @@ _ (/.set_label @value) _ (..$Long::literal expected) _ (/.set_label @end)] - ..$Long::wrap))))]] + ..$Long::wrap)))) + value (let [method (type.method [(list) (list) (type.class (list) "java.lang.Object") (list)])] + (is (for_any (_ of) + (-> (Bytecode of) + (Try of))) + (function (_ it) + (do try.monad + [environment (environment.static method) + [pool [_ _ _ _ it]] ((/.resolve environment it) pool.empty)] + (in it)))))]] (<| (_.for [/.Label /.new_label /.set_label]) (all _.and - (..coverage [/.goto] (jump /.goto)) - (..coverage [/.goto_w] (jump /.goto_w)))))) + (..coverage [/.goto] + (jump /.goto)) + (..coverage [/.goto_w] + (jump /.goto_w)) + (_.coverage [/.set?] + (|> (do /.monad + [@it /.new_label + _ (/.set_label @it)] + (/.set? @it)) + value + (match? {try.#Success _}))) + (_.coverage [/.unset_label] + (|> (do /.monad + [@it /.new_label + _ (/.goto @it)] + (in false)) + value + (exception.when /.unset_label + (function.constant true)) + (exception.otherwise + (function.constant false)))) + (_.coverage [/.unknown_label] + (let [@it (|> /.new_label + value + (try.else (undefined)))] + (|> (do /.monad + [it (/.set? @it)] + (in (|> (do try.monad + [_ it] + (in false)) + (exception.when /.unknown_label + (function.constant true)) + (exception.otherwise + (function.constant false))))) + value + (exception.otherwise + (function.constant false))))) + (_.coverage [/.label_has_already_been_set] + (|> (do /.monad + [@it /.new_label + _ (/.set_label @it) + _ (/.set_label @it)] + (in false)) + value + (exception.when /.label_has_already_been_set + (function.constant true)) + (exception.otherwise + (function.constant false)))) + )))) (the switch Test @@ -1455,7 +1513,7 @@ [expected ..$Long::random dummy ..$Long::random exception ..$String::random] - (<| (..coverage [/.athrow]) + (<| (..coverage [/.try /.athrow]) (..bytecode ((!::= java/lang/Long .jvm_long_=#) expected)) (do /.monad [.let [$Exception (type.class (list) "java.lang.Exception")] @@ -1680,4 +1738,5 @@ /utf8.test /class.test /name_and_type.test + /reference.test ))) diff --git a/stdlib/source/test/lux/meta/compiler/target/jvm/constant/name_and_type.lux b/stdlib/source/test/lux/meta/compiler/target/jvm/constant/name_and_type.lux index d8fcdc32c7..619e45c33e 100644 --- a/stdlib/source/test/lux/meta/compiler/target/jvm/constant/name_and_type.lux +++ b/stdlib/source/test/lux/meta/compiler/target/jvm/constant/name_and_type.lux @@ -32,7 +32,8 @@ (the .public test Test (<| (_.covering /._) - (_.for [/.Name_And_Type]) + (_.for [/.Name_And_Type + /.#name /.#descriptor]) (all _.and (_.for [/.equivalence /.=] (static.when (same? /.equivalence /.=) diff --git a/stdlib/source/test/lux/meta/compiler/target/jvm/constant/reference.lux b/stdlib/source/test/lux/meta/compiler/target/jvm/constant/reference.lux new file mode 100644 index 0000000000..871d018a03 --- /dev/null +++ b/stdlib/source/test/lux/meta/compiler/target/jvm/constant/reference.lux @@ -0,0 +1,50 @@ +... This Source Code Form is subject to the terms of the Mozilla Public License, v. 2.0. +... If a copy of the MPL was not distributed with this file, You can obtain one at https://mozilla.org/MPL/2.0/. + +(.using + [library + [lux (.except) + [abstract + [monad (.only do)] + ["[0]" equivalence + ["[1]T" \\test]]] + [data + ["[0]" bit] + ["[0]" binary (.only) + ["![1]" \\injection]]] + [math + ["[0]" random (.only Random) (.use "[1]#[0]" functor)]] + [meta + ["[0]" static]] + [test + ["_" property (.only Test)]]]] + [\\library + ["[0]" / (.only) + [/// + ["[0]" index (.only Index) + ["[1]T" \\test]]]]]) + +(the .public random + (Random (/.Reference Any)) + (random.and indexT.random + indexT.random)) + +(the .public test + Test + (<| (_.covering /._) + (_.for [/.Reference + /.#class /.#name_and_type]) + (all _.and + (_.for [/.equivalence /.=] + (static.when (same? /.equivalence /.=) + (equivalenceT.spec /.equivalence ..random))) + + (do [! random.monad] + [sample_0 ..random + sample_1 ..random] + (_.coverage [/.as_binary] + (bit.= (/.= sample_0 + sample_1) + (binary.= (!binary.value /.as_binary sample_0) + (!binary.value /.as_binary sample_1))))) + ))) diff --git a/to_do.md b/to_do.md index 6c41417d5c..494de09a7d 100644 --- a/to_do.md +++ b/to_do.md @@ -15,6 +15,7 @@ ## To Do +0. Allow producing JVM artifacts without source-tracking/debugging information. 0. [The Design and Implementation of an Extensible System Meta-Programming Language](https://arxiv.org/abs/2309.15416) 0. [HasChor: Functional Choreographic Programming for All (Functional Pearl)](https://arxiv.org/abs/2303.00924) 0. Compile `not`-like pattern-matching with `~` in languages/targets which support it, instead of compiling them as `if`s. @@ -88,7 +89,6 @@ 0. Unary `-` and `/` for numbers that feature inverses. 0. `N/D` native parser syntax for `Fraction` numbers. 0. `(+|-)N/D` native parser syntax for `Rational` numbers. -0. Allow producing JVM artifacts without source-tracking/debugging information. 0. [multithreading: a tiny runtime that allows you to execute JavaScript functions on separate threads](https://github.com/W4G1/multithreading) ## Done