From 926c3e1dcc392dc21b77a93200fa3e01eb113cf2 Mon Sep 17 00:00:00 2001 From: Eduardo Julian Date: Tue, 28 May 2019 18:48:01 -0400 Subject: Applied several tweaks to make the code easier to process by the new compiler. --- stdlib/source/lux.lux | 32 +++++-- stdlib/source/lux/control/concurrency/actor.lux | 10 +- stdlib/source/lux/control/region.lux | 16 ++-- stdlib/source/lux/control/thread.lux | 14 ++- stdlib/source/lux/control/writer.lux | 11 ++- stdlib/source/lux/data/collection/tree/zipper.lux | 104 +++++++++++---------- stdlib/source/lux/data/text/regex.lux | 2 +- stdlib/source/lux/tool/compiler/analysis.lux | 5 +- stdlib/source/lux/tool/compiler/default/init.lux | 4 +- stdlib/source/lux/tool/compiler/name.lux | 5 +- .../tool/compiler/phase/generation/common-lisp.lux | 1 + .../compiler/phase/generation/common-lisp/case.lux | 7 +- .../generation/common-lisp/extension/common.lux | 4 +- .../lux/tool/compiler/phase/generation/js.lux | 1 + .../lux/tool/compiler/phase/generation/js/case.lux | 7 +- .../phase/generation/js/extension/common.lux | 4 +- .../lux/tool/compiler/phase/generation/lua.lux | 1 + .../tool/compiler/phase/generation/lua/case.lux | 7 +- .../phase/generation/lua/extension/common.lux | 4 +- .../lux/tool/compiler/phase/generation/php.lux | 1 + .../tool/compiler/phase/generation/php/case.lux | 7 +- .../phase/generation/php/extension/common.lux | 4 +- .../lux/tool/compiler/phase/generation/python.lux | 1 + .../tool/compiler/phase/generation/python/case.lux | 7 +- .../phase/generation/python/extension/common.lux | 4 +- .../lux/tool/compiler/phase/generation/ruby.lux | 1 + .../tool/compiler/phase/generation/ruby/case.lux | 7 +- .../phase/generation/ruby/extension/common.lux | 4 +- .../lux/tool/compiler/phase/generation/scheme.lux | 1 + .../tool/compiler/phase/generation/scheme/case.lux | 7 +- .../phase/generation/scheme/extension/common.lux | 4 +- .../source/lux/tool/compiler/phase/statement.lux | 1 + .../source/lux/tool/compiler/phase/synthesis.lux | 4 +- stdlib/source/test/lux/control/parser.lux | 2 +- stdlib/source/test/lux/control/security/policy.lux | 1 + .../source/test/lux/data/collection/sequence.lux | 1 + stdlib/source/test/lux/data/identity.lux | 2 + stdlib/source/test/lux/data/number/complex.lux | 2 +- stdlib/source/test/lux/math.lux | 2 +- .../test/lux/tool/compiler/default/syntax.lux | 16 ++-- 40 files changed, 166 insertions(+), 152 deletions(-) (limited to 'stdlib/source') diff --git a/stdlib/source/lux.lux b/stdlib/source/lux.lux index 9e370f12b..b75b5bebe 100644 --- a/stdlib/source/lux.lux +++ b/stdlib/source/lux.lux @@ -5568,12 +5568,19 @@ (def: (multi-level-case$ g!_ [[init-pattern levels] body]) (-> Code [Multi-Level-Case Code] (List Code)) (let [inner-pattern-body (list@fold (function (_ [calculation pattern] success) - (` (case (~ calculation) - (~ pattern) - (~ success) - - (~ g!_) - #.None))) + (let [bind? (case pattern + [_ (#.Identifier _)] + #1 + + _ + #0)] + (` (case (~ calculation) + (~ pattern) + (~ success) + + (~+ (if bind? + (list) + (list g!_ (` #.None)))))))) (` (#.Some (~ body))) (: (List [Code Code]) (list@reverse levels)))] (list init-pattern inner-pattern-body))) @@ -5601,6 +5608,12 @@ (^ (list& [_meta (#Form levels)] body next-branches)) (do meta-monad [mlc (multi-level-case^ levels) + #let [initial-bind? (case mlc + [[_ (#.Identifier _)] _] + #1 + + _ + #0)] expected get-expected-type g!temp (gensym "temp")] (let [output (list g!temp @@ -5613,9 +5626,10 @@ ("lux check" (#.Apply (~ (type-to-code expected)) Maybe) (case (~ g!temp) (~+ (multi-level-case$ g!temp [mlc body])) - - (~ g!temp) - #.None)))))] + + (~+ (if initial-bind? + (list) + (list g!temp (` #.None)))))))))] (wrap output))) _ diff --git a/stdlib/source/lux/control/concurrency/actor.lux b/stdlib/source/lux/control/concurrency/actor.lux index 6c0d1928e..09ef7e625 100644 --- a/stdlib/source/lux/control/concurrency/actor.lux +++ b/stdlib/source/lux/control/concurrency/actor.lux @@ -57,9 +57,9 @@ (abstract: #export (Actor s) {#.doc "An actor, defined as all the necessities it requires."} - {#mailbox (Atom ) - #obituary [(Promise ) - (Resolver )]} + {#obituary [(Promise ) + (Resolver )] + #mailbox (Atom )} ## TODO: Delete after new-luxc becomes the new standard compiler. (def: (actor mailbox obituary) @@ -68,8 +68,8 @@ [(Promise ) (Resolver )] (Actor s))) - (:abstraction {#mailbox mailbox - #obituary obituary})) + (:abstraction {#obituary obituary + #mailbox mailbox})) (type: #export (Message s) ) diff --git a/stdlib/source/lux/control/region.lux b/stdlib/source/lux/control/region.lux index 0671e1c08..56e64f1ed 100644 --- a/stdlib/source/lux/control/region.lux +++ b/stdlib/source/lux/control/region.lux @@ -98,12 +98,16 @@ (do Monad [[cleaners ef] (ff [region cleaners]) [cleaners ea] (fa [region cleaners])] - (case [ef ea] - [(#error.Success f) (#error.Success a)] - (wrap [cleaners (#error.Success (f a))]) - - (^or [(#error.Failure error) _] - [_ (#error.Failure error)]) + (case ef + (#error.Success f) + (case ea + (#error.Success a) + (wrap [cleaners (#error.Success (f a))]) + + (#error.Failure error) + (wrap [cleaners (#error.Failure error)])) + + (#error.Failure error) (wrap [cleaners (#error.Failure error)])))))) (structure: #export (monad Monad) diff --git a/stdlib/source/lux/control/thread.lux b/stdlib/source/lux/control/thread.lux index ec9650664..b27e56395 100644 --- a/stdlib/source/lux/control/thread.lux +++ b/stdlib/source/lux/control/thread.lux @@ -32,7 +32,15 @@ (All [! a] (-> (Box ! a) (Thread ! a))) (function (_ !) (`` (for {(~~ (static @.old)) - ("jvm aaload" (:representation box) 0)})))) + ("jvm aaload" (:representation box) 0) + + (~~ (static @.jvm)) + ("jvm array read object" + (|> 0 + (:coerce (primitive "java.lang.Long")) + "jvm object cast" + "jvm conversion long-to-int") + (:representation box))})))) (def: #export (write value box) (All [a] (-> a (All [!] (-> (Box ! a) (Thread ! Any))))) @@ -46,11 +54,11 @@ a)) (thread [])) -(def: #export (io thread) +(def: #export io (All [a] (-> (All [!] (Thread ! a)) (IO a))) - (io.io (..run thread))) + (|>> ..run io.io)) (structure: #export functor (All [!] (Functor (Thread !))) diff --git a/stdlib/source/lux/control/writer.lux b/stdlib/source/lux/control/writer.lux index bbca0faa0..866fe0b18 100644 --- a/stdlib/source/lux/control/writer.lux +++ b/stdlib/source/lux/control/writer.lux @@ -1,5 +1,6 @@ (.module: [lux #* + ["@" target] [abstract monoid ["." functor (#+ Functor)] @@ -59,10 +60,12 @@ (def: (join MlMla) (do monad - [## TODO: Remove once new-luxc is the standard compiler. - [l1 Mla] (: (($ 1) (Writer ($ 0) (($ 1) (Writer ($ 0) ($ 2))))) - MlMla) - ## [l1 Mla] MlMla + [[l1 Mla] (`` (for {(~~ (static @.old)) + (: (($ 1) (Writer ($ 0) (($ 1) (Writer ($ 0) ($ 2))))) + MlMla) + + (~~ (static @.jvm)) + MlMla})) [l2 a] Mla] (wrap [(:: monoid compose l1 l2) a])))) diff --git a/stdlib/source/lux/data/collection/tree/zipper.lux b/stdlib/source/lux/data/collection/tree/zipper.lux index 1c94d734e..f6a8ad8f0 100644 --- a/stdlib/source/lux/data/collection/tree/zipper.lux +++ b/stdlib/source/lux/data/collection/tree/zipper.lux @@ -1,5 +1,7 @@ (.module: [lux #* + ["@" target] + [type (#+ :share)] [abstract functor comonad @@ -92,20 +94,21 @@ zipper (#.Some parent) - (|> parent - ## TODO: Remove once new-luxc becomes the standard compiler. - (update@ #node (: (-> (Tree ($ 0)) (Tree ($ 0))) - (function (_ node) - (set@ #//.children (list@compose (list.reverse (get@ #lefts zipper)) - (#.Cons (get@ #node zipper) - (get@ #rights zipper))) - node)))) - ## (update@ #node (function (_ node) - ## (set@ #//.children (list@compose (list.reverse (get@ #lefts zipper)) - ## (#.Cons (get@ #node zipper) - ## (get@ #rights zipper))) - ## node))) - ))) + (update@ #node (`` (for {(~~ (static @.old)) + (: (-> (Tree ($ 0)) (Tree ($ 0))) + (set@ #//.children (list@compose (list.reverse (get@ #lefts zipper)) + (#.Cons (get@ #node zipper) + (get@ #rights zipper))))) + + (~~ (static @.jvm)) + (:share [a] + {(Zipper a) + zipper} + {(-> (Tree a) (Tree a)) + (set@ #//.children (list@compose (list.reverse (get@ #lefts zipper)) + (#.Cons (get@ #node zipper) + (get@ #rights zipper))))})})) + parent))) (def: #export (start zipper) (All [a] (-> (Zipper a) (Zipper a))) @@ -198,13 +201,13 @@ (All [a] (-> a (Zipper a) (Zipper a))) (update@ [#node #//.children] (function (_ children) - ## TODO: Remove once new-luxc becomes the standard compiler. - (list& (: (Tree ($ 0)) - (//.tree [value {}])) - children) - ## (list& (//.tree [value {}]) - ## children) - ) + (list& (`` (for {(~~ (static @.old)) + (: (Tree ($ 0)) + (//.tree [value {}])) + + (~~ (static @.jvm)) + (//.tree [value {}])})) + children)) zipper)) (def: #export (append-child value zipper) @@ -212,11 +215,12 @@ (update@ [#node #//.children] (function (_ children) (list@compose children - ## TODO: Remove once new-luxc becomes the standard compiler. - (list (: (Tree ($ 0)) - (//.tree [value {}]))) - ## (list (//.tree [value {}])) - )) + (list (`` (for {(~~ (static @.old)) + (: (Tree ($ 0)) + (//.tree [value {}])) + + (~~ (static @.jvm)) + (//.tree [value {}])}))))) zipper)) (def: #export (remove zipper) @@ -246,13 +250,13 @@ _ (#.Some (|> zipper (update@ (function (_ side) - ## TODO: Remove once new-luxc becomes the standard compiler. - (#.Cons (: (Tree ($ 0)) - (//.tree [value {}])) - side) - ## (#.Cons (//.tree [value {}]) - ## side) - ))))))] + (#.Cons (`` (for {(~~ (static @.old)) + (: (Tree ($ 0)) + (//.tree [value {}])) + + (~~ (static @.jvm)) + (//.tree [value {}])})) + side)))))))] [insert-left #lefts] [insert-right #rights] @@ -265,18 +269,22 @@ #rights (|> fa (get@ #rights) (list@map (//@map f))) #node (//@map f (get@ #node fa))})) -## TODO: Add again once new-luxc becomes the standard compiler. -## (structure: #export comonad (CoMonad Zipper) -## (def: &functor ..functor) - -## (def: unwrap (get@ [#node #//.value])) - -## (def: (split wa) -## (let [tree-splitter (function (tree-splitter tree) -## {#//.value (zip tree) -## #//.children (list@map tree-splitter -## (get@ #//.children tree))})] -## {#parent (|> wa (get@ #parent) (maybe@map split)) -## #lefts (|> wa (get@ #lefts) (list@map tree-splitter)) -## #rights (|> wa (get@ #rights) (list@map tree-splitter)) -## #node (|> fa (get@ #node) tree-splitter)}))) +(`` (for {(~~ (static @.old)) + (as-is) + + (~~ (static @.jvm)) + (structure: #export comonad (CoMonad Zipper) + (def: &functor ..functor) + + (def: unwrap (get@ [#node #//.value])) + + (def: (split [parent lefts rights node]) + (let [tree-splitter (: (All [a] (-> (Tree a) (Tree (Zipper a)))) + (function (tree-splitter tree) + {#//.value (zip tree) + #//.children (list@map tree-splitter + (get@ #//.children tree))}))] + {#parent (maybe@map split parent) + #lefts (list@map tree-splitter lefts) + #rights (list@map tree-splitter rights) + #node (tree-splitter node)})))})) diff --git a/stdlib/source/lux/data/text/regex.lux b/stdlib/source/lux/data/text/regex.lux index fea8835b6..964c90613 100644 --- a/stdlib/source/lux/data/text/regex.lux +++ b/stdlib/source/lux/data/text/regex.lux @@ -487,7 +487,7 @@ do-something-else))} (with-gensyms [g!temp] (wrap (list& (` (^multi (~ g!temp) - [((~! l.run) (regex (~ (code.text pattern))) (~ g!temp)) + [((~! l.run) (..regex (~ (code.text pattern))) (~ g!temp)) (#error.Success (~ (maybe.default g!temp bindings)))])) body branches)))) diff --git a/stdlib/source/lux/tool/compiler/analysis.lux b/stdlib/source/lux/tool/compiler/analysis.lux index 2c4cdbc53..998306d4a 100644 --- a/stdlib/source/lux/tool/compiler/analysis.lux +++ b/stdlib/source/lux/tool/compiler/analysis.lux @@ -78,9 +78,8 @@ ) (template [ ] - [(def: #export - (-> Analysis) - (|>> #..Primitive))] + [(template: #export ( value) + (#..Primitive ( value)))] [bit Bit #..Bit] [nat Nat #..Nat] diff --git a/stdlib/source/lux/tool/compiler/default/init.lux b/stdlib/source/lux/tool/compiler/default/init.lux index 5cb857d65..a7a861289 100644 --- a/stdlib/source/lux/tool/compiler/default/init.lux +++ b/stdlib/source/lux/tool/compiler/default/init.lux @@ -91,10 +91,10 @@ (-> Source Reader (///analysis.Operation [Source Code])) (function (_ [bundle compiler]) (case (reader source) - (#error.Failure [source' error]) + (#.Left [source' error]) (#error.Failure error) - (#error.Success [source' output]) + (#.Right [source' output]) (let [[cursor _] output] (#error.Success [[bundle (|> compiler (set@ #.source source') diff --git a/stdlib/source/lux/tool/compiler/name.lux b/stdlib/source/lux/tool/compiler/name.lux index d2841d849..252d57051 100644 --- a/stdlib/source/lux/tool/compiler/name.lux +++ b/stdlib/source/lux/tool/compiler/name.lux @@ -40,7 +40,10 @@ output ""] (if (n/< name/size idx) (recur (inc idx) - (|> name ("lux text char" idx) !sanitize (format output))) + (|> name + ("lux text char" idx) + !sanitize + (format output))) output)))) (def: #export (definition [module short]) diff --git a/stdlib/source/lux/tool/compiler/phase/generation/common-lisp.lux b/stdlib/source/lux/tool/compiler/phase/generation/common-lisp.lux index 480c473bf..6d3500416 100644 --- a/stdlib/source/lux/tool/compiler/phase/generation/common-lisp.lux +++ b/stdlib/source/lux/tool/compiler/phase/generation/common-lisp.lux @@ -13,6 +13,7 @@ ["." /// ["." extension] [// + [analysis (#+)] ["." synthesis]]]]) (def: #export (generate synthesis) 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 dd5b89e38..6f24f6c23 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 @@ -97,8 +97,6 @@ (def: fail! (_.return-from ..@fail _.nil)) -(exception: #export unrecognized-path) - (def: (multi-pop! pops) (-> Nat (Expression Any)) (_.setq @cursor (_.nthcdr/2 [(_.int (.int pops)) @cursor]))) @@ -188,10 +186,7 @@ post! (pattern-matching' generate postP)] (wrap ( pre! post!)))) ([/////synthesis.path/alt ..alternation] - [/////synthesis.path/seq _.progn]) - - _ - (////.throw unrecognized-path []))) + [/////synthesis.path/seq _.progn]))) (def: (pattern-matching generate pathP) (-> Phase Path (Operation (Expression Any))) diff --git a/stdlib/source/lux/tool/compiler/phase/generation/common-lisp/extension/common.lux b/stdlib/source/lux/tool/compiler/phase/generation/common-lisp/extension/common.lux index a72239982..8f323544e 100644 --- a/stdlib/source/lux/tool/compiler/phase/generation/common-lisp/extension/common.lux +++ b/stdlib/source/lux/tool/compiler/phase/generation/common-lisp/extension/common.lux @@ -63,8 +63,8 @@ ))) (import: #long java/lang/Double - (#static MIN_VALUE Double) - (#static MAX_VALUE Double)) + (#static MIN_VALUE double) + (#static MAX_VALUE double)) (template [ ] [(def: ( _) diff --git a/stdlib/source/lux/tool/compiler/phase/generation/js.lux b/stdlib/source/lux/tool/compiler/phase/generation/js.lux index 37a8d1bc6..c0cd734b3 100644 --- a/stdlib/source/lux/tool/compiler/phase/generation/js.lux +++ b/stdlib/source/lux/tool/compiler/phase/generation/js.lux @@ -13,6 +13,7 @@ ["." /// ["." extension] [// + [analysis (#+)] ["." synthesis]]]]) (def: #export (generate synthesis) 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 edfa2d038..e1182c4b5 100644 --- a/stdlib/source/lux/tool/compiler/phase/generation/js/case.lux +++ b/stdlib/source/lux/tool/compiler/phase/generation/js/case.lux @@ -100,8 +100,6 @@ (def: fail-pm! _.break) -(exception: #export unrecognized-path) - (def: (multi-pop-cursor! pops) (-> Nat Statement) (.let [popsJS (_.i32 (.int pops))] @@ -200,10 +198,7 @@ right! (pattern-matching' generate rightP)] (wrap ( left! right!)))) ([/////synthesis.path/seq _.then] - [/////synthesis.path/alt alternation]) - - _ - (////.throw unrecognized-path []))) + [/////synthesis.path/alt alternation]))) (def: (pattern-matching generate pathP) (-> Phase Path (Operation Statement)) diff --git a/stdlib/source/lux/tool/compiler/phase/generation/js/extension/common.lux b/stdlib/source/lux/tool/compiler/phase/generation/js/extension/common.lux index 7a38dc5cd..5253ffe19 100644 --- a/stdlib/source/lux/tool/compiler/phase/generation/js/extension/common.lux +++ b/stdlib/source/lux/tool/compiler/phase/generation/js/extension/common.lux @@ -33,8 +33,8 @@ ## [[Numbers]] (import: #long java/lang/Double - (#static MIN_VALUE Double) - (#static MAX_VALUE Double)) + (#static MIN_VALUE double) + (#static MAX_VALUE double)) (template [ ] [(def: ( _) diff --git a/stdlib/source/lux/tool/compiler/phase/generation/lua.lux b/stdlib/source/lux/tool/compiler/phase/generation/lua.lux index 480c473bf..6d3500416 100644 --- a/stdlib/source/lux/tool/compiler/phase/generation/lua.lux +++ b/stdlib/source/lux/tool/compiler/phase/generation/lua.lux @@ -13,6 +13,7 @@ ["." /// ["." extension] [// + [analysis (#+)] ["." synthesis]]]]) (def: #export (generate synthesis) diff --git a/stdlib/source/lux/tool/compiler/phase/generation/lua/case.lux b/stdlib/source/lux/tool/compiler/phase/generation/lua/case.lux index 1e2e7d254..d69668611 100644 --- a/stdlib/source/lux/tool/compiler/phase/generation/lua/case.lux +++ b/stdlib/source/lux/tool/compiler/phase/generation/lua/case.lux @@ -104,8 +104,6 @@ (def: fail! _.break) -(exception: #export unrecognized-path) - (template [ ] [(def: ( simple? idx) (-> Bit Nat Statement) @@ -188,10 +186,7 @@ post! (pattern-matching' generate postP)] (wrap ( pre! post!)))) ([/////synthesis.path/seq _.then] - [/////synthesis.path/alt ..alternation]) - - _ - (////.throw unrecognized-path []))) + [/////synthesis.path/alt ..alternation]))) (def: (pattern-matching generate pathP) (-> Phase Path (Operation Statement)) diff --git a/stdlib/source/lux/tool/compiler/phase/generation/lua/extension/common.lux b/stdlib/source/lux/tool/compiler/phase/generation/lua/extension/common.lux index e9aafeef6..25159b2a7 100644 --- a/stdlib/source/lux/tool/compiler/phase/generation/lua/extension/common.lux +++ b/stdlib/source/lux/tool/compiler/phase/generation/lua/extension/common.lux @@ -57,8 +57,8 @@ (bundle.install "char" (unary (!unary "string.char")))))) (import: #long java/lang/Double - (#static MIN_VALUE Double) - (#static MAX_VALUE Double)) + (#static MIN_VALUE double) + (#static MAX_VALUE double)) (template [ ] [(def: ( _) diff --git a/stdlib/source/lux/tool/compiler/phase/generation/php.lux b/stdlib/source/lux/tool/compiler/phase/generation/php.lux index 480c473bf..6d3500416 100644 --- a/stdlib/source/lux/tool/compiler/phase/generation/php.lux +++ b/stdlib/source/lux/tool/compiler/phase/generation/php.lux @@ -13,6 +13,7 @@ ["." /// ["." extension] [// + [analysis (#+)] ["." synthesis]]]]) (def: #export (generate synthesis) 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 4e672e600..4bd86c94e 100644 --- a/stdlib/source/lux/tool/compiler/phase/generation/php/case.lux +++ b/stdlib/source/lux/tool/compiler/phase/generation/php/case.lux @@ -100,8 +100,6 @@ (def: fail! _.break) -(exception: #export unrecognized-path) - (def: (multi-pop! pops) (-> Nat Statement) (_.; (_.array-splice/3 [@cursor @@ -198,10 +196,7 @@ post! (pattern-matching' generate postP)] (wrap ( pre! post!)))) ([/////synthesis.path/seq _.then] - [/////synthesis.path/alt ..alternation]) - - _ - (////.throw unrecognized-path []))) + [/////synthesis.path/alt ..alternation]))) (def: (pattern-matching generate pathP) (-> Phase Path (Operation Statement)) diff --git a/stdlib/source/lux/tool/compiler/phase/generation/php/extension/common.lux b/stdlib/source/lux/tool/compiler/phase/generation/php/extension/common.lux index bdda1861b..74f61fd22 100644 --- a/stdlib/source/lux/tool/compiler/phase/generation/php/extension/common.lux +++ b/stdlib/source/lux/tool/compiler/phase/generation/php/extension/common.lux @@ -55,8 +55,8 @@ (bundle.install "char" (unary _.chr/1))))) (import: #long java/lang/Double - (#static MIN_VALUE Double) - (#static MAX_VALUE Double)) + (#static MIN_VALUE double) + (#static MAX_VALUE double)) (template [ ] [(def: ( _) diff --git a/stdlib/source/lux/tool/compiler/phase/generation/python.lux b/stdlib/source/lux/tool/compiler/phase/generation/python.lux index 37a8d1bc6..c0cd734b3 100644 --- a/stdlib/source/lux/tool/compiler/phase/generation/python.lux +++ b/stdlib/source/lux/tool/compiler/phase/generation/python.lux @@ -13,6 +13,7 @@ ["." /// ["." extension] [// + [analysis (#+)] ["." synthesis]]]]) (def: #export (generate synthesis) 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 3e07a6730..d0f887385 100644 --- a/stdlib/source/lux/tool/compiler/phase/generation/python/case.lux +++ b/stdlib/source/lux/tool/compiler/phase/generation/python/case.lux @@ -98,8 +98,6 @@ (def: fail-pm! _.break) -(exception: #export unrecognized-path) - (def: (multi-pop! pops) (-> Nat (Statement Any)) (_.delete (_.slice-from (_.int (i/* -1 (.int pops))) @cursor))) @@ -195,10 +193,7 @@ post! (pattern-matching' generate postP)] (wrap ( pre! post!)))) ([/////synthesis.path/seq _.then] - [/////synthesis.path/alt ..alternation]) - - _ - (////.throw unrecognized-path []))) + [/////synthesis.path/alt ..alternation]))) (def: (pattern-matching generate pathP) (-> Phase Path (Operation (Statement Any))) diff --git a/stdlib/source/lux/tool/compiler/phase/generation/python/extension/common.lux b/stdlib/source/lux/tool/compiler/phase/generation/python/extension/common.lux index 7e1b4d2c1..0714fd26c 100644 --- a/stdlib/source/lux/tool/compiler/phase/generation/python/extension/common.lux +++ b/stdlib/source/lux/tool/compiler/phase/generation/python/extension/common.lux @@ -54,8 +54,8 @@ (bundle.install "char" (unary _.chr/1))))) (import: #long java/lang/Double - (#static MIN_VALUE Double) - (#static MAX_VALUE Double)) + (#static MIN_VALUE double) + (#static MAX_VALUE double)) (template [ ] [(def: ( _) diff --git a/stdlib/source/lux/tool/compiler/phase/generation/ruby.lux b/stdlib/source/lux/tool/compiler/phase/generation/ruby.lux index 155d3e13c..a83ac89e1 100644 --- a/stdlib/source/lux/tool/compiler/phase/generation/ruby.lux +++ b/stdlib/source/lux/tool/compiler/phase/generation/ruby.lux @@ -13,6 +13,7 @@ ["." /// ["." extension] [// + [analysis (#+)] ["." synthesis]]]]) (def: #export (generate synthesis) 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 614925cd6..25d6ff91a 100644 --- a/stdlib/source/lux/tool/compiler/phase/generation/ruby/case.lux +++ b/stdlib/source/lux/tool/compiler/phase/generation/ruby/case.lux @@ -99,8 +99,6 @@ (def: fail! _.break) -(exception: #export unrecognized-path) - (def: (multi-pop! pops) (-> Nat (Statement Any)) (_.statement (_.do "slice!" (list (_.int (i/* -1 (.int pops))) @@ -197,10 +195,7 @@ post! (pattern-matching' generate postP)] (wrap ( pre! post!)))) ([/////synthesis.path/seq _.then] - [/////synthesis.path/alt ..alternation]) - - _ - (////.throw unrecognized-path []))) + [/////synthesis.path/alt ..alternation]))) (def: (pattern-matching generate pathP) (-> Phase Path (Operation (Statement Any))) diff --git a/stdlib/source/lux/tool/compiler/phase/generation/ruby/extension/common.lux b/stdlib/source/lux/tool/compiler/phase/generation/ruby/extension/common.lux index cb72ecca0..80dbb312c 100644 --- a/stdlib/source/lux/tool/compiler/phase/generation/ruby/extension/common.lux +++ b/stdlib/source/lux/tool/compiler/phase/generation/ruby/extension/common.lux @@ -50,8 +50,8 @@ ))) (import: #long java/lang/Double - (#static MIN_VALUE Double) - (#static MAX_VALUE Double)) + (#static MIN_VALUE double) + (#static MAX_VALUE double)) (template [ ] [(def: ( _) diff --git a/stdlib/source/lux/tool/compiler/phase/generation/scheme.lux b/stdlib/source/lux/tool/compiler/phase/generation/scheme.lux index 2ccf4f45a..0152ffbcd 100644 --- a/stdlib/source/lux/tool/compiler/phase/generation/scheme.lux +++ b/stdlib/source/lux/tool/compiler/phase/generation/scheme.lux @@ -13,6 +13,7 @@ ["." /// ["." extension] [// + [analysis (#+)] ["." synthesis]]]]) (def: #export (generate synthesis) 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 04d3bae1d..bd478f921 100644 --- a/stdlib/source/lux/tool/compiler/phase/generation/scheme/case.lux +++ b/stdlib/source/lux/tool/compiler/phase/generation/scheme/case.lux @@ -96,8 +96,6 @@ (def: fail-pm! (_.raise/1 pm-error)) -(exception: #export unrecognized-path) - (def: (pm-catch handler) (-> Expression Computation) (_.lambda [(list @alt-error) #.None] @@ -154,10 +152,7 @@ rightO))) (_.lambda [(list) #.None] (_.begin (list save-cursor! - leftO))))]) - - _ - (////.throw unrecognized-path []))) + leftO))))]))) (def: (pattern-matching generate pathP) (-> Phase Path (Operation Computation)) 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 6701bc078..8140c769f 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 @@ -102,8 +102,8 @@ (///runtime.i64//logical-right-shift (_.remainder/2 (_.int +64) paramO) subjectO)) (import: java/lang/Double - (#static MIN_VALUE Double) - (#static MAX_VALUE Double)) + (#static MIN_VALUE double) + (#static MAX_VALUE double)) (template [ ] [(def: ( _) diff --git a/stdlib/source/lux/tool/compiler/phase/statement.lux b/stdlib/source/lux/tool/compiler/phase/statement.lux index 1660fdf01..2f3c68f7b 100644 --- a/stdlib/source/lux/tool/compiler/phase/statement.lux +++ b/stdlib/source/lux/tool/compiler/phase/statement.lux @@ -16,6 +16,7 @@ [".P" analysis ["." type]] ["#/" // #_ + [reference (#+)] ["#." analysis] ["/" statement (#+ Phase)]]]) diff --git a/stdlib/source/lux/tool/compiler/phase/synthesis.lux b/stdlib/source/lux/tool/compiler/phase/synthesis.lux index 0e01c0f68..1b92abf97 100644 --- a/stdlib/source/lux/tool/compiler/phase/synthesis.lux +++ b/stdlib/source/lux/tool/compiler/phase/synthesis.lux @@ -16,6 +16,7 @@ ["#/" // ("#;." monad) ["#." extension] ["#/" // #_ + [reference (#+)] ["#." analysis (#+ Analysis)] ["/" synthesis (#+ Synthesis Phase)]]]]) @@ -84,7 +85,4 @@ (do //.monad [argsS+ (monad.map @ phase args)] (wrap (#/.Extension [name argsS+]))))))) - - _ - (//;wrap (undefined)) )) diff --git a/stdlib/source/test/lux/control/parser.lux b/stdlib/source/test/lux/control/parser.lux index c0bd6d92e..6e1845d15 100644 --- a/stdlib/source/test/lux/control/parser.lux +++ b/stdlib/source/test/lux/control/parser.lux @@ -11,7 +11,7 @@ ["$." monad]]}] [control [parser - ["s" code (#+ Parser)]]] + ["s" code]]] [data ["." error (#+ Error)] [number diff --git a/stdlib/source/test/lux/control/security/policy.lux b/stdlib/source/test/lux/control/security/policy.lux index 69c358e88..6fbcea774 100644 --- a/stdlib/source/test/lux/control/security/policy.lux +++ b/stdlib/source/test/lux/control/security/policy.lux @@ -2,6 +2,7 @@ [lux #* ["_" test (#+ Test)] [abstract + [equivalence (#+)] [hash (#+ Hash)] [monad (#+ do)] {[0 #test] diff --git a/stdlib/source/test/lux/data/collection/sequence.lux b/stdlib/source/test/lux/data/collection/sequence.lux index 6b4529dfc..19926ca92 100644 --- a/stdlib/source/test/lux/data/collection/sequence.lux +++ b/stdlib/source/test/lux/data/collection/sequence.lux @@ -4,6 +4,7 @@ ["_" test (#+ Test)] [abstract comonad + [functor (#+)] [monad (#+ do)]] [data ["." maybe] diff --git a/stdlib/source/test/lux/data/identity.lux b/stdlib/source/test/lux/data/identity.lux index 38d20a7d5..3d0ae44c2 100644 --- a/stdlib/source/test/lux/data/identity.lux +++ b/stdlib/source/test/lux/data/identity.lux @@ -2,6 +2,8 @@ [lux #* ["_" test (#+ Test)] [abstract + [equivalence (#+)] + [functor (#+)] comonad [monad (#+ do)] {[0 #test] diff --git a/stdlib/source/test/lux/data/number/complex.lux b/stdlib/source/test/lux/data/number/complex.lux index 8eed3e865..644db8e27 100644 --- a/stdlib/source/test/lux/data/number/complex.lux +++ b/stdlib/source/test/lux/data/number/complex.lux @@ -20,7 +20,7 @@ {1 ["." / (#+ Complex)]}) -(def: margin-of-error Frac +1.0e-9) +(def: margin-of-error Frac +0.000000001) (def: (within? margin standard value) (-> Frac Complex Complex Bit) diff --git a/stdlib/source/test/lux/math.lux b/stdlib/source/test/lux/math.lux index c11380015..cee41346a 100644 --- a/stdlib/source/test/lux/math.lux +++ b/stdlib/source/test/lux/math.lux @@ -67,7 +67,7 @@ (do r.monad [sample (|> r.safe-frac (:: @ map (f/* +10.0)))] (_.test "Logarithm is the inverse of exponential." - (|> sample /.exp /.log (within? +1.0e-15 sample))))) + (|> sample /.exp /.log (within? +0.000000000000001 sample))))) (<| (_.context "Greatest-Common-Divisor and Least-Common-Multiple") (do r.monad [#let [gen-nat (|> r.nat (:: @ map (|>> (n/% 1000) (n/max 1))))] diff --git a/stdlib/source/test/lux/tool/compiler/default/syntax.lux b/stdlib/source/test/lux/tool/compiler/default/syntax.lux index a0005cc64..d6aee7e37 100644 --- a/stdlib/source/test/lux/tool/compiler/default/syntax.lux +++ b/stdlib/source/test/lux/tool/compiler/default/syntax.lux @@ -82,10 +82,10 @@ (case (let [source-code (%code sample)] (/.parse "" (dictionary.new text.hash) (text.size source-code) [default-cursor 0 source-code])) - (#error.Failure error) + (#.Left error) false - (#error.Success [_ parsed]) + (#.Right [_ parsed]) (:: code.equivalence = parsed sample))) (do @ [other code^] @@ -94,16 +94,16 @@ source-code//size (text.size source-code)] (case (/.parse "" (dictionary.new text.hash) source-code//size [default-cursor 0 source-code]) - (#error.Failure error) + (#.Left error) false - (#error.Success [remaining =sample]) + (#.Right [remaining =sample]) (case (/.parse "" (dictionary.new text.hash) source-code//size remaining) - (#error.Failure error) + (#.Left error) false - (#error.Success [_ =other]) + (#.Right [_ =other]) (and (:: code.equivalence = sample =sample) (:: code.equivalence = other =other))))))) ))) @@ -132,10 +132,10 @@ source-code//size (text.size source-code)] (/.parse "" (dictionary.new text.hash) source-code//size [default-cursor 0 source-code])) - (#error.Failure error) + (#.Left error) false - (#error.Success [_ parsed]) + (#.Right [_ parsed]) (:: code.equivalence = parsed sample))) ))) -- cgit v1.2.3