From 4433c9bcd6c6cac44c018aad2e21a5b4d7cc4896 Mon Sep 17 00:00:00 2001 From: Eduardo Julian Date: Wed, 29 Nov 2017 22:49:56 -0400 Subject: - Adapted main codebase to the latest syntatic changes. --- .../luxc/lang/translation/procedure/common.jvm.lux | 576 ++++++++++----------- 1 file changed, 288 insertions(+), 288 deletions(-) (limited to 'new-luxc/source/luxc/lang/translation/procedure/common.jvm.lux') diff --git a/new-luxc/source/luxc/lang/translation/procedure/common.jvm.lux b/new-luxc/source/luxc/lang/translation/procedure/common.jvm.lux index 01f2a33c7..41d9b91ab 100644 --- a/new-luxc/source/luxc/lang/translation/procedure/common.jvm.lux +++ b/new-luxc/source/luxc/lang/translation/procedure/common.jvm.lux @@ -1,4 +1,4 @@ -(;module: +(.module: lux (lux (control [monad #+ do] ["p" parser] @@ -13,23 +13,23 @@ ["s" syntax #+ syntax:]) [host]) (luxc ["&" lang] - (lang [";L" host] + (lang [".L" host] (host ["$" jvm] (jvm ["$t" type] ["$d" def] ["$i" inst])) ["la" analysis] ["ls" synthesis] - (translation [";T" runtime] - [";T" case] - [";T" function] - [";T" loop])))) + (translation [".T" runtime] + [".T" case] + [".T" function] + [".T" loop])))) -(host;import java.lang.Long +(host.import java/lang/Long (#static MIN_VALUE Long) (#static MAX_VALUE Long)) -(host;import java.lang.Double +(host.import java/lang/Double (#static MIN_VALUE Double) (#static MAX_VALUE Double) (#static NaN Double) @@ -38,42 +38,42 @@ ## [Types] (type: #export Translator - (-> ls;Synthesis (Meta $;Inst))) + (-> ls.Synthesis (Meta $.Inst))) (type: #export Proc - (-> Translator (List ls;Synthesis) (Meta $;Inst))) + (-> Translator (List ls.Synthesis) (Meta $.Inst))) (type: #export Bundle (Dict Text Proc)) -(syntax: (Vector [size s;nat] elemT) - (wrap (list (` [(~@ (list;repeat size elemT))])))) +(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)) +(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 $;Type ($t;class "java.lang.Object" (list))) -(def: $Object-Array $;Type ($t;array +1 $Object)) -(def: $Variant $;Type ($t;array +1 $Object)) -(def: $String $;Type ($t;class "java.lang.String" (list))) -(def: $CharSequence $;Type ($t;class "java.lang.CharSequence" (list))) -(def: $Function $;Type ($t;class hostL;function-class (list))) +(def: $Object $.Type ($t.class "java.lang.Object" (list))) +(def: $Object-Array $.Type ($t.array +1 $Object)) +(def: $Variant $.Type ($t.array +1 $Object)) +(def: $String $.Type ($t.class "java.lang.String" (list))) +(def: $CharSequence $.Type ($t.class "java.lang.CharSequence" (list))) +(def: $Function $.Type ($t.class hostL.function-class (list))) (def: #export (install name unnamed) (-> Text (-> Text Proc) (-> Bundle Bundle)) - (dict;put name (unnamed name))) + (dict.put name (unnamed name))) (def: #export (prefix prefix bundle) (-> Text Bundle Bundle) (|> bundle - dict;entries + dict.entries (list/map (function [[key val]] [(format prefix " " key) val])) - (dict;from-list text;Hash))) + (dict.from-list text.Hash))) (def: (wrong-arity proc expected actual) (-> Text Nat Nat Text) @@ -81,26 +81,26 @@ "Expected: " (|> expected nat-to-int %i) "\n" " Actual: " (|> actual nat-to-int %i))) -(syntax: (arity: [name s;local-symbol] [arity s;nat]) +(syntax: (arity: [name s.local-symbol] [arity s.nat]) (with-gensyms [g!proc g!name g!translate g!inputs] (do @ - [g!input+ (monad;seq @ (list;repeat arity (macro;gensym "input")))] - (wrap (list (` (def: #export ((~ (code;local-symbol name)) (~ g!proc)) - (-> (-> (;;Vector (~ (code;nat arity)) $;Inst) $;Inst) - (-> Text ;;Proc)) + [g!input+ (monad.seq @ (list.repeat arity (macro.gensym "input")))] + (wrap (list (` (def: #export ((~ (code.local-symbol name)) (~ g!proc)) + (-> (-> (..Vector (~ (code.nat arity)) $.Inst) $.Inst) + (-> Text ..Proc)) (function [(~ g!name)] (function [(~ g!translate) (~ g!inputs)] (case (~ g!inputs) (^ (list (~@ g!input+))) - (do macro;Monad + (do macro.Monad [(~@ (|> g!input+ (list/map (function [g!input] (list g!input (` ((~ g!translate) (~ g!input)))))) - list;concat))] + list.concat))] ((~' wrap) ((~ g!proc) [(~@ g!input+)]))) (~' _) - (macro;fail (wrong-arity (~ g!name) +1 (list;size (~ g!inputs)))))))))))))) + (macro.fail (wrong-arity (~ g!name) +1 (list.size (~ g!inputs)))))))))))))) (arity: nullary +0) (arity: unary +1) @@ -111,54 +111,54 @@ (-> Variadic (-> Text Proc)) (function [proc-name] (function [translate inputsS] - (do macro;Monad - [inputsI (monad;map @ translate inputsS)] + (do macro.Monad + [inputsI (monad.map @ translate inputsS)] (wrap (proc inputsI)))))) ## [Instructions] -(def: lux-intI $;Inst (|>. $i;I2L ($i;wrap #$;Long))) -(def: jvm-intI $;Inst (|>. ($i;unwrap #$;Long) $i;L2I)) +(def: lux-intI $.Inst (|>> $i.I2L ($i.wrap #$.Long))) +(def: jvm-intI $.Inst (|>> ($i.unwrap #$.Long) $i.L2I)) (def: (array-writeI arrayI idxI elemI) - (-> $;Inst $;Inst $;Inst - $;Inst) - (|>. arrayI ($i;CHECKCAST ($t;descriptor $Object-Array)) - $i;DUP + (-> $.Inst $.Inst $.Inst + $.Inst) + (|>> arrayI ($i.CHECKCAST ($t.descriptor $Object-Array)) + $i.DUP idxI jvm-intI elemI - $i;AASTORE)) + $i.AASTORE)) (def: (predicateI tester) - (-> (-> $;Label $;Inst) - $;Inst) - (<| $i;with-label (function [@then]) - $i;with-label (function [@end]) - (|>. (tester @then) - ($i;GETSTATIC "java.lang.Boolean" "FALSE" ($t;class "java.lang.Boolean" (list))) - ($i;GOTO @end) - ($i;label @then) - ($i;GETSTATIC "java.lang.Boolean" "TRUE" ($t;class "java.lang.Boolean" (list))) - ($i;label @end) + (-> (-> $.Label $.Inst) + $.Inst) + (<| $i.with-label (function [@then]) + $i.with-label (function [@end]) + (|>> (tester @then) + ($i.GETSTATIC "java.lang.Boolean" "FALSE" ($t.class "java.lang.Boolean" (list))) + ($i.GOTO @end) + ($i.label @then) + ($i.GETSTATIC "java.lang.Boolean" "TRUE" ($t.class "java.lang.Boolean" (list))) + ($i.label @end) ))) ## [Procedures] ## [[Lux]] (def: (lux//is [leftI rightI]) Binary - (|>. leftI + (|>> leftI rightI - (predicateI $i;IF_ACMPEQ))) + (predicateI $i.IF_ACMPEQ))) (def: (lux//if [testI thenI elseI]) Trinary - (caseT;translate-if testI thenI elseI)) + (caseT.translate-if testI thenI elseI)) (def: (lux//try riskyI) Unary - (|>. riskyI - ($i;CHECKCAST hostL;function-class) - ($i;INVOKESTATIC hostL;runtime-class "try" - ($t;method (list $Function) (#;Some $Object-Array) (list)) + (|>> riskyI + ($i.CHECKCAST hostL.function-class) + ($i.INVOKESTATIC hostL.runtime-class "try" + ($t.method (list $Function) (#.Some $Object-Array) (list)) false))) (def: (lux//noop valueI) @@ -167,80 +167,80 @@ (exception: #export Wrong-Syntax) (def: #export (wrong-syntax procedure args) - (-> Text (List ls;Synthesis) Text) + (-> Text (List ls.Synthesis) Text) (format "Procedure: " procedure "\n" - "Arguments: " (%code (code;tuple args)))) + "Arguments: " (%code (code.tuple args)))) (def: lux//loop (-> Text Proc) (function [proc-name] (function [translate inputsS] - (case (s;run inputsS ($_ p;seq s;nat (s;tuple (p;many s;any)) s;any)) - (#e;Success [offset initsS+ bodyS]) - (loopT;translate-loop translate offset initsS+ bodyS) + (case (s.run inputsS ($_ p.seq s.nat (s.tuple (p.many s.any)) s.any)) + (#e.Success [offset initsS+ bodyS]) + (loopT.translate-loop translate offset initsS+ bodyS) - (#e;Error error) - (&;throw Wrong-Syntax (wrong-syntax proc-name inputsS))) + (#e.Error error) + (&.throw Wrong-Syntax (wrong-syntax proc-name inputsS))) ))) (def: lux//recur (-> Text Proc) (function [proc-name] (function [translate inputsS] - (loopT;translate-recur translate inputsS)))) + (loopT.translate-recur translate inputsS)))) ## [[Bits]] (do-template [ ] [(def: ( [inputI maskI]) Binary - (|>. inputI ($i;unwrap #$;Long) - maskI ($i;unwrap #$;Long) - ($i;wrap #$;Long)))] + (|>> inputI ($i.unwrap #$.Long) + maskI ($i.unwrap #$.Long) + ($i.wrap #$.Long)))] - [bit//and $i;LAND] - [bit//or $i;LOR] - [bit//xor $i;LXOR] + [bit//and $i.LAND] + [bit//or $i.LOR] + [bit//xor $i.LXOR] ) (def: (bit//count inputI) Unary - (|>. inputI ($i;unwrap #$;Long) - ($i;INVOKESTATIC "java.lang.Long" "bitCount" ($t;method (list $t;long) (#;Some $t;int) (list)) false) + (|>> inputI ($i.unwrap #$.Long) + ($i.INVOKESTATIC "java.lang.Long" "bitCount" ($t.method (list $t.long) (#.Some $t.int) (list)) false) lux-intI)) (do-template [ ] [(def: ( [inputI shiftI]) Binary - (|>. inputI ($i;unwrap #$;Long) + (|>> inputI ($i.unwrap #$.Long) shiftI jvm-intI - ($i;wrap #$;Long)))] + ($i.wrap #$.Long)))] - [bit//shift-left $i;LSHL] - [bit//shift-right $i;LSHR] - [bit//unsigned-shift-right $i;LUSHR] + [bit//shift-left $i.LSHL] + [bit//shift-right $i.LSHR] + [bit//unsigned-shift-right $i.LUSHR] ) ## [[Arrays]] (def: (array//new lengthI) Unary - (|>. lengthI jvm-intI ($i;ANEWARRAY ($t;binary-name "java.lang.Object")))) + (|>> lengthI jvm-intI ($i.ANEWARRAY ($t.binary-name "java.lang.Object")))) (def: (array//get [arrayI idxI]) Binary - (<| $i;with-label (function [@is-null]) - $i;with-label (function [@end]) - (|>. arrayI ($i;CHECKCAST ($t;descriptor $Object-Array)) + (<| $i.with-label (function [@is-null]) + $i.with-label (function [@end]) + (|>> arrayI ($i.CHECKCAST ($t.descriptor $Object-Array)) idxI jvm-intI - $i;AALOAD - $i;DUP - ($i;IFNULL @is-null) - runtimeT;someI - ($i;GOTO @end) - ($i;label @is-null) - $i;POP - runtimeT;noneI - ($i;label @end)))) + $i.AALOAD + $i.DUP + ($i.IFNULL @is-null) + runtimeT.someI + ($i.GOTO @end) + ($i.label @is-null) + $i.POP + runtimeT.noneI + ($i.label @end)))) (def: (array//put [arrayI idxI elemI]) Trinary @@ -248,137 +248,137 @@ (def: (array//remove [arrayI idxI]) Binary - (array-writeI arrayI idxI $i;NULL)) + (array-writeI arrayI idxI $i.NULL)) (def: (array//size arrayI) Unary - (|>. arrayI ($i;CHECKCAST ($t;descriptor $Object-Array)) - $i;ARRAYLENGTH + (|>> arrayI ($i.CHECKCAST ($t.descriptor $Object-Array)) + $i.ARRAYLENGTH lux-intI)) ## [[Numbers]] (def: nat-method - $;Method - ($t;method (list $t;long $t;long) (#;Some $t;long) (list))) + $.Method + ($t.method (list $t.long $t.long) (#.Some $t.long) (list))) -(def: deg-method $;Method nat-method) +(def: deg-method $.Method nat-method) (def: compare-nat-method - $;Method - ($t;method (list $t;long $t;long) (#;Some $t;int) (list))) + $.Method + ($t.method (list $t.long $t.long) (#.Some $t.int) (list))) (do-template [ ] [(def: ( _) Nullary - (|>. ($i;wrap )))] + (|>> ($i.wrap )))] - [nat//min ($i;long 0) #$;Long] - [nat//max ($i;long -1) #$;Long] + [nat//min ($i.long 0) #$.Long] + [nat//max ($i.long -1) #$.Long] - [int//min ($i;long Long.MIN_VALUE) #$;Long] - [int//max ($i;long Long.MAX_VALUE) #$;Long] + [int//min ($i.long Long::MIN_VALUE) #$.Long] + [int//max ($i.long Long::MAX_VALUE) #$.Long] - [frac//smallest ($i;double Double.MIN_VALUE) #$;Double] - [frac//min ($i;double (f.* -1.0 Double.MAX_VALUE)) #$;Double] - [frac//max ($i;double Double.MAX_VALUE) #$;Double] - [frac//not-a-number ($i;double Double.NaN) #$;Double] - [frac//positive-infinity ($i;double Double.POSITIVE_INFINITY) #$;Double] - [frac//negative-infinity ($i;double Double.NEGATIVE_INFINITY) #$;Double] - - [deg//min ($i;long 0) #$;Long] - [deg//max ($i;long -1) #$;Long] + [frac//smallest ($i.double Double::MIN_VALUE) #$.Double] + [frac//min ($i.double (f/* -1.0 Double::MAX_VALUE)) #$.Double] + [frac//max ($i.double Double::MAX_VALUE) #$.Double] + [frac//not-a-number ($i.double Double::NaN) #$.Double] + [frac//positive-infinity ($i.double Double::POSITIVE_INFINITY) #$.Double] + [frac//negative-infinity ($i.double Double::NEGATIVE_INFINITY) #$.Double] + + [deg//min ($i.long 0) #$.Long] + [deg//max ($i.long -1) #$.Long] ) (do-template [ ] [(def: ( [subjectI paramI]) Binary - (|>. subjectI ($i;unwrap ) - paramI ($i;unwrap ) + (|>> subjectI ($i.unwrap ) + paramI ($i.unwrap ) - ($i;wrap )))] + ($i.wrap )))] - [int//add #$;Long $i;LADD] - [int//sub #$;Long $i;LSUB] - [int//mul #$;Long $i;LMUL] - [int//div #$;Long $i;LDIV] - [int//rem #$;Long $i;LREM] + [int//add #$.Long $i.LADD] + [int//sub #$.Long $i.LSUB] + [int//mul #$.Long $i.LMUL] + [int//div #$.Long $i.LDIV] + [int//rem #$.Long $i.LREM] - [nat//add #$;Long $i;LADD] - [nat//sub #$;Long $i;LSUB] - [nat//mul #$;Long $i;LMUL] - [nat//div #$;Long ($i;INVOKESTATIC hostL;runtime-class "div_nat" nat-method false)] - [nat//rem #$;Long ($i;INVOKESTATIC hostL;runtime-class "rem_nat" nat-method false)] - - [frac//add #$;Double $i;DADD] - [frac//sub #$;Double $i;DSUB] - [frac//mul #$;Double $i;DMUL] - [frac//div #$;Double $i;DDIV] - [frac//rem #$;Double $i;DREM] - - [deg//add #$;Long $i;LADD] - [deg//sub #$;Long $i;LSUB] - [deg//mul #$;Long ($i;INVOKESTATIC hostL;runtime-class "mul_deg" deg-method false)] - [deg//div #$;Long ($i;INVOKESTATIC hostL;runtime-class "div_deg" deg-method false)] - [deg//rem #$;Long $i;LSUB] - [deg//scale #$;Long $i;LMUL] - [deg//reciprocal #$;Long $i;LDIV] + [nat//add #$.Long $i.LADD] + [nat//sub #$.Long $i.LSUB] + [nat//mul #$.Long $i.LMUL] + [nat//div #$.Long ($i.INVOKESTATIC hostL.runtime-class "div_nat" nat-method false)] + [nat//rem #$.Long ($i.INVOKESTATIC hostL.runtime-class "rem_nat" nat-method false)] + + [frac//add #$.Double $i.DADD] + [frac//sub #$.Double $i.DSUB] + [frac//mul #$.Double $i.DMUL] + [frac//div #$.Double $i.DDIV] + [frac//rem #$.Double $i.DREM] + + [deg//add #$.Long $i.LADD] + [deg//sub #$.Long $i.LSUB] + [deg//mul #$.Long ($i.INVOKESTATIC hostL.runtime-class "mul_deg" deg-method false)] + [deg//div #$.Long ($i.INVOKESTATIC hostL.runtime-class "div_deg" deg-method false)] + [deg//rem #$.Long $i.LSUB] + [deg//scale #$.Long $i.LMUL] + [deg//reciprocal #$.Long $i.LDIV] ) (do-template [ ] [(do-template [ ] [(def: ( [subjectI paramI]) Binary - (|>. subjectI + (|>> subjectI paramI - ($i;int ) - (predicateI $i;IF_ICMPEQ)))] + ($i.int ) + (predicateI $i.IF_ICMPEQ)))] [ 0] [ -1])] - [nat//eq nat//lt ($i;unwrap #$;Long) ($i;INVOKESTATIC hostL;runtime-class "compare_nat" compare-nat-method false)] - [int//eq int//lt ($i;unwrap #$;Long) $i;LCMP] - [frac//eq frac//lt ($i;unwrap #$;Double) $i;DCMPG] - [deg//eq deg//lt ($i;unwrap #$;Long) ($i;INVOKESTATIC hostL;runtime-class "compare_nat" compare-nat-method false)] + [nat//eq nat//lt ($i.unwrap #$.Long) ($i.INVOKESTATIC hostL.runtime-class "compare_nat" compare-nat-method false)] + [int//eq int//lt ($i.unwrap #$.Long) $i.LCMP] + [frac//eq frac//lt ($i.unwrap #$.Double) $i.DCMPG] + [deg//eq deg//lt ($i.unwrap #$.Long) ($i.INVOKESTATIC hostL.runtime-class "compare_nat" compare-nat-method false)] ) (do-template [ ] [(def: ( inputI) Unary - (|>. inputI ))] + (|>> inputI ))] [nat//to-int id id] - [nat//char ($i;unwrap #$;Long) - ((|>. $i;L2I $i;I2C ($i;INVOKESTATIC "java.lang.Character" "toString" ($t;method (list $t;char) (#;Some $String) (list)) false)))] + [nat//char ($i.unwrap #$.Long) + ((|>> $i.L2I $i.I2C ($i.INVOKESTATIC "java.lang.Character" "toString" ($t.method (list $t.char) (#.Some $String) (list)) false)))] [int//to-nat id id] - [int//to-frac ($i;unwrap #$;Long) (<| ($i;wrap #$;Double) $i;L2D)] - - [frac//to-int ($i;unwrap #$;Double) (<| ($i;wrap #$;Long) $i;D2L)] - [frac//to-deg ($i;unwrap #$;Double) - (<| ($i;wrap #$;Long) ($i;INVOKESTATIC hostL;runtime-class "frac_to_deg" - ($t;method (list $t;double) (#;Some $t;long) (list)) false))] - [frac//encode ($i;unwrap #$;Double) - ($i;INVOKESTATIC "java.lang.Double" "toString" ($t;method (list $t;double) (#;Some $String) (list)) false)] - [frac//decode ($i;CHECKCAST "java.lang.String") - ($i;INVOKESTATIC hostL;runtime-class "decode_frac" ($t;method (list $String) (#;Some $Object-Array) (list)) false)] - - [deg//to-frac ($i;unwrap #$;Long) - (<| ($i;wrap #$;Double) ($i;INVOKESTATIC hostL;runtime-class "deg_to_frac" - ($t;method (list $t;long) (#;Some $t;double) (list)) false))] + [int//to-frac ($i.unwrap #$.Long) (<| ($i.wrap #$.Double) $i.L2D)] + + [frac//to-int ($i.unwrap #$.Double) (<| ($i.wrap #$.Long) $i.D2L)] + [frac//to-deg ($i.unwrap #$.Double) + (<| ($i.wrap #$.Long) ($i.INVOKESTATIC hostL.runtime-class "frac_to_deg" + ($t.method (list $t.double) (#.Some $t.long) (list)) false))] + [frac//encode ($i.unwrap #$.Double) + ($i.INVOKESTATIC "java.lang.Double" "toString" ($t.method (list $t.double) (#.Some $String) (list)) false)] + [frac//decode ($i.CHECKCAST "java.lang.String") + ($i.INVOKESTATIC hostL.runtime-class "decode_frac" ($t.method (list $String) (#.Some $Object-Array) (list)) false)] + + [deg//to-frac ($i.unwrap #$.Long) + (<| ($i.wrap #$.Double) ($i.INVOKESTATIC hostL.runtime-class "deg_to_frac" + ($t.method (list $t.long) (#.Some $t.double) (list)) false))] ) ## [[Text]] (do-template [ ] [(def: ( inputI) Unary - (|>. inputI - ($i;CHECKCAST "java.lang.String") - ($i;INVOKEVIRTUAL ($t;method (list) (#;Some ) (list)) false) + (|>> inputI + ($i.CHECKCAST "java.lang.String") + ($i.INVOKEVIRTUAL ($t.method (list) (#.Some ) (list)) false) ))] - [text//size "java.lang.String" "length" lux-intI $t;int] - [text//hash "java.lang.Object" "hashCode" lux-intI $t;int] + [text//size "java.lang.String" "length" lux-intI $t.int] + [text//hash "java.lang.Object" "hashCode" lux-intI $t.int] [text//trim "java.lang.String" "trim" id $String] [text//upper "java.lang.String" "toUpperCase" id $String] [text//lower "java.lang.String" "toLowerCase" id $String] @@ -387,86 +387,86 @@ (do-template [ ] [(def: ( [subjectI paramI]) Binary - (|>. subjectI + (|>> subjectI paramI ))] [text//eq id id - ($i;INVOKEVIRTUAL "java.lang.Object" "equals" ($t;method (list $Object) (#;Some $t;boolean) (list)) false) - ($i;wrap #$;Boolean)] - [text//lt ($i;CHECKCAST "java.lang.String") ($i;CHECKCAST "java.lang.String") - ($i;INVOKEVIRTUAL "java.lang.String" "compareTo" ($t;method (list $String) (#;Some $t;int) (list)) false) - (<| (predicateI $i;IF_ICMPEQ) ($i;int -1))] - [text//concat ($i;CHECKCAST "java.lang.String") ($i;CHECKCAST "java.lang.String") - ($i;INVOKEVIRTUAL "java.lang.String" "concat" ($t;method (list $String) (#;Some $String) (list)) false) + ($i.INVOKEVIRTUAL "java.lang.Object" "equals" ($t.method (list $Object) (#.Some $t.boolean) (list)) false) + ($i.wrap #$.Boolean)] + [text//lt ($i.CHECKCAST "java.lang.String") ($i.CHECKCAST "java.lang.String") + ($i.INVOKEVIRTUAL "java.lang.String" "compareTo" ($t.method (list $String) (#.Some $t.int) (list)) false) + (<| (predicateI $i.IF_ICMPEQ) ($i.int -1))] + [text//concat ($i.CHECKCAST "java.lang.String") ($i.CHECKCAST "java.lang.String") + ($i.INVOKEVIRTUAL "java.lang.String" "concat" ($t.method (list $String) (#.Some $String) (list)) false) id] - [text//contains? ($i;CHECKCAST "java.lang.String") ($i;CHECKCAST "java.lang.String") - ($i;INVOKEVIRTUAL "java.lang.String" "contains" ($t;method (list $CharSequence) (#;Some $t;boolean) (list)) false) - ($i;wrap #$;Boolean)] - [text//char ($i;CHECKCAST "java.lang.String") jvm-intI - ($i;INVOKESTATIC hostL;runtime-class "text_char" ($t;method (list $String $t;int) (#;Some $Variant) (list)) false) + [text//contains? ($i.CHECKCAST "java.lang.String") ($i.CHECKCAST "java.lang.String") + ($i.INVOKEVIRTUAL "java.lang.String" "contains" ($t.method (list $CharSequence) (#.Some $t.boolean) (list)) false) + ($i.wrap #$.Boolean)] + [text//char ($i.CHECKCAST "java.lang.String") jvm-intI + ($i.INVOKESTATIC hostL.runtime-class "text_char" ($t.method (list $String $t.int) (#.Some $Variant) (list)) false) id] ) (do-template [ ] [(def: ( [subjectI paramI extraI]) Trinary - (|>. subjectI + (|>> subjectI paramI extraI ))] - [text//clip ($i;CHECKCAST "java.lang.String") jvm-intI jvm-intI - ($i;INVOKESTATIC hostL;runtime-class "text_clip" - ($t;method (list $String $t;int $t;int) (#;Some $Variant) (list)) false)] - [text//replace-once ($i;CHECKCAST "java.lang.String") - (<| ($i;INVOKESTATIC "java.util.regex.Pattern" "quote" ($t;method (list $String) (#;Some $String) (list)) false) - ($i;CHECKCAST "java.lang.String")) - ($i;CHECKCAST "java.lang.String") - ($i;INVOKEVIRTUAL "java.lang.String" "replaceFirst" ($t;method (list $String $String) (#;Some $String) (list)) false)] - [text//replace-all ($i;CHECKCAST "java.lang.String") - (<| ($i;INVOKESTATIC "java.util.regex.Pattern" "quote" ($t;method (list $String) (#;Some $String) (list)) false) - ($i;CHECKCAST "java.lang.String")) - ($i;CHECKCAST "java.lang.String") - ($i;INVOKEVIRTUAL "java.lang.String" "replaceAll" ($t;method (list $String $String) (#;Some $String) (list)) false)] + [text//clip ($i.CHECKCAST "java.lang.String") jvm-intI jvm-intI + ($i.INVOKESTATIC hostL.runtime-class "text_clip" + ($t.method (list $String $t.int $t.int) (#.Some $Variant) (list)) false)] + [text//replace-once ($i.CHECKCAST "java.lang.String") + (<| ($i.INVOKESTATIC "java.util.regex.Pattern" "quote" ($t.method (list $String) (#.Some $String) (list)) false) + ($i.CHECKCAST "java.lang.String")) + ($i.CHECKCAST "java.lang.String") + ($i.INVOKEVIRTUAL "java.lang.String" "replaceFirst" ($t.method (list $String $String) (#.Some $String) (list)) false)] + [text//replace-all ($i.CHECKCAST "java.lang.String") + (<| ($i.INVOKESTATIC "java.util.regex.Pattern" "quote" ($t.method (list $String) (#.Some $String) (list)) false) + ($i.CHECKCAST "java.lang.String")) + ($i.CHECKCAST "java.lang.String") + ($i.INVOKEVIRTUAL "java.lang.String" "replaceAll" ($t.method (list $String $String) (#.Some $String) (list)) false)] ) -(def: index-method $;Method ($t;method (list $String $t;int) (#;Some $t;int) (list))) +(def: index-method $.Method ($t.method (list $String $t.int) (#.Some $t.int) (list))) (do-template [ ] [(def: ( [textI partI startI]) Trinary - (<| $i;with-label (function [@not-found]) - $i;with-label (function [@end]) - (|>. textI ($i;CHECKCAST "java.lang.String") - partI ($i;CHECKCAST "java.lang.String") + (<| $i.with-label (function [@not-found]) + $i.with-label (function [@end]) + (|>> textI ($i.CHECKCAST "java.lang.String") + partI ($i.CHECKCAST "java.lang.String") startI jvm-intI - ($i;INVOKEVIRTUAL "java.lang.String" index-method false) - $i;DUP - ($i;int -1) - ($i;IF_ICMPEQ @not-found) + ($i.INVOKEVIRTUAL "java.lang.String" index-method false) + $i.DUP + ($i.int -1) + ($i.IF_ICMPEQ @not-found) lux-intI - runtimeT;someI - ($i;GOTO @end) - ($i;label @not-found) - $i;POP - runtimeT;noneI - ($i;label @end))))] + runtimeT.someI + ($i.GOTO @end) + ($i.label @not-found) + $i.POP + runtimeT.noneI + ($i.label @end))))] [text//index "indexOf"] [text//last-index "lastIndexOf"] ) ## [[Math]] -(def: math-unary-method ($t;method (list $t;double) (#;Some $t;double) (list))) -(def: math-binary-method ($t;method (list $t;double $t;double) (#;Some $t;double) (list))) +(def: math-unary-method ($t.method (list $t.double) (#.Some $t.double) (list))) +(def: math-binary-method ($t.method (list $t.double $t.double) (#.Some $t.double) (list))) (do-template [ ] [(def: ( inputI) Unary - (|>. inputI - ($i;unwrap #$;Double) - ($i;INVOKESTATIC "java.lang.Math" math-unary-method false) - ($i;wrap #$;Double)))] + (|>> inputI + ($i.unwrap #$.Double) + ($i.INVOKESTATIC "java.lang.Math" math-unary-method false) + ($i.wrap #$.Double)))] [math//cos "cos"] [math//sin "sin"] @@ -488,10 +488,10 @@ (do-template [ ] [(def: ( [inputI paramI]) Binary - (|>. inputI ($i;unwrap #$;Double) - paramI ($i;unwrap #$;Double) - ($i;INVOKESTATIC "java.lang.Math" math-binary-method false) - ($i;wrap #$;Double)))] + (|>> inputI ($i.unwrap #$.Double) + paramI ($i.unwrap #$.Double) + ($i.INVOKESTATIC "java.lang.Math" math-binary-method false) + ($i.wrap #$.Double)))] [math//atan2 "atan2"] [math//pow "pow"] @@ -499,90 +499,90 @@ (def: (math//round inputI) Unary - (|>. inputI - ($i;unwrap #$;Double) - ($i;INVOKESTATIC "java.lang.Math" "round" ($t;method (list $t;double) (#;Some $t;long) (list)) false) - $i;L2D - ($i;wrap #$;Double))) + (|>> inputI + ($i.unwrap #$.Double) + ($i.INVOKESTATIC "java.lang.Math" "round" ($t.method (list $t.double) (#.Some $t.long) (list)) false) + $i.L2D + ($i.wrap #$.Double))) ## [[IO]] -(def: string-method $;Method ($t;method (list $String) #;None (list))) +(def: string-method $.Method ($t.method (list $String) #.None (list))) (def: (io//log messageI) Unary - (|>. ($i;GETSTATIC "java.lang.System" "out" ($t;class "java.io.PrintStream" (list))) + (|>> ($i.GETSTATIC "java.lang.System" "out" ($t.class "java.io.PrintStream" (list))) messageI - ($i;CHECKCAST "java.lang.String") - ($i;INVOKEVIRTUAL "java.io.PrintStream" "println" string-method false) - ($i;string hostL;unit))) + ($i.CHECKCAST "java.lang.String") + ($i.INVOKEVIRTUAL "java.io.PrintStream" "println" string-method false) + ($i.string hostL.unit))) (def: (io//error messageI) Unary - (|>. ($i;NEW "java.lang.Error") - $i;DUP + (|>> ($i.NEW "java.lang.Error") + $i.DUP messageI - ($i;CHECKCAST "java.lang.String") - ($i;INVOKESPECIAL "java.lang.Error" "" string-method false) - $i;ATHROW)) + ($i.CHECKCAST "java.lang.String") + ($i.INVOKESPECIAL "java.lang.Error" "" string-method false) + $i.ATHROW)) (def: (io//exit codeI) Unary - (|>. codeI jvm-intI - ($i;INVOKESTATIC "java.lang.System" "exit" ($t;method (list $t;int) #;None (list)) false) - $i;NULL)) + (|>> codeI jvm-intI + ($i.INVOKESTATIC "java.lang.System" "exit" ($t.method (list $t.int) #.None (list)) false) + $i.NULL)) (def: (io//current-time []) Nullary - (|>. ($i;INVOKESTATIC "java.lang.System" "currentTimeMillis" ($t;method (list) (#;Some $t;long) (list)) false) - ($i;wrap #$;Long))) + (|>> ($i.INVOKESTATIC "java.lang.System" "currentTimeMillis" ($t.method (list) (#.Some $t.long) (list)) false) + ($i.wrap #$.Long))) ## [[Atoms]] (def: atom-class Text "java.util.concurrent.atomic.AtomicReference") (def: (atom//new initI) Unary - (|>. ($i;NEW atom-class) - $i;DUP + (|>> ($i.NEW atom-class) + $i.DUP initI - ($i;INVOKESPECIAL atom-class "" ($t;method (list $Object) #;None (list)) false))) + ($i.INVOKESPECIAL atom-class "" ($t.method (list $Object) #.None (list)) false))) (def: (atom//read atomI) Unary - (|>. atomI - ($i;CHECKCAST atom-class) - ($i;INVOKEVIRTUAL atom-class "get" ($t;method (list) (#;Some $Object) (list)) false))) + (|>> atomI + ($i.CHECKCAST atom-class) + ($i.INVOKEVIRTUAL atom-class "get" ($t.method (list) (#.Some $Object) (list)) false))) (def: (atom//compare-and-swap [atomI oldI newI]) Trinary - (|>. atomI - ($i;CHECKCAST atom-class) + (|>> atomI + ($i.CHECKCAST atom-class) oldI newI - ($i;INVOKEVIRTUAL atom-class "compareAndSet" ($t;method (list $Object $Object) (#;Some $t;boolean) (list)) false) - ($i;wrap #$;Boolean))) + ($i.INVOKEVIRTUAL atom-class "compareAndSet" ($t.method (list $Object $Object) (#.Some $t.boolean) (list)) false) + ($i.wrap #$.Boolean))) ## [[Processes]] (def: (process//concurrency-level []) Nullary - (|>. ($i;INVOKESTATIC "java.lang.Runtime" "getRuntime" ($t;method (list) (#;Some ($t;class "java.lang.Runtime" (list))) (list)) false) - ($i;INVOKEVIRTUAL "java.lang.Runtime" "availableProcessors" ($t;method (list) (#;Some $t;int) (list)) false) + (|>> ($i.INVOKESTATIC "java.lang.Runtime" "getRuntime" ($t.method (list) (#.Some ($t.class "java.lang.Runtime" (list))) (list)) false) + ($i.INVOKEVIRTUAL "java.lang.Runtime" "availableProcessors" ($t.method (list) (#.Some $t.int) (list)) false) lux-intI)) (def: (process//future procedureI) Unary - (|>. procedureI ($i;CHECKCAST hostL;function-class) - ($i;INVOKESTATIC hostL;runtime-class "future" - ($t;method (list $Function) (#;Some $Object) (list)) false))) + (|>> procedureI ($i.CHECKCAST hostL.function-class) + ($i.INVOKESTATIC hostL.runtime-class "future" + ($t.method (list $Function) (#.Some $Object) (list)) false))) (def: (process//schedule [millisecondsI procedureI]) Binary - (|>. millisecondsI ($i;unwrap #$;Long) - procedureI ($i;CHECKCAST hostL;function-class) - ($i;INVOKESTATIC hostL;runtime-class "schedule" - ($t;method (list $t;long $Function) (#;Some $Object) (list)) false))) + (|>> millisecondsI ($i.unwrap #$.Long) + procedureI ($i.CHECKCAST hostL.function-class) + ($i.INVOKESTATIC hostL.runtime-class "schedule" + ($t.method (list $t.long $Function) (#.Some $Object) (list)) false))) ## [Bundles] (def: lux-procs Bundle - (|> (dict;new text;Hash) + (|> (dict.new text.Hash) (install "noop" (unary lux//noop)) (install "is" (binary lux//is)) (install "try" (unary lux//try)) @@ -594,7 +594,7 @@ (def: bit-procs Bundle (<| (prefix "bit") - (|> (dict;new text;Hash) + (|> (dict.new text.Hash) (install "count" (unary bit//count)) (install "and" (binary bit//and)) (install "or" (binary bit//or)) @@ -607,7 +607,7 @@ (def: nat-procs Bundle (<| (prefix "nat") - (|> (dict;new text;Hash) + (|> (dict.new text.Hash) (install "+" (binary nat//add)) (install "-" (binary nat//sub)) (install "*" (binary nat//mul)) @@ -623,7 +623,7 @@ (def: int-procs Bundle (<| (prefix "int") - (|> (dict;new text;Hash) + (|> (dict.new text.Hash) (install "+" (binary int//add)) (install "-" (binary int//sub)) (install "*" (binary int//mul)) @@ -639,7 +639,7 @@ (def: deg-procs Bundle (<| (prefix "deg") - (|> (dict;new text;Hash) + (|> (dict.new text.Hash) (install "+" (binary deg//add)) (install "-" (binary deg//sub)) (install "*" (binary deg//mul)) @@ -656,7 +656,7 @@ (def: frac-procs Bundle (<| (prefix "frac") - (|> (dict;new text;Hash) + (|> (dict.new text.Hash) (install "+" (binary frac//add)) (install "-" (binary frac//sub)) (install "*" (binary frac//mul)) @@ -678,7 +678,7 @@ (def: text-procs Bundle (<| (prefix "text") - (|> (dict;new text;Hash) + (|> (dict.new text.Hash) (install "=" (binary text//eq)) (install "<" (binary text//lt)) (install "concat" (binary text//concat)) @@ -696,7 +696,7 @@ (def: array-procs Bundle (<| (prefix "array") - (|> (dict;new text;Hash) + (|> (dict.new text.Hash) (install "new" (unary array//new)) (install "get" (binary array//get)) (install "put" (trinary array//put)) @@ -707,7 +707,7 @@ (def: math-procs Bundle (<| (prefix "math") - (|> (dict;new text;Hash) + (|> (dict.new text.Hash) (install "cos" (unary math//cos)) (install "sin" (unary math//sin)) (install "tan" (unary math//tan)) @@ -731,7 +731,7 @@ (def: io-procs Bundle (<| (prefix "io") - (|> (dict;new text;Hash) + (|> (dict.new text.Hash) (install "log" (unary io//log)) (install "error" (unary io//error)) (install "exit" (unary io//exit)) @@ -740,7 +740,7 @@ (def: atom-procs Bundle (<| (prefix "atom") - (|> (dict;new text;Hash) + (|> (dict.new text.Hash) (install "new" (unary atom//new)) (install "read" (unary atom//read)) (install "compare-and-swap" (trinary atom//compare-and-swap))))) @@ -748,7 +748,7 @@ (def: process-procs Bundle (<| (prefix "process") - (|> (dict;new text;Hash) + (|> (dict.new text.Hash) (install "concurrency-level" (nullary process//concurrency-level)) (install "future" (unary process//future)) (install "schedule" (binary process//schedule)) @@ -757,17 +757,17 @@ (def: #export procedures Bundle (<| (prefix "lux") - (|> (dict;new text;Hash) - (dict;merge lux-procs) - (dict;merge bit-procs) - (dict;merge nat-procs) - (dict;merge int-procs) - (dict;merge deg-procs) - (dict;merge frac-procs) - (dict;merge text-procs) - (dict;merge array-procs) - (dict;merge math-procs) - (dict;merge io-procs) - (dict;merge atom-procs) - (dict;merge process-procs) + (|> (dict.new text.Hash) + (dict.merge lux-procs) + (dict.merge bit-procs) + (dict.merge nat-procs) + (dict.merge int-procs) + (dict.merge deg-procs) + (dict.merge frac-procs) + (dict.merge text-procs) + (dict.merge array-procs) + (dict.merge math-procs) + (dict.merge io-procs) + (dict.merge atom-procs) + (dict.merge process-procs) ))) -- cgit v1.2.3