Added support for context-oriented programming.

4 files changed, 231 insertions, 17 deletions

diff --git a/stdlib/source/library/lux.lux b/stdlib/source/library/lux.lux
index d5c43cc7f..8a829ae10 100644
--- a/stdlib/source/library/lux.lux
+++ b/stdlib/source/library/lux.lux
@@ -3769,7 +3769,7 @@
           {#None}
           (failure (..wrong_syntax_error (symbol ..def))))))
 
-(with_template [<name> <form> <message>]
+(with_template [<name> <nullary> <form>]
   [(def .public <name>
      (macro (_ tokens)
        (when (list#reversed tokens)
@@ -3780,10 +3780,11 @@
                                   init)))
          
          _
-         (failure <message>))))]
+         (meta#in (list (` <nullary>))))))]
 
-  [and (if (, pre) (, post) #0) "'and' requires >=1 clauses."]
-  [or  (if (, pre) #1 (, post)) "'or' requires >=1 clauses."])
+  [and #1 (if (, pre) (, post) #0)]
+  [or  #0 (if (, pre) #1 (, post))]
+  )
 
 (def (index part text)
   (-> Text Text (Maybe Nat))
diff --git a/stdlib/source/library/lux/control/function/polymorphism/context.lux b/stdlib/source/library/lux/control/function/polymorphism/context.lux
new file mode 100644
index 000000000..ee47ece31
--- /dev/null
+++ b/stdlib/source/library/lux/control/function/polymorphism/context.lux
@@ -0,0 +1,203 @@
+(.require
+ [library
+  [lux (.except def with)
+   [abstract
+    [monad (.only do)]
+    ["[0]" hash]]
+   [control
+    [reader (.only Reader)]
+    ["?" parser (.use "[1]#[0]" monad)]
+    [function
+     ["[0]" predicate (.only Predicate)]]]
+   [data
+    ["[0]" product]
+    ["[0]" text (.use "[1]#[0]" equivalence)]
+    [collection
+     ["[0]" set (.only Set)]
+     ["[0]" list (.use "[1]#[0]" functor)]]]
+   ["[0]" meta (.only)
+    ["[0]" symbol]
+    ["[0]" static]
+    ["[0]" code (.only)
+     ["?[1]" \\parser (.only Parser)]]
+    ["[0]" macro (.only with_symbols)
+     ["[0]" context]
+     [syntax (.only syntax)
+      ["[0]" export]]]
+    [type
+     [primitive (.except #name)]]]]]
+ [///
+  ["//" mixin]])
+
+(.def .public (altered alteration scope)
+  (All (_ context value)
+    (-> (-> context context) (Reader context value)
+        (Reader context value)))
+  (function (_ context)
+    (scope (alteration context))))
+
+(with_expansions [<representation> Symbol]
+  (primitive .public Layer
+    <representation>
+
+    (.def .public layer
+      (syntax (_ [[export_policy name] (export.parser ?code.local)])
+        (do meta.monad
+          [@ meta.current_module_name]
+          (in (list (` (.def (, export_policy) (, (code.local name))
+                         Layer
+                         (<| (as Layer)
+                             (is <representation>)
+                             [(, (code.text @))
+                              (, (code.text name))]))))))))
+
+    (type .public Context
+      (Set Layer))
+
+    (.def .public empty
+      Context
+      (set.empty (at hash.functor each (|>> representation) symbol.hash)))
+    ))
+
+(with_template [<name> <change>]
+  [(.def .public (<name> layer scope)
+     (All (_ value)
+       (-> Layer (Reader Context value)
+           (Reader Context value)))
+     (function (_ context)
+       (scope (<change> layer context))))]
+
+  [with set.has]
+  [without set.lacks]
+  )
+
+(.def .public (active? layer)
+  (All (_ value)
+    (-> Layer (Predicate Context)))
+  (function (_ context)
+    (set.member? context layer)))
+
+(.def .public inactive?
+  (All (_ value)
+    (-> Layer (Predicate Context)))
+  (|>> active? predicate.complement))
+
+(type Polymorphism
+  (Record
+   [#function Text
+    #quantifications (List Code)
+    #context Code
+    #inputs (List Code)
+    #output Code
+    #default Code
+    #export_policy Code
+    #scenarios (List Code)]))
+
+(context.def [stack expression declaration] Polymorphism)
+
+(type Signature
+  (Record
+   [#name Text
+    #next Text
+    #parameters (List Code)]))
+
+(.def signature
+  (Parser Signature)
+  (?code.form
+   (all ?.and
+        ?code.local
+        ?code.local
+        (?.many ?code.any))))
+
+(.def (quoted it)
+  (-> Code Code)
+  (` ((,' .,') (, it))))
+
+(.def .public def
+  (syntax (_ [[export_policy signature] (export.parser ..signature)
+              quantifications (?code.tuple (?.some ?code.any))
+              context ?code.any
+              inputs (?code.tuple (?.many ?code.any))
+              output ?code.any
+              default ?code.any
+              methods (?.some ?code.any)])
+    (<| (with_symbols [g!self g!_ g!scenarios g!scenario g!mixin])
+        (..declaration [#function (the #name signature)
+                        #quantifications quantifications
+                        #context context
+                        #inputs inputs
+                        #output output
+                        #default default
+                        #export_policy export_policy
+                        #scenarios (list)])
+        (let [name (quoted (code.local (the #name signature)))
+              next (quoted (code.local (the #next signature)))
+              parameters (list#each quoted (the #parameters signature))
+              [@ _] (symbol .._)
+
+              g!self (quoted g!self)])
+        (` (these (,* methods)
+
+                  (static.expansion
+                   (do meta.monad
+                     [[(, g!_) (, g!_) (, g!_) (, g!_) (, g!_) (, g!_) (, g!_) (, g!scenarios)]
+                      (context.search' (|>> product.left
+                                            (at text.equivalence (,' =) (, (code.text (the #name signature)))))
+                                       [("lux in-module" (, (code.text @)) ..stack)
+                                        (symbol ..stack)])]
+                     (at meta.monad (,' in)
+                         (list (` (.def (, export_policy) (, name)
+                                    (, (quoted (` (<| (,* quantifications)
+                                                      (-> (,* inputs) (Reader (, context) (, output)))))))
+                                    (let [(, (quoted g!mixin)) (is (, (quoted (` (<| (,* quantifications)
+                                                                                     (-> [(,* inputs)] (Reader (, context) (, output)))))))
+                                                                   (//.fixed (all //.mixed
+                                                                                  ((,' .,*) (, g!scenarios))
+                                                                                  (is (, (quoted (` (<| (,* quantifications)
+                                                                                                        (//.Mixin [(,* inputs)] (Reader (, context) (, output)))))))
+                                                                                      (function ((, g!self) (, next) (, name) [(,* parameters)])
+                                                                                        (, (quoted default))))
+                                                                                  )))]
+                                      (, (when (the #parameters signature)
+                                           (list _)
+                                           (quoted g!mixin)
+
+                                           _
+                                           (` (function ((, name) (,* parameters))
+                                                ((, (quoted g!mixin)) [(,* parameters)]))))))))))))
+                  )))))
+
+(.def .public method
+  (syntax (_ [signature ..signature
+              predicate ?code.any
+              body ?code.any])
+    (do [! meta.monad]
+      [.let [criterion (is (Predicate Polymorphism)
+                           (|>> (the #function)
+                                (text#= (the #name signature))))]
+       it (context.search criterion ..stack)]
+      (with_symbols [g!self g!predicate g!parameters g!context g!_ g!next g!again]
+        (do !
+          [_ (context.revised {.#Some criterion}
+                              (revised #scenarios (|>> {.#Item (` (let [(, g!predicate) (is (<| (,* (the #quantifications it))
+                                                                                                (Predicate (, (the #context it))))
+                                                                                            (, predicate))]
+                                                                    (is (<| (,* (the #quantifications it))
+                                                                            (//.Mixin [(,* (the #inputs it))]
+                                                                                      (Reader (, (the #context it))
+                                                                                              (, (the #output it)))))
+                                                                        (function ((, g!_) (, g!next) (, g!again) (, g!parameters) (, g!context))
+                                                                          (if ((, g!predicate) (, g!context))
+                                                                            ((, g!self) (, g!next) (, g!again) (, g!parameters) (, g!context))
+                                                                            ((, g!next) (, g!parameters) (, g!context)))))))}))
+                              ..stack)]
+          (in (list (` (.def (, (the #export_policy it)) (, g!self)
+                         (<| (,* (the #quantifications it))
+                             (//.Mixin [(,* (the #inputs it))]
+                                       (Reader (, (the #context it))
+                                               (, (the #output it)))))
+                         (function ((, g!self)
+                                    (, (code.local (the #next signature)))
+                                    (, (code.local (the #name signature)))
+                                    [(,* (the #parameters signature))])
+                           (, body)))))))))))
diff --git a/stdlib/source/library/lux/control/function/predicate.lux b/stdlib/source/library/lux/control/function/predicate.lux
index 131a6520f..80703dbb6 100644
--- a/stdlib/source/library/lux/control/function/predicate.lux
+++ b/stdlib/source/library/lux/control/function/predicate.lux
@@ -1,6 +1,6 @@
 (.require
  [library
-  [lux (.except all or and)
+  [lux (.except all or and not)
    [abstract
     [monoid (.only Monoid)]
     [functor
@@ -38,13 +38,17 @@
 
 (def .public (complement predicate)
   (All (_ a) (-> (Predicate a) (Predicate a)))
-  (|>> predicate not))
+  (|>> predicate .not))
+
+(def .public not
+  (All (_ a) (-> (Predicate a) (Predicate a)))
+  ..complement)
 
 (def .public (difference sub base)
   (All (_ a) (-> (Predicate a) (Predicate a) (Predicate a)))
   (function (_ value)
     (.and (base value)
-          (not (sub value)))))
+          (.not (sub value)))))
 
 (def .public (rec predicate)
   (All (_ a)
diff --git a/stdlib/source/library/lux/test/unit.lux b/stdlib/source/library/lux/test/unit.lux
index 62e075537..14b09f014 100644
--- a/stdlib/source/library/lux/test/unit.lux
+++ b/stdlib/source/library/lux/test/unit.lux
@@ -1,6 +1,7 @@
 (.require
  [library
   [lux (.except and for)
+   ["[0]" debug]
    [abstract
     [monad (.only do)]]
    [control
@@ -92,7 +93,7 @@
   (%.Format Symbol)
   (|>> %.symbol (format ..clean_up_marker)))
 
-(def .public (with_coverage coverage condition)
+(def (with_coverage coverage condition)
   (-> (List Symbol) Bit Test)
   (let [message (|> coverage
                     (list#each ..coverage_format)
@@ -109,11 +110,12 @@
     (let [coverage (list#each (function (_ definition)
                                 (` (coverage.of (, definition))))
                               coverage)]
-      (in (list (` (..with_coverage (is (.List .Symbol)
-                                        (.list (,* coverage)))
-                     (, condition))))))))
+      (in (list (` ((debug.private ..with_coverage)
+                    (is (.List .Symbol)
+                        (.list (,* coverage)))
+                    (, condition))))))))
 
-(def .public (for' coverage test)
+(def (for' coverage test)
   (-> (List Symbol) Test Test)
   (let [context (|> coverage
                     (list#each ..coverage_format)
@@ -130,11 +132,12 @@
     (let [coverage (list#each (function (_ definition)
                                 (` (coverage.of (, definition))))
                               coverage)]
-      (in (list (` (..for' (is (.List .Symbol)
-                               (.list (,* coverage)))
-                           (, test))))))))
+      (in (list (` ((debug.private ..for')
+                    (is (.List .Symbol)
+                        (.list (,* coverage)))
+                    (, test))))))))
 
-(def .public (covering' module coverage test)
+(def (covering' module coverage test)
   (-> Text Text Test Test)
   (let [coverage (coverage.decoded module coverage)]
     (|> (..context' module test)
@@ -157,4 +160,7 @@
                                         aggregate))
                                     {.#End})
                           coverage.encoded)]]
-      (in (list (` (..covering' (, (code.text module)) (, (code.text coverage)) (, test))))))))
+      (in (list (` ((debug.private ..covering')
+                    (, (code.text module))
+                    (, (code.text coverage))
+                    (, test))))))))