From a384e0c9426d6110fa4c104a1327808a0aff91b0 Mon Sep 17 00:00:00 2001 From: Eduardo Julian Date: Fri, 24 Jun 2022 22:38:07 -0400 Subject: Generalized machinery for context-aware macros. --- documentation/bookmark/architecture.md | 6 +- documentation/bookmark/deprecation.md | 5 + documentation/bookmark/documentation.md | 1 + .../bookmark/optimization/lazy_evaluation.md | 6 +- documentation/bookmark/performance.md | 3 +- .../bookmark/programming_language/syntax.md | 4 + documentation/bookmark/random_generation.md | 4 +- documentation/bookmark/security/privacy.md | 6 + documentation/bookmark/user_interface/widget.md | 4 +- documentation/bookmark/web_framework.md | 1 + lux-mode/lux-mode.el | 7 +- stdlib/source/library/lux/macro/context.lux | 159 ++++++++++++++ stdlib/source/library/lux/meta.lux | 56 ++--- stdlib/source/library/lux/type/primitive.lux | 235 ++++----------------- stdlib/source/test/lux/macro.lux | 4 +- stdlib/source/test/lux/macro/context.lux | 12 ++ stdlib/source/test/lux/type/primitive.lux | 118 +++++------ 17 files changed, 326 insertions(+), 305 deletions(-) create mode 100644 documentation/bookmark/deprecation.md create mode 100644 documentation/bookmark/security/privacy.md create mode 100644 stdlib/source/library/lux/macro/context.lux create mode 100644 stdlib/source/test/lux/macro/context.lux diff --git a/documentation/bookmark/architecture.md b/documentation/bookmark/architecture.md index d7b2a9ccf..46710f273 100644 --- a/documentation/bookmark/architecture.md +++ b/documentation/bookmark/architecture.md @@ -1,5 +1,7 @@ # Reference -1. [Polylith](https://polylith.gitbook.io/polylith) -1. [Awesome Software Architecture](https://mehdihadeli.github.io/awesome-software-architecture/) +0. []() +0. [Software Architecture: It Might Not Be What You Think It Is](https://www.infoq.com/articles/what-software-architecture/) +0. [Polylith](https://polylith.gitbook.io/polylith) +0. [Awesome Software Architecture](https://mehdihadeli.github.io/awesome-software-architecture/) diff --git a/documentation/bookmark/deprecation.md b/documentation/bookmark/deprecation.md new file mode 100644 index 000000000..b4ecb61a0 --- /dev/null +++ b/documentation/bookmark/deprecation.md @@ -0,0 +1,5 @@ +# Reference + +0. []() +0. [Deprecating in Julia](https://invenia.github.io/blog/2022/06/17/deprecating-in-julia/) + diff --git a/documentation/bookmark/documentation.md b/documentation/bookmark/documentation.md index dec25e3d9..e8218043f 100644 --- a/documentation/bookmark/documentation.md +++ b/documentation/bookmark/documentation.md @@ -4,6 +4,7 @@ # Programming +0. [Nota](https://nota-lang.org/) 0. [Skribilo: The Ultimate Document Programming Framework](https://www.nongnu.org/skribilo/) # Diagram | Chart diff --git a/documentation/bookmark/optimization/lazy_evaluation.md b/documentation/bookmark/optimization/lazy_evaluation.md index 8e9a785fd..93cf12387 100644 --- a/documentation/bookmark/optimization/lazy_evaluation.md +++ b/documentation/bookmark/optimization/lazy_evaluation.md @@ -1,5 +1,7 @@ # Reference -1. [Promises Are Made to Be Broken: Migrating R to Strict Semantics](http://aviral.io/static/pdfs/promises-are-made-to-be-broken.pdf) -1. [Call-by-Need Is Clairvoyant Call-by-Value](http://www.cs.nott.ac.uk/~pszgmh/clairvoyant.pdf) +0. []() +0. [Comparing strict and lazy](https://www.tweag.io/blog/2022-05-12-strict-vs-lazy/) +0. [Promises Are Made to Be Broken: Migrating R to Strict Semantics](http://aviral.io/static/pdfs/promises-are-made-to-be-broken.pdf) +0. [Call-by-Need Is Clairvoyant Call-by-Value](http://www.cs.nott.ac.uk/~pszgmh/clairvoyant.pdf) diff --git a/documentation/bookmark/performance.md b/documentation/bookmark/performance.md index a5009abf5..c3fecf5e9 100644 --- a/documentation/bookmark/performance.md +++ b/documentation/bookmark/performance.md @@ -1,4 +1,5 @@ # Reference -1. [CppCon 2019: Chandler Carruth “There Are No Zero-cost Abstractions”](https://www.youtube.com/watch?v=rHIkrotSwcc) +0. [A Management Maturity Model for Performance](https://infrequently.org/2022/05/performance-management-maturity/) +0. [CppCon 2019: Chandler Carruth “There Are No Zero-cost Abstractions”](https://www.youtube.com/watch?v=rHIkrotSwcc) diff --git a/documentation/bookmark/programming_language/syntax.md b/documentation/bookmark/programming_language/syntax.md index 2d11ffaa7..5d28ea88d 100644 --- a/documentation/bookmark/programming_language/syntax.md +++ b/documentation/bookmark/programming_language/syntax.md @@ -1,4 +1,8 @@ # Reference +0. []() +0. [Composable and Compilable Macros: You Want it When?](https://www.cs.utah.edu/plt/publications/macromod.pdf) +0. [From Macros to Reusable Generative Programming](http://cs.brown.edu/~sk/Publications/Papers/Published/kfd-macro-to-gen-prog/) +0. [Not everything is an expression](https://codewords.recurse.com/issues/two/not-everything-is-an-expression) 0. [Rhombus](https://github.com/racket/rhombus-prototype) diff --git a/documentation/bookmark/random_generation.md b/documentation/bookmark/random_generation.md index 408d5da32..503c0baf5 100644 --- a/documentation/bookmark/random_generation.md +++ b/documentation/bookmark/random_generation.md @@ -1,4 +1,6 @@ # Reference -1. [Efficiently Generating a Number in a Range](https://www.pcg-random.org/posts/bounded-rands.html) +0. []() +0. [Fast random integers](https://www.erlang.org/blog/faster-rand/) +0. [Efficiently Generating a Number in a Range](https://www.pcg-random.org/posts/bounded-rands.html) diff --git a/documentation/bookmark/security/privacy.md b/documentation/bookmark/security/privacy.md new file mode 100644 index 000000000..0f7bb2ab5 --- /dev/null +++ b/documentation/bookmark/security/privacy.md @@ -0,0 +1,6 @@ +# Reference + +0. []() +0. [Sovereign Stack: Take Back What's Yours](https://sovereignstack.tools/) +0. [Privacy Resources](https://sovereignstack.tools/privacy-resources/) + diff --git a/documentation/bookmark/user_interface/widget.md b/documentation/bookmark/user_interface/widget.md index 20f6a1a81..cc9596a6b 100644 --- a/documentation/bookmark/user_interface/widget.md +++ b/documentation/bookmark/user_interface/widget.md @@ -1,4 +1,6 @@ # Reference -1. [Floating UI](https://www.floating-ui.com/) +0. []() +0. [100 Modern CSS Buttons. Every Style That You Can Imagine.](https://github.com/uihaven/ui-buttons) +0. [Floating UI](https://www.floating-ui.com/) diff --git a/documentation/bookmark/web_framework.md b/documentation/bookmark/web_framework.md index d98eb95e7..87623c576 100644 --- a/documentation/bookmark/web_framework.md +++ b/documentation/bookmark/web_framework.md @@ -32,6 +32,7 @@ # Exemplar +0. [Voby](https://github.com/vobyjs/voby) 0. ["Janus: Easy Complex UI with Declarative FRP" by Issa Tseng](https://www.youtube.com/watch?v=7S57O3VwIyQ) 0. https://github.com/alpinejs/alpine 0. [Mint: The programming language for writing single page applications.](https://www.mint-lang.com/) diff --git a/lux-mode/lux-mode.el b/lux-mode/lux-mode.el index fbba53c20..5877a72f4 100644 --- a/lux-mode/lux-mode.el +++ b/lux-mode/lux-mode.el @@ -394,11 +394,11 @@ Called by `imenu--generic-function'." (function-application (altRE "|>" "<|" "left" "right" "all")) (function-definition (altRE "function" "|>>" "<<|")) (remember (altRE "remember" "to_do" "fix_me")) + (extension (altRE "analysis" "synthesis" "generation" "directive")) (definition (altRE "\\.require" "def" "inlined" "type:" "program:" "macro" "syntax" - "exception:" - "analysis" "synthesis" "generation" "directive"))) + "exception:"))) (let ((control (altRE control//flow control//pattern-matching control//logic @@ -430,6 +430,7 @@ Called by `imenu--generic-function'." function-application function-definition remember + extension definition ;; ;;;;;;;;;;;;;;;;;;;;;; "with_expansions" @@ -577,7 +578,6 @@ This function also returns nil meaning don't specify the indentation." (define-lux-indent ("function" 'defun) - ("macro" 'defun) ("syntax" 'defun) ("template" 'defun) @@ -585,6 +585,7 @@ This function also returns nil meaning don't specify the indentation." ("def" 'defun) ("inlined" 'defun) + ("context" 'defun) ("primitive" 'defun) ("analysis" 'defun) ("synthesis" 'defun) diff --git a/stdlib/source/library/lux/macro/context.lux b/stdlib/source/library/lux/macro/context.lux new file mode 100644 index 000000000..4fe898ee4 --- /dev/null +++ b/stdlib/source/library/lux/macro/context.lux @@ -0,0 +1,159 @@ +(.require + [library + [lux (.except def global) + [abstract + [monad (.only do)] + ["[0]" predicate (.only Predicate)]] + [control + ["[0]" exception (.only exception:)] + ["[0]" maybe] + ["?" parser (.only) + ["?[0]" code]]] + [data + ["[0]" text (.use "[1]#[0]" equivalence monoid)] + [collection + ["[0]" list] + [dictionary + ["[0]" plist (.only PList)]]]] + ["[0]" meta (.only) + ["[0]" symbol (.use "[1]#[0]" codec)]]]] + ["[0]" // (.only) + [syntax (.only syntax)] + ["^" pattern] + ["[0]" code]]) + +(type: .public Stack + List) + +(exception: .public (no_definition [it Symbol]) + (exception.report + "Definition" (symbol#encoded it))) + +(.def (global it) + (-> Symbol (Meta Any)) + (do meta.monad + [.let [[@ expected_name] it] + defs (meta.definitions @)] + (case (list.one (function (_ [actual_name [exported? type value]]) + (if (text#= expected_name actual_name) + {.#Some value} + {.#None})) + defs) + {.#Some it} + (in it) + + {.#None} + (meta.failure (exception.error ..no_definition [it]))))) + +(exception: .public no_active_context) + +(.def (peek' _ context) + (All (_ a) (-> (Stack a) Symbol (Meta a))) + (do meta.monad + [stack (..global context)] + (case (|> stack + (as (Stack Any)) + list.head) + {.#Some top} + (in (as_expected top)) + + {.#None} + (meta.failure (exception.error ..no_active_context []))))) + +(.def .public peek + (syntax (_ [g!it (at ?.monad each code.symbol ?code.global)]) + (in (list (` ((~! ..peek') (~ g!it) (.symbol (~ g!it)))))))) + +(exception: .public no_example) + +(.def (search' _ ? context) + (All (_ a) (-> (Stack a) (Predicate a) Symbol (Meta a))) + (do meta.monad + [stack (..global context)] + (case (|> stack + (as (Stack Any)) + (list.example (as (Predicate Any) ?))) + {.#Some it} + (in (as_expected it)) + + {.#None} + (meta.failure (exception.error ..no_example []))))) + +(.def .public search + (syntax (_ [g!context (at ?.monad each code.symbol ?code.global) + g!? ?code.any]) + (in (list (` ((~! ..search') (~ g!context) (~ g!?) (.symbol (~ g!context)))))))) + +(.def (alter on_definition [@ context]) + (-> (-> Definition Definition) Symbol (Meta Any)) + (function (_ lux) + (let [on_global (is (-> Global Global) + (function (_ it) + (case it + {.#Definition it} + {.#Definition (on_definition it)} + + _ + it))) + on_globals (is (-> (PList Global) (PList Global)) + (plist.revised context on_global)) + on_module (is (-> Module Module) + (revised .#definitions on_globals))] + {.#Right [(revised .#modules (plist.revised @ on_module) lux) + []]}))) + +(.def (push' _ top) + (All (_ a) (-> (Stack a) a Symbol (Meta Any))) + (alter (function (_ [exported? type stack]) + (|> stack + (as (Stack Any)) + {.#Item top} + (is (Stack Any)) + [exported? type])))) + +(.def .public push + (syntax (_ [g!context (at ?.monad each code.symbol ?code.global) + g!it ?code.any]) + (in (list (` ((~! ..push') (~ g!context) (~ g!it) (.symbol (~ g!context)))))))) + +(.def pop' + (-> Symbol (Meta Any)) + (alter (function (_ [exported? type value]) + [exported? type (let [value (as (Stack Any) value)] + (maybe.else value (list.tail value)))]))) + +(.def .public pop + (syntax (_ [expression? ?code.bit + context ?code.global]) + (do meta.monad + [_ (..pop' context)] + (in (if expression? + (list (' [])) + (list)))))) + +(.def .public def + (syntax (_ [.let [! ?.monad + ?local (at ! each code.local ?code.local)] + [$ g!expression g!declaration] (?code.tuple (all ?.and ?code.local ?local ?local)) + context_type ?code.any]) + (do [! meta.monad] + [@ meta.current_module_name + .let [g!context (code.symbol [@ $])]] + (//.with_symbols [g!it g!body g!_] + (in (list (` (.def (~ (code.local $)) + (..Stack (~ context_type)) + (list))) + (` (.def ((~ g!expression) (~ g!it) (~ g!body)) + (-> (~ context_type) Code (Meta Code)) + ((~! do) (~! meta.monad) + [(~ g!_) ((~! ..push) (~ g!context) (~ g!it))] + ((~' in) (` (let [((~' ~') (~ g!body)) ((~' ~) (~ g!body)) + ((~' ~') (~ g!_)) ((~! ..pop) #1 (~ g!context))] + ((~' ~') (~ g!body)))))))) + (` (.def ((~ g!declaration) (~ g!it) (~ g!body)) + (-> (~ context_type) Code (Meta (List Code))) + ((~! do) (~! meta.monad) + [(~ g!_) ((~! ..push) (~ g!context) (~ g!it))] + ((~' in) (list (~ g!body) + (` ((~! ..pop) #0 (~ g!context)))))))) + )))))) diff --git a/stdlib/source/library/lux/meta.lux b/stdlib/source/library/lux/meta.lux index 6987ae558..cc3aa9036 100644 --- a/stdlib/source/library/lux/meta.lux +++ b/stdlib/source/library/lux/meta.lux @@ -36,11 +36,11 @@ (def (each f fa) (function (_ lux) (case (fa lux) - {try.#Failure msg} - {try.#Failure msg} - {try.#Success [lux' a]} - {try.#Success [lux' (f a)]}))))) + {try.#Success [lux' (f a)]} + + {try.#Failure msg} + {try.#Failure msg}))))) (def .public apply (Apply Meta) @@ -73,11 +73,11 @@ (def (conjoint mma) (function (_ lux) (case (mma lux) - {try.#Failure msg} - {try.#Failure msg} - {try.#Success [lux' ma]} - (ma lux')))))) + (ma lux') + + {try.#Failure msg} + {try.#Failure msg}))))) (def .public (result' lux action) (All (_ a) (-> Lux (Meta a) (Try [Lux a]))) @@ -86,21 +86,21 @@ (def .public (result lux action) (All (_ a) (-> Lux (Meta a) (Try a))) (case (action lux) - {try.#Failure error} - {try.#Failure error} - {try.#Success [_ output]} - {try.#Success output})) + {try.#Success output} + + {try.#Failure error} + {try.#Failure error})) (def .public (either left right) (All (_ a) (-> (Meta a) (Meta a) (Meta a))) (function (_ lux) (case (left lux) - {try.#Failure error} - (right lux) - {try.#Success [lux' output]} - {try.#Success [lux' output]}))) + {try.#Success [lux' output]} + + {try.#Failure error} + (right lux)))) (def .public (assertion message test) (-> Text Bit (Meta Any)) @@ -170,9 +170,6 @@ (function (_ lux) {try.#Success [lux (case (..current_module_name lux) - {try.#Failure error} - {.#None} - {try.#Success [_ this_module]} (let [modules (the .#modules lux)] (loop (again [module module @@ -200,7 +197,10 @@ {.#None} {.#Slot _} - {.#None})))))]})))) + {.#None})))) + + {try.#Failure error} + {.#None})]})))) (def .public seed (Meta Nat) @@ -456,11 +456,11 @@ (-> Text (Meta (List [Text Global]))) (function (_ lux) (case (plist.value module (the .#modules lux)) - {.#None} - {try.#Failure (all text#composite "Unknown module: " module)} - {.#Some module} - {try.#Success [lux (the .#definitions module)]}))) + {try.#Success [lux (the .#definitions module)]} + + {.#None} + {try.#Failure (all text#composite "Unknown module: " module)}))) (def .public (definitions module) (-> Text (Meta (List [Text Definition]))) @@ -600,15 +600,15 @@ (Meta (List (List [Text Type]))) (function (_ lux) (case (list.inits (the .#scopes lux)) - {.#None} - {try.#Failure "No local environment"} - {.#Some scopes} {try.#Success [lux (list#each (|>> (the [.#locals .#mappings]) (list#each (function (_ [name [type _]]) [name type]))) - scopes)]}))) + scopes)]} + + {.#None} + {try.#Failure "No local environment"}))) (def .public (de_aliased def_name) (-> Symbol (Meta Symbol)) diff --git a/stdlib/source/library/lux/type/primitive.lux b/stdlib/source/library/lux/type/primitive.lux index 52655b950..0bddb9c84 100644 --- a/stdlib/source/library/lux/type/primitive.lux +++ b/stdlib/source/library/lux/type/primitive.lux @@ -3,39 +3,25 @@ [lux (.except) ["[0]" meta] [abstract - [monad (.only Monad do)]] + [monad (.only do)]] [control ["[0]" exception (.only exception:)] ["<>" parser (.use "[1]#[0]" monad) ["<[0]>" code (.only Parser)]]] [data - ["[0]" text (.use "[1]#[0]" equivalence monoid)] + ["[0]" text (.use "[1]#[0]" equivalence)] [collection - ["[0]" list (.use "[1]#[0]" functor monoid)]]] - [macro + ["[0]" list (.use "[1]#[0]" functor)]]] + ["[0]" macro (.only) ["^" pattern] ["[0]" code] + ["[0]" context] [syntax (.only syntax) ["|[0]|" export]]] [meta ["[0]" symbol (.use "[1]#[0]" codec)]]]] ["[0]" //]) -(type: Stack - List) - -(def peek - (All (_ a) (-> (Stack a) (Maybe a))) - list.head) - -(def (push value stack) - (All (_ a) (-> a (Stack a) (Stack a))) - {.#Item value stack}) - -(def pop - (All (_ a) (-> (Stack a) (Maybe (Stack a)))) - list.tail) - (type: .public Frame (Record [#name Text @@ -43,144 +29,15 @@ #abstraction Code #representation Code])) -(def frames - (Stack Frame) - {.#End}) - -(def !peek - (template (_ ) - [(loop (again [entries ]) - (case entries - {.#Item [head_name head] tail} - (if (text#= head_name) - - (again tail)) - - {.#End} - (undefined)))])) - -(def (peek_frames_definition reference source) - (-> Text (List [Text Global]) (Stack Frame)) - (!peek source reference - (case head - {.#Definition [exported? frame_type frame_value]} - (as (Stack Frame) frame_value) +(context.def [frames expression declaration] Frame) - (^.or {.#Type _} - {.#Alias _} - {.#Tag _} - {.#Slot _}) - (undefined)))) - -(def (peek_frames reference definition_reference source) - (-> Text Text (List [Text Module]) (Stack Frame)) - (!peek source reference - (peek_frames_definition definition_reference (the .#definitions head)))) - -(exception: .public no_active_frames) - -(def (peek! frame) - (-> (Maybe Text) (Meta Frame)) - (function (_ compiler) - (let [[reference definition_reference] (symbol ..frames) - current_frames (peek_frames reference definition_reference (the .#modules compiler))] - (case (case frame - {.#Some frame} - (list.example (function (_ [actual _]) - (text#= frame actual)) - current_frames) - - {.#None} - (..peek current_frames)) - {.#Some frame} - {.#Right [compiler frame]} - - {.#None} - (exception.except ..no_active_frames []))))) - -(def .public current +(.def .public current (Meta Frame) - (..peek! {.#None})) + (context.peek ..frames)) -(def .public (specific name) +(.def .public (specific name) (-> Text (Meta Frame)) - (..peek! {.#Some name})) - -(def !push - (template (_ ) - [(loop (again [entries ]) - (case entries - {.#Item [head_name head] tail} - (if (text#= head_name) - {.#Item [head_name ] - tail} - {.#Item [head_name head] - (again tail)}) - - {.#End} - (undefined)))])) - -(def (push_frame_definition reference frame source) - (-> Text Frame (List [Text Global]) (List [Text Global])) - (!push source reference - (case head - {.#Definition [exported? frames_type frames_value]} - {.#Definition [exported? - frames_type - (..push frame (as (Stack Frame) frames_value))]} - - (^.or {.#Type _} - {.#Alias _} - {.#Tag _} - {.#Slot _}) - (undefined)))) - -(def (push_frame [module_reference definition_reference] frame source) - (-> Symbol Frame (List [Text Module]) (List [Text Module])) - (!push source module_reference - (revised .#definitions (push_frame_definition definition_reference frame) head))) - -(def (push! frame) - (-> Frame (Meta Any)) - (function (_ compiler) - {.#Right [(revised .#modules - (..push_frame (symbol ..frames) frame) - compiler) - []]})) - -(def (pop_frame_definition reference source) - (-> Text (List [Text Global]) (List [Text Global])) - (!push source reference - (case head - {.#Definition [exported? frames_type frames_value]} - {.#Definition [exported? - frames_type - (let [current_frames (as (Stack Frame) frames_value)] - (case (..pop current_frames) - {.#Some current_frames'} - current_frames' - - {.#None} - current_frames))]} - - (^.or {.#Type _} - {.#Alias _} - {.#Tag _} - {.#Slot _}) - (undefined)))) - -(def (pop_frame [module_reference definition_reference] source) - (-> Symbol (List [Text Module]) (List [Text Module])) - (!push source module_reference - (|> head (revised .#definitions (pop_frame_definition definition_reference))))) - -(def pop! - (syntax (_ []) - (function (_ compiler) - {.#Right [(revised .#modules - (..pop_frame (symbol ..frames)) - compiler) - (list)]}))) + (context.search ..frames (|>> (the #name) (text#= name)))) (def cast (Parser [(Maybe Text) Code]) @@ -191,7 +48,12 @@ [(def .public (syntax (_ [[frame value] ..cast]) (do meta.monad - [[name type_vars abstraction representation] (peek! frame)] + [[name type_vars abstraction representation] (case frame + {.#Some frame} + (..specific frame) + + {.#None} + ..current)] (in (list (` ((~! //.as) [(~+ type_vars)] (~ ) (~ ) (~ value))))))))] @@ -199,17 +61,7 @@ [representation abstraction representation] ) -(def abstraction_type_name - (-> Symbol Text) - symbol#encoded) - -(def representation_definition_name - (-> Text Text) - (|>> (all text#composite - (symbol#encoded (symbol ..#Representation)) - " "))) - -(def declaration +(def declarationP (Parser [Text (List Text)]) (<>.either (.form (<>.and .local (<>.some .local))) (<>.and .local (at <>.monad in (list))))) @@ -218,7 +70,7 @@ (Parser [Code [Text (List Text)] Code (List Code)]) (|export|.parser (all <>.and - ..declaration + ..declarationP .any (<>.some .any) ))) @@ -230,40 +82,25 @@ ..abstract]) (do meta.monad [current_module meta.current_module_name + g!Representation (macro.symbol "Representation") .let [type_varsC (list#each code.local type_vars) abstraction_declaration (` ((~ (code.local name)) (~+ type_varsC))) - representation_declaration (` ((~ (code.local (representation_definition_name name))) - (~+ type_varsC)))] - _ (..push! [name - type_varsC - abstraction_declaration - representation_declaration])] - (in (list.partial (` (type: (~ export_policy) (~ abstraction_declaration) - (Primitive (~ (code.text (abstraction_type_name [current_module name]))) - [(~+ type_varsC)]))) - (` (type: (~ representation_declaration) - (~ representation_type))) - (all list#composite - primitives - (list (` ((~! ..pop!)))))))))) - -(type: (Selection a) - (Variant - {#Specific Code a} - {#Current a})) - -(def (selection parser) - (All (_ a) (-> (Parser a) (Parser (Selection a)))) - (<>.or (<>.and .any parser) - parser)) + representation_declaration (` ((~ g!Representation) (~+ type_varsC)))]] + (..declaration [name type_varsC abstraction_declaration representation_declaration] + (` (.these (type: (~ export_policy) (~ abstraction_declaration) + (Primitive (~ (code.text (symbol#encoded [current_module name]))) + [(~+ type_varsC)])) + (type: (~ representation_declaration) + (~ representation_type)) + (~+ primitives))))))) + +(def selection + (Parser [(List Code) Code]) + (<>.either (<>.and (<>#each (|>> list) .any) .any) + (<>.and (<>#in (list)) .any))) (def .public transmutation - (syntax (_ [selection (..selection .any)]) - (case selection - {#Specific specific value} - (in (list (` (.|> (~ value) - (..representation (~ specific)) - (..abstraction (~ specific)))))) - - {#Current value} - (in (list (` (.|> (~ value) ..representation ..abstraction))))))) + (syntax (_ [[specific value] ..selection]) + (in (list (` (.|> (~ value) + (..representation (~+ specific)) + (..abstraction (~+ specific)))))))) diff --git a/stdlib/source/test/lux/macro.lux b/stdlib/source/test/lux/macro.lux index 445792fb6..9368e2a0f 100644 --- a/stdlib/source/test/lux/macro.lux +++ b/stdlib/source/test/lux/macro.lux @@ -34,7 +34,8 @@ ["[1][0]" local] ["[1][0]" syntax] ["[1][0]" template] - ["[1][0]" pattern]]) + ["[1][0]" pattern] + ["[1][0]" context]]) (def !expect (template (_ ) @@ -248,4 +249,5 @@ /syntax.test /template.test /pattern.test + /context.test ))) diff --git a/stdlib/source/test/lux/macro/context.lux b/stdlib/source/test/lux/macro/context.lux new file mode 100644 index 000000000..52df97710 --- /dev/null +++ b/stdlib/source/test/lux/macro/context.lux @@ -0,0 +1,12 @@ +(.require + [library + [lux (.except) + ["_" test (.only Test)]]] + [\\library + ["[0]" /]]) + +(def .public test + Test + (<| (_.covering /._) + (_.property "TBD" false) + )) diff --git a/stdlib/source/test/lux/type/primitive.lux b/stdlib/source/test/lux/type/primitive.lux index dfd3aa939..619b2b3f9 100644 --- a/stdlib/source/test/lux/type/primitive.lux +++ b/stdlib/source/test/lux/type/primitive.lux @@ -35,72 +35,56 @@ [specific (/.specific (template.text [g!Foo]))] ) - (def with_no_active_frames - (syntax (_ [macro .any]) - (function (_ compiler) - (let [verdict (case ((macro.expansion macro) compiler) - {try.#Failure error} - (exception.match? /.no_active_frames error) - - {try.#Success _} - false)] - {try.#Success [compiler (list (code.bit verdict))]})))) + (/.primitive (g!Foo a) + Text - (with_expansions [no_current! (..with_no_active_frames (..current)) - no_specific! (..with_no_active_frames (..specific))] - (/.primitive (g!Foo a) - Text + (/.primitive (g!Bar a) + Nat - (/.primitive (g!Bar a) - Nat - - (def .public test - Test - (<| (_.covering /._) - (_.for [/.primitive]) - (do random.monad - [expected_foo (random.lower_case 5) - expected_bar random.nat] - (all _.and - (_.coverage [/.abstraction] - (and (exec (is (g!Foo Text) - (/.abstraction g!Foo expected_foo)) - true) - (exec (is (g!Bar Text) - (/.abstraction expected_bar)) - true))) - (_.coverage [/.representation] - (and (|> expected_foo - (/.abstraction g!Foo) - (is (g!Foo Bit)) - (/.representation g!Foo) - (text#= expected_foo)) - (|> (/.abstraction expected_bar) - (is (g!Bar Bit)) - /.representation - (n.= expected_bar)))) - (_.coverage [/.transmutation] - (and (exec (|> expected_foo - (/.abstraction g!Foo) - (is (g!Foo .Macro)) - (/.transmutation g!Foo) - (is (g!Foo .Lux))) - true) - (exec (|> (/.abstraction expected_bar) - (is (g!Bar .Macro)) - /.transmutation - (is (g!Bar .Lux))) - true))) - (_.for [/.Frame] - (all _.and - (_.coverage [/.current] - (text#= (template.text [g!Bar]) - (..current))) - (_.coverage [/.specific] - (text#= (template.text [g!Foo]) - (..specific))) - (_.coverage [/.no_active_frames] - (and no_current! - no_specific!)) - )) - ))))))))) + (def .public test + Test + (<| (_.covering /._) + (_.for [/.primitive]) + (do random.monad + [expected_foo (random.lower_case 5) + expected_bar random.nat] + (all _.and + (_.coverage [/.abstraction] + (and (exec (is (g!Foo Text) + (/.abstraction g!Foo expected_foo)) + true) + (exec (is (g!Bar Text) + (/.abstraction expected_bar)) + true))) + (_.coverage [/.representation] + (and (|> expected_foo + (/.abstraction g!Foo) + (is (g!Foo Bit)) + (/.representation g!Foo) + (text#= expected_foo)) + (|> (/.abstraction expected_bar) + (is (g!Bar Bit)) + /.representation + (n.= expected_bar)))) + (_.coverage [/.transmutation] + (and (exec (|> expected_foo + (/.abstraction g!Foo) + (is (g!Foo .Macro)) + (/.transmutation g!Foo) + (is (g!Foo .Lux))) + true) + (exec (|> (/.abstraction expected_bar) + (is (g!Bar .Macro)) + /.transmutation + (is (g!Bar .Lux))) + true))) + (_.for [/.Frame] + (all _.and + (_.coverage [/.current] + (text#= (template.text [g!Bar]) + (..current))) + (_.coverage [/.specific] + (text#= (template.text [g!Foo]) + (..specific))) + )) + )))))))) -- cgit v1.2.3