diff options
author | Eduardo Julian | 2019-04-16 20:53:41 -0400 |
---|---|---|
committer | Eduardo Julian | 2019-04-16 20:53:41 -0400 |
commit | 697707d8560a5735be38fd9b1ff91a02c289d48f (patch) | |
tree | 7f9e81974c9ec3ede82e7f2392ebba037e3e9df8 /new-luxc/source/luxc/lang/translation/jvm/procedure/common.jvm.lux | |
parent | 42248854f0cb5e3364e6aae25527cee65cbda3e8 (diff) |
Made some new-luxc modules "old".
Diffstat (limited to 'new-luxc/source/luxc/lang/translation/jvm/procedure/common.jvm.lux')
-rw-r--r-- | new-luxc/source/luxc/lang/translation/jvm/procedure/common.jvm.lux | 380 |
1 files changed, 0 insertions, 380 deletions
diff --git a/new-luxc/source/luxc/lang/translation/jvm/procedure/common.jvm.lux b/new-luxc/source/luxc/lang/translation/jvm/procedure/common.jvm.lux deleted file mode 100644 index b19287b4e..000000000 --- a/new-luxc/source/luxc/lang/translation/jvm/procedure/common.jvm.lux +++ /dev/null @@ -1,380 +0,0 @@ -(.module: - [lux #* - [abstract - ["." monad (#+ do)]] - [control - ["p" parser] - ["ex" exception (#+ exception:)]] - [data - ["." text - format] - [collection - ["." list ("#/." functor)] - ["." dictionary]]] - ["." macro (#+ with-gensyms) - ["." code] - ["s" syntax (#+ syntax:)]] - [tool - [compiler - ["." synthesis (#+ Synthesis)] - ["." phase - ["." extension - ["." bundle]]]]] - [host (#+ import:)]] - [luxc - [lang - [host - ["$" jvm (#+ Label Inst Method Handler Bundle) - ["_t" type] - ["_" inst]]]]] - ["." /// - ["." runtime]]) - -(import: java/lang/Double - (#static MIN_VALUE Double) - (#static MAX_VALUE Double)) - -## [Types] -(syntax: (Vector {size s.nat} elemT) - (wrap (list (` [(~+ (list.repeat size elemT))])))) - -(type: #export Nullary (-> (Vector 0 Inst) Inst)) -(type: #export Unary (-> (Vector 1 Inst) Inst)) -(type: #export Binary (-> (Vector 2 Inst) Inst)) -(type: #export Trinary (-> (Vector 3 Inst) Inst)) -(type: #export Variadic (-> (List Inst) Inst)) - -## [Utils] -(def: $Object-Array $.Type (_t.array 1 ///.$Object)) -(def: $String $.Type (_t.class "java.lang.String" (list))) -(def: $CharSequence $.Type (_t.class "java.lang.CharSequence" (list))) - -(syntax: (arity: {name s.local-identifier} {arity s.nat}) - (with-gensyms [g!_ g!extension g!extension-name g!phase g!inputs] - (do @ - [g!inputC+ (monad.seq @ (list.repeat arity (macro.gensym "input"))) - #let [arityC (code.nat arity)]] - (wrap (list (` (def: #export ((~ (code.local-identifier name)) (~ g!extension)) - (-> (-> (..Vector (~ arityC) Inst) Inst) ..Handler) - (function ((~ g!_) (~ g!extension-name) (~ g!phase) (~ g!inputs)) - (case (~ g!inputs) - (^ (list (~+ g!inputC+))) - (do phase.monad - [(~+ (|> g!inputC+ - (list/map (function (_ g!input) - (list g!input (` ((~ g!phase) (~ g!input)))))) - list.concat))] - ((~' wrap) ((~ g!extension) [(~+ g!inputC+)]))) - - (~ g!_) - (phase.fail (ex.construct extension.incorrect-arity - [(~ g!extension-name) (~ arityC) (list.size (~ g!inputs))]))))))))))) - -(arity: nullary 0) -(arity: unary 1) -(arity: binary 2) -(arity: trinary 3) - -(def: #export (variadic extension) - (-> Variadic Handler) - (function (_ extension-name phase inputsS) - (do phase.monad - [inputsH (monad.map @ phase inputsS)] - (wrap (extension inputsH))))) - -## [Instructions] -(def: lux-intI Inst (|>> _.I2L (_.wrap #$.Long))) -(def: jvm-intI Inst (|>> (_.unwrap #$.Long) _.L2I)) -(def: check-stringI Inst (_.CHECKCAST "java.lang.String")) - -(def: (predicateI tester) - (-> (-> Label Inst) - Inst) - (<| _.with-label (function (_ @then)) - _.with-label (function (_ @end)) - (|>> (tester @then) - (_.GETSTATIC "java.lang.Boolean" "FALSE" (_t.class "java.lang.Boolean" (list))) - (_.GOTO @end) - (_.label @then) - (_.GETSTATIC "java.lang.Boolean" "TRUE" (_t.class "java.lang.Boolean" (list))) - (_.label @end) - ))) - -(def: unitI Inst (_.string synthesis.unit)) - -## Extensions -### Lux -(def: (lux::is [referenceI sampleI]) - Binary - (|>> referenceI - sampleI - (predicateI _.IF_ACMPEQ))) - -(def: (lux::try riskyI) - Unary - (|>> riskyI - (_.CHECKCAST ///.function-class) - (_.INVOKESTATIC ///.runtime-class "try" - (_t.method (list ///.$Function) (#.Some $Object-Array) (list)) - #0))) - -### Bits -(template [<name> <op>] - [(def: (<name> [maskI inputI]) - Binary - (|>> inputI (_.unwrap #$.Long) - maskI (_.unwrap #$.Long) - <op> (_.wrap #$.Long)))] - - [bit::and _.LAND] - [bit::or _.LOR] - [bit::xor _.LXOR] - ) - -(template [<name> <op>] - [(def: (<name> [shiftI inputI]) - Binary - (|>> inputI (_.unwrap #$.Long) - shiftI jvm-intI - <op> - (_.wrap #$.Long)))] - - [bit::left-shift _.LSHL] - [bit::arithmetic-right-shift _.LSHR] - [bit::logical-right-shift _.LUSHR] - ) - -### Numbers -(template [<name> <const> <type>] - [(def: (<name> _) - Nullary - (|>> <const> (_.wrap <type>)))] - - [frac::smallest (_.double (Double::MIN_VALUE)) #$.Double] - [frac::min (_.double (f/* -1.0 (Double::MAX_VALUE))) #$.Double] - [frac::max (_.double (Double::MAX_VALUE)) #$.Double] - ) - -(template [<name> <type> <op>] - [(def: (<name> [paramI subjectI]) - Binary - (|>> subjectI (_.unwrap <type>) - paramI (_.unwrap <type>) - <op> - (_.wrap <type>)))] - - [i64::+ #$.Long _.LADD] - [i64::- #$.Long _.LSUB] - [int::* #$.Long _.LMUL] - [int::/ #$.Long _.LDIV] - [int::% #$.Long _.LREM] - - [frac::+ #$.Double _.DADD] - [frac::- #$.Double _.DSUB] - [frac::* #$.Double _.DMUL] - [frac::/ #$.Double _.DDIV] - [frac::% #$.Double _.DREM] - ) - -(template [<eq> <lt> <unwrap> <cmp>] - [(template [<name> <reference>] - [(def: (<name> [paramI subjectI]) - Binary - (|>> subjectI <unwrap> - paramI <unwrap> - <cmp> - (_.int <reference>) - (predicateI _.IF_ICMPEQ)))] - - [<eq> +0] - [<lt> -1])] - - [i64::= int::< (_.unwrap #$.Long) _.LCMP] - [frac::= frac::< (_.unwrap #$.Double) _.DCMPG] - ) - -(template [<name> <prepare> <transform>] - [(def: (<name> inputI) - Unary - (|>> inputI <prepare> <transform>))] - - [int::frac (_.unwrap #$.Long) (<| (_.wrap #$.Double) _.L2D)] - [int::char (_.unwrap #$.Long) - ((|>> _.L2I _.I2C (_.INVOKESTATIC "java.lang.Character" "toString" (_t.method (list _t.char) (#.Some $String) (list)) #0)))] - - [frac::int (_.unwrap #$.Double) (<| (_.wrap #$.Long) _.D2L)] - [frac::encode (_.unwrap #$.Double) - (_.INVOKESTATIC "java.lang.Double" "toString" (_t.method (list _t.double) (#.Some $String) (list)) #0)] - [frac::decode ..check-stringI - (_.INVOKESTATIC ///.runtime-class "decode_frac" (_t.method (list $String) (#.Some $Object-Array) (list)) #0)] - ) - -### Text -(def: (text::size inputI) - Unary - (|>> inputI - ..check-stringI - (_.INVOKEVIRTUAL "java.lang.String" "length" (_t.method (list) (#.Some _t.int) (list)) #0) - lux-intI)) - -(template [<name> <pre-subject> <pre-param> <op> <post>] - [(def: (<name> [paramI subjectI]) - Binary - (|>> subjectI <pre-subject> - paramI <pre-param> - <op> <post>))] - - [text::= (<|) (<|) - (_.INVOKEVIRTUAL "java.lang.Object" "equals" (_t.method (list ///.$Object) (#.Some _t.boolean) (list)) #0) - (_.wrap #$.Boolean)] - [text::< ..check-stringI ..check-stringI - (_.INVOKEVIRTUAL "java.lang.String" "compareTo" (_t.method (list $String) (#.Some _t.int) (list)) #0) - (predicateI _.IFLT)] - [text::char ..check-stringI jvm-intI - (_.INVOKEVIRTUAL "java.lang.String" "charAt" (_t.method (list _t.int) (#.Some _t.char) (list)) #0) - lux-intI] - ) - -(def: (text::concat [leftI rightI]) - Binary - (|>> leftI ..check-stringI - rightI ..check-stringI - (_.INVOKEVIRTUAL "java.lang.String" "concat" (_t.method (list $String) (#.Some $String) (list)) #0))) - -(def: (text::clip [startI endI subjectI]) - Trinary - (|>> subjectI ..check-stringI - startI jvm-intI - endI jvm-intI - (_.INVOKEVIRTUAL "java.lang.String" "substring" (_t.method (list _t.int _t.int) (#.Some $String) (list)) #0))) - -(def: index-method Method (_t.method (list $String _t.int) (#.Some _t.int) (list))) -(def: (text::index [startI partI textI]) - Trinary - (<| _.with-label (function (_ @not-found)) - _.with-label (function (_ @end)) - (|>> textI ..check-stringI - partI ..check-stringI - startI jvm-intI - (_.INVOKEVIRTUAL "java.lang.String" "indexOf" index-method #0) - _.DUP - (_.int -1) - (_.IF_ICMPEQ @not-found) - lux-intI - runtime.someI - (_.GOTO @end) - (_.label @not-found) - _.POP - runtime.noneI - (_.label @end)))) - -### I/O -(def: string-method Method (_t.method (list $String) #.None (list))) -(def: (io::log messageI) - Unary - (|>> (_.GETSTATIC "java.lang.System" "out" (_t.class "java.io.PrintStream" (list))) - messageI - ..check-stringI - (_.INVOKEVIRTUAL "java.io.PrintStream" "println" string-method #0) - unitI)) - -(def: (io::error messageI) - Unary - (|>> (_.NEW "java.lang.Error") - _.DUP - messageI - ..check-stringI - (_.INVOKESPECIAL "java.lang.Error" "<init>" string-method #0) - _.ATHROW)) - -(def: (io::exit codeI) - Unary - (|>> codeI jvm-intI - (_.INVOKESTATIC "java.lang.System" "exit" (_t.method (list _t.int) #.None (list)) #0) - _.NULL)) - -(def: (io::current-time _) - Nullary - (|>> (_.INVOKESTATIC "java.lang.System" "currentTimeMillis" (_t.method (list) (#.Some _t.long) (list)) #0) - (_.wrap #$.Long))) - -## Bundles -(def: bundle::lux - Bundle - (|> (: Bundle bundle.empty) - (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 bit::and)) - (bundle.install "or" (binary bit::or)) - (bundle.install "xor" (binary bit::xor)) - (bundle.install "left-shift" (binary bit::left-shift)) - (bundle.install "logical-right-shift" (binary bit::logical-right-shift)) - (bundle.install "arithmetic-right-shift" (binary bit::arithmetic-right-shift)) - (bundle.install "+" (binary i64::+)) - (bundle.install "-" (binary i64::-)) - (bundle.install "=" (binary i64::=))))) - -(def: bundle::int - Bundle - (<| (bundle.prefix "int") - (|> (: Bundle bundle.empty) - (bundle.install "*" (binary int::*)) - (bundle.install "/" (binary int::/)) - (bundle.install "%" (binary int::%)) - (bundle.install "<" (binary int::<)) - (bundle.install "frac" (unary int::frac)) - (bundle.install "char" (unary int::char))))) - -(def: bundle::frac - Bundle - (<| (bundle.prefix "frac") - (|> (: Bundle bundle.empty) - (bundle.install "+" (binary frac::+)) - (bundle.install "-" (binary frac::-)) - (bundle.install "*" (binary frac::*)) - (bundle.install "/" (binary frac::/)) - (bundle.install "%" (binary frac::%)) - (bundle.install "=" (binary frac::=)) - (bundle.install "<" (binary frac::<)) - (bundle.install "smallest" (nullary frac::smallest)) - (bundle.install "min" (nullary frac::min)) - (bundle.install "max" (nullary frac::max)) - (bundle.install "int" (unary frac::int)) - (bundle.install "encode" (unary frac::encode)) - (bundle.install "decode" (unary frac::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::int) - (dictionary.merge bundle::frac) - (dictionary.merge bundle::text) - (dictionary.merge bundle::io)))) |