From 697707d8560a5735be38fd9b1ff91a02c289d48f Mon Sep 17 00:00:00 2001 From: Eduardo Julian Date: Tue, 16 Apr 2019 20:53:41 -0400 Subject: Made some new-luxc modules "old". --- .../luxc/lang/translation/jvm/procedure/common.lux | 327 +++++++++++++++++++++ 1 file changed, 327 insertions(+) create mode 100644 new-luxc/source/luxc/lang/translation/jvm/procedure/common.lux (limited to 'new-luxc/source/luxc/lang/translation/jvm/procedure/common.lux') diff --git a/new-luxc/source/luxc/lang/translation/jvm/procedure/common.lux b/new-luxc/source/luxc/lang/translation/jvm/procedure/common.lux new file mode 100644 index 000000000..aeaa1d664 --- /dev/null +++ b/new-luxc/source/luxc/lang/translation/jvm/procedure/common.lux @@ -0,0 +1,327 @@ +(.module: + [lux #* + [abstract + ["." monad (#+ do)]] + [control + ["p" parser] + ["ex" exception (#+ exception:)]] + [data + ["." text + format] + [collection + ["." dictionary]]] + [tool + [compiler + ["." 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 Method Bundle) + ["_t" type] + ["_" inst]]]]] + ["." /// + ["." runtime]]) + +(import: java/lang/Double + (#static MIN_VALUE Double) + (#static MAX_VALUE Double)) + +(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))) + +(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)) + +(def: (lux::is [referenceI sampleI]) + (Binary Inst) + (|>> referenceI + sampleI + (predicateI _.IF_ACMPEQ))) + +(def: (lux::try riskyI) + (Unary Inst) + (|>> riskyI + (_.CHECKCAST ///.function-class) + (_.INVOKESTATIC ///.runtime-class "try" + (_t.method (list ///.$Function) (#.Some $Object-Array) (list)) + #0))) + +(template [ ] + [(def: ( [maskI inputI]) + (Binary Inst) + (|>> inputI (_.unwrap #$.Long) + maskI (_.unwrap #$.Long) + (_.wrap #$.Long)))] + + [bit::and _.LAND] + [bit::or _.LOR] + [bit::xor _.LXOR] + ) + +(template [ ] + [(def: ( [shiftI inputI]) + (Binary Inst) + (|>> inputI (_.unwrap #$.Long) + shiftI jvm-intI + + (_.wrap #$.Long)))] + + [bit::left-shift _.LSHL] + [bit::arithmetic-right-shift _.LSHR] + [bit::logical-right-shift _.LUSHR] + ) + +(template [ ] + [(def: ( _) + (Nullary Inst) + (|>> (_.wrap )))] + + [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 [ ] + [(def: ( [paramI subjectI]) + (Binary Inst) + (|>> subjectI (_.unwrap ) + paramI (_.unwrap ) + + (_.wrap )))] + + [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 [ ] + [(template [ ] + [(def: ( [paramI subjectI]) + (Binary Inst) + (|>> subjectI + paramI + + (_.int ) + (predicateI _.IF_ICMPEQ)))] + + [ +0] + [ -1])] + + [i64::= int::< (_.unwrap #$.Long) _.LCMP] + [frac::= frac::< (_.unwrap #$.Double) _.DCMPG] + ) + +(template [ ] + [(def: ( inputI) + (Unary Inst) + (|>> inputI ))] + + [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)] + ) + +(def: (text::size inputI) + (Unary Inst) + (|>> inputI + ..check-stringI + (_.INVOKEVIRTUAL "java.lang.String" "length" (_t.method (list) (#.Some _t.int) (list)) #0) + lux-intI)) + +(template [ ] + [(def: ( [paramI subjectI]) + (Binary Inst) + (|>> subjectI + paramI + ))] + + [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 Inst) + (|>> 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 Inst) + (|>> 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 Inst) + (<| _.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)))) + +(def: string-method Method (_t.method (list $String) #.None (list))) +(def: (io::log messageI) + (Unary Inst) + (|>> (_.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 Inst) + (|>> (_.NEW "java.lang.Error") + _.DUP + messageI + ..check-stringI + (_.INVOKESPECIAL "java.lang.Error" "" string-method #0) + _.ATHROW)) + +(def: (io::exit codeI) + (Unary Inst) + (|>> codeI jvm-intI + (_.INVOKESTATIC "java.lang.System" "exit" (_t.method (list _t.int) #.None (list)) #0) + _.NULL)) + +(def: (io::current-time _) + (Nullary Inst) + (|>> (_.INVOKESTATIC "java.lang.System" "currentTimeMillis" (_t.method (list) (#.Some _t.long) (list)) #0) + (_.wrap #$.Long))) + +(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)))) -- cgit v1.2.3