diff options
Diffstat (limited to '')
5 files changed, 185 insertions, 231 deletions
diff --git a/stdlib/source/lux/target/scheme.lux b/stdlib/source/lux/target/scheme.lux index 820ff8c83..886d2ba88 100644 --- a/stdlib/source/lux/target/scheme.lux +++ b/stdlib/source/lux/target/scheme.lux @@ -1,15 +1,14 @@ (.module: [lux (#- Code int or and if function cond let) [control - [pipe (#+ new> cond> case>)] - ["." function]] + [pipe (#+ new> cond> case>)]] [data [number ["." frac]] ["." text format] [collection - ["." list ("#;." functor fold)]]] + ["." list ("#@." functor fold)]]] [macro ["." template]] [type @@ -44,25 +43,25 @@ (def: #export var (-> Text Var) (|>> :abstraction)) - (def: (arguments [vars rest]) + (def: (arguments [mandatory rest]) (-> Arguments (Code Any)) (case rest (#.Some rest) - (case vars + (case mandatory #.Nil rest _ (|> (format " . " (:representation rest)) - (format (|> vars - (list;map ..code) + (format (|> mandatory + (list@map ..code) (text.join-with " "))) (text.enclose ["(" ")"]) :abstraction)) #.None - (|> vars - (list;map ..code) + (|> mandatory + (list@map ..code) (text.join-with " ") (text.enclose ["(" ")"]) :abstraction))) @@ -129,14 +128,15 @@ (|>> :abstraction)) (def: form - (-> (List (Code Any)) Text) - (|>> (list;map ..code) + (-> (List (Code Any)) Code) + (|>> (list@map ..code) (text.join-with " ") - (text.enclose ["(" ")"]))) + (text.enclose ["(" ")"]) + :abstraction)) (def: #export (apply/* func args) (-> Expression (List Expression) Computation) - (:abstraction (..form (#.Cons func args)))) + (..form (#.Cons func args))) (template [<name> <function>] [(def: #export <name> @@ -193,7 +193,7 @@ [[append/2 "append"] [cons/2 "cons"] [make-vector/2 "make-vector"] - [vector-ref/2 "vector-ref"] + ## [vector-ref/2 "vector-ref"] [list-tail/2 "list-tail"] [map/2 "map"] [string-ref/2 "string-ref"] @@ -207,6 +207,23 @@ [[vector-copy!/5 "vector-copy!"]]] ) + ## TODO: define "vector-ref/2" like a normal apply/2 function. + ## "vector-ref/2" as an 'invoke' is problematic, since it only works + ## in Kawa. + ## However, the way Kawa defines "vector-ref" causes trouble, + ## because it does a runtime type-check which throws an error when + ## it checks against custom values/objects/classes made for + ## JVM<->Scheme interop. + ## There are 2 ways to deal with this: + ## 0. To fork Kawa, and get rid of the type-check so the normal + ## "vector-ref" can be used instead. + ## 1. To carry on, and then, when it's time to compile the compiler + ## itself into Scheme, switch from 'invoke' to normal 'vector-ref'. + ## Either way, the 'invoke' needs to go away. + (def: #export (vector-ref/2 vector index) + (-> Expression Expression Computation) + (..form (list (..var "invoke") vector (..symbol "getRaw") index))) + (template [<lux-name> <scheme-name>] [(def: #export (<lux-name> param subject) (-> Expression Expression Computation) @@ -238,7 +255,7 @@ (template [<lux-name> <scheme-name>] [(def: #export <lux-name> (-> (List Expression) Computation) - (|>> (list& (..global <scheme-name>)) ..form :abstraction))] + (|>> (list& (..global <scheme-name>)) ..form))] [or "or"] [and "and"] @@ -247,20 +264,17 @@ (template [<lux-name> <scheme-name> <var> <pre>] [(def: #export (<lux-name> bindings body) (-> (List [<var> Expression]) Expression Computation) - (:abstraction - (..form (list (..global <scheme-name>) - (|> bindings - (list;map (.function (_ [binding/name binding/value]) - (:abstraction - (..form (list (<pre> binding/name) - binding/value))))) - ..form - :abstraction) - body))))] - - [let "let" Var function.identity] - [let* "let*" Var function.identity] - [letrec "letrec" Var function.identity] + (..form (list (..global <scheme-name>) + (|> bindings + (list@map (.function (_ [binding/name binding/value]) + (..form (list (|> binding/name <pre>) + binding/value)))) + ..form) + body)))] + + [let "let" Var (<|)] + [let* "let*" Var (<|)] + [letrec "letrec" Var (<|)] [let-values "let-values" Arguments ..arguments] [let*-values "let*-values" Arguments ..arguments] [letrec-values "letrec-values" Arguments ..arguments] @@ -268,17 +282,15 @@ (def: #export (if test then else) (-> Expression Expression Expression Computation) - (:abstraction - (..form (list (..global "if") test then else)))) + (..form (list (..global "if") test then else))) (def: #export (when test then) (-> Expression Expression Computation) - (:abstraction - (..form (list (..global "when") test then)))) + (..form (list (..global "when") test then))) (def: #export (cond clauses else) (-> (List [Expression Expression]) Expression Computation) - (|> (list;fold (.function (_ [test then] next) + (|> (list@fold (.function (_ [test then] next) (if test then next)) else (list.reverse clauses)) @@ -287,31 +299,31 @@ (def: #export (lambda arguments body) (-> Arguments Expression Computation) - (:abstraction - (..form (list (..global "lambda") - (..arguments arguments) - body)))) + (..form (list (..global "lambda") + (..arguments arguments) + body))) - (def: #export (define name arguments body) + (def: #export (define-function name arguments body) (-> Var Arguments Expression Computation) - (:abstraction - (..form (list (..global "define") - (|> arguments - (update@ #mandatory (|>> (#.Cons name))) - ..arguments) - body)))) + (..form (list (..global "define") + (|> arguments + (update@ #mandatory (|>> (#.Cons name))) + ..arguments) + body))) + + (def: #export (define-constant name value) + (-> Var Expression Computation) + (..form (list (..global "define") name value))) (def: #export begin (-> (List Expression) Computation) - (|>> (#.Cons (..global "begin")) ..form :abstraction)) + (|>> (#.Cons (..global "begin")) ..form)) (def: #export (set! name value) (-> Var Expression Computation) - (:abstraction - (..form (list (..global "set!") name value)))) + (..form (list (..global "set!") name value))) (def: #export (with-exception-handler handler body) (-> Expression Expression Computation) - (:abstraction - (..form (list (..global "with-exception-handler") handler body)))) + (..form (list (..global "with-exception-handler") handler body))) ) diff --git a/stdlib/source/lux/tool/compiler/phase/generation/scheme/case.lux b/stdlib/source/lux/tool/compiler/phase/generation/scheme/case.lux index d4cd440fb..04d3bae1d 100644 --- a/stdlib/source/lux/tool/compiler/phase/generation/scheme/case.lux +++ b/stdlib/source/lux/tool/compiler/phase/generation/scheme/case.lux @@ -9,7 +9,7 @@ ["." text format] [collection - ["." list ("#;." functor fold)]]] + ["." list ("#@." functor fold)]]] [target ["_" scheme (#+ Expression Computation Var)]]] ["." // #_ @@ -17,7 +17,7 @@ ["#." primitive] ["#/" // #_ ["#." reference] - ["#/" // ("#;." monad) + ["#/" // ("#@." monad) ["#/" // #_ [reference (#+ Register)] ["#." synthesis (#+ Synthesis Path)]]]]]) @@ -35,15 +35,18 @@ bodyO)))) (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.product//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)))) @@ -98,9 +101,9 @@ (def: (pm-catch handler) (-> Expression Computation) (_.lambda [(list @alt-error) #.None] - (_.if (|> @alt-error (_.eqv?/2 pm-error)) - handler - (_.raise/1 @alt-error)))) + (_.if (|> @alt-error (_.eqv?/2 pm-error)) + handler + (_.raise/1 @alt-error)))) (def: (pattern-matching' generate pathP) (-> Phase Path (Operation Expression)) @@ -109,15 +112,14 @@ (generate bodyS) #/////synthesis.Pop - (////;wrap pop-cursor!) + (////@wrap pop-cursor!) (#/////synthesis.Bind register) - (////;wrap (_.define (..register register) [(list) #.None] - cursor-top)) + (////@wrap (_.define-constant (..register register) ..cursor-top)) (^template [<tag> <format> <=>] (^ (<tag> value)) - (////;wrap (_.when (|> value <format> (<=> cursor-top) _.not/1) + (////@wrap (_.when (|> value <format> (<=> cursor-top) _.not/1) fail-pm!))) ([/////synthesis.path/bit //primitive.bit _.eqv?/2] [/////synthesis.path/i64 (<| //primitive.i64 .int) _.=/2] @@ -126,18 +128,18 @@ (^template [<pm> <flag> <prep>] (^ (<pm> idx)) - (////;wrap (_.let (list [@temp (|> idx <prep> .int _.int (//runtime.sum//get cursor-top <flag>))]) + (////@wrap (_.let (list [@temp (|> idx <prep> .int _.int (//runtime.sum//get cursor-top <flag>))]) (_.if (_.null?/1 @temp) fail-pm! (push-cursor! @temp))))) ([/////synthesis.side/left _.nil (<|)] [/////synthesis.side/right (_.string "") inc]) - (^template [<pm> <getter> <prep>] + (^template [<pm> <getter>] (^ (<pm> idx)) - (////;wrap (|> idx <prep> .int _.int (<getter> cursor-top) push-cursor!))) - ([/////synthesis.member/left //runtime.product//left (<|)] - [/////synthesis.member/right //runtime.product//right inc]) + (////@wrap (push-cursor! (<getter> (_.int (.int idx)) cursor-top)))) + ([/////synthesis.member/left //runtime.tuple//left] + [/////synthesis.member/right //runtime.tuple//right]) (^template [<tag> <computation>] (^ (<tag> leftP rightP)) diff --git a/stdlib/source/lux/tool/compiler/phase/generation/scheme/extension/common.lux b/stdlib/source/lux/tool/compiler/phase/generation/scheme/extension/common.lux index f33cb9599..6701bc078 100644 --- a/stdlib/source/lux/tool/compiler/phase/generation/scheme/extension/common.lux +++ b/stdlib/source/lux/tool/compiler/phase/generation/scheme/extension/common.lux @@ -82,36 +82,24 @@ Binary (<op> paramO subjectO))] - [bit::and _.bit-and/2] - [bit::or _.bit-or/2] - [bit::xor _.bit-xor/2] + [i64::and _.bit-and/2] + [i64::or _.bit-or/2] + [i64::xor _.bit-xor/2] ) -(def: (bit::left-shift [subjectO paramO]) +(def: (i64::left-shift [subjectO paramO]) Binary (_.arithmetic-shift/2 (_.remainder/2 (_.int +64) paramO) subjectO)) -(def: (bit::arithmetic-right-shift [subjectO paramO]) +(def: (i64::arithmetic-right-shift [subjectO paramO]) Binary (_.arithmetic-shift/2 (|> paramO (_.remainder/2 (_.int +64)) (_.*/2 (_.int -1))) subjectO)) -(def: (bit::logical-right-shift [subjectO paramO]) +(def: (i64::logical-right-shift [subjectO paramO]) Binary - (///runtime.bit//logical-right-shift (_.remainder/2 (_.int +64) paramO) subjectO)) - -(def: bundle::bit - Bundle - (<| (bundle.prefix "bit") - (|> 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)) - ))) + (///runtime.i64//logical-right-shift (_.remainder/2 (_.int +64) paramO) subjectO)) (import: java/lang/Double (#static MIN_VALUE Double) @@ -122,9 +110,9 @@ Nullary (<encode> <const>))] - [frac::smallest (Double::MIN_VALUE) _.float] - [frac::min (f/* -1.0 (Double::MAX_VALUE)) _.float] - [frac::max (Double::MAX_VALUE) _.float] + [f64::smallest (Double::MIN_VALUE) _.float] + [f64::min (f/* -1.0 (Double::MAX_VALUE)) _.float] + [f64::max (Double::MAX_VALUE) _.float] ) (template [<name> <op>] @@ -132,11 +120,11 @@ Binary (|> subjectO (<op> paramO)))] - [int::+ _.+/2] - [int::- _.-/2] - [int::* _.*/2] - [int::/ _.quotient/2] - [int::% _.remainder/2] + [i64::+ _.+/2] + [i64::- _.-/2] + [i64::* _.*/2] + [i64::/ _.quotient/2] + [i64::% _.remainder/2] ) (template [<name> <op>] @@ -144,13 +132,13 @@ Binary (<op> paramO subjectO))] - [frac::+ _.+/2] - [frac::- _.-/2] - [frac::* _.*/2] - [frac::/ _.//2] - [frac::% _.mod/2] - [frac::= _.=/2] - [frac::< _.</2] + [f64::+ _.+/2] + [f64::- _.-/2] + [f64::* _.*/2] + [f64::/ _.//2] + [f64::% _.mod/2] + [f64::= _.=/2] + [f64::< _.</2] [text::= _.string=?/2] [text::< _.string<?/2] @@ -161,41 +149,47 @@ Binary (<cmp> paramO subjectO))] - [int::= _.=/2] - [int::< _.</2] + [i64::= _.=/2] + [i64::< _.</2] ) -(def: int::char (|>> _.integer->char/1 _.string/1)) +(def: i64::char (|>> _.integer->char/1 _.string/1)) -(def: bundle::int +(def: bundle::i64 Bundle - (<| (bundle.prefix "int") + (<| (bundle.prefix "i64") (|> bundle.empty - (bundle.install "+" (binary int::+)) - (bundle.install "-" (binary int::-)) - (bundle.install "*" (binary int::*)) - (bundle.install "/" (binary int::/)) - (bundle.install "%" (binary int::%)) - (bundle.install "=" (binary int::=)) - (bundle.install "<" (binary int::<)) - (bundle.install "to-frac" (unary (|>> (_.//2 (_.float +1.0))))) - (bundle.install "char" (unary int::char))))) - -(def: bundle::frac + (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 (|>> (_.//2 (_.float +1.0))))) + (bundle.install "char" (unary i64::char))))) + +(def: bundle::f64 Bundle - (<| (bundle.prefix "frac") + (<| (bundle.prefix "f64") (|> 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 "to-int" (unary _.exact/1)) + (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 _.exact/1)) (bundle.install "encode" (unary _.number->string/1)) (bundle.install "decode" (unary ///runtime.frac//decode))))) @@ -240,9 +234,8 @@ Bundle (<| (bundle.prefix "lux") (|> bundle::lux - (dict.merge bundle::bit) - (dict.merge bundle::int) - (dict.merge bundle::frac) + (dict.merge bundle::i64) + (dict.merge bundle::f64) (dict.merge bundle::text) (dict.merge bundle::io) ))) diff --git a/stdlib/source/lux/tool/compiler/phase/generation/scheme/runtime.lux b/stdlib/source/lux/tool/compiler/phase/generation/scheme/runtime.lux index 3fe02a55d..94269b4aa 100644 --- a/stdlib/source/lux/tool/compiler/phase/generation/scheme/runtime.lux +++ b/stdlib/source/lux/tool/compiler/phase/generation/scheme/runtime.lux @@ -38,8 +38,6 @@ (def: unit (_.string /////synthesis.unit)) -(def: #export variant-tag "lux-variant") - (def: (flag value) (-> Bit Computation) (if value @@ -48,8 +46,7 @@ (def: (variant' tag last? value) (-> Expression Expression Expression Computation) - (<| (_.cons/2 (_.symbol ..variant-tag)) - (_.cons/2 tag) + (<| (_.cons/2 tag) (_.cons/2 last?) value)) @@ -102,15 +99,15 @@ _.Computation (~ (case argsC+ #.Nil - (` (_.define (~ @runtime) [(list) #.None] (~ definition))) + (` (_.define-constant (~ @runtime) [(list) #.None] (~ definition))) _ (` (let [(~+ (|> (list.zip2 argsC+ argsLC+) (list;map (function (_ [left right]) (list left right))) list;join))] - (_.define (~ @runtime) [(list (~+ argsLC+)) #.None] - (~ definition)))))))))))) + (_.define-function (~ @runtime) [(list (~+ argsLC+)) #.None] + (~ definition)))))))))))) (runtime: (slice offset length list) (<| (_.if (_.null?/1 list) @@ -156,58 +153,40 @@ (_.begin (list @@lux//try @@lux//program-args))) -(def: minimum-index-length - (-> Expression Computation) - (|>> (_.+/2 (_.int +1)))) - -(def: product-element - (-> Expression Expression Computation) - (function.flip _.vector-ref/2)) - -(def: (product-tail product) +(def: last-index (-> Expression Computation) - (_.vector-ref/2 product (|> (_.length/1 product) (_.-/2 (_.int +1))))) + (|>> _.length/1 (_.-/2 (_.int +1)))) -(def: (updated-index min-length product) - (-> Expression Expression Computation) - (|> min-length (_.-/2 (_.length/1 product)))) - -(runtime: (product//left product index) - (let [@index_min_length (_.var "index_min_length")] +(runtime: (tuple//left lefts tuple) + (with-vars [last-index-right] (_.begin - (list (_.define @index_min_length [(list) #.None] - (minimum-index-length index)) - (_.if (|> product _.length/1 (_.>/2 @index_min_length)) + (list (_.define-constant last-index-right (..last-index tuple)) + (_.if (_.>/2 lefts last-index-right) ## No need for recursion - (product-element index product) + (_.vector-ref/2 tuple lefts) ## Needs recursion - (product//left (product-tail product) - (updated-index @index_min_length product))))))) - -(runtime: (product//right product index) - (let [@index_min_length (_.var "index_min_length") - @product_length (_.var "product_length") - @slice (_.var "slice") - last-element? (|> @product_length (_.=/2 @index_min_length)) - needs-recursion? (|> @product_length (_.</2 @index_min_length))] + (tuple//left (_.-/2 last-index-right lefts) + (_.vector-ref/2 tuple last-index-right))))))) + +(runtime: (tuple//right lefts tuple) + (with-vars [last-index-right right-index @slice] (_.begin - (list - (_.define @index_min_length [(list) #.None] (minimum-index-length index)) - (_.define @product_length [(list) #.None] (_.length/1 product)) - (<| (_.if last-element? - (product-element index product)) - (_.if needs-recursion? - (product//right (product-tail product) - (updated-index @index_min_length product))) - ## Must slice - (_.begin - (list (_.define @slice [(list) #.None] - (_.make-vector/1 (|> @product_length (_.-/2 index)))) - (_.vector-copy!/5 @slice (_.int +0) product index @product_length) - @slice))))))) + (list (_.define-constant last-index-right (..last-index tuple)) + (_.define-constant right-index (_.+/2 (_.int +1) lefts)) + (_.cond (list [(_.=/2 right-index last-index-right) + (_.vector-ref/2 tuple right-index)] + [(_.>/2 right-index last-index-right) + ## Needs recursion. + (tuple//right (_.-/2 last-index-right lefts) + (_.vector-ref/2 tuple last-index-right))]) + (_.begin + (list (_.define-constant @slice (_.make-vector/1 (_.-/2 right-index (_.length/1 tuple)))) + (_.vector-copy!/5 @slice (_.int +0) tuple right-index (_.length/1 tuple)) + @slice)))) + ))) (runtime: (sum//get sum last? wanted-tag) - (with-vars [variant-tag sum-tag sum-flag sum-value] + (with-vars [sum-tag sum-flag sum-value] (let [no-match _.nil is-last? (|> sum-flag (_.eqv?/2 (_.string ""))) test-recursion (_.if is-last? @@ -216,8 +195,10 @@ (|> wanted-tag (_.-/2 sum-tag)) last?) no-match)] - (<| (_.let-values (list [[(list variant-tag sum-tag sum-flag sum-value) #.None] - (_.apply/* (_.global "apply") (list (_.global "values") sum))])) + (<| (_.let (list [sum-tag (_.car/1 sum)] + [sum-value (_.cdr/1 sum)])) + (_.let (list [sum-flag (_.car/1 sum-value)] + [sum-value (_.cdr/1 sum-value)])) (_.if (|> wanted-tag (_.=/2 sum-tag)) (_.if (|> sum-flag (_.eqv?/2 last?)) sum-value @@ -231,11 +212,11 @@ (def: runtime//adt Computation - (_.begin (list @@product//left - @@product//right + (_.begin (list @@tuple//left + @@tuple//right @@sum//get))) -(runtime: (bit//logical-right-shift shift input) +(runtime: (i64//logical-right-shift shift input) (_.if (_.=/2 (_.int +0) shift) input (|> input @@ -244,7 +225,7 @@ (def: runtime//bit Computation - (_.begin (list @@bit//logical-right-shift))) + (_.begin (list @@i64//logical-right-shift))) (runtime: (frac//decode input) (with-vars [@output] @@ -259,42 +240,6 @@ (_.begin (list @@frac//decode))) -(def: (check-index-out-of-bounds array idx body) - (-> Expression Expression Expression Computation) - (_.if (|> idx (_.<=/2 (_.length/1 array))) - body - (_.raise/1 (_.string "Array index out of bounds!")))) - -(runtime: (array//get array idx) - (with-vars [@temp] - (<| (check-index-out-of-bounds array idx) - (_.let (list [@temp (_.vector-ref/2 array idx)]) - (_.if (|> @temp (_.eqv?/2 _.nil)) - ..none - (..some @temp)))))) - -(runtime: (array//put array idx value) - (<| (check-index-out-of-bounds array idx) - (_.begin - (list (_.vector-set!/3 array idx value) - array)))) - -(def: runtime//array - Computation - (_.begin - (list @@array//get - @@array//put))) - -(runtime: (box//write value box) - (_.begin - (list - (_.vector-set!/3 box (_.int +0) value) - ..unit))) - -(def: runtime//box - Computation - (_.begin (list @@box//write))) - (runtime: (io//current-time _) (|> (_.apply/* (_.global "current-second") (list)) (_.*/2 (_.int +1,000)) @@ -310,8 +255,6 @@ runtime//bit runtime//adt runtime//frac - runtime//array - runtime//box runtime//io ))) diff --git a/stdlib/source/lux/tool/compiler/phase/generation/scheme/structure.lux b/stdlib/source/lux/tool/compiler/phase/generation/scheme/structure.lux index e101effeb..f435442cc 100644 --- a/stdlib/source/lux/tool/compiler/phase/generation/scheme/structure.lux +++ b/stdlib/source/lux/tool/compiler/phase/generation/scheme/structure.lux @@ -30,4 +30,8 @@ (-> Phase (Variant Synthesis) (Operation Expression)) (do ///.monad [valueT (generate valueS)] - (wrap (runtime.variant [lefts right? valueT])))) + (wrap (runtime.variant [(if right? + (inc lefts) + lefts) + right? + valueT])))) |