From d4ded2084127fd8953d2889d72bab889213000a1 Mon Sep 17 00:00:00 2001 From: Eduardo Julian Date: Sun, 7 Apr 2019 21:12:08 -0400 Subject: Upgraded the tuple right-access mechanism to the new style. --- .../lux/tool/compiler/phase/generation/js/case.lux | 28 ++++++++------ .../tool/compiler/phase/generation/js/runtime.lux | 39 +++++++++---------- .../tool/compiler/phase/generation/python/case.lux | 28 ++++++++------ .../compiler/phase/generation/python/runtime.lux | 45 +++++++++++----------- 4 files changed, 74 insertions(+), 66 deletions(-) (limited to 'stdlib/source') 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 [ ] + ( lefts) + ( (_.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 [ ] - (^ ( idx)) - (////@wrap (|> idx .int _.i32 ( ..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 [ ] + (^ ( lefts)) + (////@wrap (push-cursor! ( (_.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 [ ] + ( lefts) + ( (_.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 [ ] - (^ ( idx)) - (////@wrap (|> idx .int _.int ( ..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 [ ] + (^ ( lefts)) + (////@wrap (|> ..peek-cursor ( (_.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 -- cgit v1.2.3