Added functions with named parameters.

9 files changed, 297 insertions, 22 deletions

diff --git a/stdlib/source/library/lux/control/function/named.lux b/stdlib/source/library/lux/control/function/named.lux
new file mode 100644
index 000000000..eeade0ed5
--- /dev/null
+++ b/stdlib/source/library/lux/control/function/named.lux
@@ -0,0 +1,76 @@
+... https://en.wikipedia.org/wiki/Named_parameter
+(.require
+ [library
+  [lux (.except def)
+   [abstract
+    ["[0]" monad (.only do)]]
+   [control
+    ["?" parser]
+    ["[0]" maybe]
+    ["[0]" exception (.only Exception)]]
+   [data
+    ["[0]" text (.only)
+     ["%" \\format]]
+    [collection
+     ["[0]" list (.use "[1]#[0]" monad)]
+     ["[0]" set]
+     ["[0]" dictionary]]]
+   [math
+    [number
+     ["n" nat]]]
+   ["[0]" meta (.only)
+    ["[0]" code (.only)
+     ["?[1]" \\parser]]
+    [macro (.only with_symbols)
+     [syntax (.only syntax)
+      ["[0]" export]]]]]])
+
+(exception.def .public (duplicate_parameters [definition parameters])
+  (Exception [Symbol (List Text)])
+  (exception.report
+   (list ["Definition" (%.symbol definition)]
+         ["Parameters" (%.list %.text parameters)])))
+
+(exception.def .public (invalid_parameters [definition expected actual])
+  (Exception [Symbol (List Text) (List Text)])
+  (exception.report
+   (list ["Definition" (%.symbol definition)]
+         ["Expected" (%.list %.text expected)]
+         ["Actual" (%.list %.text actual)])))
+
+(.def .public def
+  (syntax (_ [[exported? [name parameters] type body]
+              (export.parser (all ?.and
+                                  (?code.form (?.and ?code.local (?.some ?code.local)))
+                                  ?code.any
+                                  ?code.any))])
+    (do meta.monad
+      [here meta.current_module_name]
+      (if (n.= (list.size parameters)
+               (set.size (set.of_list text.hash parameters)))
+        (with_symbols [g!function g!parameters g!_ g!it]
+          (with_expansions [<invalid_parameters> (meta.failure (exception.error ..invalid_parameters [(symbol (, (code.symbol [here name])))
+                                                                                                      (list (,* (list#each code.text parameters)))
+                                                                                                      (dictionary.keys (, g!parameters))]))]
+            (in (list (` (.def (, exported?) ((, g!function) (,* (list#each code.local parameters)))
+                           (, type)
+                           (, body)))
+                      (` (.def (, exported?) (, (code.local name))
+                           (syntax ((, (code.local name)) [(, g!parameters) (?.some (?.and ?code.local ?code.any))])
+                             (let [(, g!parameters) (dictionary.of_list text.hash (, g!parameters))]
+                               (when (dictionary.size (, g!parameters))
+                                 (, (code.nat (list.size parameters)))
+                                 (when (monad.each maybe.monad
+                                                   (function ((, g!_) (, g!it))
+                                                     (dictionary.value (, g!it) (, g!parameters)))
+                                                   (list (,* (list#each code.text parameters))))
+                                   {.#Some (, g!parameters)}
+                                   (at meta.monad (,' in)
+                                       (list (` ((, g!function) ((,' .,*) (, g!parameters))))))
+                                   
+                                   {.#None}
+                                   <invalid_parameters>)
+
+                                 (, g!_)
+                                 <invalid_parameters>)))))))))
+        (meta.failure (exception.error ..duplicate_parameters [[here name] parameters]))))))
diff --git a/stdlib/source/library/lux/meta/macro/context.lux b/stdlib/source/library/lux/meta/macro/context.lux
index dc2911506..9db9ef978 100644
--- a/stdlib/source/library/lux/meta/macro/context.lux
+++ b/stdlib/source/library/lux/meta/macro/context.lux
@@ -24,7 +24,7 @@
 (type .public Stack
   List)
 
-(exception.def .public (no_definition it)
+(exception.def (no_definition it)
   (Exception Symbol)
   (exception.report
    (list ["Definition" (symbol#encoded it)])))
@@ -66,8 +66,8 @@
 
 (exception.def .public no_example)
 
-(.def .public (search' _ ? context)
-  (All (_ a) (-> (Stack a) (Predicate a) Symbol (Meta a)))
+(.def .public (search' ? _ context)
+  (All (_ a) (-> (Predicate a) (Stack a) Symbol (Meta a)))
   (do meta.monad
     [stack (..global context)]
     (when (|> stack
@@ -80,9 +80,9 @@
       (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))))))))
+  (syntax (_ [g!? ?code.any
+              g!context (at ?.monad each code.symbol ?code.global)])
+    (in (list (` (..search' (, g!?) (, g!context) (.symbol (, g!context))))))))
 
 (.def (alter on_definition [@ context])
   (-> (-> Definition Definition) Symbol (Meta Any))
@@ -102,8 +102,8 @@
       {.#Right [(revised .#modules (property.revised @ on_module) lux)
                 []]})))
 
-(.def .public (push' _ top)
-  (All (_ a) (-> (Stack a) a Symbol (Meta Any)))
+(.def .public (push' top _)
+  (All (_ a) (-> a (Stack a) Symbol (Meta Any)))
   (alter (function (_ [exported? type stack])
            (|> stack
                (as (Stack Any))
@@ -112,25 +112,29 @@
                [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))))))))
+  (syntax (_ [g!it ?code.any
+              g!context (at ?.monad each code.symbol ?code.global)])
+    (in (list (` (..push' (, g!it) (, g!context) (.symbol (, g!context))))))))
 
-(.def pop'
+(.def .public 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
+(.def .public pop'
   (syntax (_ [expression? ?code.bit
               context ?code.global])
     (do meta.monad
-      [_ (..pop' context)]
+      [_ (..pop'' context)]
       (in (if expression?
             (list (' []))
             (list))))))
 
+(.def .public pop
+  (syntax (_ [g!context (at ?.monad each code.symbol ?code.global)])
+    (in (list (` (..pop'' (.symbol (, g!context))))))))
+
 (.def .public def
   (syntax (_ [.let [! ?.monad
                     ?local (at ! each code.local ?code.local)]
@@ -146,14 +150,14 @@
                   (` (.def ((, g!expression) (, g!it) (, g!body))
                        (-> (, context_type) Code (Meta Code))
                        (do meta.monad
-                         [(, g!_) (..push (, g!context) (, g!it))]
+                         [(, g!_) (..push (, g!it) (, g!context))]
                          ((,' in) (` (let [((,' ,') (, g!body)) ((,' ,) (, g!body))
-                                           ((,' ,') (, g!_)) (..pop #1 (, g!context))]
+                                           ((,' ,') (, 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))]
+                         [(, g!_) (..push (, g!it) (, g!context))]
                          ((,' in) (list (, g!body)
-                                        (` (..pop #0 (, g!context))))))))
+                                        (` (..pop' #0 (, g!context))))))))
                   ))))))
diff --git a/stdlib/source/library/lux/meta/static.lux b/stdlib/source/library/lux/meta/static.lux
index 9a8d25cfe..3b2fd8065 100644
--- a/stdlib/source/library/lux/meta/static.lux
+++ b/stdlib/source/library/lux/meta/static.lux
@@ -48,6 +48,13 @@
          .let [[format expression] (as <type> pair)]]
         (in (list (format expression)))))))
 
+(with_expansions [<type> (Meta (List Code))]
+  (def .public expansion
+    (syntax (_ [expression <code>.any])
+      (do meta.monad
+        [expression (meta.eval (.type_literal <type>) expression)]
+        (as <type> expression)))))
+
 (with_expansions [<type> (Ex (_ a)
                            [(-> a Code)
                             (List a)])]
diff --git a/stdlib/source/library/lux/meta/type/primitive.lux b/stdlib/source/library/lux/meta/type/primitive.lux
index 8c6b0a98e..5f7269bca 100644
--- a/stdlib/source/library/lux/meta/type/primitive.lux
+++ b/stdlib/source/library/lux/meta/type/primitive.lux
@@ -35,7 +35,7 @@
 
 (.def .public (specific name)
   (-> Text (Meta Frame))
-  (context.search ..frames (|>> (the #name) (text#= name))))
+  (context.search (|>> (the #name) (text#= name)) ..frames))
 
 (def cast
   (Parser [(Maybe Text) Code])
diff --git a/stdlib/source/library/lux/world/time/instant.lux b/stdlib/source/library/lux/world/time/instant.lux
index 55bb1eae8..db4d3ffa6 100644
--- a/stdlib/source/library/lux/world/time/instant.lux
+++ b/stdlib/source/library/lux/world/time/instant.lux
@@ -6,7 +6,8 @@
     [order (.only Order)]
     [enum (.only Enum)]
     [codec (.only Codec)]
-    [monad (.only Monad do)]]
+    [monad (.only Monad do)]
+    [hash (.only Hash)]]
    [control
     [io (.only IO io)]
     ["<>" parser (.only)]
@@ -70,6 +71,13 @@
      (def (< param subject)
        (at i.order < (representation param) (representation subject)))))
 
+  (def .public hash
+    (Hash Instant)
+    (implementation
+     (def equivalence ..equivalence)
+     (def hash
+       (|>> representation (at i.hash hash)))))
+
   (`` (def .public enum
         (Enum Instant)
         (implementation
diff --git a/stdlib/source/test/lux/control/function.lux b/stdlib/source/test/lux/control/function.lux
index b3e79f47d..a2ac4a355 100644
--- a/stdlib/source/test/lux/control/function.lux
+++ b/stdlib/source/test/lux/control/function.lux
@@ -21,7 +21,8 @@
   ["[1][0]" mutual]
   ["[1][0]" inline]
   ["[1][0]" predicate]
-  ["[1][0]" variadic]])
+  ["[1][0]" variadic]
+  ["[1][0]" named]])
 
 (def .public test
   Test
@@ -69,4 +70,5 @@
              /inline.test
              /predicate.test
              /variadic.test
+             /named.test
              ))))
diff --git a/stdlib/source/test/lux/control/function/named.lux b/stdlib/source/test/lux/control/function/named.lux
new file mode 100644
index 000000000..064e2e8ab
--- /dev/null
+++ b/stdlib/source/test/lux/control/function/named.lux
@@ -0,0 +1,73 @@
+(.require
+ [library
+  [lux (.except)
+   [abstract
+    [monad (.only do)]]
+   [control
+    ["[0]" try]
+    ["[0]" exception]]
+   [data
+    ["[0]" text]]
+   [math
+    ["[0]" random]
+    [number
+     ["n" nat]]]
+   [meta
+    ["[0]" code (.only)
+     ["<[1]>" \\parser]]
+    [macro
+     [syntax (.only syntax)]
+     ["[0]" expansion]]]
+   [test
+    ["_" property (.only Test)]]]]
+ [\\library
+  ["[0]" /]])
+
+(def macro_error
+  (syntax (_ [macro <code>.any])
+    (function (_ compiler)
+      (when ((expansion.complete macro) compiler)
+        {try.#Failure error}
+        {try.#Success [compiler (list (code.text error))]}
+        
+        {try.#Success _}
+        {try.#Failure "OOPS!"}))))
+
+(/.def (+ left right)
+  (-> Nat Nat Nat)
+  (n.+ left right))
+
+(def .public test
+  Test
+  (do [! random.monad]
+    [p0 random.nat
+     p1 random.nat]
+    (<| (_.covering /._)
+        (all _.and
+             (_.coverage [/.def]
+               (n.= (n.+ p0 p1)
+                    (+ left p0
+                       right p1)))
+             (_.coverage [/.duplicate_parameters]
+               (text.contains? (the exception.#label /.duplicate_parameters)
+                               (macro_error
+                                (/.def .public (- _ _)
+                                  (-> Nat (List Nat) Nat)
+                                  (undefined)))))
+             (_.coverage [/.invalid_parameters]
+               (and (text.contains? (the exception.#label /.invalid_parameters)
+                                    (macro_error
+                                     (+ left p0)))
+                    (text.contains? (the exception.#label /.invalid_parameters)
+                                    (macro_error
+                                     (+ right p1)))
+                    (text.contains? (the exception.#label /.invalid_parameters)
+                                    (macro_error
+                                     (+ left p0
+                                        right p1
+                                        yolo p0)))
+                    (text.contains? (the exception.#label /.invalid_parameters)
+                                    (macro_error
+                                     (+ left p0
+                                        yolo p0)))))
+             ))))
diff --git a/stdlib/source/test/lux/meta/macro.lux b/stdlib/source/test/lux/meta/macro.lux
index b2b7e0eda..270040d6d 100644
--- a/stdlib/source/test/lux/meta/macro.lux
+++ b/stdlib/source/test/lux/meta/macro.lux
@@ -30,6 +30,7 @@
    ["[0]" template]
    ["[0]" expansion]]]
  ["[0]" /
+  ["[1][0]" context]
   ["[1][0]" local]
   ["[1][0]" syntax]
   ["[1][0]" template]
@@ -247,7 +248,8 @@
                   ))
 
            ..test|expansion
-           
+
+           /context.test
            /local.test
            /syntax.test
            /template.test
diff --git a/stdlib/source/test/lux/meta/macro/context.lux b/stdlib/source/test/lux/meta/macro/context.lux
new file mode 100644
index 000000000..cbcdf60e0
--- /dev/null
+++ b/stdlib/source/test/lux/meta/macro/context.lux
@@ -0,0 +1,103 @@
+(.require
+ [library
+  [lux (.except)
+   [abstract
+    [monad (.only do)]]
+   [control
+    ["[0]" try]
+    ["[0]" exception]]
+   [data
+    ["[0]" text (.only)
+     ["%" \\format]]]
+   [math
+    [number
+     ["n" nat]]]
+   ["[0]" meta (.only)
+    ["[0]" static]
+    ["[0]" code (.only)
+     ["<[1]>" \\parser]]
+    [macro
+     [syntax (.only syntax)]
+     ["[0]" expansion]]]
+   [test
+    ["_" property (.only Test)]]]]
+ [\\library
+  ["[0]" /]])
+
+(def macro_error
+  (syntax (_ [macro <code>.any])
+    (function (_ compiler)
+      (when ((expansion.complete macro) compiler)
+        {try.#Failure error}
+        {try.#Success [compiler (list (code.text error))]}
+        
+        {try.#Success _}
+        {try.#Failure "OOPS!"}))))
+
+(/.def [stack expression declaration] Nat)
+
+(with_expansions [<top> (static.random_nat)]
+  (<| static.expansion
+      (declaration <top>)
+      (` (def (,' declaration!) true))))
+
+(def .public test
+  Test
+  (<| (_.covering /._)
+      (all _.and
+           (_.coverage [/.def]
+             (and declaration!
+                  (with_expansions [<top> (static.random_nat)]
+                    (<| static.expansion
+                        (do meta.monad
+                          [it (expression <top> (` true))]
+                          (in (list it)))))))
+           (_.coverage [/.peek /.peek'
+                        /.push /.push']
+             (with_expansions [<expected> (static.random_nat)]
+               (n.= <expected>
+                    (<| static.expansion
+                        (do meta.monad
+                          [_ (/.push <expected> ..stack)
+                           actual (/.peek ..stack)
+                           _ (/.pop ..stack)]
+                          (in (list (code.nat actual))))))))
+           (_.coverage [/.no_active_context]
+             (<| (text.contains? (the exception.#label /.no_active_context))
+                 macro_error
+                 static.expansion
+                 (do meta.monad
+                   [top (/.peek ..stack)]
+                   (in (list (code.nat top))))))
+           (_.coverage [/.pop /.pop' /.pop'']
+             (with_expansions [<dummy> (static.random_nat)
+                               <expected> (static.nat (++ <dummy>))]
+               (n.= <expected>
+                    (<| static.expansion
+                        (do meta.monad
+                          [_ (/.push <dummy> ..stack)
+                           _ (/.pop ..stack)
+                           _ (/.push <expected> ..stack)
+                           actual (/.peek ..stack)
+                           _ (/.pop ..stack)]
+                          (in (list (code.nat actual))))))))
+           (_.coverage [/.search /.search']
+             (with_expansions [<expected> (static.random_nat)]
+               (n.= <expected>
+                    (<| static.expansion
+                        (do meta.monad
+                          [_ (/.push <expected> ..stack)
+                           actual (/.search (n.= <expected>) ..stack)
+                           _ (/.pop ..stack)]
+                          (in (list (code.nat actual))))))))
+           (_.coverage [/.no_example]
+             (with_expansions [<expected> (static.random_nat)]
+               (<| (text.contains? (the exception.#label /.no_example))
+                   macro_error
+                   static.expansion
+                   (do meta.monad
+                     [_ (/.push <expected> ..stack)
+                      actual (/.search (|>> (n.= <expected>) not) ..stack)
+                      _ (/.pop ..stack)]
+                     (in (list (code.nat actual)))))))
+           )))