diff options
Diffstat (limited to 'stdlib/source/lux/tool/compiler/phase')
20 files changed, 93 insertions, 61 deletions
diff --git a/stdlib/source/lux/tool/compiler/phase/analysis/case.lux b/stdlib/source/lux/tool/compiler/phase/analysis/case.lux index dd45ab734..c69abb4df 100644 --- a/stdlib/source/lux/tool/compiler/phase/analysis/case.lux +++ b/stdlib/source/lux/tool/compiler/phase/analysis/case.lux @@ -8,6 +8,8 @@ [data ["." product] ["." maybe] + [number + ["n" nat]] [text ["%" format (#+ format)]] [collection @@ -187,15 +189,15 @@ num-subs (maybe.default (list.size subs) num-tags) num-sub-patterns (list.size sub-patterns) - matches (cond (n/< num-subs num-sub-patterns) + matches (cond (n.< num-subs num-sub-patterns) (let [[prefix suffix] (list.split (dec num-sub-patterns) subs)] (list.zip2 (list@compose prefix (list (type.tuple suffix))) sub-patterns)) - (n/> num-subs num-sub-patterns) + (n.> num-subs num-sub-patterns) (let [[prefix suffix] (list.split (dec num-subs) sub-patterns)] (list.zip2 subs (list@compose prefix (list (code.tuple suffix))))) - ## (n/= num-subs num-sub-patterns) + ## (n.= num-subs num-sub-patterns) (list.zip2 subs sub-patterns))] (do @ [[memberP+ thenA] (list@fold (: (All [a] @@ -246,16 +248,16 @@ num-cases (maybe.default size-sum num-tags)] (.case (list.nth idx flat-sum) (^multi (#.Some caseT) - (n/< num-cases idx)) + (n.< num-cases idx)) (do ///.monad - [[testP nextA] (if (and (n/> num-cases size-sum) - (n/= (dec num-cases) idx)) + [[testP nextA] (if (and (n.> num-cases size-sum) + (n.= (dec num-cases) idx)) (analyse-pattern #.None (type.variant (list.drop (dec num-cases) flat-sum)) (` [(~+ values)]) next) (analyse-pattern #.None caseT (` [(~+ values)]) next)) - #let [right? (n/= (dec num-cases) idx) + #let [right? (n.= (dec num-cases) idx) lefts (if right? (dec idx) idx)]] diff --git a/stdlib/source/lux/tool/compiler/phase/analysis/case/coverage.lux b/stdlib/source/lux/tool/compiler/phase/analysis/case/coverage.lux index af43a0e53..f81fa19fd 100644 --- a/stdlib/source/lux/tool/compiler/phase/analysis/case/coverage.lux +++ b/stdlib/source/lux/tool/compiler/phase/analysis/case/coverage.lux @@ -10,7 +10,7 @@ ["." bit ("#@." equivalence)] ["." maybe] [number - ["." nat]] + ["n" nat]] ["." text ["%" format (#+ Format format)]] [collection @@ -29,7 +29,7 @@ (def: known-cases? (-> Nat Bit) - (n/> 0)) + (n.> 0)) ## The coverage of a pattern-matching expression summarizes how well ## all the possible values of an input are being covered by the @@ -147,7 +147,7 @@ (wrap (#Variant (if right? (#.Some idx) #.None) - (|> (dictionary.new nat.hash) + (|> (dictionary.new n.hash) (dictionary.put idx value-coverage))))))) (def: (xor left right) @@ -184,7 +184,7 @@ (bit@= sideR sideS) [(#Variant allR casesR) (#Variant allS casesS)] - (and (n/= (cases allR) + (and (n.= (cases allR) (cases allS)) (:: (dictionary.equivalence =) = casesR casesS)) @@ -195,7 +195,7 @@ [(#Alt _) (#Alt _)] (let [flatR (flatten-alt reference) flatS (flatten-alt sample)] - (and (n/= (list.size flatR) (list.size flatS)) + (and (n.= (list.size flatR) (list.size flatS)) (list.every? (function (_ [coverageR coverageS]) (= coverageR coverageS)) (list.zip2 flatR flatS)))) @@ -229,7 +229,7 @@ so-far-cases (cases allA)] (cond (and (known-cases? addition-cases) (known-cases? so-far-cases) - (not (n/= addition-cases so-far-cases))) + (not (n.= addition-cases so-far-cases))) (ex.throw variants-do-not-match [addition-cases so-far-cases]) (:: (dictionary.equivalence ..equivalence) = casesSF casesA) @@ -250,7 +250,7 @@ casesSF (dictionary.entries casesA))] (wrap (if (and (or (known-cases? addition-cases) (known-cases? so-far-cases)) - (n/= (inc (n/max addition-cases so-far-cases)) + (n.= (inc (n.max addition-cases so-far-cases)) (dictionary.size casesM)) (list.every? exhaustive? (dictionary.values casesM))) #Exhaustive diff --git a/stdlib/source/lux/tool/compiler/phase/analysis/inference.lux b/stdlib/source/lux/tool/compiler/phase/analysis/inference.lux index 701e01167..f3cc27357 100644 --- a/stdlib/source/lux/tool/compiler/phase/analysis/inference.lux +++ b/stdlib/source/lux/tool/compiler/phase/analysis/inference.lux @@ -6,6 +6,8 @@ ["ex" exception (#+ exception:)]] [data ["." maybe] + [number + ["n" nat]] ["." text ["%" format (#+ format)]] [collection @@ -66,14 +68,14 @@ [#.Apply]) (#.Parameter idx) - (if (n/= parameter-idx idx) + (if (n.= parameter-idx idx) replacement type) (^template [<tag>] (<tag> env quantified) (<tag> (list@map (replace parameter-idx replacement) env) - (replace (n/+ 2 parameter-idx) replacement quantified))) + (replace (n.+ 2 parameter-idx) replacement quantified))) ([#.UnivQ] [#.ExQ]) @@ -183,7 +185,7 @@ ([#.Sum] [#.Product] [#.Function] [#.Apply]) (#.Parameter index) - (if (n/= target index) + (if (n.= target index) sub base) @@ -205,7 +207,7 @@ (^template [<tag>] (<tag> env bodyT) (do ///.monad - [bodyT+ (record' (n/+ 2 target) originalT bodyT)] + [bodyT+ (record' (n.+ 2 target) originalT bodyT)] (wrap (<tag> env bodyT+)))) ([#.UnivQ] [#.ExQ]) @@ -228,7 +230,7 @@ (def: #export (record inferT) (-> Type (Operation Type)) - (record' (n/- 2 0) inferT inferT)) + (record' (n.- 2 0) inferT inferT)) ## Turns a variant type into the kind of function type suitable for inference. (def: #export (variant tag expected-size inferT) @@ -253,28 +255,28 @@ (let [cases (type.flatten-variant currentT) actual-size (list.size cases) boundary (dec expected-size)] - (cond (or (n/= expected-size actual-size) - (and (n/> expected-size actual-size) - (n/< boundary tag))) + (cond (or (n.= expected-size actual-size) + (and (n.> expected-size actual-size) + (n.< boundary tag))) (case (list.nth tag cases) (#.Some caseT) - (///@wrap (if (n/= 0 depth) + (///@wrap (if (n.= 0 depth) (type.function (list caseT) currentT) - (let [replace' (replace (|> depth dec (n/* 2)) inferT)] + (let [replace' (replace (|> depth dec (n.* 2)) inferT)] (type.function (list (replace' caseT)) (replace' currentT))))) #.None (/.throw variant-tag-out-of-bounds [expected-size tag inferT])) - (n/< expected-size actual-size) + (n.< expected-size actual-size) (/.throw smaller-variant-than-expected [expected-size actual-size]) - (n/= boundary tag) + (n.= boundary tag) (let [caseT (type.variant (list.drop boundary cases))] - (///@wrap (if (n/= 0 depth) + (///@wrap (if (n.= 0 depth) (type.function (list caseT) currentT) - (let [replace' (replace (|> depth dec (n/* 2)) inferT)] + (let [replace' (replace (|> depth dec (n.* 2)) inferT)] (type.function (list (replace' caseT)) (replace' currentT)))))) diff --git a/stdlib/source/lux/tool/compiler/phase/analysis/structure.lux b/stdlib/source/lux/tool/compiler/phase/analysis/structure.lux index eeb2cf9e0..49447e847 100644 --- a/stdlib/source/lux/tool/compiler/phase/analysis/structure.lux +++ b/stdlib/source/lux/tool/compiler/phase/analysis/structure.lux @@ -10,7 +10,7 @@ ["." product] ["." maybe] [number - ["." nat]] + ["n" nat]] [text ["%" format (#+ format)]] [collection @@ -94,7 +94,7 @@ (#.Sum _) (let [flat (type.flatten-variant expectedT) type-size (list.size flat) - right? (n/= (dec type-size) + right? (n.= (dec type-size) tag) lefts (if right? (dec tag) @@ -269,7 +269,7 @@ [#let [case-size (list.size group)] inferenceT (//inference.variant idx case-size variantT) [inferredT valueA+] (//inference.general analyse inferenceT (list valueC)) - #let [right? (n/= (dec case-size) idx) + #let [right? (n.= (dec case-size) idx) lefts (if right? (dec idx) idx)]] @@ -312,7 +312,7 @@ [_ tag-set recordT] (///extension.lift (macro.resolve-tag head-k)) #let [size-record (list.size record) size-ts (list.size tag-set)] - _ (if (n/= size-ts size-record) + _ (if (n.= size-ts size-record) (wrap []) (/.throw record-size-mismatch [size-ts size-record recordT record])) #let [tuple-range (list.indices size-ts) @@ -330,7 +330,7 @@ #.None (/.throw tag-does-not-belong-to-record [key recordT])))) (: (Dictionary Nat Code) - (dictionary.new nat.hash)) + (dictionary.new n.hash)) record) #let [ordered-tuple (list@map (function (_ idx) (maybe.assume (dictionary.get idx idx->val))) tuple-range)]] diff --git a/stdlib/source/lux/tool/compiler/phase/extension/analysis/jvm.lux b/stdlib/source/lux/tool/compiler/phase/extension/analysis/jvm.lux index 3acecec11..85d7524f9 100644 --- a/stdlib/source/lux/tool/compiler/phase/extension/analysis/jvm.lux +++ b/stdlib/source/lux/tool/compiler/phase/extension/analysis/jvm.lux @@ -14,6 +14,8 @@ [data ["." maybe] ["." product] + [number + ["n" nat]] ["." text ("#@." equivalence) ["%" format (#+ format)]] [collection @@ -329,7 +331,7 @@ (analyse lengthC)) expectedT (///.lift macro.expected-type) [level elem-class] (array-type-info false expectedT) - _ (if (n/> 0 level) + _ (if (n.> 0 level) (wrap []) (/////analysis.throw ..non-array expectedT))] (wrap (#/////analysis.Extension extension-name (list (/////analysis.nat (dec level)) @@ -940,7 +942,7 @@ _ #1) - arity-matches? (n/= (list.size arg-classes) (list.size parameters)) + arity-matches? (n.= (list.size arg-classes) (list.size parameters)) inputs-match? (list@fold (function (_ [expectedJC actualJC] prev) (and prev (text@= expectedJC actualJC))) @@ -962,7 +964,7 @@ (:: try.monad map (list@map jvm.descriptor)) ////.lift)] (wrap (and (java/lang/Object::equals class (java/lang/reflect/Constructor::getDeclaringClass constructor)) - (n/= (list.size arg-classes) (list.size parameters)) + (n.= (list.size arg-classes) (list.size parameters)) (list@fold (function (_ [expectedJC actualJC] prev) (and prev (text@= expectedJC actualJC))) @@ -971,7 +973,7 @@ (def: idx-to-parameter (-> Nat .Type) - (|>> (n/* 2) inc #.Parameter)) + (|>> (n.* 2) inc #.Parameter)) (def: (jvm-type-var-mapping owner-tvars method-tvars) (-> (List Text) (List Text) [(List .Type) Mapping]) @@ -1830,7 +1832,7 @@ (and (text@= super-name sub-name) (method@= superJT subJT)))) list.size - (n/= 1) + (n.= 1) not)) sub-set)) @@ -1852,7 +1854,7 @@ array.to-list (list@map (|>> java/lang/reflect/TypeVariable::getName)))] _ (////.assert ..class-parameter-mismatch [expected-parameters actual-parameters] - (n/= (list.size expected-parameters) + (n.= (list.size expected-parameters) (list.size actual-parameters)))] (wrap (|> (list.zip2 expected-parameters actual-parameters) (list@fold (function (_ [expected actual] mapping) diff --git a/stdlib/source/lux/tool/compiler/phase/extension/analysis/lux.lux b/stdlib/source/lux/tool/compiler/phase/extension/analysis/lux.lux index efd917bd2..b73f30a6b 100644 --- a/stdlib/source/lux/tool/compiler/phase/extension/analysis/lux.lux +++ b/stdlib/source/lux/tool/compiler/phase/extension/analysis/lux.lux @@ -10,6 +10,8 @@ ["<c>" code (#+ Parser)]]] [data ["." maybe] + [number + ["n" nat]] ["." text ["%" format (#+ format)]] [collection @@ -48,7 +50,7 @@ (let [num-expected (list.size inputsT+)] (function (_ extension-name analyse args) (let [num-actual (list.size args)] - (if (n/= num-expected num-actual) + (if (n.= num-expected num-actual) (do ////.monad [_ (typeA.infer outputT) argsA (monad.map @ diff --git a/stdlib/source/lux/tool/compiler/phase/generation/common-lisp/case.lux b/stdlib/source/lux/tool/compiler/phase/generation/common-lisp/case.lux index 6b782a24d..6fdb37e34 100644 --- a/stdlib/source/lux/tool/compiler/phase/generation/common-lisp/case.lux +++ b/stdlib/source/lux/tool/compiler/phase/generation/common-lisp/case.lux @@ -6,6 +6,8 @@ ["ex" exception (#+ exception:)]] [data ["." text] + [number + ["n" nat]] [collection ["." list ("#@." functor fold)] ["." set]]] @@ -175,7 +177,7 @@ (do ////.monad [next! (pattern-matching' generate nextP')] (////@wrap ($_ _.progn - (..multi-pop! (n/+ 2 extra-pops)) + (..multi-pop! (n.+ 2 extra-pops)) next!)))) (^template [<tag> <combinator>] diff --git a/stdlib/source/lux/tool/compiler/phase/generation/common-lisp/loop.lux b/stdlib/source/lux/tool/compiler/phase/generation/common-lisp/loop.lux index 13e049e1d..a00fc2b12 100644 --- a/stdlib/source/lux/tool/compiler/phase/generation/common-lisp/loop.lux +++ b/stdlib/source/lux/tool/compiler/phase/generation/common-lisp/loop.lux @@ -4,6 +4,8 @@ ["." monad (#+ do)]] [data ["." product] + [number + ["n" nat]] [text ["%" format (#+ format)]] [collection @@ -27,7 +29,7 @@ (generate bodyS))] (wrap (_.labels (list [@scope {#_.input (|> initsS+ list.enumerate - (list@map (|>> product.left (n/+ start) //case.register)) + (list@map (|>> product.left (n.+ start) //case.register)) _.args) #_.output bodyG}]) (_.funcall/+ [(_.function/1 @scope) initsG+]))))) 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 f17b2b983..d9956579c 100644 --- a/stdlib/source/lux/tool/compiler/phase/generation/js/case.lux +++ b/stdlib/source/lux/tool/compiler/phase/generation/js/case.lux @@ -6,6 +6,8 @@ ["ex" exception (#+ exception:)]] [data ["." text] + [number + ["n" nat]] [collection ["." list ("#@." functor fold)]]] [target @@ -207,7 +209,7 @@ (do ////.monad [next! (pattern-matching' generate nextP')] (////@wrap ($_ _.then - (multi-pop-cursor! (n/+ 2 extra-pops)) + (multi-pop-cursor! (n.+ 2 extra-pops)) next!)))) (^template [<tag> <combinator>] diff --git a/stdlib/source/lux/tool/compiler/phase/generation/js/loop.lux b/stdlib/source/lux/tool/compiler/phase/generation/js/loop.lux index 65e691c51..101c49b95 100644 --- a/stdlib/source/lux/tool/compiler/phase/generation/js/loop.lux +++ b/stdlib/source/lux/tool/compiler/phase/generation/js/loop.lux @@ -5,6 +5,8 @@ [data ["." product] ["." text] + [number + ["n" nat]] [collection ["." list ("#@." functor)]]] [target @@ -28,7 +30,7 @@ #let [closure (_.function @scope (|> initsS+ list.enumerate - (list@map (|>> product.left (n/+ start) //case.register))) + (list@map (|>> product.left (n.+ start) //case.register))) (_.return bodyO))]] (wrap (_.apply/* closure initsO+)))) diff --git a/stdlib/source/lux/tool/compiler/phase/generation/lua/loop.lux b/stdlib/source/lux/tool/compiler/phase/generation/lua/loop.lux index b575ec97b..f1bb7fb84 100644 --- a/stdlib/source/lux/tool/compiler/phase/generation/lua/loop.lux +++ b/stdlib/source/lux/tool/compiler/phase/generation/lua/loop.lux @@ -4,6 +4,8 @@ ["." monad (#+ do)]] [data ["." product] + [number + ["n" nat]] [text ["%" format (#+ format)]] [collection @@ -28,7 +30,7 @@ _ (///.save! true ["" (_.code @loop)] (_.function @loop (|> initsS+ list.enumerate - (list@map (|>> product.left (n/+ start) //case.register))) + (list@map (|>> product.left (n.+ start) //case.register))) (_.return bodyO)))] (wrap (_.apply/* initsO+ @loop)))) diff --git a/stdlib/source/lux/tool/compiler/phase/generation/php/case.lux b/stdlib/source/lux/tool/compiler/phase/generation/php/case.lux index fedfff63f..cbdbb1c70 100644 --- a/stdlib/source/lux/tool/compiler/phase/generation/php/case.lux +++ b/stdlib/source/lux/tool/compiler/phase/generation/php/case.lux @@ -9,6 +9,7 @@ ["." text ["%" format (#+ format)]] [number + ["n" nat] ["i" int]] [collection ["." list ("#@." functor fold)] @@ -188,7 +189,7 @@ ## (do ////.monad ## [next! (pattern-matching' generate nextP')] ## (////@wrap ($_ _.then - ## (..multi-pop! (n/+ 2 extra-pops)) + ## (..multi-pop! (n.+ 2 extra-pops)) ## next!)))) (^template [<tag> <combinator>] diff --git a/stdlib/source/lux/tool/compiler/phase/generation/php/loop.lux b/stdlib/source/lux/tool/compiler/phase/generation/php/loop.lux index 75cdedae3..3ec2d2d40 100644 --- a/stdlib/source/lux/tool/compiler/phase/generation/php/loop.lux +++ b/stdlib/source/lux/tool/compiler/phase/generation/php/loop.lux @@ -4,6 +4,8 @@ ["." monad (#+ do)]] [data ["." product] + [number + ["n" nat]] [text ["%" format (#+ format)]] [collection @@ -34,7 +36,7 @@ (_.closure (list (_.reference @loopL)) (|> initsS+ list.enumerate - (list@map (|>> product.left (n/+ start) //case.register [#0]))) + (list@map (|>> product.left (n.+ start) //case.register [#0]))) (_.return bodyO))) (_.; (_.set @loopG @loopL))))] (wrap (_.apply/* initsO+ @loopG)))) 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 9589e3336..aeaa18986 100644 --- a/stdlib/source/lux/tool/compiler/phase/generation/python/case.lux +++ b/stdlib/source/lux/tool/compiler/phase/generation/python/case.lux @@ -8,6 +8,7 @@ ["." text ["%" format (#+ format)]] [number + ["n" nat] ["i" int]] [collection ["." list ("#@." functor fold)] @@ -185,7 +186,7 @@ (do ////.monad [next! (pattern-matching' generate nextP')] (////@wrap ($_ _.then - (..multi-pop! (n/+ 2 extra-pops)) + (..multi-pop! (n.+ 2 extra-pops)) next!)))) (^template [<tag> <combinator>] diff --git a/stdlib/source/lux/tool/compiler/phase/generation/python/loop.lux b/stdlib/source/lux/tool/compiler/phase/generation/python/loop.lux index f0d75ef29..02d4a92ec 100644 --- a/stdlib/source/lux/tool/compiler/phase/generation/python/loop.lux +++ b/stdlib/source/lux/tool/compiler/phase/generation/python/loop.lux @@ -4,6 +4,8 @@ ["." monad (#+ do)]] [data ["." product] + [number + ["n" nat]] [text ["%" format (#+ format)]] [collection @@ -28,7 +30,7 @@ _ (///.save! true ["" (_.code @loop)] (_.def @loop (|> initsS+ list.enumerate - (list@map (|>> product.left (n/+ start) //case.register))) + (list@map (|>> product.left (n.+ start) //case.register))) (_.return bodyO)))] (wrap (_.apply/* @loop initsO+)))) diff --git a/stdlib/source/lux/tool/compiler/phase/generation/ruby/case.lux b/stdlib/source/lux/tool/compiler/phase/generation/ruby/case.lux index 695485a16..8d95783a9 100644 --- a/stdlib/source/lux/tool/compiler/phase/generation/ruby/case.lux +++ b/stdlib/source/lux/tool/compiler/phase/generation/ruby/case.lux @@ -7,6 +7,7 @@ [data ["." text] [number + ["n" nat] ["i" int]] [collection ["." list ("#@." functor fold)] @@ -186,7 +187,7 @@ (do ////.monad [next! (pattern-matching' generate nextP')] (////@wrap ($_ _.then - (..multi-pop! (n/+ 2 extra-pops)) + (..multi-pop! (n.+ 2 extra-pops)) next!)))) (^template [<tag> <combinator>] diff --git a/stdlib/source/lux/tool/compiler/phase/generation/ruby/loop.lux b/stdlib/source/lux/tool/compiler/phase/generation/ruby/loop.lux index 6503d23f8..4bb7d44c7 100644 --- a/stdlib/source/lux/tool/compiler/phase/generation/ruby/loop.lux +++ b/stdlib/source/lux/tool/compiler/phase/generation/ruby/loop.lux @@ -4,6 +4,8 @@ ["." monad (#+ do)]] [data ["." product] + [number + ["n" nat]] [text ["%" format (#+ format)]] [collection @@ -29,7 +31,7 @@ (_.lambda (#.Some @loop) (|> initsS+ list.enumerate - (list@map (|>> product.left (n/+ start) //case.register)))) + (list@map (|>> product.left (n.+ start) //case.register)))) (_.apply/* initsO+))))) (def: #export (recur generate argsS+) diff --git a/stdlib/source/lux/tool/compiler/phase/generation/scheme/loop.lux b/stdlib/source/lux/tool/compiler/phase/generation/scheme/loop.lux index a0a5d74eb..294b3ed2d 100644 --- a/stdlib/source/lux/tool/compiler/phase/generation/scheme/loop.lux +++ b/stdlib/source/lux/tool/compiler/phase/generation/scheme/loop.lux @@ -5,6 +5,8 @@ [data ["." product] ["." text] + [number + ["n" nat]] [collection ["." list ("#;." functor)]]] [target @@ -27,7 +29,7 @@ (generate bodyS))] (wrap (_.letrec (list [@scope (_.lambda [(|> initsS+ list.enumerate - (list;map (|>> product.left (n/+ start) //case.register))) + (list;map (|>> product.left (n.+ start) //case.register))) #.None] bodyO)]) (_.apply/* @scope initsO+))))) diff --git a/stdlib/source/lux/tool/compiler/phase/synthesis/case.lux b/stdlib/source/lux/tool/compiler/phase/synthesis/case.lux index 8ee2ab8c2..55cdf5034 100644 --- a/stdlib/source/lux/tool/compiler/phase/synthesis/case.lux +++ b/stdlib/source/lux/tool/compiler/phase/synthesis/case.lux @@ -10,6 +10,7 @@ ["." bit ("#@." equivalence)] ["." text ("#@." equivalence)] [number + ["n" nat] ["." frac ("#@." equivalence)]] [collection ["." list ("#@." functor fold monoid)] @@ -59,7 +60,7 @@ (#////analysis.Complex (#////analysis.Tuple tuple)) (let [tuple::last (dec (list.size tuple))] (list@fold (function (_ [tuple::lefts tuple::member] nextC) - (let [right? (n/= tuple::last tuple::lefts) + (let [right? (n.= tuple::last tuple::lefts) end?' (and end? right?)] (<| (///@map (|>> (#/.Seq (#/.Access (#/.Member (if right? (#.Right (dec tuple::lefts)) @@ -105,7 +106,7 @@ (^template [<access> <side>] [(#/.Access (<access> (<side> leftL))) (#/.Access (<access> (<side> rightL)))] - (if (n/= leftL rightL) + (if (n.= leftL rightL) rightP <default>)) ([#/.Side #.Left] @@ -114,7 +115,7 @@ [#/.Member #.Right]) [(#/.Bind leftR) (#/.Bind rightR)] - (if (n/= leftR rightR) + (if (n.= leftR rightR) rightP <default>) @@ -127,7 +128,7 @@ [inputS (synthesize^ inputA)] (with-expansions [<unnecesary-let> (as-is (^multi (^ (#////analysis.Reference (////reference.local outputR))) - (n/= inputR outputR)) + (n.= inputR outputR)) (wrap inputS)) <let> diff --git a/stdlib/source/lux/tool/compiler/phase/synthesis/loop.lux b/stdlib/source/lux/tool/compiler/phase/synthesis/loop.lux index 0ac6cc12b..62bfda31c 100644 --- a/stdlib/source/lux/tool/compiler/phase/synthesis/loop.lux +++ b/stdlib/source/lux/tool/compiler/phase/synthesis/loop.lux @@ -6,6 +6,8 @@ ["p" parser]] [data ["." maybe ("#;." monad)] + [number + ["n" nat]] [collection ["." list ("#;." functor)]]] [macro @@ -152,7 +154,7 @@ #.None))) (^ (#/.Function (recursive-apply argsS))) - (if (n/= arity (list.size argsS)) + (if (n.= arity (list.size argsS)) (#.Some (|> argsS #/.Recur #/.Loop #/.Control)) #.None) @@ -177,7 +179,7 @@ (function (recur pathS) (case pathS (#/.Bind register) - (#.Some (#/.Bind (n/+ offset register))) + (#.Some (#/.Bind (n.+ offset register))) (^template [<tag>] (<tag> leftS rightS) @@ -218,7 +220,7 @@ (#.Some exprS) (^ (////reference.local register)) - (#.Some (#/.Reference (////reference.local (n/+ offset register)))) + (#.Some (#/.Reference (////reference.local (n.+ offset register)))) (^ (////reference.foreign register)) (|> scope-environment @@ -250,7 +252,7 @@ (get@ #/.inits) (monad.map maybe.monad recur)) iteration' (recur (get@ #/.iteration scopeS))] - (wrap (/.loop/scope {#/.start (|> scopeS (get@ #/.start) (n/+ offset)) + (wrap (/.loop/scope {#/.start (|> scopeS (get@ #/.start) (n.+ offset)) #/.inits inits' #/.iteration iteration'}))) @@ -284,7 +286,7 @@ (def: #export (loop environment num-locals inits functionS) (-> Environment Nat (List Synthesis) Abstraction (Maybe Synthesis)) (let [bodyS (get@ #/.body functionS)] - (if (and (n/= (list.size inits) + (if (and (n.= (list.size inits) (get@ #/.arity functionS)) (proper? bodyS)) (|> bodyS |