aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
Diffstat
-rw-r--r--luxc/src/lux/compiler/jvm/case.clj41
-rw-r--r--luxc/src/lux/compiler/jvm/lux.clj6
-rw-r--r--luxc/src/lux/compiler/jvm/rt.clj113
-rw-r--r--new-luxc/source/luxc/lang/translation/jvm/case.jvm.lux52
-rw-r--r--new-luxc/source/luxc/lang/translation/jvm/runtime.jvm.lux44
-rw-r--r--stdlib/source/lux/tool/compiler/phase/generation/js/case.lux28
-rw-r--r--stdlib/source/lux/tool/compiler/phase/generation/js/runtime.lux39
-rw-r--r--stdlib/source/lux/tool/compiler/phase/generation/python/case.lux28
-rw-r--r--stdlib/source/lux/tool/compiler/phase/generation/python/runtime.lux45
9 files changed, 209 insertions, 187 deletions
diff --git a/luxc/src/lux/compiler/jvm/case.clj b/luxc/src/lux/compiler/jvm/case.clj
index cceed14e4..aa262a102 100644
--- a/luxc/src/lux/compiler/jvm/case.clj
+++ b/luxc/src/lux/compiler/jvm/case.clj
@@ -108,27 +108,26 @@
(.visitMethodInsn Opcodes/INVOKEVIRTUAL "java/lang/Object" "equals" "(Ljava/lang/Object;)Z")
(.visitJumpInsn Opcodes/IFEQ $else))
- (&o/$TuplePM _idx+)
- (|let [[_idx is-tail?] (|case _idx+
- (&/$Left _idx)
- (&/T [_idx false])
-
- (&/$Right _idx)
- (&/T [_idx true]))]
- (if (= 0 _idx)
- (doto writer
- stack-peek
- (.visitTypeInsn Opcodes/CHECKCAST "[Ljava/lang/Object;")
- (.visitLdcInsn (int 0))
- (.visitInsn Opcodes/AALOAD)
- (.visitMethodInsn Opcodes/INVOKESTATIC "lux/LuxRT" "pm_stack_push" "([Ljava/lang/Object;Ljava/lang/Object;)[Ljava/lang/Object;"))
- (doto writer
- stack-peek
- (.visitTypeInsn Opcodes/CHECKCAST "[Ljava/lang/Object;")
- (.visitLdcInsn (int _idx))
- (.visitMethodInsn Opcodes/INVOKESTATIC "lux/LuxRT" (if is-tail? "product_getRight" "tuple_left") "([Ljava/lang/Object;I)Ljava/lang/Object;")
- (.visitMethodInsn Opcodes/INVOKESTATIC "lux/LuxRT" "pm_stack_push" "([Ljava/lang/Object;Ljava/lang/Object;)[Ljava/lang/Object;")
- )))
+ (&o/$TuplePM (&/$Left lefts))
+ (let [accessI (if (= 0 lefts)
+ #(doto %
+ (.visitInsn Opcodes/AALOAD))
+ #(doto %
+ (.visitMethodInsn Opcodes/INVOKESTATIC "lux/LuxRT" "tuple_left" "([Ljava/lang/Object;I)Ljava/lang/Object;")))]
+ (doto writer
+ stack-peek
+ (.visitTypeInsn Opcodes/CHECKCAST "[Ljava/lang/Object;")
+ (.visitLdcInsn (int lefts))
+ accessI
+ (.visitMethodInsn Opcodes/INVOKESTATIC "lux/LuxRT" "pm_stack_push" "([Ljava/lang/Object;Ljava/lang/Object;)[Ljava/lang/Object;")))
+
+ (&o/$TuplePM (&/$Right _idx))
+ (doto writer
+ stack-peek
+ (.visitTypeInsn Opcodes/CHECKCAST "[Ljava/lang/Object;")
+ (.visitLdcInsn (int (dec _idx)))
+ (.visitMethodInsn Opcodes/INVOKESTATIC "lux/LuxRT" "tuple_right" "([Ljava/lang/Object;I)Ljava/lang/Object;")
+ (.visitMethodInsn Opcodes/INVOKESTATIC "lux/LuxRT" "pm_stack_push" "([Ljava/lang/Object;Ljava/lang/Object;)[Ljava/lang/Object;"))
(&o/$VariantPM _idx+)
(|let [$success (new Label)
diff --git a/luxc/src/lux/compiler/jvm/lux.clj b/luxc/src/lux/compiler/jvm/lux.clj
index b57b94894..4aebc2bbf 100644
--- a/luxc/src/lux/compiler/jvm/lux.clj
+++ b/luxc/src/lux/compiler/jvm/lux.clj
@@ -206,9 +206,11 @@
(|let [[idx tail?] step]
(doto *writer*
(.visitTypeInsn Opcodes/CHECKCAST "[Ljava/lang/Object;")
- (.visitLdcInsn (int idx))
+ (.visitLdcInsn (int (if tail?
+ (dec idx)
+ idx)))
(.visitMethodInsn Opcodes/INVOKESTATIC "lux/LuxRT"
- (if tail? "product_getRight" "tuple_left")
+ (if tail? "tuple_right" "tuple_left")
"([Ljava/lang/Object;I)Ljava/lang/Object;"))))
_path)]]
(return nil)))
diff --git a/luxc/src/lux/compiler/jvm/rt.clj b/luxc/src/lux/compiler/jvm/rt.clj
index d28011b41..f5fc85795 100644
--- a/luxc/src/lux/compiler/jvm/rt.clj
+++ b/luxc/src/lux/compiler/jvm/rt.clj
@@ -68,88 +68,85 @@
;; Runtime infrastructure
(defn ^:private compile-LuxRT-adt-methods [^ClassWriter =class]
- (|let [_ (let [$begin (new Label)
+ (|let [lefts #(doto %
+ (.visitVarInsn Opcodes/ILOAD 1))
+ tuple-size #(doto %
+ (.visitVarInsn Opcodes/ALOAD 0)
+ (.visitInsn Opcodes/ARRAYLENGTH))
+ last-right-index #(doto %
+ tuple-size
+ (.visitLdcInsn (int 1))
+ (.visitInsn Opcodes/ISUB))
+ sub-tuple #(doto %
+ (.visitVarInsn Opcodes/ALOAD 0)
+ last-right-index
+ (.visitInsn Opcodes/AALOAD)
+ (.visitTypeInsn Opcodes/CHECKCAST "[Ljava/lang/Object;"))
+ _ (let [$begin (new Label)
$not-rec (new Label)
- index-right #(doto %
- (.visitVarInsn Opcodes/ALOAD 0)
- (.visitInsn Opcodes/ARRAYLENGTH)
- (.visitLdcInsn (int 1))
- (.visitInsn Opcodes/ISUB))
- lefts #(doto %
- (.visitVarInsn Opcodes/ILOAD 1))
left-index lefts
- access #(doto %
- (.visitVarInsn Opcodes/ALOAD 0)
- left-index
- (.visitInsn Opcodes/AALOAD))
+ left-access #(doto %
+ (.visitVarInsn Opcodes/ALOAD 0)
+ left-index
+ (.visitInsn Opcodes/AALOAD))
sub-lefts #(doto %
- ;; index-right, lefts
+ ;; last-right-index, lefts
(.visitInsn Opcodes/SWAP)
- (.visitInsn Opcodes/ISUB))
- sub-tuple #(doto %
- (.visitVarInsn Opcodes/ALOAD 0)
- index-right
- (.visitInsn Opcodes/AALOAD)
- (.visitTypeInsn Opcodes/CHECKCAST "[Ljava/lang/Object;"))]
+ (.visitInsn Opcodes/ISUB))]
(doto (.visitMethod =class (+ Opcodes/ACC_PUBLIC Opcodes/ACC_STATIC) "tuple_left" "([Ljava/lang/Object;I)Ljava/lang/Object;" nil nil)
(.visitCode)
(.visitLabel $begin)
- index-right
+ last-right-index
lefts
(.visitInsn Opcodes/DUP2) (.visitJumpInsn Opcodes/IF_ICMPGT $not-rec)
- sub-lefts (.visitVarInsn Opcodes/ISTORE 1)
sub-tuple (.visitVarInsn Opcodes/ASTORE 0)
+ sub-lefts (.visitVarInsn Opcodes/ISTORE 1)
(.visitJumpInsn Opcodes/GOTO $begin)
(.visitLabel $not-rec)
- ;; index-right, lefts
+ ;; last-right-index, lefts
;; (.visitInsn Opcodes/POP2) ;;
- access
+ left-access
(.visitInsn Opcodes/ARETURN)
(.visitMaxs 0 0)
(.visitEnd)))
_ (let [$begin (new Label)
$is-last (new Label)
- $must-copy (new Label)]
- (doto (.visitMethod =class (+ Opcodes/ACC_PUBLIC Opcodes/ACC_STATIC) "product_getRight" "([Ljava/lang/Object;I)Ljava/lang/Object;" nil nil)
+ $must-copy (new Label)
+ right-index #(doto %
+ lefts
+ (.visitLdcInsn (int 1))
+ (.visitInsn Opcodes/IADD))
+ right-access #(doto %
+ (.visitVarInsn Opcodes/ALOAD 0)
+ (.visitInsn Opcodes/SWAP)
+ (.visitInsn Opcodes/AALOAD))
+ sub-right #(doto %
+ (.visitVarInsn Opcodes/ALOAD 0)
+ right-index
+ tuple-size
+ (.visitMethodInsn Opcodes/INVOKESTATIC "java/util/Arrays" "copyOfRange" "([Ljava/lang/Object;II)[Ljava/lang/Object;"))
+ sub-lefts #(doto %
+ lefts
+ last-right-index
+ (.visitInsn Opcodes/ISUB))]
+ (doto (.visitMethod =class (+ Opcodes/ACC_PUBLIC Opcodes/ACC_STATIC) "tuple_right" "([Ljava/lang/Object;I)Ljava/lang/Object;" nil nil)
(.visitCode)
(.visitLabel $begin)
- (.visitVarInsn Opcodes/ALOAD 0) ;; tuple
- (.visitInsn Opcodes/ARRAYLENGTH) ;; tuple-size
- (.visitVarInsn Opcodes/ILOAD 1) ;; tuple-size, index
- (.visitLdcInsn (int 1)) ;; tuple-size, index, offset-last-elem
- (.visitInsn Opcodes/IADD) ;; tuple-size, index-last-elem
- (.visitInsn Opcodes/DUP2) ;; tuple-size, index-last-elem, tuple-size, index-last-elem
- (.visitJumpInsn Opcodes/IF_ICMPEQ $is-last) ;; tuple-size, index-last-elem
- (.visitJumpInsn Opcodes/IF_ICMPGT $must-copy) ;;
+ last-right-index
+ right-index
+ (.visitInsn Opcodes/DUP2) (.visitJumpInsn Opcodes/IF_ICMPEQ $is-last)
+ (.visitJumpInsn Opcodes/IF_ICMPGT $must-copy)
;; Must recurse
- (.visitVarInsn Opcodes/ALOAD 0) ;; tuple
- (.visitInsn Opcodes/DUP) ;; tuple, tuple
- (.visitInsn Opcodes/ARRAYLENGTH) ;; tuple, tuple-size
- (.visitLdcInsn (int 1)) ;; tuple, tuple-size, offset-last-elem
- (.visitInsn Opcodes/ISUB) ;; tuple, offset-tuple-last-elem
- (.visitInsn Opcodes/AALOAD) ;; tuple-tail
- (.visitVarInsn Opcodes/ILOAD 1) ;; tuple-tail, index
- (.visitVarInsn Opcodes/ALOAD 0) ;; tuple-tail, index, tuple
- (.visitInsn Opcodes/ARRAYLENGTH) ;; tuple-tail, index, tuple-size
- (.visitLdcInsn (int 1)) ;; tuple-tail, index, tuple-size, 1
- (.visitInsn Opcodes/ISUB) ;; tuple-tail, index, tuple-size*
- (.visitInsn Opcodes/ISUB) ;; tuple-tail, index*
- (.visitVarInsn Opcodes/ISTORE 1) ;; tuple-tail
- (.visitTypeInsn Opcodes/CHECKCAST "[Ljava/lang/Object;") ;; tuple-tail
- (.visitVarInsn Opcodes/ASTORE 0) ;;
+ sub-tuple (.visitVarInsn Opcodes/ASTORE 0)
+ sub-lefts (.visitVarInsn Opcodes/ISTORE 1)
(.visitJumpInsn Opcodes/GOTO $begin)
(.visitLabel $must-copy)
- (.visitVarInsn Opcodes/ALOAD 0)
- (.visitVarInsn Opcodes/ILOAD 1)
- (.visitVarInsn Opcodes/ALOAD 0)
- (.visitInsn Opcodes/ARRAYLENGTH)
- (.visitMethodInsn Opcodes/INVOKESTATIC "java/util/Arrays" "copyOfRange" "([Ljava/lang/Object;II)[Ljava/lang/Object;")
+ sub-right
(.visitInsn Opcodes/ARETURN)
- (.visitLabel $is-last) ;; tuple-size, index-last-elem
- ;; (.visitInsn Opcodes/POP2) ;;
- (.visitVarInsn Opcodes/ALOAD 0) ;; tuple
- (.visitVarInsn Opcodes/ILOAD 1) ;; tuple, index
- (.visitInsn Opcodes/AALOAD) ;; elem
+ (.visitLabel $is-last)
+ ;; last-right-index, right-index
+ ;; (.visitInsn Opcodes/POP)
+ right-access
(.visitInsn Opcodes/ARETURN)
(.visitMaxs 0 0)
(.visitEnd)))
diff --git a/new-luxc/source/luxc/lang/translation/jvm/case.jvm.lux b/new-luxc/source/luxc/lang/translation/jvm/case.jvm.lux
index 22817e8eb..43d11c71e 100644
--- a/new-luxc/source/luxc/lang/translation/jvm/case.jvm.lux
+++ b/new-luxc/source/luxc/lang/translation/jvm/case.jvm.lux
@@ -132,29 +132,35 @@
([synthesis.side/left _.NULL function.identity]
[synthesis.side/right (_.string "") .inc])
- (^template [<pattern> <method> <prepare>]
- (^ (<pattern> idx))
- (operation/wrap (.case (<prepare> idx)
- 0
- (|>> peekI
- (_.CHECKCAST ($t.descriptor runtime.$Tuple))
- (_.int +0)
- _.AALOAD
- pushI)
-
- idx
- (|>> peekI
- (_.CHECKCAST ($t.descriptor runtime.$Tuple))
- (_.int (.int idx))
- (_.INVOKESTATIC //.runtime-class
- <method>
- ($t.method (list runtime.$Tuple $t.int)
- (#.Some $Object)
- (list))
- #0)
- pushI))))
- ([synthesis.member/left "tuple_left" <|]
- [synthesis.member/right "pm_right" inc])
+ (^ (synthesis.member/left lefts))
+ (operation/wrap (.let [accessI (.case lefts
+ 0
+ _.AALOAD
+
+ lefts
+ (_.INVOKESTATIC //.runtime-class
+ "tuple_left"
+ ($t.method (list runtime.$Tuple $t.int)
+ (#.Some $Object)
+ (list))
+ #0))]
+ (|>> peekI
+ (_.CHECKCAST ($t.descriptor runtime.$Tuple))
+ (_.int (.int lefts))
+ accessI
+ pushI)))
+
+ (^ (synthesis.member/right lefts))
+ (operation/wrap (|>> peekI
+ (_.CHECKCAST ($t.descriptor runtime.$Tuple))
+ (_.int (.int lefts))
+ (_.INVOKESTATIC //.runtime-class
+ "tuple_right"
+ ($t.method (list runtime.$Tuple $t.int)
+ (#.Some $Object)
+ (list))
+ #0)
+ pushI))
(#synthesis.Alt leftP rightP)
(do phase.monad
diff --git a/new-luxc/source/luxc/lang/translation/jvm/runtime.jvm.lux b/new-luxc/source/luxc/lang/translation/jvm/runtime.jvm.lux
index 6ea00df21..973170d77 100644
--- a/new-luxc/source/luxc/lang/translation/jvm/runtime.jvm.lux
+++ b/new-luxc/source/luxc/lang/translation/jvm/runtime.jvm.lux
@@ -136,8 +136,6 @@
last-right-indexI (|>> tuple-sizeI (_.int +1) _.ISUB)
leftsI (_.ILOAD 1)
left-indexI leftsI
- accessI (|>> (_.ALOAD 0) left-indexI _.AALOAD)
- sub-leftsI (|>> _.SWAP _.ISUB)
sub-tupleI (|>> (_.ALOAD 0) last-right-indexI _.AALOAD (_.CHECKCAST ($t.descriptor $Tuple)))
expected-last-sizeI (|>> (_.ILOAD 1) (_.int +1) _.IADD)]
@@ -231,6 +229,8 @@
($d.method #$.Public $.staticM "tuple_left" ($t.method (list $Tuple $t.int) (#.Some $Object) (list))
(<| _.with-label (function (_ @begin))
_.with-label (function (_ @not-recursive))
+ (let [left-accessI (|>> (_.ALOAD 0) left-indexI _.AALOAD)
+ sub-leftsI (|>> _.SWAP _.ISUB)])
(|>> (_.label @begin)
last-right-indexI
leftsI
@@ -241,34 +241,44 @@
(_.GOTO @begin)
(_.label @not-recursive)
## _.POP2
- accessI
+ left-accessI
_.ARETURN)))
- ($d.method #$.Public $.staticM "pm_right" ($t.method (list $Tuple $t.int) (#.Some $Object) (list))
+ ($d.method #$.Public $.staticM "tuple_right" ($t.method (list $Tuple $t.int) (#.Some $Object) (list))
(<| _.with-label (function (_ @begin))
_.with-label (function (_ @tail))
_.with-label (function (_ @slice))
- (let [updated-idxI (|>> (_.ILOAD 1) (_.int +1) _.ISUB tuple-sizeI _.ISUB)
- sliceI (|>> (_.ALOAD 0) (_.ILOAD 1) tuple-sizeI
- (_.INVOKESTATIC "java.util.Arrays" "copyOfRange"
- ($t.method (list $Object-Array $t.int $t.int)
- (#.Some $Object-Array)
- (list))
- #0))])
+ (let [right-indexI (|>> leftsI
+ (_.int +1)
+ _.IADD)
+ right-accessI (|>> (_.ALOAD 0)
+ _.SWAP
+ _.AALOAD)
+ sub-rightI (|>> (_.ALOAD 0)
+ right-indexI
+ tuple-sizeI
+ (_.INVOKESTATIC "java.util.Arrays" "copyOfRange"
+ ($t.method (list $Object-Array $t.int $t.int)
+ (#.Some $Object-Array)
+ (list))
+ #0))
+ sub-leftsI (|>> leftsI
+ last-right-indexI
+ _.ISUB)])
(|>> (_.label @begin)
- tuple-sizeI
- expected-last-sizeI
+ last-right-indexI
+ right-indexI
_.DUP2 (_.IF_ICMPEQ @tail)
(_.IF_ICMPGT @slice)
## Must recurse
sub-tupleI (_.ASTORE 0)
- updated-idxI (_.ISTORE 1)
+ sub-leftsI (_.ISTORE 1)
(_.GOTO @begin)
(_.label @slice)
- sliceI
+ sub-rightI
_.ARETURN
(_.label @tail)
- ## _.POP2
- accessI
+ ## _.POP
+ right-accessI
_.ARETURN)))
)))
diff --git a/stdlib/source/lux/tool/compiler/phase/generation/js/case.lux b/stdlib/source/lux/tool/compiler/phase/generation/js/case.lux
index f426dd6ff..dca429854 100644
--- a/stdlib/source/lux/tool/compiler/phase/generation/js/case.lux
+++ b/stdlib/source/lux/tool/compiler/phase/generation/js/case.lux
@@ -39,15 +39,18 @@
(list valueO)))))
(def: #export (record-get generate valueS pathP)
- (-> Phase Synthesis (List [Nat Bit])
+ (-> Phase Synthesis (List (Either Nat Nat))
(Operation Expression))
(do ////.monad
[valueO (generate valueS)]
- (wrap (list@fold (function (_ [idx tail?] source)
- (.let [method (.if tail?
- //runtime.product//right
- //runtime.tuple//left)]
- (method source (_.i32 (.int idx)))))
+ (wrap (list@fold (function (_ side source)
+ (.let [method (.case side
+ (^template [<side> <accessor>]
+ (<side> lefts)
+ (<accessor> (_.i32 (.int lefts))))
+ ([#.Left //runtime.tuple//left]
+ [#.Right //runtime.tuple//right]))]
+ (method source)))
valueO
pathP))))
@@ -165,11 +168,14 @@
([/////synthesis.side/left /////synthesis.simple-left-side ..left-choice]
[/////synthesis.side/right /////synthesis.simple-right-side ..right-choice])
- (^template [<pm> <getter> <prep>]
- (^ (<pm> idx))
- (////@wrap (|> idx <prep> .int _.i32 (<getter> ..peek-cursor) push-cursor!)))
- ([/////synthesis.member/left //runtime.tuple//left (<|)]
- [/////synthesis.member/right //runtime.product//right inc])
+ (^ (/////synthesis.member/left 0))
+ (////@wrap (push-cursor! (_.at (_.i32 +0) ..peek-cursor)))
+
+ (^template [<pm> <getter>]
+ (^ (<pm> lefts))
+ (////@wrap (push-cursor! (<getter> (_.i32 (.int lefts)) ..peek-cursor))))
+ ([/////synthesis.member/left //runtime.tuple//left]
+ [/////synthesis.member/right //runtime.tuple//right])
(^ (/////synthesis.!bind-top register thenP))
(do ////.monad
diff --git a/stdlib/source/lux/tool/compiler/phase/generation/js/runtime.lux b/stdlib/source/lux/tool/compiler/phase/generation/js/runtime.lux
index 43dcbe716..9102dd30d 100644
--- a/stdlib/source/lux/tool/compiler/phase/generation/js/runtime.lux
+++ b/stdlib/source/lux/tool/compiler/phase/generation/js/runtime.lux
@@ -177,33 +177,30 @@
@lux//program-args
))
-(runtime: (tuple//left tuple lefts)
- (with-vars [index-right]
+(runtime: (tuple//left lefts tuple)
+ (with-vars [last-index-right]
($_ _.then
- (_.define index-right (..last-index tuple))
- (_.if (_.> lefts index-right)
+ (_.define last-index-right (..last-index tuple))
+ (_.if (_.> lefts last-index-right)
## No need for recursion
(_.return (_.at lefts tuple))
## Needs recursion
- (_.return (tuple//left (_.at index-right tuple)
- (_.- index-right lefts)))))))
+ (_.return (tuple//left (_.- last-index-right lefts)
+ (_.at last-index-right tuple)))))))
-(runtime: (product//right product index)
- (with-vars [index-min-length]
+(runtime: (tuple//right lefts tuple)
+ (with-vars [last-index-right right-index]
($_ _.then
- (_.define index-min-length (_.+ (_.i32 +1) index))
- (_.cond (list [(_.= index-min-length
- (..length product))
- ## Last element.
- (_.return (_.at index product))]
- [(_.< index-min-length
- (..length product))
+ (_.define last-index-right (..last-index tuple))
+ (_.define right-index (_.+ (_.i32 +1) lefts))
+ (_.cond (list [(_.= right-index last-index-right)
+ (_.return (_.at right-index tuple))]
+ [(_.> right-index last-index-right)
## Needs recursion.
- (_.return (product//right (last-element product)
- (_.- (..length product)
- index-min-length)))])
- ## Must slice
- (_.return (_.do "slice" (list index) product))))))
+ (_.return (tuple//right (_.- last-index-right lefts)
+ (_.at last-index-right tuple)))])
+ (_.return (_.do "slice" (list right-index) tuple)))
+ )))
(runtime: (sum//get sum wants-last wanted-tag)
(let [no-match! (_.return _.null)
@@ -232,7 +229,7 @@
Statement
($_ _.then
@tuple//left
- @product//right
+ @tuple//right
@sum//get
))
diff --git a/stdlib/source/lux/tool/compiler/phase/generation/python/case.lux b/stdlib/source/lux/tool/compiler/phase/generation/python/case.lux
index 6e4988b9b..923f3d1d3 100644
--- a/stdlib/source/lux/tool/compiler/phase/generation/python/case.lux
+++ b/stdlib/source/lux/tool/compiler/phase/generation/python/case.lux
@@ -43,15 +43,18 @@
(list valueO)))))
(def: #export (record-get generate valueS pathP)
- (-> Phase Synthesis (List [Nat Bit])
+ (-> Phase Synthesis (List (Either Nat Nat))
(Operation (Expression Any)))
(do ////.monad
[valueO (generate valueS)]
- (wrap (list@fold (function (_ [idx tail?] source)
- (.let [method (.if tail?
- //runtime.product//right
- //runtime.tuple//left)]
- (method source (_.int (.int idx)))))
+ (wrap (list@fold (function (_ side source)
+ (.let [method (.case side
+ (^template [<side> <accessor>]
+ (<side> lefts)
+ (<accessor> (_.int (.int lefts))))
+ ([#.Left //runtime.tuple//left]
+ [#.Right //runtime.tuple//right]))]
+ (method source)))
valueO
pathP))))
@@ -159,11 +162,14 @@
([/////synthesis.side/left /////synthesis.simple-left-side ..left-choice]
[/////synthesis.side/right /////synthesis.simple-right-side ..right-choice])
- (^template [<pm> <getter> <prep>]
- (^ (<pm> idx))
- (////@wrap (|> idx <prep> .int _.int (<getter> ..peek-cursor) push-cursor!)))
- ([/////synthesis.member/left //runtime.tuple//left (<|)]
- [/////synthesis.member/right //runtime.product//right inc])
+ (^ (/////synthesis.member/left 0))
+ (////@wrap (|> ..peek-cursor (_.nth (_.int +0)) push-cursor!))
+
+ (^template [<pm> <getter>]
+ (^ (<pm> lefts))
+ (////@wrap (|> ..peek-cursor (<getter> (_.int (.int lefts))) push-cursor!)))
+ ([/////synthesis.member/left //runtime.tuple//left]
+ [/////synthesis.member/right //runtime.tuple//right])
(^ (/////synthesis.!bind-top register thenP))
(do ////.monad
diff --git a/stdlib/source/lux/tool/compiler/phase/generation/python/runtime.lux b/stdlib/source/lux/tool/compiler/phase/generation/python/runtime.lux
index c4a1a6da2..f5a734346 100644
--- a/stdlib/source/lux/tool/compiler/phase/generation/python/runtime.lux
+++ b/stdlib/source/lux/tool/compiler/phase/generation/python/runtime.lux
@@ -180,34 +180,33 @@
@io//exit!
@io//current-time!))
-(runtime: (tuple//left tuple lefts)
- (with-vars [index-right]
+(def: last-index
+ (|>> _.len/1 (_.- (_.int +1))))
+
+(runtime: (tuple//left lefts tuple)
+ (with-vars [last-index-right]
($_ _.then
- (_.set (list index-right) (_.- (_.int +1)
- (_.len/1 tuple)))
- (_.if (_.> lefts index-right)
+ (_.set (list last-index-right) (..last-index tuple))
+ (_.if (_.> lefts last-index-right)
## No need for recursion
(_.return (_.nth lefts tuple))
## Needs recursion
- (_.return (tuple//left (_.nth index-right tuple)
- (_.- index-right lefts)))))))
+ (_.return (tuple//left (_.- last-index-right lefts)
+ (_.nth last-index-right tuple)))))))
-(runtime: (product//right product index)
- (with-vars [index-min-length]
+(runtime: (tuple//right lefts tuple)
+ (with-vars [last-index-right right-index]
($_ _.then
- (_.set (list index-min-length) (_.+ (_.int +1) index))
- (_.cond (list [(_.= index-min-length (_.len/1 product))
- ## Last element.
- (_.return (_.nth index product))]
- [(_.< index-min-length (_.len/1 product))
- ## Needs recursion
- (_.return (product//right (_.nth (_.- (_.int +1)
- (_.len/1 product))
- product)
- (_.- (_.len/1 product)
- index-min-length)))])
- ## Must slice
- (_.return (_.slice-from index product))))))
+ (_.set (list last-index-right) (..last-index tuple))
+ (_.set (list right-index) (_.+ (_.int +1) lefts))
+ (_.cond (list [(_.= right-index last-index-right)
+ (_.return (_.nth right-index tuple))]
+ [(_.> right-index last-index-right)
+ ## Needs recursion.
+ (_.return (tuple//right (_.- last-index-right lefts)
+ (_.nth last-index-right tuple)))])
+ (_.return (_.slice-from right-index tuple)))
+ )))
(runtime: (sum//get sum wantsLast wantedTag)
(let [no-match! (_.return _.none)
@@ -237,7 +236,7 @@
(Statement Any)
($_ _.then
@tuple//left
- @product//right
+ @tuple//right
@sum//get))
(def: full-64-bits
generated by cgit v1.2.3 (git 2.25.1) at 2024-07-15 23:34:27 +0000