Property-based testing can now log/print successful seeds from run.

16 files changed, 191 insertions, 73 deletions

diff --git a/stdlib/source/library/lux/control/exception.lux b/stdlib/source/library/lux/control/exception.lux
index fabba5ad5..55ac0667d 100644
--- a/stdlib/source/library/lux/control/exception.lux
+++ b/stdlib/source/library/lux/control/exception.lux
@@ -75,17 +75,17 @@
 
 (.def exceptionP
   (Parser [export.Policy [[Text Code] Code Code]])
-  (export.parser
-   (all <>.either
-        (all <>.and
-             (<code>.form (<>.and <code>.local <code>.any))
-             <code>.any
-             <code>.any)
-        (do <>.monad
-          [name <code>.local]
-          (in [[name (code.local name)]
-               (` (Exception Any))
-               (` "")])))))
+  (export.with
+    (all <>.either
+         (all <>.and
+              (<code>.form (<>.and <code>.local <code>.any))
+              <code>.any
+              <code>.any)
+         (do <>.monad
+           [name <code>.local]
+           (in [[name (code.local name)]
+                (` (Exception Any))
+                (` "")])))))
 
 (.def .public def
   (syntax (_ [[export_policy [[name input] type body]] ..exceptionP])
diff --git a/stdlib/source/library/lux/control/function/named.lux b/stdlib/source/library/lux/control/function/named.lux
index eeade0ed5..39e0fba22 100644
--- a/stdlib/source/library/lux/control/function/named.lux
+++ b/stdlib/source/library/lux/control/function/named.lux
@@ -40,10 +40,10 @@
 
 (.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))])
+              (export.with (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)
diff --git a/stdlib/source/library/lux/control/function/polymorphism/context.lux b/stdlib/source/library/lux/control/function/polymorphism/context.lux
index 904cc100c..be28c494e 100644
--- a/stdlib/source/library/lux/control/function/polymorphism/context.lux
+++ b/stdlib/source/library/lux/control/function/polymorphism/context.lux
@@ -41,7 +41,7 @@
     <representation>
 
     (.def .public layer
-      (syntax (_ [[export_policy name] (export.parser ?code.local)])
+      (syntax (_ [[export_policy name] (export.with ?code.local)])
         (do meta.monad
           [@ meta.current_module_name]
           (in (list (` (.def (, export_policy) (, (code.local name))
@@ -118,7 +118,7 @@
   (` ((,' .,') (, it))))
 
 (.def .public def
-  (syntax (_ [[export_policy signature] (export.parser ..signature)
+  (syntax (_ [[export_policy signature] (export.with ..signature)
               quantifications (?code.tuple (?.some ?code.any))
               context ?code.any
               inputs (?code.tuple (?.many ?code.any))
diff --git a/stdlib/source/library/lux/control/function/polymorphism/predicate.lux b/stdlib/source/library/lux/control/function/polymorphism/predicate.lux
index 78a238fa4..3a145e7eb 100644
--- a/stdlib/source/library/lux/control/function/polymorphism/predicate.lux
+++ b/stdlib/source/library/lux/control/function/polymorphism/predicate.lux
@@ -58,14 +58,14 @@
 
 (.def .public def
   (syntax (_ [[export_policy signature quantifications inputs output default methods]
-              (export.parser
-               (all ?.and
-                    ..signature
-                    (?code.tuple (?.some ?code.any))
-                    (?code.tuple (?.many ?code.any))
-                    ?code.any
-                    ?code.any
-                    (?.some ?code.any)))])
+              (export.with
+                (all ?.and
+                     ..signature
+                     (?code.tuple (?.some ?code.any))
+                     (?code.tuple (?.many ?code.any))
+                     ?code.any
+                     ?code.any
+                     (?.some ?code.any)))])
     (<| (with_symbols [g!self g!_ g!scenarios g!scenario g!mixin])
         (..declaration [#function (the #name signature)
                         #quantifications quantifications
diff --git a/stdlib/source/library/lux/control/function/polymorphism/type.lux b/stdlib/source/library/lux/control/function/polymorphism/type.lux
index 6dbd0ef42..5aec52b70 100644
--- a/stdlib/source/library/lux/control/function/polymorphism/type.lux
+++ b/stdlib/source/library/lux/control/function/polymorphism/type.lux
@@ -34,12 +34,12 @@
 
 (.def .public def
   (syntax (_ [[export_policy name parameters type methods]
-              (export.parser
-               (all ?.and
-                    ?code.local
-                    (?code.tuple (?.many ?code.local))
-                    ?code.any
-                    (?.many ?code.any)))])
+              (export.with
+                (all ?.and
+                     ?code.local
+                     (?code.tuple (?.many ?code.local))
+                     ?code.any
+                     (?.many ?code.any)))])
     (<| (do meta.monad
           [@ meta.current_module_name
            g!interface (macro.symbol name)
diff --git a/stdlib/source/library/lux/control/function/variadic.lux b/stdlib/source/library/lux/control/function/variadic.lux
index 5b53bbe83..e914dde9e 100644
--- a/stdlib/source/library/lux/control/function/variadic.lux
+++ b/stdlib/source/library/lux/control/function/variadic.lux
@@ -36,10 +36,10 @@
 
 (.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))])
+              (export.with (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)
diff --git a/stdlib/source/library/lux/control/security/capability.lux b/stdlib/source/library/lux/control/security/capability.lux
index e422ba4ed..bdcc86586 100644
--- a/stdlib/source/library/lux/control/security/capability.lux
+++ b/stdlib/source/library/lux/control/security/capability.lux
@@ -18,7 +18,7 @@
      ["<[1]>" \\parser]]
     ["[0]" macro (.only)
      [syntax (.only syntax)
-      ["|[0]|" export]
+      ["[0]" export]
       ["|[0]|" declaration]]]
     [type
      ["[0]" primitive (.except def)]]]]])
@@ -35,10 +35,10 @@
 
   (def .public capability
     (syntax (_ [[export_policy declaration [forger input output]]
-                (|export|.parser
-                 (all <>.and
-                      |declaration|.parser
-                      (<code>.form (all <>.and <code>.local <code>.any <code>.any))))])
+                (export.with
+                  (all <>.and
+                       |declaration|.parser
+                       (<code>.form (all <>.and <code>.local <code>.any <code>.any))))])
       (macro.with_symbols [g!_]
         (do [! meta.monad]
           [this_module meta.current_module_name
diff --git a/stdlib/source/library/lux/meta/macro/context.lux b/stdlib/source/library/lux/meta/macro/context.lux
index c39bbd539..4ec34b5df 100644
--- a/stdlib/source/library/lux/meta/macro/context.lux
+++ b/stdlib/source/library/lux/meta/macro/context.lux
@@ -230,9 +230,9 @@
   (syntax (_ [.let [! ?.monad
                     ?local (at ! each code.local ?code.local)]
 
-              [export_$? $] (?code.tuple (export.parser ?code.local))
-              [export_expression? g!expression] (?code.tuple (export.parser ?local))
-              [export_declaration? g!declaration] (?code.tuple (export.parser ?local))
+              [export_$? $] (?code.tuple (export.with ?code.local))
+              [export_expression? g!expression] (?code.tuple (export.with ?local))
+              [export_declaration? g!declaration] (?code.tuple (export.with ?local))
               
               context_type ?code.any])
     (do [! meta.monad]
diff --git a/stdlib/source/library/lux/meta/macro/syntax/export.lux b/stdlib/source/library/lux/meta/macro/syntax/export.lux
index 98db6124e..522fefb6b 100644
--- a/stdlib/source/library/lux/meta/macro/syntax/export.lux
+++ b/stdlib/source/library/lux/meta/macro/syntax/export.lux
@@ -1,6 +1,6 @@
 (.require
  [library
-  [lux (.except)
+  [lux (.except with)
    [abstract
     [monad (.only do)]]
    [control
@@ -37,6 +37,6 @@
           _
           (in default)))))
 
-(def .public parser
+(def .public with
   (All (_ a) (-> (Parser a) (Parser [Policy a])))
   (<>.and ..policy))
diff --git a/stdlib/source/library/lux/meta/macro/vocabulary.lux b/stdlib/source/library/lux/meta/macro/vocabulary.lux
index 31e0dc1d9..71327712d 100644
--- a/stdlib/source/library/lux/meta/macro/vocabulary.lux
+++ b/stdlib/source/library/lux/meta/macro/vocabulary.lux
@@ -25,7 +25,7 @@
 
 (.def local
   (Parser [Code Code])
-  (?code.tuple (export.parser (?#each code.local ?code.local))))
+  (?code.tuple (export.with (?#each code.local ?code.local))))
 
 (.def .public def
   (syntax (_ [[public|private@type type] ..local
diff --git a/stdlib/source/library/lux/meta/type/primitive.lux b/stdlib/source/library/lux/meta/type/primitive.lux
index db066d253..033be6d6e 100644
--- a/stdlib/source/library/lux/meta/type/primitive.lux
+++ b/stdlib/source/library/lux/meta/type/primitive.lux
@@ -17,7 +17,7 @@
     ["[0]" macro (.only)
      ["[0]" context]
      [syntax (.only syntax)
-      ["|[0]|" export]]]]]]
+      ["[0]" export]]]]]]
  ["[0]" //])
 
 (type .public Frame
@@ -70,12 +70,12 @@
 
 (.def abstract
   (Parser [Code [Text (List Text)] Code (List Code)])
-  (|export|.parser
-   (all <>.and
-        ..declarationP
-        <code>.any
-        (<>.some <code>.any)
-        )))
+  (export.with
+    (all <>.and
+         ..declarationP
+         <code>.any
+         (<>.some <code>.any)
+         )))
 
 ... TODO: Make sure the generated code always gets optimized away.
 ... (This applies to uses of "abstraction" and "representation")
diff --git a/stdlib/source/library/lux/meta/type/row.lux b/stdlib/source/library/lux/meta/type/row.lux
index c4c8b9b1f..3d3ac324d 100644
--- a/stdlib/source/library/lux/meta/type/row.lux
+++ b/stdlib/source/library/lux/meta/type/row.lux
@@ -103,7 +103,7 @@
       (n.= (list.size it))))
 
 (def .public type
-  (syntax (_ [[export_policy [name parameters]] (export.parser ..declaration)
+  (syntax (_ [[export_policy [name parameters]] (export.with ..declaration)
               [super slots] ..definition])
     (let [slot_names (list#each product.left slots)]
       (if (unique_slots? slot_names)
diff --git a/stdlib/source/library/lux/test/property.lux b/stdlib/source/library/lux/test/property.lux
index 732be561f..db3adfb11 100644
--- a/stdlib/source/library/lux/test/property.lux
+++ b/stdlib/source/library/lux/test/property.lux
@@ -108,8 +108,19 @@
 
 (exception.def .public must_try_test_at_least_once)
 
-(def .public (times amount test)
-  (-> Nat Test Test)
+(type .public Success_Policy
+  Bit)
+
+(def .public ignore_success
+  Success_Policy
+  #0)
+
+(def .public announce_success
+  Success_Policy
+  #1)
+
+(def .public (times amount announce_success? test)
+  (-> Nat Success_Policy Test Test)
   (when amount
     0 (..failure (exception.error ..must_try_test_at_least_once []))
     _ (do random.monad
@@ -120,12 +131,16 @@
                      [[tally documentation] instance]
                      (if (..failed? tally)
                        (in [tally (times_failure seed documentation)])
-                       (when amount
-                         1 instance
-                         _ (|> test
-                               (times (-- amount))
-                               (random.result prng')
-                               product.right))))])))))
+                       (exec
+                         (if announce_success?
+                           (debug.log! (format "Succeeded with this seed: " (%.nat seed)))
+                           [])
+                         (when amount
+                           1 instance
+                           _ (|> test
+                                 (times (-- amount) announce_success?)
+                                 (random.result prng')
+                                 product.right)))))])))))
 
 (def (description duration tally)
   (-> Duration Tally Text)
diff --git a/stdlib/source/library/lux/world/net.lux b/stdlib/source/library/lux/world/net.lux
index fccb47177..4bbf75cd3 100644
--- a/stdlib/source/library/lux/world/net.lux
+++ b/stdlib/source/library/lux/world/net.lux
@@ -1,13 +1,13 @@
 (.require
  [library
-  [lux (.except #host)]])
+  [lux (.except #host)]]
+ [/
+  [uri
+   [port (.only Port)]]])
 
 (type .public Host
   Text)
 
-(type .public Port
-  Nat)
-
 (type .public URL
   Text)
 
diff --git a/stdlib/source/library/lux/world/net/uri/port.lux b/stdlib/source/library/lux/world/net/uri/port.lux
new file mode 100644
index 000000000..3b6d8a8e5
--- /dev/null
+++ b/stdlib/source/library/lux/world/net/uri/port.lux
@@ -0,0 +1,103 @@
+... https://en.wikipedia.org/wiki/List_of_TCP_and_UDP_port_numbers
+(.require
+ [library
+  [lux (.except)
+   [meta
+    [macro
+     ["[0]" template]]]]])
+
+(type .public Port
+  Nat)
+
+(with_template [<port> <name> <aliases>']
+  [(def .public <name>
+     Port
+     <port>)
+
+   (with_expansions [<aliases> (template.spliced <aliases>')]
+     (with_template [<alias>]
+       [(def .public <alias> <name>)]
+
+       <aliases>
+       ))]
+
+  [007 echo_protocol []] ... https://en.wikipedia.org/wiki/Echo_Protocol
+  [009 discard_protocol []] ... https://en.wikipedia.org/wiki/Discard_Protocol
+  [013 daytime_protocol []] ... https://en.wikipedia.org/wiki/Daytime_Protocol
+  [017 quote_of_the_day []] ... https://en.wikipedia.org/wiki/QOTD
+  [018 message_send_protocol []] ... https://en.wikipedia.org/wiki/Message_Send_Protocol
+  [019 character_generator_protocol []] ... https://en.wikipedia.org/wiki/Character_Generator_Protocol
+  [020 file_transfer_protocol_data_transfer [[ftp_data_transfer]]]
+  [021 file_transfer_protocol_control [[ftp_control]]]
+  [023 telnet []] ... https://en.wikipedia.org/wiki/Telnet
+  [025 simple_mail_transfer_protocol [[smtp]]] ... https://en.wikipedia.org/wiki/Simple_Mail_Transfer_Protocol
+  [037 time_protocol []] ... https://en.wikipedia.org/wiki/Time_Protocol
+  [042 host_name_server_protocol []] ... https://en.wikipedia.org/wiki/ARPA_Host_Name_Server_Protocol
+  [043 whois []] ... https://en.wikipedia.org/wiki/WHOIS
+  [053 domain_name_system [[dns]]] ... https://en.wikipedia.org/wiki/Domain_Name_System
+  [070 gopher []] ... https://en.wikipedia.org/wiki/Gopher_(protocol)
+  [079 finger []] ... https://en.wikipedia.org/wiki/Finger_(protocol)
+  [080 hypertext_transfer_protocol [[http]]] ... https://en.wikipedia.org/wiki/Hypertext_Transfer_Protocol
+  [088 kerberos []] ... https://en.wikipedia.org/wiki/Kerberos_(protocol)
+
+  [104 digital_imaging_and_communications_in_medicine [[dicom]]] ... https://en.wikipedia.org/wiki/DICOM
+  [107 remote_user_telnet_service [[rtelnet]]] ... https://en.wikipedia.org/wiki/Rtelnet
+  [109 post_office_protocol_2 [[pop2]]] ... https://en.wikipedia.org/wiki/Post_Office_Protocol
+  [110 post_office_protocol_3 [[pop3]]] ... https://en.wikipedia.org/wiki/Post_Office_Protocol
+  [111 open_network_computing_remote_procedure_call [[onc_rpc]]] ... https://en.wikipedia.org/wiki/Sun_RPC
+  [115 simple_file_transfer_protocol [[simple_ftp]]] ... https://en.wikipedia.org/wiki/File_Transfer_Protocol#Simple_File_Transfer_Protocol
+  [119 network_news_transfer_protocol [[nntp]]] ... https://en.wikipedia.org/wiki/Network_News_Transfer_Protocol
+  [123 network_time_protocol [[ntp]]] ... https://en.wikipedia.org/wiki/Network_Time_Protocol
+  [143 internet_message_access_protocol [[imap]]] ... https://en.wikipedia.org/wiki/Internet_Message_Access_Protocol
+  [153 simple_gateway_monitoring_protocol [[sgmp]]] ... https://en.wikipedia.org/wiki/Simple_Gateway_Monitoring_Protocol
+  [156 structured_query_language [[sql]]] ... https://en.wikipedia.org/wiki/SQL
+  [161 simple_network_management_protocol [[snmp]]] ... https://en.wikipedia.org/wiki/Simple_Network_Management_Protocol
+  [162 simple_network_management_protocol_trap [[snmp_trap]]] ... https://en.wikipedia.org/wiki/Simple_Network_Management_Protocol
+  [169 secure_neighbor_discovery [[send]]] ... https://en.wikipedia.org/wiki/Secure_Neighbor_Discovery
+  [177 x_display_manager_control_protocol [[xdmcp]]] ... https://en.wikipedia.org/wiki/X_display_manager#XDMCP
+  [179 border_gateway_protocol [[bgp]]] ... https://en.wikipedia.org/wiki/Border_Gateway_Protocol
+  [194 internet_relay_chat [[irc]]] ... https://en.wikipedia.org/wiki/Internet_Relay_Chat
+  [199 snmp_unix_multiplexer [[smux]]] ... https://datatracker.ietf.org/doc/html/rfc1227#page-8
+
+  [264 border_gateway_multicast_protocol [[bgmp]]] ... https://en.wikipedia.org/wiki/Border_Gateway_Multicast_Protocol
+
+  [319 precision_time_protocol_event_messages [[ptp_event_messages]]] ... https://en.wikipedia.org/wiki/Precision_Time_Protocol
+  [320 precision_time_protocol_general_messages [[ptp_general_messages]]] ... https://en.wikipedia.org/wiki/Precision_Time_Protocol
+  [389 lightweight_directory_access_protocol [[ldap]]] ... https://en.wikipedia.org/wiki/Lightweight_Directory_Access_Protocol
+
+  [401 uninterruptible_power_supply [[ups]]] ... https://en.wikipedia.org/wiki/Uninterruptible_power_supply
+  [427 service_location_protocol [[slp]]] ... https://en.wikipedia.org/wiki/Service_Location_Protocol
+  [443 hypertext_transfer_protocol_secure [[https]]] ... https://en.wikipedia.org/wiki/HTTPS
+  [444 simple_network_paging_protocol [[snpp]]] ... https://en.wikipedia.org/wiki/Simple_Network_Paging_Protocol
+  [464 kerberos_change/set_password []] ... https://en.wikipedia.org/wiki/Kerberos_(protocol)
+
+  [530 remote_procedure_call [[rpc]]] ... https://en.wikipedia.org/wiki/Remote_procedure_call
+  [554 real_time_streaming_protocol [[rtsp]]] ... https://en.wikipedia.org/wiki/Real_Time_Streaming_Protocol
+  [546 dynamic_host_configuration_protocol/6_client [[dhcp/6_client]]] ... https://en.wikipedia.org/wiki/Dynamic_Host_Configuration_Protocol
+  [547 dynamic_host_configuration_protocol/6_server [[dhcp/6_server]]] ... https://en.wikipedia.org/wiki/Dynamic_Host_Configuration_Protocol
+  [563 network_news_transfer_protocol_secure [[nntps]]] ... https://en.wikipedia.org/wiki/Network_News_Transfer_Protocol
+
+  [631 internet_printing_protocol [[ipp]]] ... https://en.wikipedia.org/wiki/Internet_Printing_Protocol
+  [636 lightweight_directory_access_protocol_secure [[ldaps]]] ... https://en.wikipedia.org/wiki/Lightweight_Directory_Access_Protocol
+  [639 multicast_source_discovery_protocol [[msdp]]] ... https://en.wikipedia.org/wiki/Multicast_Source_Discovery_Protocol
+  [646 label_distribution_protocol [[ldp]]] ... https://en.wikipedia.org/wiki/Label_Distribution_Protocol
+  [674 application_configuration_access_protocol [[acap]]] ... https://en.wikipedia.org/wiki/Application_Configuration_Access_Protocol
+  [698 optimized_link_state_routing_protocol [[olsr]]] ... https://en.wikipedia.org/wiki/Optimized_Link_State_Routing_Protocol
+
+  [700 extensible_provisioning_protocol [[epp]]] ... https://en.wikipedia.org/wiki/Extensible_Provisioning_Protocol
+  [701 link_management_protocol [[lmp]]] ... https://www.ietf.org/rfc/rfc4204.txt
+  [706 secure_internet_live_conferencing_protocol [[silc]]] ... https://en.wikipedia.org/wiki/SILC_(protocol)
+  [749 kerberos_administration []] ... https://en.wikipedia.org/wiki/Kerberos_(protocol)
+
+  [829 certificate_management_protocol [[cmp]]] ... https://en.wikipedia.org/wiki/Certificate_Management_Protocol
+  [830 network_configuration_protocol/ssh [[netconf/ssh]]] ... https://en.wikipedia.org/wiki/NETCONF
+  [831 network_configuration_protocol/beep [[netconf/beep]]] ... https://en.wikipedia.org/wiki/NETCONF
+  [832 network_configuration_protocol/soap/https [[netconf/soap/https]]] ... https://en.wikipedia.org/wiki/NETCONF
+  [833 network_configuration_protocol/soap/beep [[netconf/soap/beep]]] ... https://en.wikipedia.org/wiki/NETCONF
+
+  [989 file_transfer_protocol_secure_data_transfer [[ftps_data_transfer]]] ... https://en.wikipedia.org/wiki/FTPS
+  [990 file_transfer_protocol_secure_control [[ftps_control]]] ... https://en.wikipedia.org/wiki/FTPS
+  [992 telnet/tls []] ... https://en.wikipedia.org/wiki/Telnet
+  [993 internet_message_access_protocol_secure [[imaps]]] ... https://en.wikipedia.org/wiki/Internet_Message_Access_Protocol
+  [995 post_office_protocol_3_secure [[pop3s]]] ... https://en.wikipedia.org/wiki/Post_Office_Protocol
+  )
diff --git a/stdlib/source/library/lux/world/net/uri/scheme.lux b/stdlib/source/library/lux/world/net/uri/scheme.lux
index 2c5d7b36f..aabe810b1 100644
--- a/stdlib/source/library/lux/world/net/uri/scheme.lux
+++ b/stdlib/source/library/lux/world/net/uri/scheme.lux
@@ -95,30 +95,30 @@
     [ftp file_transfer_protocol]
 
     [http hypertext_transfer_protocol]
-    [https secure_hypertext_transfer_protocol]
+    [https hypertext_transfer_protocol_secure]
 
     [imap internet_message_access_protocol]
     [ipp internet_printing_protocol]
-    [ipps secure_internet_printing_protocol]
+    [ipps internet_printing_protocol_secure]
     [irc internet_relay_chat]
-    [ircs secure_internet_relay_chat]
+    [ircs internet_relay_chat_secure]
 
     [ldap lightweight_directory_access_protocol]
-    [ldaps secure_lightweight_directory_access_protocol]
+    [ldaps lightweight_directory_access_protocol_secure]
 
     [pop post_office_protocol]
 
     [sip session_initiation_protocol]
-    [sips secure_session_initiation_protocol]
+    [sips session_initiation_protocol_secure]
     [sms short_message_service]
     [snmp simple_network_management_protocol]
     [ssh secure_shell_protocol]
 
     [stun session_traversal_utilities_for_nat]
-    [stuns secure_session_traversal_utilities_for_nat]
+    [stuns session_traversal_utilities_for_nat_secure]
 
     [turn traversal_using_relays_around_nat]
-    [turns secure_traversal_using_relays_around_nat]
+    [turns traversal_using_relays_around_nat_secure]
 
     [xmpp extensible_messaging_and_presence_protocol]
     )