Place the "program:" macro of "lux/control/parser/cli" in its own module.

17 files changed, 188 insertions, 190 deletions

diff --git a/stdlib/source/lux/abstract/hash.lux b/stdlib/source/lux/abstract/hash.lux
index fabe5be6d..9a8b44dfb 100644
--- a/stdlib/source/lux/abstract/hash.lux
+++ b/stdlib/source/lux/abstract/hash.lux
@@ -1,7 +1,9 @@
 (.module:
   [lux #*]
   [//
-   [equivalence (#+ Equivalence)]])
+   ["." equivalence (#+ Equivalence)]
+   [functor
+    ["." contravariant]]])
 
 (signature: #export (Hash a)
   {#.doc (doc "A way to produce hash-codes for a type's instances."
@@ -10,3 +12,15 @@
      &equivalence)
   (: (-> a Nat)
      hash))
+
+(structure: #export functor
+  (contravariant.Functor Hash)
+  
+  (def: (map f super)
+    (structure
+     (def: &equivalence
+       (\ equivalence.functor map f
+          (\ super &equivalence)))
+     
+     (def: hash
+       (|>> f (\ super hash))))))
diff --git a/stdlib/source/lux/control/exception.lux b/stdlib/source/lux/control/exception.lux
index 161597421..63f4a0853 100644
--- a/stdlib/source/lux/control/exception.lux
+++ b/stdlib/source/lux/control/exception.lux
@@ -18,7 +18,9 @@
      ["sc" common
       ["scr" reader]
       ["scw" writer]
-      ["|.|" export]]]]
+      ["|.|" export]
+      ["." type #_
+       ["|#_.|" variable]]]]]
    [math
     [number
      ["n" nat ("#\." decimal)]]]]
@@ -86,7 +88,7 @@
     (..throw exception message)))
 
 (syntax: #export (exception: {export |export|.parser}
-                   {t_vars (p.default (list) (s.tuple scr.type_variables))}
+                   {t_vars (p.default (list) (s.tuple (p.some |type_variable|.parser)))}
                    {[name inputs] (p.either (p.and s.local_identifier (wrap (list)))
                                             (s.form (p.and s.local_identifier (p.some scr.typed_input))))}
                    {body (p.maybe s.any)})
@@ -106,7 +108,7 @@
              g!self (code.local_identifier name)]]
       (wrap (list (` (def: (~+ (|export|.write export))
                        (~ g!self)
-                       (All [(~+ (scw.type_variables t_vars))]
+                       (All [(~+ (list\map |type_variable|.format t_vars))]
                          (..Exception [(~+ (list\map (get@ #sc.input_type) inputs))]))
                        (let [(~ g!descriptor) (~ (code.text descriptor))]
                          {#..label (~ g!descriptor)
diff --git a/stdlib/source/lux/control/parser/cli.lux b/stdlib/source/lux/control/parser/cli.lux
index 7df6e448e..b39b4234c 100644
--- a/stdlib/source/lux/control/parser/cli.lux
+++ b/stdlib/source/lux/control/parser/cli.lux
@@ -1,25 +1,13 @@
 (.module:
   [lux #*
-   ["@" target]
    [abstract
     [monad (#+ do)]]
    [control
     ["." try (#+ Try)]]
    [data
-    [collection
-     ["." list ("#\." monoid monad)]]
     ["." text ("#\." equivalence)
-     ["%" format (#+ format)]]]
-   [meta (#+ with_gensyms)]
-   [macro
-    ["." code]
-    [syntax (#+ syntax:)]]]
-  ["." //
-   ["s" code]
-   [//
-    ["." io]
-    [concurrency
-     ["." thread]]]])
+     ["%" format (#+ format)]]]]
+  ["." //])
 
 (type: #export (Parser a)
   {#.doc "A command-line interface parser."}
@@ -108,73 +96,3 @@
   (|> value
       (//.after (//.either (..this short) (..this long)))
       ..somewhere))
-
-(type: Program_Args
-  (#Raw Text)
-  (#Parsed (List [Code Code])))
-
-(def: program_args^
-  (s.Parser Program_Args)
-  (//.or s.local_identifier
-         (s.tuple (//.some (//.either (do //.monad
-                                        [name s.local_identifier]
-                                        (wrap [(code.identifier ["" name]) (` any)]))
-                                      (s.record (//.and s.any s.any)))))))
-
-(syntax: #export (program:
-                   {args program_args^}
-                   body)
-  {#.doc (doc "Defines the entry-point to a program (similar to the 'main' function/method in other programming languages)."
-              "Can take a list of all the input parameters to the program, or can destructure them using CLI-option combinators from the lux/cli module."
-              (program: all_args
-                (do io.monad
-                  [foo init_program
-                   bar (do_something all_args)]
-                  (wrap [])))
-
-              (program: [name]
-                (io (log! (\ text.monoid compose "Hello, " name))))
-
-              (program: [{config config^}]
-                (do io.monad
-                  [data (init_program config)]
-                  (do_something data))))}
-  (with_gensyms [g!program g!args g!_ g!output g!message]
-    (let [initialization+event_loop
-          (` ((~! do) (~! io.monad)
-              [(~ g!output) (~ body)
-               (~+ (for {@.old
-                         (list)
-                         
-                         @.jvm
-                         (list)
-
-                         @.js
-                         (list)}
-                        (list g!_
-                              (` ((~! thread.run!) [])))))]
-              ((~' wrap) (~ g!output))))]
-      (case args
-        (#Raw args)
-        (wrap (list (` ("lux def program"
-                        (.function ((~ g!program) (~ (code.identifier ["" args])))
-                          (~ initialization+event_loop))))))
-        
-        (#Parsed args)
-        (wrap (list (` ("lux def program"
-                        (.function ((~ g!program) (~ g!args))
-                          (case ((: (~! (..Parser (io.IO .Any)))
-                                    ((~! do) (~! //.monad)
-                                     [(~+ (|> args
-                                              (list\map (function (_ [binding parser])
-                                                          (list binding parser)))
-                                              list\join))]
-                                     ((~' wrap) (~ initialization+event_loop))))
-                                 (~ g!args))
-                            (#.Right [(~ g!_) (~ g!output)])
-                            (~ g!output)
-
-                            (#.Left (~ g!message))
-                            (.error! (~ g!message))))))
-                    ))
-        ))))
diff --git a/stdlib/source/lux/locale.lux b/stdlib/source/lux/locale.lux
index 45d29b66d..38b11fd6b 100644
--- a/stdlib/source/lux/locale.lux
+++ b/stdlib/source/lux/locale.lux
@@ -2,7 +2,7 @@
   [lux #*
    [abstract
     [equivalence (#+ Equivalence)]
-    [hash (#+ Hash)]]
+    ["." hash (#+ Hash)]]
    [data
     ["." maybe ("#\." functor)]
     ["." text
@@ -34,19 +34,11 @@
     (-> Locale Text)
     (|>> :representation))
 
-  (structure: #export equivalence
-    (Equivalence Locale)
-    
-    (def: (= reference sample)
-      (\ text.equivalence = (:representation reference) (:representation sample))))
-
-  (structure: #export hash
+  (def: #export hash
     (Hash Locale)
-    
-    (def: &equivalence
-      ..equivalence)
-    
-    (def: hash
-      (|>> :representation
-           (\ text.hash hash))))
+    (\ hash.functor map ..code text.hash))
+
+  (def: #export equivalence
+    (Equivalence Locale)
+    (\ ..hash &equivalence))
   )
diff --git a/stdlib/source/lux/macro/syntax/common.lux b/stdlib/source/lux/macro/syntax/common.lux
index 6b2a84622..8cfbdeddd 100644
--- a/stdlib/source/lux/macro/syntax/common.lux
+++ b/stdlib/source/lux/macro/syntax/common.lux
@@ -5,6 +5,3 @@
 (type: #export Typed_Input
   {#input_binding Code
    #input_type Code})
-
-(type: #export Type_Var
-  Text)
diff --git a/stdlib/source/lux/macro/syntax/common/reader.lux b/stdlib/source/lux/macro/syntax/common/reader.lux
index fcf9ce0d0..cd7ca1dce 100644
--- a/stdlib/source/lux/macro/syntax/common/reader.lux
+++ b/stdlib/source/lux/macro/syntax/common/reader.lux
@@ -14,52 +14,7 @@
    ["." meta]]
   ["." //])
 
-(def: (flat_list^ _)
-  (-> Any (Parser (List Code)))
-  (p.either (do p.monad
-              [_ (s.tag! (name_of #.Nil))]
-              (wrap (list)))
-            (s.form (do p.monad
-                      [_ (s.tag! (name_of #.Cons))
-                       [head tail] (s.tuple (p.and s.any s.any))
-                       tail (s.local (list tail) (flat_list^ []))]
-                      (wrap (#.Cons head tail))))))
-
-(template [<name> <type> <tag> <then>]
-  [(def: <name>
-     (Parser <type>)
-     (<| s.tuple
-         (p.after s.any)
-         s.form
-         (do p.monad
-           [_ (s.tag! (name_of <tag>))]
-           <then>)))]
-
-  [tuple_meta^ (List Code) #.Tuple (flat_list^ [])]
-  [text_meta^  Text        #.Text  s.text]
-  )
-
-(def: (find_definition_args meta_data)
-  (-> (List [Name Code]) (List Text))
-  (<| (maybe.default (list))
-      (: (Maybe (List Text)))
-      (case (list.find (|>> product.left (name\= ["lux" "func-args"])) meta_data)
-        (^multi (#.Some [_ value])
-                [(p.run tuple_meta^ (list value))
-                 (#.Right [_ args])]
-                [(p.run (p.some text_meta^) args)
-                 (#.Right [_ args])])
-        (#.Some args)
-
-        _
-        #.None)))
-
 (def: #export typed_input
   {#.doc "Reader for the common typed-argument syntax used by many macros."}
   (Parser //.Typed_Input)
   (s.record (p.and s.any s.any)))
-
-(def: #export type_variables
-  {#.doc "Reader for the common type var/param used by many macros."}
-  (Parser (List Text))
-  (p.some s.local_identifier))
diff --git a/stdlib/source/lux/macro/syntax/common/type/variable.lux b/stdlib/source/lux/macro/syntax/common/type/variable.lux
new file mode 100644
index 000000000..22f37a35c
--- /dev/null
+++ b/stdlib/source/lux/macro/syntax/common/type/variable.lux
@@ -0,0 +1,27 @@
+(.module:
+  [lux #*
+   [abstract
+    [equivalence (#+ Equivalence)]]
+   [control
+    [parser
+     ["<.>" code (#+ Parser)]]]
+   [data
+    ["." text]]
+   [macro
+    ["." code]]])
+
+(type: #export Variable
+  Text)
+
+(def: #export equivalence
+  (Equivalence Variable)
+  text.equivalence)
+
+(def: #export format
+  (-> Variable Code)
+  code.local_identifier)
+
+(def: #export parser
+  {#.doc "Parser for the common type variable/parameter used by many macros."}
+  (Parser Variable)
+  <code>.local_identifier)
diff --git a/stdlib/source/lux/macro/syntax/common/writer.lux b/stdlib/source/lux/macro/syntax/common/writer.lux
index 6657e9b9d..18b6556b8 100644
--- a/stdlib/source/lux/macro/syntax/common/writer.lux
+++ b/stdlib/source/lux/macro/syntax/common/writer.lux
@@ -15,7 +15,3 @@
   (-> //.Typed_Input Code)
   (code.record (list [(get@ #//.input_binding value)
                       (get@ #//.input_type value)])))
-
-(def: #export type_variables
-  (-> (List //.Type_Var) (List Code))
-  (list\map code.local_identifier))
diff --git a/stdlib/source/lux/math/number/complex.lux b/stdlib/source/lux/math/number/complex.lux
index d1a2957f0..32c14f74e 100644
--- a/stdlib/source/lux/math/number/complex.lux
+++ b/stdlib/source/lux/math/number/complex.lux
@@ -304,11 +304,11 @@
                         {#real real
                          #imaginary imaginary})))))))
 
-(def: #export (within? margin_of_error standard value)
+(def: #export (approximately? margin_of_error standard value)
   (-> Frac Complex Complex Bit)
-  (and (f.within? margin_of_error
-                  (get@ #..real standard)
-                  (get@ #..real value))
-       (f.within? margin_of_error
-                  (get@ #..imaginary standard)
-                  (get@ #..imaginary value))))
+  (and (f.approximately? margin_of_error
+                         (get@ #..real standard)
+                         (get@ #..real value))
+       (f.approximately? margin_of_error
+                         (get@ #..imaginary standard)
+                         (get@ #..imaginary value))))
diff --git a/stdlib/source/lux/math/number/frac.lux b/stdlib/source/lux/math/number/frac.lux
index 3e1fadc2e..09c80cd05 100644
--- a/stdlib/source/lux/math/number/frac.lux
+++ b/stdlib/source/lux/math/number/frac.lux
@@ -419,7 +419,7 @@
   (def: &equivalence ..equivalence)
   (def: hash ..to_bits))
 
-(def: #export (within? margin_of_error standard value)
+(def: #export (approximately? margin_of_error standard value)
   (-> Frac Frac Frac Bit)
   (|> value
       (..- standard)
diff --git a/stdlib/source/lux/math/random.lux b/stdlib/source/lux/math/random.lux
index 0f16553de..5af6de041 100644
--- a/stdlib/source/lux/math/random.lux
+++ b/stdlib/source/lux/math/random.lux
@@ -1,10 +1,10 @@
 (.module: {#.doc "Pseudo-random number generation (PRNG) algorithms."}
   [lux (#- or and list i64 nat int rev char)
    [abstract
+    [hash (#+ Hash)]
     [functor (#+ Functor)]
     [apply (#+ Apply)]
-    ["." monad (#+ do Monad)]
-    hash]
+    ["." monad (#+ do Monad)]]
    [data
     ["." product]
     ["." maybe]
@@ -25,9 +25,9 @@
     [number (#+ hex)
      ["n" nat]
      ["i" int]
+     ["f" frac]
      ["r" ratio]
      ["c" complex]
-     ["f" frac]
      ["." i64]]]
    [time
     ["." instant (#+ Instant)]
diff --git a/stdlib/source/lux/meta/location.lux b/stdlib/source/lux/meta/location.lux
index ec35a83e6..3ddbeac6a 100644
--- a/stdlib/source/lux/meta/location.lux
+++ b/stdlib/source/lux/meta/location.lux
@@ -1,5 +1,15 @@
 (.module:
-  [lux #*])
+  [lux #*
+   [abstract
+    [equivalence (#+ Equivalence)]]])
+
+(structure: #export equivalence
+  (Equivalence Location)
+
+  (def: (= reference subject)
+    (and ("lux text =" (get@ #.module reference) (get@ #.module subject))
+         ("lux i64 =" (get@ #.line reference) (get@ #.line subject))
+         ("lux i64 =" (get@ #.column reference) (get@ #.column subject)))))
 
 (def: #export dummy
   Location
diff --git a/stdlib/source/lux/program.lux b/stdlib/source/lux/program.lux
new file mode 100644
index 000000000..209a95221
--- /dev/null
+++ b/stdlib/source/lux/program.lux
@@ -0,0 +1,88 @@
+(.module:
+  [lux #*
+   [meta (#+ with_gensyms)]
+   ["@" target]
+   [abstract
+    [monad (#+ do)]]
+   [control
+    ["." io]
+    [concurrency
+     ["." thread]]
+    ["<>" parser
+     ["<.>" code]
+     ["<.>" cli]]]
+   [data
+    ["." text]
+    [collection
+     ["." list ("#\." monad)]]]
+   [macro
+    [syntax (#+ syntax:)]
+    ["." code]]])
+
+(type: Arguments
+  (#Raw Text)
+  (#Parsed (List [Code Code])))
+
+(def: arguments^
+  (<code>.Parser Arguments)
+  (<>.or <code>.local_identifier
+         (<code>.tuple (<>.some (<>.either (do <>.monad
+                                             [name <code>.local_identifier]
+                                             (wrap [(code.identifier ["" name]) (` (~! <cli>.any))]))
+                                           (<code>.record (<>.and <code>.any <code>.any)))))))
+
+(syntax: #export (program:
+                   {args ..arguments^}
+                   body)
+  {#.doc (doc "Defines the entry-point to a program (similar to the 'main' function/method in other programming languages)."
+              "Can take a list of all the input parameters to the program."
+              "Or, can destructure them using CLI-option combinators from the lux/control/parser/cli module."
+              (program: all_args
+                (do io.monad
+                  [foo init_program
+                   bar (do_something all_args)]
+                  (wrap [])))
+
+              (program: [name]
+                (io (log! (\ text.monoid compose "Hello, " name))))
+
+              (program: [{config config^}]
+                (do io.monad
+                  [data (init_program config)]
+                  (do_something data))))}
+  (with_gensyms [g!program g!args g!_ g!output g!message]
+    (let [initialization+event_loop
+          (` ((~! do) (~! io.monad)
+              [(~ g!output) (~ body)
+               (~+ (for {@.old
+                         (list)
+                         
+                         @.jvm
+                         (list)
+
+                         @.js
+                         (list)}
+                        (list g!_
+                              (` ((~! thread.run!) [])))))]
+              ((~' wrap) (~ g!output))))]
+      (wrap (list (` ("lux def program"
+                      (~ (case args
+                           (#Raw args)
+                           (` (.function ((~ g!program) (~ (code.identifier ["" args])))
+                                (~ initialization+event_loop)))
+                           
+                           (#Parsed args)
+                           (` (.function ((~ g!program) (~ g!args))
+                                (case ((: (~! (<cli>.Parser (io.IO .Any)))
+                                          ((~! do) (~! <>.monad)
+                                           [(~+ (|> args
+                                                    (list\map (function (_ [binding parser])
+                                                                (list binding parser)))
+                                                    list\join))]
+                                           ((~' wrap) (~ initialization+event_loop))))
+                                       (~ g!args))
+                                  (#.Right [(~ g!_) (~ g!output)])
+                                  (~ g!output)
+
+                                  (#.Left (~ g!message))
+                                  (.error! (~ g!message))))))))))))))
diff --git a/stdlib/source/lux/target/jvm/bytecode.lux b/stdlib/source/lux/target/jvm/bytecode.lux
index 6e24b790a..a319ef2a7 100644
--- a/stdlib/source/lux/target/jvm/bytecode.lux
+++ b/stdlib/source/lux/target/jvm/bytecode.lux
@@ -463,7 +463,7 @@
 
 (import: java/lang/Double
   ["#::."
-   (#static doubleToRawLongBits #manual [double] int)])
+   (#static doubleToRawLongBits #manual [double] long)])
 
 (template [<name> <type> <constructor> <constant> <wide> <to_lux> <specializations>]
   [(def: #export (<name> value)
@@ -511,7 +511,7 @@
        (:coerce Int)))
 
 (def: negative_zero_float_bits
-  (|> -0.0 host.double_to_float ..float_bits))
+  (|> -0.0 (:coerce java/lang/Double) host.double_to_float ..float_bits))
 
 (def: #export (float value)
   (-> java/lang/Float (Bytecode Any))
@@ -548,7 +548,7 @@
 (def: (arbitrary_double value)
   (-> java/lang/Double (Bytecode Any))
   (do ..monad
-    [index (..lift (//constant/pool.double (//constant.double value)))]
+    [index (..lift (//constant/pool.double (//constant.double (:coerce Frac value))))]
     (..bytecode $0 $2 @_ _.ldc2_w/double [index])))
 
 (def: double_bits
@@ -557,14 +557,14 @@
        (:coerce Int)))
 
 (def: negative_zero_double_bits
-  (..double_bits -0.0))
+  (..double_bits (:coerce java/lang/Double -0.0)))
 
 (def: #export (double value)
   (-> java/lang/Double (Bytecode Any))
   (if (i.= ..negative_zero_double_bits
            (..double_bits value))
     (..arbitrary_double value)
-    (case value
+    (case (:coerce Frac value)
       (^template [<special> <instruction>]
         [<special> (..bytecode $0 $2 @_ <instruction> [])])
       ([+0.0 _.dconst_0]
diff --git a/stdlib/source/lux/tool/compiler/language/lux/phase/extension/analysis/jvm.lux b/stdlib/source/lux/tool/compiler/language/lux/phase/extension/analysis/jvm.lux
index fe753e2cc..2502d8325 100644
--- a/stdlib/source/lux/tool/compiler/language/lux/phase/extension/analysis/jvm.lux
+++ b/stdlib/source/lux/tool/compiler/language/lux/phase/extension/analysis/jvm.lux
@@ -1056,20 +1056,21 @@
                               _
                               true)
            arity_matches? (n.= (list.size inputsJT) (list.size parameters))
-           inputs_match? (list\fold (function (_ [expectedJC actualJC] prev)
-                                      (and prev
-                                           (jvm\= expectedJC (: (Type Value)
-                                                                (case (jvm_parser.var? actualJC)
-                                                                  (#.Some name)
-                                                                  (|> aliasing
-                                                                      (dictionary.get name)
-                                                                      (maybe.default name)
-                                                                      jvm.var)
-
-                                                                  #.None
-                                                                  actualJC)))))
-                                    true
-                                    (list.zip/2 parameters inputsJT))]]
+           inputs_match? (and arity_matches?
+                              (list\fold (function (_ [expectedJC actualJC] prev)
+                                           (and prev
+                                                (jvm\= expectedJC (: (Type Value)
+                                                                     (case (jvm_parser.var? actualJC)
+                                                                       (#.Some name)
+                                                                       (|> aliasing
+                                                                           (dictionary.get name)
+                                                                           (maybe.default name)
+                                                                           jvm.var)
+
+                                                                       #.None
+                                                                       actualJC)))))
+                                         true
+                                         (list.zip/2 parameters inputsJT)))]]
     (wrap (and correct_class?
                correct_method?
                static_matches?
diff --git a/stdlib/source/lux/world/file/watch.lux b/stdlib/source/lux/world/file/watch.lux
index 15ff185b5..948219013 100644
--- a/stdlib/source/lux/world/file/watch.lux
+++ b/stdlib/source/lux/world/file/watch.lux
@@ -290,7 +290,7 @@
 
                                (import: java/nio/file/Path
                                  ["#::."
-                                  (register [java/nio/file/WatchService [(java/nio/file/WatchEvent$Kind java/lang/Object)]] #io #try java/nio/file/WatchKey)
+                                  (register [java/nio/file/WatchService [(java/nio/file/WatchEvent$Kind [? < java/lang/Object])]] #io #try java/nio/file/WatchKey)
                                   (toString [] java/lang/String)])
 
                                (import: java/nio/file/StandardWatchEventKinds
diff --git a/stdlib/source/lux/world/input/keyboard.lux b/stdlib/source/lux/world/input/keyboard.lux
index b6fdb06ee..ccb90d30c 100644
--- a/stdlib/source/lux/world/input/keyboard.lux
+++ b/stdlib/source/lux/world/input/keyboard.lux
@@ -1,7 +1,5 @@
 (.module:
-  [lux #*
-   [data
-    [text (#+ Char)]]])
+  [lux #*])
 
 (type: #export Key
   Nat)