From 0f996f63bad02778d6dd3de767151f524a79df22 Mon Sep 17 00:00:00 2001 From: Eduardo Julian Date: Thu, 19 Mar 2020 21:20:08 -0400 Subject: Test for predicates + adjustments to code-generation code. --- stdlib/source/lux/abstract/predicate.lux | 3 +- .../compiler/language/lux/phase/generation/js.lux | 2 +- .../language/lux/phase/generation/js/function.lux | 9 ++-- .../language/lux/phase/generation/js/runtime.lux | 33 ++++++------ .../compiler/language/lux/phase/generation/lua.lux | 2 +- .../language/lux/phase/generation/lua/function.lux | 8 +-- .../language/lux/phase/generation/lua/runtime.lux | 23 +++++---- .../language/lux/phase/generation/python.lux | 2 +- .../lux/phase/generation/python/function.lux | 8 +-- .../lux/phase/generation/python/runtime.lux | 23 +++++---- .../language/lux/phase/generation/reference.lux | 43 +++++++++++----- .../language/lux/phase/generation/ruby.lux | 2 +- .../lux/phase/generation/ruby/function.lux | 8 +-- .../language/lux/phase/generation/ruby/runtime.lux | 23 +++++---- stdlib/source/test/lux/abstract.lux | 7 ++- stdlib/source/test/lux/abstract/order.lux | 2 +- stdlib/source/test/lux/abstract/predicate.lux | 59 ++++++++++++++++++++++ 17 files changed, 174 insertions(+), 83 deletions(-) create mode 100644 stdlib/source/test/lux/abstract/predicate.lux diff --git a/stdlib/source/lux/abstract/predicate.lux b/stdlib/source/lux/abstract/predicate.lux index de3fc087d..b69b43415 100644 --- a/stdlib/source/lux/abstract/predicate.lux +++ b/stdlib/source/lux/abstract/predicate.lux @@ -49,7 +49,8 @@ (All [a] (-> (-> (Predicate a) (Predicate a)) (Predicate a))) - (|>> (predicate (rec predicate)))) + (function (recur input) + (predicate recur input))) (structure: #export contravariant (Contravariant Predicate) diff --git a/stdlib/source/lux/tool/compiler/language/lux/phase/generation/js.lux b/stdlib/source/lux/tool/compiler/language/lux/phase/generation/js.lux index c1970c013..e7cebfdbf 100644 --- a/stdlib/source/lux/tool/compiler/language/lux/phase/generation/js.lux +++ b/stdlib/source/lux/tool/compiler/language/lux/phase/generation/js.lux @@ -36,7 +36,7 @@ (/structure.tuple generate archive members) (#synthesis.Reference value) - (/reference@reference value) + (/reference@reference archive value) (^ (synthesis.branch/case case)) (/case.case generate archive case) diff --git a/stdlib/source/lux/tool/compiler/language/lux/phase/generation/js/function.lux b/stdlib/source/lux/tool/compiler/language/lux/phase/generation/js/function.lux index cf2f4db68..81b9752a3 100644 --- a/stdlib/source/lux/tool/compiler/language/lux/phase/generation/js/function.lux +++ b/stdlib/source/lux/tool/compiler/language/lux/phase/generation/js/function.lux @@ -11,7 +11,7 @@ [target ["_" js (#+ Expression Computation Var)]]] ["." // #_ - [runtime (#+ Operation Phase Generator)] + ["#." runtime (#+ Operation Phase Generator)] ["#." reference] ["#." case] ["/#" // #_ @@ -56,9 +56,10 @@ (def: #export (function generate archive [environment arity bodyS]) (Generator (Abstraction Synthesis)) (do ///////phase.monad - [[function-name bodyO] (/////generation.with-context + [[function-name bodyO] (/////generation.with-new-context (do @ - [function-name /////generation.context] + [function-name (:: @ map ///reference.artifact-name + /////generation.context)] (/////generation.with-anchor (_.var function-name) (generate archive bodyS)))) #let [capture (:: //reference.system variable)] @@ -66,7 +67,7 @@ (monad.map @ capture environment)) #let [arityO (|> arity .int _.i32) @num-args (_.var "num_args") - @self (_.var function-name) + @self (_.var (///reference.artifact-name function-name)) apply-poly (.function (_ args func) (|> func (_.do "apply" (list _.null args)))) initialize-self! (_.define (//case.register 0) @self) diff --git a/stdlib/source/lux/tool/compiler/language/lux/phase/generation/js/runtime.lux b/stdlib/source/lux/tool/compiler/language/lux/phase/generation/js/runtime.lux index fb197118a..ddcc765a2 100644 --- a/stdlib/source/lux/tool/compiler/language/lux/phase/generation/js/runtime.lux +++ b/stdlib/source/lux/tool/compiler/language/lux/phase/generation/js/runtime.lux @@ -12,20 +12,21 @@ ["." text ["%" format (#+ format)]] [collection - ["." list ("#;." functor)]]] + ["." list ("#@." functor)]]] ["." macro ["." code] [syntax (#+ syntax:)]] [target ["_" js (#+ Expression Var Computation Statement)]]] - ["." ///// #_ - ["#." synthesis] - ["#." generation] + ["." /// #_ + ["#." reference] ["//#" /// #_ - ["#." phase] - ["#." name] - [meta - [archive (#+ Archive)]]]] + ["#." synthesis] + ["#." generation (#+ Buffer)] + ["//#" /// #_ + ["#." phase] + [meta + [archive (#+ Archive)]]]]] ) (template [ ] @@ -88,12 +89,12 @@ (def: variable (-> Text Var) - (|>> ///////name.normalize + (|>> ///reference.sanitize _.var)) (def: runtime-name (-> Text Var) - (|>> ///////name.normalize + (|>> ///reference.sanitize (format ..prefix "$") _.var)) @@ -104,9 +105,9 @@ (syntax: #export (with-vars {vars (s.tuple (p.some s.local-identifier))} body) (wrap (list (` (let [(~+ (|> vars - (list;map (function (_ var) + (list@map (function (_ var) (list (code.local-identifier var) - (` (_.var (~ (code.text (///////name.normalize var)))))))) + (` (_.var (~ (code.text (///reference.sanitize var)))))))) list.concat))] (~ body)))))) @@ -132,8 +133,8 @@ (let [nameC (code.local-identifier name) code-nameC (code.local-identifier (format "@" name)) runtime-nameC (` (runtime-name (~ (code.text name)))) - inputsC (list;map code.local-identifier inputs) - inputs-typesC (list;map (function.constant (` _.Expression)) inputs)] + inputsC (list@map code.local-identifier inputs) + inputs-typesC (list@map (function.constant (` _.Expression)) inputs)] (wrap (list (` (def: #export ((~ nameC) (~+ inputsC)) (-> (~+ inputs-typesC) Computation) (_.apply/* (~ runtime-nameC) (list (~+ inputsC))))) @@ -736,11 +737,11 @@ (def: #export artifact Text prefix) (def: #export generate - (Operation Any) + (Operation (Buffer Statement)) (/////generation.with-buffer (do ///////phase.monad [_ (/////generation.save! true ["" ..prefix] ($_ _.then _.use-strict ..runtime))] - (/////generation.save-buffer! ..artifact)))) + /////generation.buffer))) diff --git a/stdlib/source/lux/tool/compiler/language/lux/phase/generation/lua.lux b/stdlib/source/lux/tool/compiler/language/lux/phase/generation/lua.lux index 3a041f594..a455b13b9 100644 --- a/stdlib/source/lux/tool/compiler/language/lux/phase/generation/lua.lux +++ b/stdlib/source/lux/tool/compiler/language/lux/phase/generation/lua.lux @@ -36,7 +36,7 @@ (/structure.tuple generate archive members) (#synthesis.Reference value) - (/reference@reference value) + (/reference@reference archive value) (^ (synthesis.branch/case case)) (/case.case generate archive case) diff --git a/stdlib/source/lux/tool/compiler/language/lux/phase/generation/lua/function.lux b/stdlib/source/lux/tool/compiler/language/lux/phase/generation/lua/function.lux index 556f8d169..23697cfcb 100644 --- a/stdlib/source/lux/tool/compiler/language/lux/phase/generation/lua/function.lux +++ b/stdlib/source/lux/tool/compiler/language/lux/phase/generation/lua/function.lux @@ -62,14 +62,16 @@ (def: #export (function generate archive [environment arity bodyS]) (Generator (Abstraction Synthesis)) (do ///////phase.monad - [[function-name bodyO] (/////generation.with-context + [[function-name bodyO] (/////generation.with-new-context (do @ - [function-name /////generation.context] + [function-name (:: @ map ///reference.artifact-name + /////generation.context)] (/////generation.with-anchor (_.var function-name) (generate archive bodyS)))) closureO+ (: (Operation (List (Expression Any))) (monad.map @ (:: //reference.system variable) environment)) - #let [@curried (_.var "curried") + #let [function-name (///reference.artifact-name function-name) + @curried (_.var "curried") arityO (|> arity .int _.int) @num-args (_.var "num_args") @self (_.var function-name) diff --git a/stdlib/source/lux/tool/compiler/language/lux/phase/generation/lua/runtime.lux b/stdlib/source/lux/tool/compiler/language/lux/phase/generation/lua/runtime.lux index ad3745dff..e5011d01a 100644 --- a/stdlib/source/lux/tool/compiler/language/lux/phase/generation/lua/runtime.lux +++ b/stdlib/source/lux/tool/compiler/language/lux/phase/generation/lua/runtime.lux @@ -18,14 +18,15 @@ [syntax (#+ syntax:)]] [target ["_" lua (#+ Expression Location Var Computation Literal Statement)]]] - ["." ///// #_ - ["#." synthesis] - ["#." generation] + ["." /// #_ + ["#." reference] ["//#" /// #_ - ["#." phase] - ["#." name] - [meta - [archive (#+ Archive)]]]]) + ["#." synthesis] + ["#." generation (#+ Buffer)] + ["//#" /// #_ + ["#." phase] + [meta + [archive (#+ Archive)]]]]]) (template [ ] [(type: #export @@ -84,7 +85,7 @@ (def: runtime-name (-> Text Var) - (|>> ///////name.normalize + (|>> ///reference.sanitize (format ..prefix "_") _.var)) @@ -97,7 +98,7 @@ (wrap (list (` (let [(~+ (|> vars (list@map (function (_ var) (list (code.local-identifier var) - (` (_.var (~ (code.text (///////name.normalize var)))))))) + (` (_.var (~ (code.text (///reference.sanitize var)))))))) list.concat))] (~ body)))))) @@ -360,9 +361,9 @@ (def: #export artifact ..prefix) (def: #export generate - (Operation Any) + (Operation (Buffer Statement)) (/////generation.with-buffer (do ///////phase.monad [_ (/////generation.save! true ["" ..prefix] ..runtime)] - (/////generation.save-buffer! ..artifact)))) + /////generation.buffer))) diff --git a/stdlib/source/lux/tool/compiler/language/lux/phase/generation/python.lux b/stdlib/source/lux/tool/compiler/language/lux/phase/generation/python.lux index f6e14de75..19013715b 100644 --- a/stdlib/source/lux/tool/compiler/language/lux/phase/generation/python.lux +++ b/stdlib/source/lux/tool/compiler/language/lux/phase/generation/python.lux @@ -36,7 +36,7 @@ (/structure.tuple generate archive members) (#////synthesis.Reference value) - (/reference@reference value) + (/reference@reference archive value) (^ (////synthesis.branch/case case)) (/case.case generate archive case) diff --git a/stdlib/source/lux/tool/compiler/language/lux/phase/generation/python/function.lux b/stdlib/source/lux/tool/compiler/language/lux/phase/generation/python/function.lux index eb815a2c8..ded751c2e 100644 --- a/stdlib/source/lux/tool/compiler/language/lux/phase/generation/python/function.lux +++ b/stdlib/source/lux/tool/compiler/language/lux/phase/generation/python/function.lux @@ -62,14 +62,16 @@ (def: #export (function generate archive [environment arity bodyS]) (Generator (Abstraction Synthesis)) (do ///////phase.monad - [[function-name bodyO] (/////generation.with-context + [[function-name bodyO] (/////generation.with-new-context (do @ - [function-name /////generation.context] + [function-name (:: @ map ///reference.artifact-name + /////generation.context)] (/////generation.with-anchor (_.var function-name) (generate archive bodyS)))) closureO+ (: (Operation (List (Expression Any))) (monad.map @ (:: //reference.system variable) environment)) - #let [@curried (_.var "curried") + #let [function-name (///reference.artifact-name function-name) + @curried (_.var "curried") arityO (|> arity .int _.int) @num-args (_.var "num_args") @self (_.var function-name) diff --git a/stdlib/source/lux/tool/compiler/language/lux/phase/generation/python/runtime.lux b/stdlib/source/lux/tool/compiler/language/lux/phase/generation/python/runtime.lux index 8916ad6d8..d3d1d532a 100644 --- a/stdlib/source/lux/tool/compiler/language/lux/phase/generation/python/runtime.lux +++ b/stdlib/source/lux/tool/compiler/language/lux/phase/generation/python/runtime.lux @@ -18,14 +18,15 @@ [syntax (#+ syntax:)]] [target ["_" python (#+ Expression SVar Computation Literal Statement)]]] - ["." ///// #_ - ["#." synthesis] - ["#." generation] + ["." /// #_ + ["#." reference] ["//#" /// #_ - ["#." phase] - ["#." name] - [meta - [archive (#+ Archive)]]]]) + ["#." synthesis] + ["#." generation (#+ Buffer)] + ["//#" /// #_ + ["#." phase] + [meta + [archive (#+ Archive)]]]]]) (template [ ] [(type: #export @@ -78,7 +79,7 @@ (def: runtime-name (-> Text SVar) - (|>> ///////name.normalize + (|>> ///reference.sanitize (format ..prefix "_") _.var)) @@ -91,7 +92,7 @@ (wrap (list (` (let [(~+ (|> vars (list@map (function (_ var) (list (code.local-identifier var) - (` (_.var (~ (code.text (///////name.normalize var)))))))) + (` (_.var (~ (code.text (///reference.sanitize var)))))))) list.concat))] (~ body)))))) @@ -336,10 +337,10 @@ (def: #export artifact ..prefix) (def: #export generate - (Operation Any) + (Operation (Buffer (Statement Any))) (/////generation.with-buffer (do ///////phase.monad [_ (/////generation.save! true ["" ..prefix] (<| (_.comment "-*- coding: utf-8 -*-") ..runtime))] - (/////generation.save-buffer! ..artifact)))) + /////generation.buffer))) diff --git a/stdlib/source/lux/tool/compiler/language/lux/phase/generation/reference.lux b/stdlib/source/lux/tool/compiler/language/lux/phase/generation/reference.lux index e75c8e41e..86fb57f0a 100644 --- a/stdlib/source/lux/tool/compiler/language/lux/phase/generation/reference.lux +++ b/stdlib/source/lux/tool/compiler/language/lux/phase/generation/reference.lux @@ -1,17 +1,21 @@ (.module: [lux #* + [abstract + [monad (#+ do)]] [control pipe] [data - [text + ["." text ["%" format (#+ format)]]] [type (#+ :share)]] ["." //// #_ [synthesis (#+ Synthesis)] - ["#." generation] + ["#." generation (#+ Context)] ["//#" /// #_ ["#." reference (#+ Register Variable Reference)] - ["#." phase ("#@." monad)]]]) + ["#." phase ("#@." monad)] + [meta + [archive (#+ Archive)]]]]) (signature: #export (System expression) (: (-> Register expression) @@ -22,10 +26,10 @@ (-> Variable (////generation.Operation anchor expression directive))) variable) (: (All [anchor directive] - (-> Name (////generation.Operation anchor expression directive))) + (-> Archive Name (////generation.Operation anchor expression directive))) constant) (: (All [anchor directive] - (-> Reference (////generation.Operation anchor expression directive))) + (-> Archive Reference (////generation.Operation anchor expression directive))) reference)) (def: (variable-maker prefix variable) @@ -45,6 +49,16 @@ ["l" local] ) +(def: #export sanitize + (-> Text Text) + (|>> (text.replace-all "-" "_") + (text.replace-all "?" "Q") + (text.replace-all "@" "A"))) + +(def: #export (artifact-name [module id]) + (-> Context Text) + (format "lux_" "m" module "a" (%.nat id))) + (def: #export (system constant variable) (All [expression] (-> (-> Text expression) (-> Text expression) @@ -66,16 +80,19 @@ {(-> Text expression) constant} {(All [anchor directive] - (-> Name (////generation.Operation anchor expression directive))) - (|>> ////generation.remember (//////phase@map constant))})] + (-> Archive Name (////generation.Operation anchor expression directive))) + (function (_ archive name) + (|> (////generation.remember archive name) + (//////phase@map (|>> ..artifact-name constant))))})] (structure (def: local local) (def: foreign foreign) (def: variable variable) (def: constant constant) - (def: reference - (|>> (case> (#//////reference.Constant value) - (constant value) - - (#//////reference.Variable value) - (variable value))))))) + (def: (reference archive reference) + (case reference + (#//////reference.Constant value) + (constant archive value) + + (#//////reference.Variable value) + (variable value)))))) diff --git a/stdlib/source/lux/tool/compiler/language/lux/phase/generation/ruby.lux b/stdlib/source/lux/tool/compiler/language/lux/phase/generation/ruby.lux index f6e14de75..19013715b 100644 --- a/stdlib/source/lux/tool/compiler/language/lux/phase/generation/ruby.lux +++ b/stdlib/source/lux/tool/compiler/language/lux/phase/generation/ruby.lux @@ -36,7 +36,7 @@ (/structure.tuple generate archive members) (#////synthesis.Reference value) - (/reference@reference value) + (/reference@reference archive value) (^ (////synthesis.branch/case case)) (/case.case generate archive case) diff --git a/stdlib/source/lux/tool/compiler/language/lux/phase/generation/ruby/function.lux b/stdlib/source/lux/tool/compiler/language/lux/phase/generation/ruby/function.lux index 3e63c5a86..b4b89e375 100644 --- a/stdlib/source/lux/tool/compiler/language/lux/phase/generation/ruby/function.lux +++ b/stdlib/source/lux/tool/compiler/language/lux/phase/generation/ruby/function.lux @@ -55,14 +55,16 @@ (def: #export (function generate archive [environment arity bodyS]) (Generator (Abstraction Synthesis)) (do ///////phase.monad - [[function-name bodyO] (/////generation.with-context + [[function-name bodyO] (/////generation.with-new-context (do @ - [function-name /////generation.context] + [function-name (:: @ map ///reference.artifact-name + /////generation.context)] (/////generation.with-anchor (_.local function-name) (generate archive bodyS)))) closureO+ (: (Operation (List (Expression Any))) (monad.map @ (:: //reference.system variable) environment)) - #let [@curried (_.local "curried") + #let [function-name (///reference.artifact-name function-name) + @curried (_.local "curried") arityO (|> arity .int _.int) limitO (|> arity dec .int _.int) @num-args (_.local "num_args") diff --git a/stdlib/source/lux/tool/compiler/language/lux/phase/generation/ruby/runtime.lux b/stdlib/source/lux/tool/compiler/language/lux/phase/generation/ruby/runtime.lux index ab1607c26..8d2e73a9d 100644 --- a/stdlib/source/lux/tool/compiler/language/lux/phase/generation/ruby/runtime.lux +++ b/stdlib/source/lux/tool/compiler/language/lux/phase/generation/ruby/runtime.lux @@ -18,14 +18,15 @@ [syntax (#+ syntax:)]] [target ["_" ruby (#+ Expression LVar Computation Literal Statement)]]] - ["." ///// #_ - ["#." synthesis] - ["#." generation] + ["." /// #_ + ["#." reference] ["//#" /// #_ - ["#." phase] - ["#." name] - [meta - [archive (#+ Archive)]]]]) + ["#." synthesis] + ["#." generation (#+ Buffer)] + ["//#" /// #_ + ["#." phase] + [meta + [archive (#+ Archive)]]]]]) (template [ ] [(type: #export @@ -82,7 +83,7 @@ (def: runtime-name (-> Text LVar) - (|>> ///////name.normalize + (|>> ///reference.sanitize (format ..prefix "_") _.local)) @@ -95,7 +96,7 @@ (wrap (list (` (let [(~+ (|> vars (list@map (function (_ var) (list (code.local-identifier var) - (` (_.local (~ (code.text (///////name.normalize var)))))))) + (` (_.local (~ (code.text (///reference.sanitize var)))))))) list.concat))] (~ body)))))) @@ -292,9 +293,9 @@ (def: #export artifact ..prefix) (def: #export generate - (Operation Any) + (Operation (Buffer (Statement Any))) (/////generation.with-buffer (do ///////phase.monad [_ (/////generation.save! true ["" ..prefix] ..runtime)] - (/////generation.save-buffer! ..artifact)))) + /////generation.buffer))) diff --git a/stdlib/source/test/lux/abstract.lux b/stdlib/source/test/lux/abstract.lux index c0ad0b823..d927dcd3e 100644 --- a/stdlib/source/test/lux/abstract.lux +++ b/stdlib/source/test/lux/abstract.lux @@ -6,7 +6,8 @@ ["#." enum] ["#." equivalence] ["#." interval] - ["#." order]]) + ["#." order] + ["#." predicate]]) (def: #export test Test @@ -15,4 +16,6 @@ /enum.test /equivalence.test /interval.test - /order.test)) + /order.test + /predicate.test + )) diff --git a/stdlib/source/test/lux/abstract/order.lux b/stdlib/source/test/lux/abstract/order.lux index a4bff03e9..ed64b5d46 100644 --- a/stdlib/source/test/lux/abstract/order.lux +++ b/stdlib/source/test/lux/abstract/order.lux @@ -14,7 +14,7 @@ (def: #export test Test - (<| (_.context (%.name (name-of /.Codec))) + (<| (_.context (%.name (name-of /.Order))) (do r.monad [left r.nat right (|> r.nat (r.filter (|>> (n.= left) not)))]) diff --git a/stdlib/source/test/lux/abstract/predicate.lux b/stdlib/source/test/lux/abstract/predicate.lux new file mode 100644 index 000000000..946d8371e --- /dev/null +++ b/stdlib/source/test/lux/abstract/predicate.lux @@ -0,0 +1,59 @@ +(.module: + [lux #* + ["_" test (#+ Test)] + [abstract + [equivalence (#+ Equivalence)] + [monad (#+ do)]] + [data + ["." bit ("#@." equivalence)] + [text + ["%" format (#+ format)]] + [number + ["n" nat]]] + [math + ["r" random (#+ Random)]]] + ["." // #_ + ["#." monoid]] + {1 + ["." / (#+ Predicate)]}) + +(def: #export test + Test + (let [/2? (: (/.Predicate Nat) + (|>> (n.% 2) (n.= 0))) + /3? (: (/.Predicate Nat) + (|>> (n.% 3) (n.= 0)))] + (<| (_.context (%.name (name-of /.Predicate))) + (do r.monad + [sample r.nat]) + ($_ _.and + (_.test (%.name (name-of /.none)) + (bit@= false (/.none sample))) + (_.test (%.name (name-of /.all)) + (bit@= true (/.all sample))) + (_.test (%.name (name-of /.unite)) + (bit@= (/.all sample) + ((/.unite /.none /.all) sample))) + (_.test (%.name (name-of /.intersect)) + (bit@= (/.none sample) + ((/.intersect /.none /.all) sample))) + (_.test (%.name (name-of /.complement)) + (and (not (bit@= (/.none sample) + ((/.complement /.none) sample))) + (not (bit@= (/.all sample) + ((/.complement /.all) sample))))) + (_.test (%.name (name-of /.difference)) + (bit@= (and (/2? sample) + (not (/3? sample))) + ((/.difference /3? /2?) sample))) + (let [equivalence (: (Equivalence (/.Predicate Nat)) + (structure + (def: (= left right) + (bit@= (left sample) + (right sample))))) + generator (: (Random (/.Predicate Nat)) + (wrap /2?))] + ($_ _.and + (//monoid.spec equivalence /.union generator) + (//monoid.spec equivalence /.intersection generator))) + )))) -- cgit v1.2.3