aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorEduardo Julian2022-06-14 10:17:32 -0400
committerEduardo Julian2022-06-14 10:17:32 -0400
commit9a835bde8908e4ebd1c8972211acadc5895d720a (patch)
treec4bd81cfff7357a3895389a1544eaa66230203ec
parentc4d938ebb2f5245b4c3faa22c4f217e7e818589f (diff)
De-sigil-ification: suffix : [Part 8]
Diffstat (limited to '')
-rw-r--r--lux-cl/source/program.lux2
-rw-r--r--lux-js/source/program.lux2
-rw-r--r--lux-lua/source/program.lux2
-rw-r--r--lux-mode/lux-mode.el12
-rw-r--r--lux-php/source/program.lux2
-rw-r--r--lux-python/source/program.lux2
-rw-r--r--lux-scheme/source/program.lux2
-rw-r--r--stdlib/source/documentation/lux/ffi.jvm.lux6
-rw-r--r--stdlib/source/documentation/lux/ffi.old.lux6
-rw-r--r--stdlib/source/documentation/lux/type/poly.lux2
-rw-r--r--stdlib/source/library/lux/ffi.jvm.lux2
-rw-r--r--stdlib/source/library/lux/ffi.old.lux2
-rw-r--r--stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/extension.lux2
-rw-r--r--stdlib/source/library/lux/type/poly.lux111
-rw-r--r--stdlib/source/polytypic/lux/abstract/equivalence.lux247
-rw-r--r--stdlib/source/polytypic/lux/abstract/functor.lux173
-rw-r--r--stdlib/source/polytypic/lux/data/format/json.lux446
-rw-r--r--stdlib/source/test/lux/ffi.jvm.lux14
-rw-r--r--stdlib/source/test/lux/ffi.old.lux4
19 files changed, 518 insertions, 521 deletions
diff --git a/lux-cl/source/program.lux b/lux-cl/source/program.lux
index 4b82594fc..d61caab05 100644
--- a/lux-cl/source/program.lux
+++ b/lux-cl/source/program.lux
@@ -145,7 +145,7 @@
(ffi.import org/armedbear/lisp/Closure
"[1]::[0]")
-(ffi.interface: LuxADT
+(ffi.interface LuxADT
(getValue [] java/lang/Object))
(ffi.import program/LuxADT
diff --git a/lux-js/source/program.lux b/lux-js/source/program.lux
index b8ba06d2c..52f5d49ef 100644
--- a/lux-js/source/program.lux
+++ b/lux-js/source/program.lux
@@ -141,7 +141,7 @@
"[1]::[0]")
(with_template [<name>]
- [(ffi.interface: <name>
+ [(ffi.interface <name>
(getValue [] java/lang/Object))
(import <name>
diff --git a/lux-lua/source/program.lux b/lux-lua/source/program.lux
index dc909805f..7a2f2712e 100644
--- a/lux-lua/source/program.lux
+++ b/lux-lua/source/program.lux
@@ -172,7 +172,7 @@
"Class" (ffi.of_string (java/lang/Object::toString (java/lang/Object::getClass object)))
"Object" (ffi.of_string (java/lang/Object::toString object))))
- (ffi.interface: LuxValue
+ (ffi.interface LuxValue
(getValue [] java/lang/Object))
(ffi.import LuxValue
diff --git a/lux-mode/lux-mode.el b/lux-mode/lux-mode.el
index 7d9f18203..8b79a6cf5 100644
--- a/lux-mode/lux-mode.el
+++ b/lux-mode/lux-mode.el
@@ -376,7 +376,7 @@ Called by `imenu--generic-function'."
(type//checking (altRE "is" "as" "let" "as_expected" "type_of" "sharing" "by_example" "hole"))
(type//primitive (altRE "primitive:" "abstraction" "representation" "transmutation"))
(type//unit (altRE "unit:" "scale:"))
- (type//poly (altRE "poly:"))
+ (type//poly (altRE "polytypic"))
(type//dynamic (altRE "dynamic" "static"))
(type//capability (altRE "capability:"))
;; Data
@@ -389,7 +389,7 @@ Called by `imenu--generic-function'."
(code//super-quotation (altRE "``" "~~"))
(code//template (altRE "with_template" "template"))
;; Miscellaneous
- (jvm-host (altRE "import" "export" "class:" "interface:" "object" "do_to" "synchronized" "class_for"))
+ (jvm-host (altRE "import" "export" "class:" "interface" "object" "do_to" "synchronized" "class_for"))
(alternative-format (altRE "char" "bin" "oct" "hex"))
(documentation (altRE "comment" "documentation:"))
(function-application (altRE "|>" "<|" "left" "right" "all"))
@@ -579,18 +579,20 @@ This function also returns nil meaning don't specify the indentation."
(define-lux-indent
("function" 'defun)
+
("macro" 'defun)
("syntax" 'defun)
("template" 'defun)
- ("message" 'defun)
+ ("polytypic" 'defun)
("analysis" 'defun)
("synthesis" 'defun)
("generation" 'defun)
("directive" 'defun)
- (import 'defun)
- (export 'defun)
+ ("interface" 'defun)
+ ("import" 'defun)
+ ("export" 'defun)
(let 'defun)
(case 'defun)
diff --git a/lux-php/source/program.lux b/lux-php/source/program.lux
index 24f215fb5..1e117c033 100644
--- a/lux-php/source/program.lux
+++ b/lux-php/source/program.lux
@@ -167,7 +167,7 @@
(call [php/runtime/env/Environment [php/runtime/Memory]] "try" php/runtime/Memory))
(with_template [<name>]
- [(ffi.interface: <name>
+ [(ffi.interface <name>
(getValue [] java/lang/Object))
(`` (ffi.import (~~ (template.symbol ["program/" <name>]))
diff --git a/lux-python/source/program.lux b/lux-python/source/program.lux
index 2704b0e80..ecb78d6f4 100644
--- a/lux-python/source/program.lux
+++ b/lux-python/source/program.lux
@@ -199,7 +199,7 @@
_
(exception.except ..unknown_kind_of_object [(as java/lang/Object host_object)])))
- (ffi.interface: LuxValue
+ (ffi.interface LuxValue
(value [] java/lang/Object))
(import LuxValue
diff --git a/lux-scheme/source/program.lux b/lux-scheme/source/program.lux
index b70e6f17c..c0145adf7 100644
--- a/lux-scheme/source/program.lux
+++ b/lux-scheme/source/program.lux
@@ -160,7 +160,7 @@
false))
(with_template [<name>]
- [(ffi.interface: <name>
+ [(ffi.interface <name>
(getValue [] java/lang/Object))
(`` (ffi.import (~~ (template.symbol ["program/" <name>]))
diff --git a/stdlib/source/documentation/lux/ffi.jvm.lux b/stdlib/source/documentation/lux/ffi.jvm.lux
index 254f5d7a1..72a5e15cd 100644
--- a/stdlib/source/documentation/lux/ffi.jvm.lux
+++ b/stdlib/source/documentation/lux/ffi.jvm.lux
@@ -110,9 +110,9 @@
"(::new! []) for calling the class's constructor."
"(::resolve! container [value]) for calling the 'resolve' method."])
-(documentation: /.interface:
+(documentation: /.interface
"Allows defining JVM interfaces."
- [(interface: TestInterface
+ [(interface TestInterface
([] foo [boolean String] void "throws" [Exception]))])
(documentation: /.object
@@ -306,7 +306,7 @@
..short_to_char
..class:
- ..interface:
+ ..interface
..object
..null
..null?
diff --git a/stdlib/source/documentation/lux/ffi.old.lux b/stdlib/source/documentation/lux/ffi.old.lux
index 36282f92d..a93ecbe95 100644
--- a/stdlib/source/documentation/lux/ffi.old.lux
+++ b/stdlib/source/documentation/lux/ffi.old.lux
@@ -74,9 +74,9 @@
"(::new! []) for calling the class's constructor."
"(::resolve! container [value]) for calling the 'resolve' method."])
-(documentation: /.interface:
+(documentation: /.interface
"Allows defining JVM interfaces."
- [(interface: TestInterface
+ [(interface TestInterface
([] foo [boolean String] void "throws" [Exception]))])
(documentation: /.object
@@ -240,7 +240,7 @@
..char_to_int
..char_to_long
..class:
- ..interface:
+ ..interface
..object
..null
..null?
diff --git a/stdlib/source/documentation/lux/type/poly.lux b/stdlib/source/documentation/lux/type/poly.lux
index e08c1d058..92183f398 100644
--- a/stdlib/source/documentation/lux/type/poly.lux
+++ b/stdlib/source/documentation/lux/type/poly.lux
@@ -26,5 +26,5 @@
($.module /._
""
[..code
- ($.default /.poly:)]
+ ($.default /.polytypic)]
[]))
diff --git a/stdlib/source/library/lux/ffi.jvm.lux b/stdlib/source/library/lux/ffi.jvm.lux
index 4753e6f14..32b5410ee 100644
--- a/stdlib/source/library/lux/ffi.jvm.lux
+++ b/stdlib/source/library/lux/ffi.jvm.lux
@@ -1230,7 +1230,7 @@
[(~+ (list#each field_decl$ fields))]
[(~+ methods)])))))))
-(def: .public interface:
+(def: .public interface
(syntax (_ [.let [! <>.monad]
[full_class_name class_vars] (at ! each parser.declaration ..declaration^)
supers (<>.else (list)
diff --git a/stdlib/source/library/lux/ffi.old.lux b/stdlib/source/library/lux/ffi.old.lux
index db6bfb42e..1933ba032 100644
--- a/stdlib/source/library/lux/ffi.old.lux
+++ b/stdlib/source/library/lux/ffi.old.lux
@@ -1232,7 +1232,7 @@
(with_brackets (spaced (list#each (method_def$ replacer super) methods))))))]]
(in (list (` ((~ (code.text def_code)))))))))
-(def: .public interface:
+(def: .public interface
(syntax (_ [class_decl ..class_decl^
.let [class_vars (product.right class_decl)]
supers (<>.else (list)
diff --git a/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/extension.lux b/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/extension.lux
index 8f5c9db8a..aa9829172 100644
--- a/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/extension.lux
+++ b/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/extension.lux
@@ -53,7 +53,7 @@
list.together))]
((~' in) ((~ g!extension) [(~+ g!input+)])))
- (~' _)
+ (~ g!_)
(///.except ///extension.incorrect_arity [(~ g!name) 1 (list.size (~ g!inputs))])))))))))))
(arity: 0 nullary ..Nullary)
diff --git a/stdlib/source/library/lux/type/poly.lux b/stdlib/source/library/lux/type/poly.lux
index fa27e032b..aeb27188b 100644
--- a/stdlib/source/library/lux/type/poly.lux
+++ b/stdlib/source/library/lux/type/poly.lux
@@ -24,75 +24,66 @@
[number
["n" nat]]]]])
-(def: polyP
- (Parser [Code Text Code])
- (let [private (all <>.and
- <code>.local
- <code>.any)]
- (<>.either (<>.and <code>.any private)
- (<>.and (<>#in (` .private)) private))))
-
-(def: .public poly:
- (syntax (_ [[export_policy name body] ..polyP])
+(def: .public polytypic
+ (syntax (_ [name <code>.local
+ body <code>.any])
(with_symbols [g!_ g!type g!output]
(let [g!name (code.symbol ["" name])]
- (in (.list (` (def: (~ export_policy) (~ g!name)
- ((~! syntax) ((~ g!name) [(~ g!type) (~! <code>.any)])
- ((~! do) (~! meta.monad)
- [(~ g!type) ((~! meta.eval) .Type (~ g!type))]
- (case (is (.Either .Text .Code)
- ((~! <type>.result) ((~! <>.rec)
- (function ((~ g!_) (~ g!name))
- (~ body)))
- (.as .Type (~ g!type))))
- {.#Left (~ g!output)}
- ((~! meta.failure) (~ g!output))
+ (in (.list (` ((~! syntax) ((~ g!_) [(~ g!type) (~! <code>.any)])
+ ((~! do) (~! meta.monad)
+ [(~ g!type) ((~! meta.eval) .Type (~ g!type))]
+ (case (is (.Either .Text .Code)
+ ((~! <type>.result) ((~! <>.rec)
+ (function ((~ g!_) (~ g!name))
+ (~ body)))
+ (.as .Type (~ g!type))))
+ {.#Right (~ g!output)}
+ ((~' in) (.list (~ g!output)))
- {.#Right (~ g!output)}
- ((~' in) (.list (~ g!output))))))))))))))
+ {.#Left (~ g!output)}
+ ((~! meta.failure) (~ g!output))))))))))))
(def: .public (code env type)
(-> Env Type Code)
- (`` (case type
- {.#Primitive name params}
- (` {.#Primitive (~ (code.text name))
- (.list (~+ (list#each (code env) params)))})
+ (case type
+ {.#Primitive name params}
+ (` {.#Primitive (~ (code.text name))
+ (.list (~+ (list#each (code env) params)))})
- (^.with_template [<tag>]
- [{<tag> idx}
- (` {<tag> (~ (code.nat idx))})])
- ([.#Var] [.#Ex])
+ (^.with_template [<tag>]
+ [{<tag> idx}
+ (` {<tag> (~ (code.nat idx))})])
+ ([.#Var] [.#Ex])
- {.#Parameter idx}
- (let [idx (<type>.argument env idx)]
- (if (n.= 0 idx)
- (|> (dictionary.value idx env) maybe.trusted product.left (code env))
- (` (.$ (~ (code.nat (-- idx)))))))
+ {.#Parameter idx}
+ (let [idx (<type>.argument env idx)]
+ (if (n.= 0 idx)
+ (|> (dictionary.value idx env) maybe.trusted product.left (code env))
+ (` (.$ (~ (code.nat (-- idx)))))))
- {.#Apply {.#Primitive "" {.#End}}
- {.#Parameter idx}}
- (case (<type>.argument env idx)
- 0 (|> env (dictionary.value 0) maybe.trusted product.left (code env))
- idx (undefined))
-
- (^.with_template [<tag>]
- [{<tag> left right}
- (` {<tag> (~ (code env left))
- (~ (code env right))})])
- ([.#Function] [.#Apply])
+ {.#Apply {.#Primitive "" {.#End}}
+ {.#Parameter idx}}
+ (case (<type>.argument env idx)
+ 0 (|> env (dictionary.value 0) maybe.trusted product.left (code env))
+ idx (undefined))
+
+ (^.with_template [<tag>]
+ [{<tag> left right}
+ (` {<tag> (~ (code env left))
+ (~ (code env right))})])
+ ([.#Function] [.#Apply])
- (^.with_template [<macro> <tag> <flattener>]
- [{<tag> left right}
- (` (<macro> (~+ (list#each (code env) (<flattener> type)))))])
- ([.Union .#Sum type.flat_variant]
- [.Tuple .#Product type.flat_tuple])
+ (^.with_template [<macro> <tag> <flattener>]
+ [{<tag> left right}
+ (` (<macro> (~+ (list#each (code env) (<flattener> type)))))])
+ ([.Union .#Sum type.flat_variant]
+ [.Tuple .#Product type.flat_tuple])
- {.#Named name sub_type}
- (code.symbol name)
+ {.#Named name sub_type}
+ (code.symbol name)
- (^.with_template [<tag>]
- [{<tag> scope body}
- (` {<tag> (.list (~+ (list#each (code env) scope)))
- (~ (code env body))})])
- ([.#UnivQ] [.#ExQ])
- )))
+ (^.with_template [<tag>]
+ [{<tag> scope body}
+ (` {<tag> (.list (~+ (list#each (code env) scope)))
+ (~ (code env body))})])
+ ([.#UnivQ] [.#ExQ])))
diff --git a/stdlib/source/polytypic/lux/abstract/equivalence.lux b/stdlib/source/polytypic/lux/abstract/equivalence.lux
index 119142267..03d3dd3de 100644
--- a/stdlib/source/polytypic/lux/abstract/equivalence.lux
+++ b/stdlib/source/polytypic/lux/abstract/equivalence.lux
@@ -35,133 +35,134 @@
["[0]" day]
["[0]" month]]
["[0]" type (.only)
- ["[0]" poly (.only poly:)]
+ ["[0]" poly (.only polytypic)]
["[0]" unit]]]]
[\\library
["[0]" /]])
-(poly: .public equivalence
- (`` (do [! <>.monad]
- [.let [g!_ (code.local "_____________")]
- *env* <type>.env
- inputT <type>.next
- .let [@Equivalence (is (-> Type Code)
- (function (_ type)
- (` ((~! /.Equivalence) (~ (poly.code *env* type))))))]]
- (all <>.either
- ... Basic types
- (~~ (with_template [<matcher> <eq>]
- [(do !
- [_ <matcher>]
- (in (` (is (~ (@Equivalence inputT))
- <eq>))))]
+(def: .public equivalence
+ (polytypic equivalence
+ (`` (do [! <>.monad]
+ [.let [g!_ (code.local "_____________")]
+ *env* <type>.env
+ inputT <type>.next
+ .let [@Equivalence (is (-> Type Code)
+ (function (_ type)
+ (` ((~! /.Equivalence) (~ (poly.code *env* type))))))]]
+ (all <>.either
+ ... Basic types
+ (~~ (with_template [<matcher> <eq>]
+ [(do !
+ [_ <matcher>]
+ (in (` (is (~ (@Equivalence inputT))
+ <eq>))))]
- [(<type>.exactly Any) (function ((~ g!_) (~ g!_) (~ g!_)) #1)]
- [(<type>.sub Bit) (~! bit.equivalence)]
- [(<type>.sub Nat) (~! nat.equivalence)]
- [(<type>.sub Int) (~! int.equivalence)]
- [(<type>.sub Rev) (~! rev.equivalence)]
- [(<type>.sub Frac) (~! frac.equivalence)]
- [(<type>.sub Text) (~! text.equivalence)]))
- ... Composite types
- (~~ (with_template [<name> <eq>]
- [(do !
- [[_ argC] (<type>.applied (<>.and (<type>.exactly <name>)
- equivalence))]
- (in (` (is (~ (@Equivalence inputT))
- (<eq> (~ argC))))))]
+ [(<type>.exactly Any) (function ((~ g!_) (~ g!_) (~ g!_)) #1)]
+ [(<type>.sub Bit) (~! bit.equivalence)]
+ [(<type>.sub Nat) (~! nat.equivalence)]
+ [(<type>.sub Int) (~! int.equivalence)]
+ [(<type>.sub Rev) (~! rev.equivalence)]
+ [(<type>.sub Frac) (~! frac.equivalence)]
+ [(<type>.sub Text) (~! text.equivalence)]))
+ ... Composite types
+ (~~ (with_template [<name> <eq>]
+ [(do !
+ [[_ argC] (<type>.applied (<>.and (<type>.exactly <name>)
+ equivalence))]
+ (in (` (is (~ (@Equivalence inputT))
+ (<eq> (~ argC))))))]
- [.Maybe (~! maybe.equivalence)]
- [.List (~! list.equivalence)]
- [sequence.Sequence (~! sequence.equivalence)]
- [array.Array (~! array.equivalence)]
- [queue.Queue (~! queue.equivalence)]
- [set.Set (~! set.equivalence)]
- [tree.Tree (~! tree.equivalence)]
- ))
- (do !
- [[_ _ valC] (<type>.applied (all <>.and
- (<type>.exactly dictionary.Dictionary)
- <type>.any
- equivalence))]
- (in (` (is (~ (@Equivalence inputT))
- ((~! dictionary.equivalence) (~ valC))))))
- ... Models
- (~~ (with_template [<type> <eq>]
- [(do !
- [_ (<type>.exactly <type>)]
- (in (` (is (~ (@Equivalence inputT))
- <eq>))))]
+ [.Maybe (~! maybe.equivalence)]
+ [.List (~! list.equivalence)]
+ [sequence.Sequence (~! sequence.equivalence)]
+ [array.Array (~! array.equivalence)]
+ [queue.Queue (~! queue.equivalence)]
+ [set.Set (~! set.equivalence)]
+ [tree.Tree (~! tree.equivalence)]
+ ))
+ (do !
+ [[_ _ valC] (<type>.applied (all <>.and
+ (<type>.exactly dictionary.Dictionary)
+ <type>.any
+ equivalence))]
+ (in (` (is (~ (@Equivalence inputT))
+ ((~! dictionary.equivalence) (~ valC))))))
+ ... Models
+ (~~ (with_template [<type> <eq>]
+ [(do !
+ [_ (<type>.exactly <type>)]
+ (in (` (is (~ (@Equivalence inputT))
+ <eq>))))]
- [duration.Duration duration.equivalence]
- [instant.Instant instant.equivalence]
- [date.Date date.equivalence]
- [day.Day day.equivalence]
- [month.Month month.equivalence]
- ))
- (do !
- [_ (<type>.applied (<>.and (<type>.exactly unit.Qty)
- <type>.any))]
- (in (` (is (~ (@Equivalence inputT))
- unit.equivalence))))
- ... Variants
- (do !
- [members (<type>.variant (<>.many equivalence))
- .let [last (-- (list.size members))
- g!_ (code.local "_____________")
- g!left (code.local "_____________left")
- g!right (code.local "_____________right")]]
- (in (` (is (~ (@Equivalence inputT))
- (function ((~ g!_) (~ g!left) (~ g!right))
- (case [(~ g!left) (~ g!right)]
- (~+ (list#conjoint (list#each (function (_ [tag g!eq])
- (if (nat.= last tag)
- (list (` [{(~ (code.nat (-- tag))) #1 (~ g!left)}
- {(~ (code.nat (-- tag))) #1 (~ g!right)}])
- (` ((~ g!eq) (~ g!left) (~ g!right))))
- (list (` [{(~ (code.nat tag)) #0 (~ g!left)}
- {(~ (code.nat tag)) #0 (~ g!right)}])
- (` ((~ g!eq) (~ g!left) (~ g!right))))))
- (list.enumeration members))))
- (~ g!_)
- #0))))))
- ... Tuples
- (do !
- [g!eqs (<type>.tuple (<>.many equivalence))
- .let [g!_ (code.local "_____________")
- indices (list.indices (list.size g!eqs))
- g!lefts (list#each (|>> nat#encoded (text#composite "left") code.local) indices)
- g!rights (list#each (|>> nat#encoded (text#composite "right") code.local) indices)]]
- (in (` (is (~ (@Equivalence inputT))
- (function ((~ g!_) [(~+ g!lefts)] [(~+ g!rights)])
- (and (~+ (|> (list.zipped_3 g!eqs g!lefts g!rights)
- (list#each (function (_ [g!eq g!left g!right])
- (` ((~ g!eq) (~ g!left) (~ g!right)))))))))))))
- ... Type recursion
- (do !
- [[g!self bodyC] (<type>.recursive equivalence)
- .let [g!_ (code.local "_____________")]]
- (in (` (is (~ (@Equivalence inputT))
- ((~! /.rec) (.function ((~ g!_) (~ g!self))
- (~ bodyC)))))))
- <type>.recursive_self
- ... Type applications
- (do !
- [[funcC argsC] (<type>.applied (<>.and equivalence (<>.many equivalence)))]
- (in (` ((~ funcC) (~+ argsC)))))
- ... Parameters
- <type>.parameter
- ... Polymorphism
- (do !
- [[funcC varsC bodyC] (<type>.polymorphic equivalence)]
- (in (` (is (All ((~ g!_) (~+ varsC))
- (-> (~+ (list#each (|>> (~) ((~! /.Equivalence)) (`)) varsC))
- ((~! /.Equivalence) ((~ (poly.code *env* inputT)) (~+ varsC)))))
- (function ((~ funcC) (~+ varsC))
- (~ bodyC))))))
- <type>.recursive_call
- ... If all else fails...
- (|> <type>.any
- (at ! each (|>> %.type (format "Cannot create Equivalence for: ") <>.failure))
- (at ! conjoint))
- ))))
+ [duration.Duration duration.equivalence]
+ [instant.Instant instant.equivalence]
+ [date.Date date.equivalence]
+ [day.Day day.equivalence]
+ [month.Month month.equivalence]
+ ))
+ (do !
+ [_ (<type>.applied (<>.and (<type>.exactly unit.Qty)
+ <type>.any))]
+ (in (` (is (~ (@Equivalence inputT))
+ unit.equivalence))))
+ ... Variants
+ (do !
+ [members (<type>.variant (<>.many equivalence))
+ .let [last (-- (list.size members))
+ g!_ (code.local "_____________")
+ g!left (code.local "_____________left")
+ g!right (code.local "_____________right")]]
+ (in (` (is (~ (@Equivalence inputT))
+ (function ((~ g!_) (~ g!left) (~ g!right))
+ (case [(~ g!left) (~ g!right)]
+ (~+ (list#conjoint (list#each (function (_ [tag g!eq])
+ (if (nat.= last tag)
+ (list (` [{(~ (code.nat (-- tag))) #1 (~ g!left)}
+ {(~ (code.nat (-- tag))) #1 (~ g!right)}])
+ (` ((~ g!eq) (~ g!left) (~ g!right))))
+ (list (` [{(~ (code.nat tag)) #0 (~ g!left)}
+ {(~ (code.nat tag)) #0 (~ g!right)}])
+ (` ((~ g!eq) (~ g!left) (~ g!right))))))
+ (list.enumeration members))))
+ (~ g!_)
+ #0))))))
+ ... Tuples
+ (do !
+ [g!eqs (<type>.tuple (<>.many equivalence))
+ .let [g!_ (code.local "_____________")
+ indices (list.indices (list.size g!eqs))
+ g!lefts (list#each (|>> nat#encoded (text#composite "left") code.local) indices)
+ g!rights (list#each (|>> nat#encoded (text#composite "right") code.local) indices)]]
+ (in (` (is (~ (@Equivalence inputT))
+ (function ((~ g!_) [(~+ g!lefts)] [(~+ g!rights)])
+ (and (~+ (|> (list.zipped_3 g!eqs g!lefts g!rights)
+ (list#each (function (_ [g!eq g!left g!right])
+ (` ((~ g!eq) (~ g!left) (~ g!right)))))))))))))
+ ... Type recursion
+ (do !
+ [[g!self bodyC] (<type>.recursive equivalence)
+ .let [g!_ (code.local "_____________")]]
+ (in (` (is (~ (@Equivalence inputT))
+ ((~! /.rec) (.function ((~ g!_) (~ g!self))
+ (~ bodyC)))))))
+ <type>.recursive_self
+ ... Type applications
+ (do !
+ [[funcC argsC] (<type>.applied (<>.and equivalence (<>.many equivalence)))]
+ (in (` ((~ funcC) (~+ argsC)))))
+ ... Parameters
+ <type>.parameter
+ ... Polymorphism
+ (do !
+ [[funcC varsC bodyC] (<type>.polymorphic equivalence)]
+ (in (` (is (All ((~ g!_) (~+ varsC))
+ (-> (~+ (list#each (|>> (~) ((~! /.Equivalence)) (`)) varsC))
+ ((~! /.Equivalence) ((~ (poly.code *env* inputT)) (~+ varsC)))))
+ (function ((~ funcC) (~+ varsC))
+ (~ bodyC))))))
+ <type>.recursive_call
+ ... If all else fails...
+ (|> <type>.any
+ (at ! each (|>> %.type (format "Cannot create Equivalence for: ") <>.failure))
+ (at ! conjoint))
+ )))))
diff --git a/stdlib/source/polytypic/lux/abstract/functor.lux b/stdlib/source/polytypic/lux/abstract/functor.lux
index 3ad598a91..fc7cae722 100644
--- a/stdlib/source/polytypic/lux/abstract/functor.lux
+++ b/stdlib/source/polytypic/lux/abstract/functor.lux
@@ -19,92 +19,93 @@
[number
["n" nat]]]
["[0]" type (.only)
- ["[0]" poly (.only poly:)]]]]
+ ["[0]" poly (.only polytypic)]]]]
[\\library
["[0]" /]])
-(poly: .public functor
- (do [! p.monad]
- [.let [g!_ (code.local "____________")
- type_funcC (code.local "____________type_funcC")
- funcC (code.local "____________funcC")
- inputC (code.local "____________inputC")]
- *env* <type>.env
- inputT <type>.next
- [polyC varsC non_functorT] (<type>.local (list inputT)
- (<type>.polymorphic <type>.any))
- .let [num_vars (list.size varsC)]
- .let [@Functor (is (-> Type Code)
- (function (_ unwrappedT)
- (if (n.= 1 num_vars)
- (` ((~! /.Functor) (~ (poly.code *env* unwrappedT))))
- (let [paramsC (|> num_vars -- list.indices (list#each (|>> %.nat code.local)))]
- (` (All ((~ g!_) (~+ paramsC))
- ((~! /.Functor) ((~ (poly.code *env* unwrappedT)) (~+ paramsC)))))))))
- Arg<?> (is (-> Code (<type>.Parser Code))
- (function (Arg<?> valueC)
- (all p.either
- ... Type-var
- (do p.monad
- [.let [varI (|> num_vars (n.* 2) --)]
- _ (<type>.this_parameter varI)]
- (in (` ((~ funcC) (~ valueC)))))
- ... Variants
- (do !
- [_ (in [])
- membersC (<type>.variant (p.many (Arg<?> valueC)))
- .let [last (-- (list.size membersC))]]
- (in (` (case (~ valueC)
- (~+ (list#conjoint (list#each (function (_ [tag memberC])
- (if (n.= last tag)
- (list (` {(~ (code.nat (-- tag))) #1 (~ valueC)})
- (` {(~ (code.nat (-- tag))) #1 (~ memberC)}))
- (list (` {(~ (code.nat tag)) #0 (~ valueC)})
- (` {(~ (code.nat tag)) #0 (~ memberC)}))))
- (list.enumeration membersC))))))))
- ... Tuples
- (do p.monad
- [pairsCC (is (<type>.Parser (List [Code Code]))
- (<type>.tuple (loop (again [idx 0
- pairsCC (is (List [Code Code])
- (list))])
- (p.either (let [slotC (|> idx %.nat (format "____________slot") code.local)]
- (do !
- [_ (in [])
- memberC (Arg<?> slotC)]
- (again (++ idx)
- (list#composite pairsCC (list [slotC memberC])))))
- (in pairsCC)))))]
- (in (` (case (~ valueC)
- [(~+ (list#each product.left pairsCC))]
- [(~+ (list#each product.right pairsCC))]))))
- ... Functions
- (do !
- [_ (in [])
- .let [g! (code.local "____________")
- outL (code.local "____________outL")]
- [inT+ outC] (<type>.function (p.many <type>.any)
- (Arg<?> outL))
- .let [inC+ (|> (list.size inT+)
- list.indices
- (list#each (|>> %.nat (format "____________inC") code.local)))]]
- (in (` (function ((~ g!) (~+ inC+))
- (let [(~ outL) ((~ valueC) (~+ inC+))]
- (~ outC))))))
- ... Recursion
- (do p.monad
- [_ <type>.recursive_call]
- (in (` ((~' each) (~ funcC) (~ valueC)))))
- ... Parameters
- (do p.monad
- [_ <type>.any]
- (in valueC))
- )))]
- [_ _ outputC] (is (<type>.Parser [Code (List Code) Code])
- (p.either (<type>.polymorphic
- (Arg<?> inputC))
- (p.failure (format "Cannot create Functor for: " (%.type inputT)))))]
- (in (` (is (~ (@Functor inputT))
- (implementation
- (def: ((~' each) (~ funcC) (~ inputC))
- (~ outputC))))))))
+(def: .public functor
+ (polytypic functor
+ (do [! p.monad]
+ [.let [g!_ (code.local "____________")
+ type_funcC (code.local "____________type_funcC")
+ funcC (code.local "____________funcC")
+ inputC (code.local "____________inputC")]
+ *env* <type>.env
+ inputT <type>.next
+ [polyC varsC non_functorT] (<type>.local (list inputT)
+ (<type>.polymorphic <type>.any))
+ .let [num_vars (list.size varsC)]
+ .let [@Functor (is (-> Type Code)
+ (function (_ unwrappedT)
+ (if (n.= 1 num_vars)
+ (` ((~! /.Functor) (~ (poly.code *env* unwrappedT))))
+ (let [paramsC (|> num_vars -- list.indices (list#each (|>> %.nat code.local)))]
+ (` (All ((~ g!_) (~+ paramsC))
+ ((~! /.Functor) ((~ (poly.code *env* unwrappedT)) (~+ paramsC)))))))))
+ Arg<?> (is (-> Code (<type>.Parser Code))
+ (function (Arg<?> valueC)
+ (all p.either
+ ... Type-var
+ (do p.monad
+ [.let [varI (|> num_vars (n.* 2) --)]
+ _ (<type>.this_parameter varI)]
+ (in (` ((~ funcC) (~ valueC)))))
+ ... Variants
+ (do !
+ [_ (in [])
+ membersC (<type>.variant (p.many (Arg<?> valueC)))
+ .let [last (-- (list.size membersC))]]
+ (in (` (case (~ valueC)
+ (~+ (list#conjoint (list#each (function (_ [tag memberC])
+ (if (n.= last tag)
+ (list (` {(~ (code.nat (-- tag))) #1 (~ valueC)})
+ (` {(~ (code.nat (-- tag))) #1 (~ memberC)}))
+ (list (` {(~ (code.nat tag)) #0 (~ valueC)})
+ (` {(~ (code.nat tag)) #0 (~ memberC)}))))
+ (list.enumeration membersC))))))))
+ ... Tuples
+ (do p.monad
+ [pairsCC (is (<type>.Parser (List [Code Code]))
+ (<type>.tuple (loop (again [idx 0
+ pairsCC (is (List [Code Code])
+ (list))])
+ (p.either (let [slotC (|> idx %.nat (format "____________slot") code.local)]
+ (do !
+ [_ (in [])
+ memberC (Arg<?> slotC)]
+ (again (++ idx)
+ (list#composite pairsCC (list [slotC memberC])))))
+ (in pairsCC)))))]
+ (in (` (case (~ valueC)
+ [(~+ (list#each product.left pairsCC))]
+ [(~+ (list#each product.right pairsCC))]))))
+ ... Functions
+ (do !
+ [_ (in [])
+ .let [g! (code.local "____________")
+ outL (code.local "____________outL")]
+ [inT+ outC] (<type>.function (p.many <type>.any)
+ (Arg<?> outL))
+ .let [inC+ (|> (list.size inT+)
+ list.indices
+ (list#each (|>> %.nat (format "____________inC") code.local)))]]
+ (in (` (function ((~ g!) (~+ inC+))
+ (let [(~ outL) ((~ valueC) (~+ inC+))]
+ (~ outC))))))
+ ... Recursion
+ (do p.monad
+ [_ <type>.recursive_call]
+ (in (` ((~' each) (~ funcC) (~ valueC)))))
+ ... Parameters
+ (do p.monad
+ [_ <type>.any]
+ (in valueC))
+ )))]
+ [_ _ outputC] (is (<type>.Parser [Code (List Code) Code])
+ (p.either (<type>.polymorphic
+ (Arg<?> inputC))
+ (p.failure (format "Cannot create Functor for: " (%.type inputT)))))]
+ (in (` (is (~ (@Functor inputT))
+ (implementation
+ (def: ((~' each) (~ funcC) (~ inputC))
+ (~ outputC)))))))))
diff --git a/stdlib/source/polytypic/lux/data/format/json.lux b/stdlib/source/polytypic/lux/data/format/json.lux
index 801a16e19..b86f256a2 100644
--- a/stdlib/source/polytypic/lux/data/format/json.lux
+++ b/stdlib/source/polytypic/lux/data/format/json.lux
@@ -35,7 +35,7 @@
["[0]" month]]
["[0]" type (.only)
["[0]" unit]
- ["[0]" poly (.only poly:)]]]]
+ ["[0]" poly (.only polytypic)]]]]
[\\library
["[0]" / (.only JSON)]])
@@ -96,233 +96,235 @@
(|>> (at ..int_codec decoded)
(at try.functor each (debug.private unit.in'))))))
-(poly: encoded
- (with_expansions
- [<basic> (with_template [<matcher> <encoder>]
- [(do !
- [.let [g!_ (code.local "_______")]
- _ <matcher>]
- (in (` (is (~ (@JSON#encoded inputT))
- <encoder>))))]
+(def: encoded
+ (polytypic encoded
+ (with_expansions
+ [<basic> (with_template [<matcher> <encoder>]
+ [(do !
+ [.let [g!_ (code.local "_______")]
+ _ <matcher>]
+ (in (` (is (~ (@JSON#encoded inputT))
+ <encoder>))))]
- [(<type>.exactly Any) (function ((~ g!_) (~ (code.symbol ["" "0"]))) {/.#Null})]
- [(<type>.sub Bit) (|>> {/.#Boolean})]
- [(<type>.sub Nat) (at (~! ..nat_codec) (~' encoded))]
- [(<type>.sub Int) (at (~! ..int_codec) (~' encoded))]
- [(<type>.sub Frac) (|>> {/.#Number})]
- [(<type>.sub Text) (|>> {/.#String})])
- <time> (with_template [<type> <codec>]
- [(do !
- [_ (<type>.exactly <type>)]
- (in (` (is (~ (@JSON#encoded inputT))
- (|>> (at (~! <codec>) (~' encoded)) {/.#String})))))]
+ [(<type>.exactly Any) (function ((~ g!_) (~ (code.symbol ["" "0"]))) {/.#Null})]
+ [(<type>.sub Bit) (|>> {/.#Boolean})]
+ [(<type>.sub Nat) (at (~! ..nat_codec) (~' encoded))]
+ [(<type>.sub Int) (at (~! ..int_codec) (~' encoded))]
+ [(<type>.sub Frac) (|>> {/.#Number})]
+ [(<type>.sub Text) (|>> {/.#String})])
+ <time> (with_template [<type> <codec>]
+ [(do !
+ [_ (<type>.exactly <type>)]
+ (in (` (is (~ (@JSON#encoded inputT))
+ (|>> (at (~! <codec>) (~' encoded)) {/.#String})))))]
- ... [duration.Duration duration.codec]
- ... [instant.Instant instant.codec]
- [date.Date date.codec]
- [day.Day day.codec]
- [month.Month month.codec])]
- (do [! <>.monad]
- [*env* <type>.env
- .let [g!_ (code.local "_______")
- @JSON#encoded (is (-> Type Code)
- (function (_ type)
- (` (-> (~ (poly.code *env* type)) /.JSON))))]
- inputT <type>.next]
- (all <>.either
- <basic>
- <time>
- (do !
- [unitT (<type>.applied (<>.after (<type>.exactly unit.Qty)
- <type>.any))]
- (in (` (is (~ (@JSON#encoded inputT))
- (at (~! qty_codec) (~' encoded))))))
- (do !
- [.let [g!_ (code.local "_______")
- g!key (code.local "_______key")
- g!val (code.local "_______val")]
- [_ _ =val=] (<type>.applied (all <>.and
- (<type>.exactly dictionary.Dictionary)
- (<type>.exactly .Text)
+ ... [duration.Duration duration.codec]
+ ... [instant.Instant instant.codec]
+ [date.Date date.codec]
+ [day.Day day.codec]
+ [month.Month month.codec])]
+ (do [! <>.monad]
+ [*env* <type>.env
+ .let [g!_ (code.local "_______")
+ @JSON#encoded (is (-> Type Code)
+ (function (_ type)
+ (` (-> (~ (poly.code *env* type)) /.JSON))))]
+ inputT <type>.next]
+ (all <>.either
+ <basic>
+ <time>
+ (do !
+ [unitT (<type>.applied (<>.after (<type>.exactly unit.Qty)
+ <type>.any))]
+ (in (` (is (~ (@JSON#encoded inputT))
+ (at (~! qty_codec) (~' encoded))))))
+ (do !
+ [.let [g!_ (code.local "_______")
+ g!key (code.local "_______key")
+ g!val (code.local "_______val")]
+ [_ _ =val=] (<type>.applied (all <>.and
+ (<type>.exactly dictionary.Dictionary)
+ (<type>.exactly .Text)
+ encoded))]
+ (in (` (is (~ (@JSON#encoded inputT))
+ (|>> ((~! dictionary.entries))
+ ((~! list#each) (function ((~ g!_) [(~ g!key) (~ g!val)])
+ [(~ g!key) ((~ =val=) (~ g!val))]))
+ ((~! dictionary.of_list) (~! text.hash))
+ {/.#Object})))))
+ (do !
+ [[_ =sub=] (<type>.applied (all <>.and
+ (<type>.exactly .Maybe)
encoded))]
- (in (` (is (~ (@JSON#encoded inputT))
- (|>> ((~! dictionary.entries))
- ((~! list#each) (function ((~ g!_) [(~ g!key) (~ g!val)])
- [(~ g!key) ((~ =val=) (~ g!val))]))
- ((~! dictionary.of_list) (~! text.hash))
- {/.#Object})))))
- (do !
- [[_ =sub=] (<type>.applied (all <>.and
- (<type>.exactly .Maybe)
- encoded))]
- (in (` (is (~ (@JSON#encoded inputT))
- ((~! ..nullable) (~ =sub=))))))
- (do !
- [[_ =sub=] (<type>.applied (all <>.and
- (<type>.exactly .List)
- encoded))]
- (in (` (is (~ (@JSON#encoded inputT))
- (|>> ((~! list#each) (~ =sub=)) ((~! sequence.of_list)) {/.#Array})))))
- (do !
- [.let [g!_ (code.local "_______")
- g!input (code.local "_______input")]
- members (<type>.variant (<>.many encoded))
- .let [last (-- (list.size members))]]
- (in (` (is (~ (@JSON#encoded inputT))
- (function ((~ g!_) (~ g!input))
- (case (~ g!input)
- (~+ (list#conjoint (list#each (function (_ [tag g!encoded])
- (if (n.= last tag)
- (.list (` {(~ (code.nat (-- tag))) #1 (~ g!input)})
- (` ((~! /.json) [(~ (code.frac (..tag (-- tag))))
- #1
- ((~ g!encoded) (~ g!input))])))
- (.list (` {(~ (code.nat tag)) #0 (~ g!input)})
- (` ((~! /.json) [(~ (code.frac (..tag tag)))
- #0
- ((~ g!encoded) (~ g!input))])))))
- (list.enumeration members))))))))))
- (do !
- [g!encoders (<type>.tuple (<>.many encoded))
- .let [g!_ (code.local "_______")
- g!members (|> (list.size g!encoders)
- list.indices
- (list#each (|>> n#encoded code.local)))]]
- (in (` (is (~ (@JSON#encoded inputT))
- (function ((~ g!_) [(~+ g!members)])
- ((~! /.json) [(~+ (list#each (function (_ [g!member g!encoded])
- (` ((~ g!encoded) (~ g!member))))
- (list.zipped_2 g!members g!encoders)))]))))))
- ... Type recursion
- (do !
- [[selfC non_recC] (<type>.recursive encoded)
- .let [g! (code.local "____________")]]
- (in (` (is (~ (@JSON#encoded inputT))
- ((~! ..rec_encoded) (.function ((~ g!) (~ selfC))
- (~ non_recC)))))))
- <type>.recursive_self
- ... Type applications
- (do !
- [partsC (<type>.applied (<>.many encoded))]
- (in (` ((~+ partsC)))))
- ... Polymorphism
- (do !
- [[funcC varsC bodyC] (<type>.polymorphic encoded)]
- (in (` (is (All ((~ g!_) (~+ varsC))
- (-> (~+ (list#each (function (_ varC) (` (-> (~ varC) /.JSON)))
- varsC))
- (-> ((~ (poly.code *env* inputT)) (~+ varsC))
- /.JSON)))
- (function ((~ funcC) (~+ varsC))
- (~ bodyC))))))
- <type>.parameter
- <type>.recursive_call
- ... If all else fails...
- (<>.failure (format "Cannot create JSON encoder for: " (type.format inputT)))
- ))))
+ (in (` (is (~ (@JSON#encoded inputT))
+ ((~! ..nullable) (~ =sub=))))))
+ (do !
+ [[_ =sub=] (<type>.applied (all <>.and
+ (<type>.exactly .List)
+ encoded))]
+ (in (` (is (~ (@JSON#encoded inputT))
+ (|>> ((~! list#each) (~ =sub=)) ((~! sequence.of_list)) {/.#Array})))))
+ (do !
+ [.let [g!_ (code.local "_______")
+ g!input (code.local "_______input")]
+ members (<type>.variant (<>.many encoded))
+ .let [last (-- (list.size members))]]
+ (in (` (is (~ (@JSON#encoded inputT))
+ (function ((~ g!_) (~ g!input))
+ (case (~ g!input)
+ (~+ (list#conjoint (list#each (function (_ [tag g!encoded])
+ (if (n.= last tag)
+ (.list (` {(~ (code.nat (-- tag))) #1 (~ g!input)})
+ (` ((~! /.json) [(~ (code.frac (..tag (-- tag))))
+ #1
+ ((~ g!encoded) (~ g!input))])))
+ (.list (` {(~ (code.nat tag)) #0 (~ g!input)})
+ (` ((~! /.json) [(~ (code.frac (..tag tag)))
+ #0
+ ((~ g!encoded) (~ g!input))])))))
+ (list.enumeration members))))))))))
+ (do !
+ [g!encoders (<type>.tuple (<>.many encoded))
+ .let [g!_ (code.local "_______")
+ g!members (|> (list.size g!encoders)
+ list.indices
+ (list#each (|>> n#encoded code.local)))]]
+ (in (` (is (~ (@JSON#encoded inputT))
+ (function ((~ g!_) [(~+ g!members)])
+ ((~! /.json) [(~+ (list#each (function (_ [g!member g!encoded])
+ (` ((~ g!encoded) (~ g!member))))
+ (list.zipped_2 g!members g!encoders)))]))))))
+ ... Type recursion
+ (do !
+ [[selfC non_recC] (<type>.recursive encoded)
+ .let [g! (code.local "____________")]]
+ (in (` (is (~ (@JSON#encoded inputT))
+ ((~! ..rec_encoded) (.function ((~ g!) (~ selfC))
+ (~ non_recC)))))))
+ <type>.recursive_self
+ ... Type applications
+ (do !
+ [partsC (<type>.applied (<>.many encoded))]
+ (in (` ((~+ partsC)))))
+ ... Polymorphism
+ (do !
+ [[funcC varsC bodyC] (<type>.polymorphic encoded)]
+ (in (` (is (All ((~ g!_) (~+ varsC))
+ (-> (~+ (list#each (function (_ varC) (` (-> (~ varC) /.JSON)))
+ varsC))
+ (-> ((~ (poly.code *env* inputT)) (~+ varsC))
+ /.JSON)))
+ (function ((~ funcC) (~+ varsC))
+ (~ bodyC))))))
+ <type>.parameter
+ <type>.recursive_call
+ ... If all else fails...
+ (<>.failure (format "Cannot create JSON encoder for: " (type.format inputT)))
+ )))))
-(poly: decoded
- (with_expansions
- [<basic> (with_template [<matcher> <decoder>]
- [(do !
- [_ <matcher>]
- (in (` (is (~ (@JSON#decoded inputT))
- (~! <decoder>)))))]
+(def: decoded
+ (polytypic decoded
+ (with_expansions
+ [<basic> (with_template [<matcher> <decoder>]
+ [(do !
+ [_ <matcher>]
+ (in (` (is (~ (@JSON#decoded inputT))
+ (~! <decoder>)))))]
- [(<type>.exactly Any) </>.null]
- [(<type>.sub Bit) </>.boolean]
- [(<type>.sub Nat) (<>.codec ..nat_codec </>.any)]
- [(<type>.sub Int) (<>.codec ..int_codec </>.any)]
- [(<type>.sub Frac) </>.number]
- [(<type>.sub Text) </>.string])
- <time> (with_template [<type> <codec>]
- [(do !
- [_ (<type>.exactly <type>)]
- (in (` (is (~ (@JSON#decoded inputT))
- ((~! <>.codec) (~! <codec>) (~! </>.string))))))]
+ [(<type>.exactly Any) </>.null]
+ [(<type>.sub Bit) </>.boolean]
+ [(<type>.sub Nat) (<>.codec ..nat_codec </>.any)]
+ [(<type>.sub Int) (<>.codec ..int_codec </>.any)]
+ [(<type>.sub Frac) </>.number]
+ [(<type>.sub Text) </>.string])
+ <time> (with_template [<type> <codec>]
+ [(do !
+ [_ (<type>.exactly <type>)]
+ (in (` (is (~ (@JSON#decoded inputT))
+ ((~! <>.codec) (~! <codec>) (~! </>.string))))))]
- ... [duration.Duration duration.codec]
- ... [instant.Instant instant.codec]
- [date.Date date.codec]
- [day.Day day.codec]
- [month.Month month.codec])]
- (do [! <>.monad]
- [*env* <type>.env
- .let [g!_ (code.local "_______")
- @JSON#decoded (is (-> Type Code)
- (function (_ type)
- (` (</>.Parser (~ (poly.code *env* type))))))]
- inputT <type>.next]
- (all <>.either
- <basic>
- <time>
- (do !
- [unitT (<type>.applied (<>.after (<type>.exactly unit.Qty)
- <type>.any))]
- (in (` (is (~ (@JSON#decoded inputT))
- ((~! <>.codec) (~! qty_codec) (~! </>.any))))))
- (do !
- [[_ _ valC] (<type>.applied (all <>.and
- (<type>.exactly dictionary.Dictionary)
- (<type>.exactly .Text)
- decoded))]
- (in (` (is (~ (@JSON#decoded inputT))
- ((~! </>.dictionary) (~ valC))))))
- (do !
- [[_ subC] (<type>.applied (<>.and (<type>.exactly .Maybe)
- decoded))]
- (in (` (is (~ (@JSON#decoded inputT))
- ((~! </>.nullable) (~ subC))))))
- (do !
- [[_ subC] (<type>.applied (<>.and (<type>.exactly .List)
- decoded))]
- (in (` (is (~ (@JSON#decoded inputT))
- ((~! </>.array) ((~! <>.some) (~ subC)))))))
- (do !
- [members (<type>.variant (<>.many decoded))
- .let [last (-- (list.size members))]]
- (in (` (is (~ (@JSON#decoded inputT))
- (all ((~! <>.or))
- (~+ (list#each (function (_ [tag memberC])
- (if (n.= last tag)
- (` (|> (~ memberC)
- ((~! <>.after) ((~! </>.this_boolean) (~ (code.bit #1))))
- ((~! <>.after) ((~! </>.this_number) (~ (code.frac (..tag (-- tag))))))
- ((~! </>.array))))
- (` (|> (~ memberC)
- ((~! <>.after) ((~! </>.this_boolean) (~ (code.bit #0))))
- ((~! <>.after) ((~! </>.this_number) (~ (code.frac (..tag tag)))))
- ((~! </>.array))))))
- (list.enumeration members))))))))
- (do !
- [g!decoders (<type>.tuple (<>.many decoded))]
- (in (` (is (~ (@JSON#decoded inputT))
- ((~! </>.array) (all ((~! <>.and)) (~+ g!decoders)))))))
- ... Type recursion
- (do !
- [[selfC bodyC] (<type>.recursive decoded)
- .let [g! (code.local "____________")]]
- (in (` (is (~ (@JSON#decoded inputT))
- ((~! <>.rec) (.function ((~ g!) (~ selfC))
- (~ bodyC)))))))
- <type>.recursive_self
- ... Type applications
- (do !
- [[funcC argsC] (<type>.applied (<>.and decoded (<>.many decoded)))]
- (in (` ((~ funcC) (~+ argsC)))))
- ... Polymorphism
- (do !
- [[funcC varsC bodyC] (<type>.polymorphic decoded)]
- (in (` (is (All ((~ g!_) (~+ varsC))
- (-> (~+ (list#each (|>> (~) </>.Parser (`)) varsC))
- (</>.Parser ((~ (poly.code *env* inputT)) (~+ varsC)))))
- (function ((~ funcC) (~+ varsC))
- (~ bodyC))))))
- <type>.parameter
- <type>.recursive_call
- ... If all else fails...
- (<>.failure (format "Cannot create JSON decoder for: " (type.format inputT)))
- ))))
+ ... [duration.Duration duration.codec]
+ ... [instant.Instant instant.codec]
+ [date.Date date.codec]
+ [day.Day day.codec]
+ [month.Month month.codec])]
+ (do [! <>.monad]
+ [*env* <type>.env
+ .let [g!_ (code.local "_______")
+ @JSON#decoded (is (-> Type Code)
+ (function (_ type)
+ (` (</>.Parser (~ (poly.code *env* type))))))]
+ inputT <type>.next]
+ (all <>.either
+ <basic>
+ <time>
+ (do !
+ [unitT (<type>.applied (<>.after (<type>.exactly unit.Qty)
+ <type>.any))]
+ (in (` (is (~ (@JSON#decoded inputT))
+ ((~! <>.codec) (~! qty_codec) (~! </>.any))))))
+ (do !
+ [[_ _ valC] (<type>.applied (all <>.and
+ (<type>.exactly dictionary.Dictionary)
+ (<type>.exactly .Text)
+ decoded))]
+ (in (` (is (~ (@JSON#decoded inputT))
+ ((~! </>.dictionary) (~ valC))))))
+ (do !
+ [[_ subC] (<type>.applied (<>.and (<type>.exactly .Maybe)
+ decoded))]
+ (in (` (is (~ (@JSON#decoded inputT))
+ ((~! </>.nullable) (~ subC))))))
+ (do !
+ [[_ subC] (<type>.applied (<>.and (<type>.exactly .List)
+ decoded))]
+ (in (` (is (~ (@JSON#decoded inputT))
+ ((~! </>.array) ((~! <>.some) (~ subC)))))))
+ (do !
+ [members (<type>.variant (<>.many decoded))
+ .let [last (-- (list.size members))]]
+ (in (` (is (~ (@JSON#decoded inputT))
+ (all ((~! <>.or))
+ (~+ (list#each (function (_ [tag memberC])
+ (if (n.= last tag)
+ (` (|> (~ memberC)
+ ((~! <>.after) ((~! </>.this_boolean) (~ (code.bit #1))))
+ ((~! <>.after) ((~! </>.this_number) (~ (code.frac (..tag (-- tag))))))
+ ((~! </>.array))))
+ (` (|> (~ memberC)
+ ((~! <>.after) ((~! </>.this_boolean) (~ (code.bit #0))))
+ ((~! <>.after) ((~! </>.this_number) (~ (code.frac (..tag tag)))))
+ ((~! </>.array))))))
+ (list.enumeration members))))))))
+ (do !
+ [g!decoders (<type>.tuple (<>.many decoded))]
+ (in (` (is (~ (@JSON#decoded inputT))
+ ((~! </>.array) (all ((~! <>.and)) (~+ g!decoders)))))))
+ ... Type recursion
+ (do !
+ [[selfC bodyC] (<type>.recursive decoded)
+ .let [g! (code.local "____________")]]
+ (in (` (is (~ (@JSON#decoded inputT))
+ ((~! <>.rec) (.function ((~ g!) (~ selfC))
+ (~ bodyC)))))))
+ <type>.recursive_self
+ ... Type applications
+ (do !
+ [[funcC argsC] (<type>.applied (<>.and decoded (<>.many decoded)))]
+ (in (` ((~ funcC) (~+ argsC)))))
+ ... Polymorphism
+ (do !
+ [[funcC varsC bodyC] (<type>.polymorphic decoded)]
+ (in (` (is (All ((~ g!_) (~+ varsC))
+ (-> (~+ (list#each (|>> (~) </>.Parser (`)) varsC))
+ (</>.Parser ((~ (poly.code *env* inputT)) (~+ varsC)))))
+ (function ((~ funcC) (~+ varsC))
+ (~ bodyC))))))
+ <type>.parameter
+ <type>.recursive_call
+ ... If all else fails...
+ (<>.failure (format "Cannot create JSON decoder for: " (type.format inputT)))
+ )))))
(def: .public codec
(syntax (_ [inputT <code>.any])
diff --git a/stdlib/source/test/lux/ffi.jvm.lux b/stdlib/source/test/lux/ffi.jvm.lux
index e2f50a5e6..146fb5683 100644
--- a/stdlib/source/test/lux/ffi.jvm.lux
+++ b/stdlib/source/test/lux/ffi.jvm.lux
@@ -198,7 +198,7 @@
/.null?
not)))
(~~ (with_template [<object> <primitive> <jvm#value> <jvm#=>
- <lux#value> <as> <of> <lux#=>]
+ <lux#value> <as> <of> <lux#=>]
[(_.coverage [<object> <primitive>]
(|> <jvm#value>
(is <object>)
@@ -262,35 +262,35 @@
(type#= /.Character (/.type char)))))
))))
-(/.interface: test/TestInterface0
+(/.interface test/TestInterface0
([] actual0 [] java/lang/Long))
(/.import test/TestInterface0
"[1]::[0]"
(actual0 [] java/lang/Long))
-(/.interface: test/TestInterface1
+(/.interface test/TestInterface1
([] actual1 [java/lang/Boolean] java/lang/Long "throws" [java/lang/Throwable]))
(/.import test/TestInterface1
"[1]::[0]"
(actual1 [java/lang/Boolean] "try" java/lang/Long))
-(/.interface: test/TestInterface2
+(/.interface test/TestInterface2
([a] actual2 [a] a))
(/.import test/TestInterface2
"[1]::[0]"
([a] actual2 [a] a))
-(/.interface: (test/TestInterface3 a)
+(/.interface (test/TestInterface3 a)
([] actual3 [] a))
(/.import (test/TestInterface3 a)
"[1]::[0]"
(actual3 [] a))
-(/.interface: test/TestInterface4
+(/.interface test/TestInterface4
([] actual4 [long long] long))
(/.import test/TestInterface4
@@ -369,7 +369,7 @@
(/.of_long actual_right)))))]
(i.= expected
(/.of_long (test/TestInterface4::actual4 left right object/4))))]]
- (_.coverage [/.interface: /.object]
+ (_.coverage [/.interface /.object]
(and example/0!
example/1!
example/2!
diff --git a/stdlib/source/test/lux/ffi.old.lux b/stdlib/source/test/lux/ffi.old.lux
index 542c03d34..b00020c6c 100644
--- a/stdlib/source/test/lux/ffi.old.lux
+++ b/stdlib/source/test/lux/ffi.old.lux
@@ -60,7 +60,7 @@
(upC [] void)
(downC [] void))
-(/.interface: TestInterface
+(/.interface TestInterface
([] current [] java/lang/Long "throws" [java/lang/Exception])
([] up [] test/lux/ffi/TestInterface "throws" [java/lang/Exception])
([] down [] test/lux/ffi/TestInterface "throws" [java/lang/Exception]))
@@ -219,7 +219,7 @@
(test/lux/ffi/TestClass::downC))
test/lux/ffi/TestClass::currentC
(i.= (i.+ increase counter))))
- (_.coverage [/.interface: /.object]
+ (_.coverage [/.interface /.object]
(|> (..test_object increase counter)
test/lux/ffi/TestInterface::up
test/lux/ffi/TestInterface::up