diff options
Diffstat (limited to 'lux-jvm/source/luxc/lang/translation/jvm/extension/common.lux')
| -rw-r--r-- | lux-jvm/source/luxc/lang/translation/jvm/extension/common.lux | 359 |
1 files changed, 0 insertions, 359 deletions
diff --git a/lux-jvm/source/luxc/lang/translation/jvm/extension/common.lux b/lux-jvm/source/luxc/lang/translation/jvm/extension/common.lux deleted file mode 100644 index 10fe4e948..000000000 --- a/lux-jvm/source/luxc/lang/translation/jvm/extension/common.lux +++ /dev/null @@ -1,359 +0,0 @@ -(.using - [library - [lux {"-" Type Label} - [ffi {"+" import:}] - [abstract - ["[0]" monad {"+" do}]] - [control - ["[0]" try] - ["<>" parser - ["<s>" synthesis {"+" Parser}]]] - [data - ["[0]" product] - [collection - ["[0]" list ("[1]@[0]" monad)] - ["[0]" dictionary]]] - [math - [number - ["f" frac]]] - [target - [jvm - ["[0]" type]]] - [tool - [compiler - ["[0]" phase] - [meta - [archive {"+" Archive}]] - [language - [lux - ["[0]" synthesis {"+" Synthesis %synthesis}] - [phase - [generation - [extension {"+" Nullary Unary Binary Trinary Variadic - nullary unary binary trinary variadic}]] - ["[0]" extension - ["[0]" bundle]]]]]]]]] - [luxc - [lang - [host - ["$" jvm {"+" Label Inst Def Handler Bundle Operation Phase} - ["_" inst]]]]] - ["[0]" /// - ["[0]" runtime]]) - -(def: .public (custom [parser handler]) - (All (_ s) - (-> [(Parser s) - (-> Text Phase Archive s (Operation Inst))] - Handler)) - (function (_ extension_name phase archive input) - (case (<s>.result parser input) - {try.#Success input'} - (handler extension_name phase archive input') - - {try.#Failure error} - (phase.except extension.invalid_syntax [extension_name %synthesis input])))) - -(def: $String (type.class "java.lang.String" (list))) -(def: $CharSequence (type.class "java.lang.CharSequence" (list))) -(def: $System (type.class "java.lang.System" (list))) -(def: $Object (type.class "java.lang.Object" (list))) - -(def: lux_intI Inst (|>> _.I2L (_.wrap type.long))) -(def: jvm_intI Inst (|>> (_.unwrap type.long) _.L2I)) -(def: check_stringI Inst (_.CHECKCAST $String)) - -(def: (predicateI tester) - (-> (-> Label Inst) - Inst) - (let [$Boolean (type.class "java.lang.Boolean" (list))] - (<| _.with_label (function (_ @then)) - _.with_label (function (_ @end)) - (|>> (tester @then) - (_.GETSTATIC $Boolean "FALSE" $Boolean) - (_.GOTO @end) - (_.label @then) - (_.GETSTATIC $Boolean "TRUE" $Boolean) - (_.label @end) - )))) - -(def: unitI Inst (_.string synthesis.unit)) - -... TODO: Get rid of this ASAP -(def: lux::syntax_char_case! - (..custom [($_ <>.and - <s>.any - <s>.any - (<>.some (<s>.tuple ($_ <>.and - (<s>.tuple (<>.many <s>.i64)) - <s>.any)))) - (function (_ extension_name phase archive [input else conditionals]) - (<| _.with_label (function (_ @end)) - _.with_label (function (_ @else)) - (do [@ phase.monad] - [inputG (phase archive input) - elseG (phase archive else) - conditionalsG+ (is (Operation (List [(List [Int Label]) - Inst])) - (monad.each @ (function (_ [chars branch]) - (do @ - [branchG (phase archive branch)] - (in (<| _.with_label (function (_ @branch)) - [(list@each (function (_ char) - [(.int char) @branch]) - chars) - (|>> (_.label @branch) - branchG - (_.GOTO @end))])))) - conditionals)) - .let [table (|> conditionalsG+ - (list@each product.left) - list@conjoint) - conditionalsG (|> conditionalsG+ - (list@each product.right) - _.fuse)]] - (in (|>> inputG (_.unwrap type.long) _.L2I - (_.LOOKUPSWITCH @else table) - conditionalsG - (_.label @else) - elseG - (_.label @end))))))])) - -(def: (lux::is [referenceI sampleI]) - (Binary Inst) - (|>> referenceI - sampleI - (predicateI _.IF_ACMPEQ))) - -(def: (lux::try riskyI) - (Unary Inst) - (|>> riskyI - (_.CHECKCAST ///.$Function) - (_.INVOKESTATIC ///.$Runtime "try" runtime.try))) - -(template [<name> <op>] - [(def: (<name> [maskI inputI]) - (Binary Inst) - (|>> inputI (_.unwrap type.long) - maskI (_.unwrap type.long) - <op> (_.wrap type.long)))] - - [i64::and _.LAND] - [i64::or _.LOR] - [i64::xor _.LXOR] - ) - -(template [<name> <op>] - [(def: (<name> [shiftI inputI]) - (Binary Inst) - (|>> inputI (_.unwrap type.long) - shiftI jvm_intI - <op> - (_.wrap type.long)))] - - [i64::left_shift _.LSHL] - [i64::right_shift _.LUSHR] - ) - -(template [<name> <type> <op>] - [(def: (<name> [paramI subjectI]) - (Binary Inst) - (|>> subjectI (_.unwrap <type>) - paramI (_.unwrap <type>) - <op> - (_.wrap <type>)))] - - [i64::+ type.long _.LADD] - [i64::- type.long _.LSUB] - [i64::* type.long _.LMUL] - [i64::/ type.long _.LDIV] - [i64::% type.long _.LREM] - - [f64::+ type.double _.DADD] - [f64::- type.double _.DSUB] - [f64::* type.double _.DMUL] - [f64::/ type.double _.DDIV] - [f64::% type.double _.DREM] - ) - -(template [<eq> <lt> <type> <cmp>] - [(template [<name> <reference>] - [(def: (<name> [paramI subjectI]) - (Binary Inst) - (|>> subjectI (_.unwrap <type>) - paramI (_.unwrap <type>) - <cmp> - (_.int <reference>) - (predicateI _.IF_ICMPEQ)))] - - [<eq> +0] - [<lt> -1])] - - [i64::= i64::< type.long _.LCMP] - [f64::= f64::< type.double _.DCMPG] - ) - -(template [<name> <prepare> <transform>] - [(def: (<name> inputI) - (Unary Inst) - (|>> inputI <prepare> <transform>))] - - [i64::f64 (_.unwrap type.long) (<| (_.wrap type.double) _.L2D)] - [i64::char (_.unwrap type.long) - ((|>> _.L2I _.I2C (_.INVOKESTATIC (type.class "java.lang.Character" (list)) "toString" (type.method [(list) (list type.char) $String (list)]))))] - - [f64::i64 (_.unwrap type.double) (<| (_.wrap type.long) _.D2L)] - [f64::encode (_.unwrap type.double) - (_.INVOKESTATIC (type.class "java.lang.Double" (list)) "toString" (type.method [(list) (list type.double) $String (list)]))] - [f64::decode ..check_stringI - (_.INVOKESTATIC ///.$Runtime "decode_frac" (type.method [(list) (list $String) ///.$Variant (list)]))] - ) - -(def: (text::size inputI) - (Unary Inst) - (|>> inputI - ..check_stringI - (_.INVOKEVIRTUAL $String "length" (type.method [(list) (list) type.int (list)])) - lux_intI)) - -(template [<name> <pre_subject> <pre_param> <op> <post>] - [(def: (<name> [paramI subjectI]) - (Binary Inst) - (|>> subjectI <pre_subject> - paramI <pre_param> - <op> <post>))] - - [text::= (<|) (<|) - (_.INVOKEVIRTUAL $Object "equals" (type.method [(list) (list $Object) type.boolean (list)])) - (_.wrap type.boolean)] - [text::< ..check_stringI ..check_stringI - (_.INVOKEVIRTUAL $String "compareTo" (type.method [(list) (list $String) type.int (list)])) - (predicateI _.IFLT)] - [text::char ..check_stringI jvm_intI - (_.INVOKEVIRTUAL $String "charAt" (type.method [(list) (list type.int) type.char (list)])) - lux_intI] - ) - -(def: (text::concat [leftI rightI]) - (Binary Inst) - (|>> leftI ..check_stringI - rightI ..check_stringI - (_.INVOKEVIRTUAL $String "concat" (type.method [(list) (list $String) $String (list)])))) - -(def: (text::clip [offsetI lengthI subjectI]) - (Trinary Inst) - (|>> subjectI ..check_stringI - offsetI jvm_intI - _.DUP - lengthI jvm_intI - _.IADD - (_.INVOKEVIRTUAL $String "substring" (type.method [(list) (list type.int type.int) $String (list)])))) - -(def: index_method (type.method [(list) (list $String type.int) type.int (list)])) -(def: (text::index [startI partI textI]) - (Trinary Inst) - (<| _.with_label (function (_ @not_found)) - _.with_label (function (_ @end)) - (|>> textI ..check_stringI - partI ..check_stringI - startI jvm_intI - (_.INVOKEVIRTUAL $String "indexOf" index_method) - _.DUP - (_.int -1) - (_.IF_ICMPEQ @not_found) - lux_intI - runtime.someI - (_.GOTO @end) - (_.label @not_found) - _.POP - runtime.noneI - (_.label @end)))) - -(def: string_method (type.method [(list) (list $String) type.void (list)])) -(def: (io::log messageI) - (Unary Inst) - (let [$PrintStream (type.class "java.io.PrintStream" (list))] - (|>> (_.GETSTATIC $System "out" $PrintStream) - messageI - ..check_stringI - (_.INVOKEVIRTUAL $PrintStream "println" string_method) - unitI))) - -(def: (io::error messageI) - (Unary Inst) - (let [$Error (type.class "java.lang.Error" (list))] - (|>> (_.NEW $Error) - _.DUP - messageI - ..check_stringI - (_.INVOKESPECIAL $Error "<init>" string_method) - _.ATHROW))) - -(def: bundle::lux - Bundle - (|> (is Bundle bundle.empty) - (bundle.install "syntax char case!" lux::syntax_char_case!) - (bundle.install "is" (binary lux::is)) - (bundle.install "try" (unary lux::try)))) - -(def: bundle::i64 - Bundle - (<| (bundle.prefix "i64") - (|> (is Bundle bundle.empty) - (bundle.install "and" (binary i64::and)) - (bundle.install "or" (binary i64::or)) - (bundle.install "xor" (binary i64::xor)) - (bundle.install "left-shift" (binary i64::left_shift)) - (bundle.install "right-shift" (binary i64::right_shift)) - (bundle.install "=" (binary i64::=)) - (bundle.install "<" (binary i64::<)) - (bundle.install "+" (binary i64::+)) - (bundle.install "-" (binary i64::-)) - (bundle.install "*" (binary i64::*)) - (bundle.install "/" (binary i64::/)) - (bundle.install "%" (binary i64::%)) - (bundle.install "f64" (unary i64::f64)) - (bundle.install "char" (unary i64::char))))) - -(def: bundle::f64 - Bundle - (<| (bundle.prefix "f64") - (|> (is Bundle bundle.empty) - (bundle.install "+" (binary f64::+)) - (bundle.install "-" (binary f64::-)) - (bundle.install "*" (binary f64::*)) - (bundle.install "/" (binary f64::/)) - (bundle.install "%" (binary f64::%)) - (bundle.install "=" (binary f64::=)) - (bundle.install "<" (binary f64::<)) - (bundle.install "i64" (unary f64::i64)) - (bundle.install "encode" (unary f64::encode)) - (bundle.install "decode" (unary f64::decode))))) - -(def: bundle::text - Bundle - (<| (bundle.prefix "text") - (|> (is Bundle bundle.empty) - (bundle.install "=" (binary text::=)) - (bundle.install "<" (binary text::<)) - (bundle.install "concat" (binary text::concat)) - (bundle.install "index" (trinary text::index)) - (bundle.install "size" (unary text::size)) - (bundle.install "char" (binary text::char)) - (bundle.install "clip" (trinary text::clip))))) - -(def: bundle::io - Bundle - (<| (bundle.prefix "io") - (|> (is Bundle bundle.empty) - (bundle.install "log" (unary io::log)) - (bundle.install "error" (unary io::error))))) - -(def: .public bundle - Bundle - (<| (bundle.prefix "lux") - (|> bundle::lux - (dictionary.merged bundle::i64) - (dictionary.merged bundle::f64) - (dictionary.merged bundle::text) - (dictionary.merged bundle::io)))) |