aboutsummaryrefslogtreecommitdiff
path: root/new-luxc/source/luxc/lang/translation/jvm/procedure/common.lux
diff options
context:
space:
mode:
Diffstat (limited to 'new-luxc/source/luxc/lang/translation/jvm/procedure/common.lux')
-rw-r--r--new-luxc/source/luxc/lang/translation/jvm/procedure/common.lux385
1 files changed, 0 insertions, 385 deletions
diff --git a/new-luxc/source/luxc/lang/translation/jvm/procedure/common.lux b/new-luxc/source/luxc/lang/translation/jvm/procedure/common.lux
deleted file mode 100644
index a46813232..000000000
--- a/new-luxc/source/luxc/lang/translation/jvm/procedure/common.lux
+++ /dev/null
@@ -1,385 +0,0 @@
-(.module:
- [lux (#- Type)
- [abstract
- ["." monad (#+ do)]]
- [control
- ["." try]
- ["<>" parser
- ["<s>" synthesis (#+ Parser)]]
- ["ex" exception (#+ exception:)]]
- [data
- ["." product]
- [number
- ["f" frac]]
- [collection
- ["." list ("#@." monad)]
- ["." dictionary]]]
- [target
- [jvm
- ["." type
- ["." signature]]]]
- [tool
- [compiler
- ["." 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 s (Operation Inst))]
- Handler))
- (function (_ extension-name phase input)
- (case (<s>.run input parser)
- (#try.Success input')
- (handler extension-name phase 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
- <s>.any
- <s>.any
- (<>.some (<s>.tuple ($_ <>.and
- (<s>.tuple (<>.many <s>.i64))
- <s>.any))))
- (function (_ extension-name phase [input else conditionals])
- (<| _.with-label (function (_ @end))
- _.with-label (function (_ @else))
- (do phase.monad
- [inputG (phase input)
- elseG (phase else)
- conditionalsG+ (: (Operation (List [(List [Int Label])
- Inst]))
- (monad.map @ (function (_ [chars branch])
- (do @
- [branchG (phase 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 [<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::arithmetic-right-shift _.LSHR]
- [i64::logical-right-shift _.LUSHR]
- )
-
-(template [<name> <const> <type>]
- [(def: (<name> _)
- (Nullary Inst)
- (|>> <const> (_.wrap <type>)))]
-
- [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 [<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 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 [<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 $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 "<init>" 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))))
generated by cgit v1.2.3 (git 2.25.1) at 2024-11-05 12:07:29 +0000