From b4d0eba7485caf0c6cf58de1193a9114fa273d8b Mon Sep 17 00:00:00 2001 From: Eduardo Julian Date: Sat, 30 May 2020 15:19:28 -0400 Subject: Split new-luxc into lux-jvm and lux-r. --- .../luxc/lang/translation/jvm/extension/common.lux | 388 --------------------- 1 file changed, 388 deletions(-) delete mode 100644 new-luxc/source/luxc/lang/translation/jvm/extension/common.lux (limited to 'new-luxc/source/luxc/lang/translation/jvm/extension/common.lux') diff --git a/new-luxc/source/luxc/lang/translation/jvm/extension/common.lux b/new-luxc/source/luxc/lang/translation/jvm/extension/common.lux deleted file mode 100644 index 383415c0a..000000000 --- a/new-luxc/source/luxc/lang/translation/jvm/extension/common.lux +++ /dev/null @@ -1,388 +0,0 @@ -(.module: - [lux (#- Type) - [abstract - ["." monad (#+ do)]] - [control - ["." try] - ["<>" parser - ["" synthesis (#+ Parser)]]] - [data - ["." product] - [number - ["f" frac]] - [collection - ["." list ("#@." monad)] - ["." dictionary]]] - [target - [jvm - ["." type]]] - [tool - [compiler - ["." phase] - [meta - [archive (#+ Archive)]] - [language - [lux - ["." synthesis (#+ Synthesis %synthesis)] - [phase - [generation - [extension (#+ Nullary Unary Binary Trinary Variadic - nullary unary binary trinary variadic)]] - ["." extension - ["." bundle]]]]]]] - [host (#+ import:)]] - [luxc - [lang - [host - ["$" jvm (#+ Label Inst Def Handler Bundle Operation Phase) - ["_" inst]]]]] - ["." /// - ["." runtime]]) - -(def: #export (custom [parser handler]) - (All [s] - (-> [(Parser s) - (-> Text Phase Archive s (Operation Inst))] - Handler)) - (function (_ extension-name phase archive input) - (case (.run parser input) - (#try.Success input') - (handler extension-name phase archive input') - - (#try.Failure error) - (phase.throw extension.invalid-syntax [extension-name %synthesis input])))) - -(import: java/lang/Double - (#static MIN_VALUE Double) - (#static MAX_VALUE Double)) - -(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 - .any - .any - (<>.some (.tuple ($_ <>.and - (.tuple (<>.many .i64)) - .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+ (: (Operation (List [(List [Int Label]) - Inst])) - (monad.map @ (function (_ [chars branch]) - (do @ - [branchG (phase archive branch)] - (wrap (<| _.with-label (function (_ @branch)) - [(list@map (function (_ char) - [(.int char) @branch]) - chars) - (|>> (_.label @branch) - branchG - (_.GOTO @end))])))) - conditionals)) - #let [table (|> conditionalsG+ - (list@map product.left) - list@join) - conditionalsG (|> conditionalsG+ - (list@map product.right) - _.fuse)]] - (wrap (|>> 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 [ ] - [(def: ( [maskI inputI]) - (Binary Inst) - (|>> inputI (_.unwrap type.long) - maskI (_.unwrap type.long) - (_.wrap type.long)))] - - [i64::and _.LAND] - [i64::or _.LOR] - [i64::xor _.LXOR] - ) - -(template [ ] - [(def: ( [shiftI inputI]) - (Binary Inst) - (|>> inputI (_.unwrap type.long) - shiftI jvm-intI - - (_.wrap type.long)))] - - [i64::left-shift _.LSHL] - [i64::arithmetic-right-shift _.LSHR] - [i64::logical-right-shift _.LUSHR] - ) - -(template [ ] - [(def: ( _) - (Nullary Inst) - (|>> (_.wrap )))] - - [f64::smallest (_.double (Double::MIN_VALUE)) type.double] - [f64::min (_.double (f.* -1.0 (Double::MAX_VALUE))) type.double] - [f64::max (_.double (Double::MAX_VALUE)) type.double] - ) - -(template [ ] - [(def: ( [paramI subjectI]) - (Binary Inst) - (|>> subjectI (_.unwrap ) - paramI (_.unwrap ) - - (_.wrap )))] - - [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 [ ] - [(template [ ] - [(def: ( [paramI subjectI]) - (Binary Inst) - (|>> subjectI (_.unwrap ) - paramI (_.unwrap ) - - (_.int ) - (predicateI _.IF_ICMPEQ)))] - - [ +0] - [ -1])] - - [i64::= i64::< type.long _.LCMP] - [f64::= f64::< type.double _.DCMPG] - ) - -(template [ ] - [(def: ( inputI) - (Unary Inst) - (|>> inputI ))] - - [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 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 type.double) $String (list)]))] - [f64::decode ..check-stringI - (_.INVOKESTATIC ///.$Runtime "decode_frac" (type.method [(list $String) ///.$Variant (list)]))] - ) - -(def: (text::size inputI) - (Unary Inst) - (|>> inputI - ..check-stringI - (_.INVOKEVIRTUAL $String "length" (type.method [(list) type.int (list)])) - lux-intI)) - -(template [ ] - [(def: ( [paramI subjectI]) - (Binary Inst) - (|>> subjectI - paramI - ))] - - [text::= (<|) (<|) - (_.INVOKEVIRTUAL $Object "equals" (type.method [(list $Object) type.boolean (list)])) - (_.wrap type.boolean)] - [text::< ..check-stringI ..check-stringI - (_.INVOKEVIRTUAL $String "compareTo" (type.method [(list $String) type.int (list)])) - (predicateI _.IFLT)] - [text::char ..check-stringI jvm-intI - (_.INVOKEVIRTUAL $String "charAt" (type.method [(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 $String) $String (list)])))) - -(def: (text::clip [startI endI subjectI]) - (Trinary Inst) - (|>> subjectI ..check-stringI - startI jvm-intI - endI jvm-intI - (_.INVOKEVIRTUAL $String "substring" (type.method [(list type.int type.int) $String (list)])))) - -(def: index-method (type.method [(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 $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 "" string-method) - _.ATHROW))) - -(def: (io::exit codeI) - (Unary Inst) - (|>> codeI jvm-intI - (_.INVOKESTATIC $System "exit" (type.method [(list type.int) type.void (list)])) - _.NULL)) - -(def: (io::current-time _) - (Nullary Inst) - (|>> (_.INVOKESTATIC $System "currentTimeMillis" (type.method [(list) type.long (list)])) - (_.wrap type.long))) - -(def: bundle::lux - Bundle - (|> (: 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") - (|> (: 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 "logical-right-shift" (binary i64::logical-right-shift)) - (bundle.install "arithmetic-right-shift" (binary i64::arithmetic-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") - (|> (: 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 "smallest" (nullary f64::smallest)) - (bundle.install "min" (nullary f64::min)) - (bundle.install "max" (nullary f64::max)) - (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") - (|> (: 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") - (|> (: Bundle bundle.empty) - (bundle.install "log" (unary io::log)) - (bundle.install "error" (unary io::error)) - (bundle.install "exit" (unary io::exit)) - (bundle.install "current-time" (nullary io::current-time))))) - -(def: #export bundle - Bundle - (<| (bundle.prefix "lux") - (|> bundle::lux - (dictionary.merge bundle::i64) - (dictionary.merge bundle::f64) - (dictionary.merge bundle::text) - (dictionary.merge bundle::io)))) -- cgit v1.2.3