aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorEduardo Julian2021-09-13 01:35:52 -0400
committerEduardo Julian2021-09-13 01:35:52 -0400
commitc19b19a2d48c3937bae72982cbb88b78d21b3891 (patch)
tree0215a9cfabfec7ad979dcfa8df0b5ffcc787ec4e
parent6368253e731bd20b5f9f6891306b8302ec330d38 (diff)
Updated new compilers w.r.t. removal of tags/labels.
-rw-r--r--lux-jvm/source/luxc/lang/directive/jvm.lux6
-rw-r--r--lux-jvm/source/luxc/lang/host/jvm.lux6
-rw-r--r--lux-jvm/source/luxc/lang/translation/jvm.lux6
-rw-r--r--lux-jvm/source/luxc/lang/translation/jvm/common.lux74
-rw-r--r--lux-jvm/source/luxc/lang/translation/jvm/expression.lux1
-rw-r--r--lux-jvm/source/luxc/lang/translation/jvm/extension/host.lux6
-rw-r--r--lux-jvm/source/luxc/lang/translation/jvm/function.lux18
-rw-r--r--lux-jvm/source/luxc/lang/translation/jvm/runtime.lux30
-rw-r--r--lux-jvm/source/program.lux16
-rw-r--r--stdlib/source/library/lux.lux3
-rw-r--r--stdlib/source/library/lux/ffi.jvm.lux40
-rw-r--r--stdlib/source/library/lux/tool/compiler/language/lux/phase/analysis.lux2
-rw-r--r--stdlib/source/library/lux/tool/compiler/language/lux/phase/analysis/case.lux149
-rw-r--r--stdlib/source/library/lux/tool/compiler/language/lux/phase/analysis/module.lux4
-rw-r--r--stdlib/source/library/lux/tool/compiler/language/lux/phase/analysis/structure.lux16
-rw-r--r--stdlib/source/library/lux/tool/compiler/meta/io/archive.lux2
-rw-r--r--stdlib/source/library/lux/world/service/authentication.lux26
-rw-r--r--stdlib/source/library/lux/world/service/crud.lux35
-rw-r--r--stdlib/source/library/lux/world/service/inventory.lux34
-rw-r--r--stdlib/source/library/lux/world/service/journal.lux53
-rw-r--r--stdlib/source/library/lux/world/service/mail.lux20
-rw-r--r--stdlib/source/library/lux/world/shell.lux4
22 files changed, 159 insertions, 392 deletions
diff --git a/lux-jvm/source/luxc/lang/directive/jvm.lux b/lux-jvm/source/luxc/lang/directive/jvm.lux
index 7b1b35b52..6063d0df0 100644
--- a/lux-jvm/source/luxc/lang/directive/jvm.lux
+++ b/lux-jvm/source/luxc/lang/directive/jvm.lux
@@ -1464,9 +1464,9 @@
(list#each ..constraint type_variables)
supers
(|> method_declarations
- (list#each (function (_ (^slots [#name #annotations #type_variables #exceptions #arguments #return]))
- (def.abstract_method {jvm.#Public} jvm.noneM name
- (/type.method [type_variables arguments return exceptions]))))
+ (list#each (function (_ (^open "_[0]"))
+ (def.abstract_method {jvm.#Public} jvm.noneM _#name
+ (/type.method [_#type_variables _#arguments _#return _#exceptions]))))
def.fuse))]]]
(directive.lifted_generation
(do !
diff --git a/lux-jvm/source/luxc/lang/host/jvm.lux b/lux-jvm/source/luxc/lang/host/jvm.lux
index 600f26dd7..dc4a3b351 100644
--- a/lux-jvm/source/luxc/lang/host/jvm.lux
+++ b/lux-jvm/source/luxc/lang/host/jvm.lux
@@ -9,6 +9,8 @@
["<[0]>" code]]]
[data
[binary {"+" Binary}]
+ [text
+ ["%" format {"+" format}]]
[collection
["[0]" list ("[1]#[0]" monad)]]]
[macro
@@ -96,14 +98,14 @@
options (<code>.tuple (<>.many <code>.local_identifier))])
(let [g!type (code.local_identifier type)
g!none (code.local_identifier none)
- g!tags+ (list#each code.local_tag options)
+ g!tags+ (list#each (|>> (format "#") code.local_identifier) options)
g!_left (code.local_identifier "_left")
g!_right (code.local_identifier "_right")
g!options+ (list#each (function (_ option)
(` (def: .public (~ (code.local_identifier option))
(~ g!type)
(|> (~ g!none)
- (with@ (~ (code.local_tag option)) #1)))))
+ (with@ (~ (code.local_identifier (format "#" option))) #1)))))
options)]
(in (list& (` (type: .public (~ g!type)
(.Record
diff --git a/lux-jvm/source/luxc/lang/translation/jvm.lux b/lux-jvm/source/luxc/lang/translation/jvm.lux
index b3ae09176..5fee195d4 100644
--- a/lux-jvm/source/luxc/lang/translation/jvm.lux
+++ b/lux-jvm/source/luxc/lang/translation/jvm.lux
@@ -164,14 +164,14 @@
[loader
(: Host
(implementation
- (def: (evaluate! context valueI)
+ (def: (evaluate context valueI)
(# try.monad each product.left
(..evaluate! library loader context valueI)))
- (def: execute!
+ (def: execute
(..execute! library loader))
- (def: define!
+ (def: define
(..define! library loader))
(def: (ingest context bytecode)
diff --git a/lux-jvm/source/luxc/lang/translation/jvm/common.lux b/lux-jvm/source/luxc/lang/translation/jvm/common.lux
deleted file mode 100644
index 57f3ee822..000000000
--- a/lux-jvm/source/luxc/lang/translation/jvm/common.lux
+++ /dev/null
@@ -1,74 +0,0 @@
-(.module:
- [library
- ... [lux "*"
- ... [abstract
- ... [monad {"+" do}]]
- ... [control
- ... ["[0]" try {"+" Try}]
- ... ["ex" exception {"+" exception:}]
- ... ["[0]" io]]
- ... [data
- ... [binary {"+" Binary}]
- ... ["[0]" text {"+" \n} ("[1]#[0]" hash)
- ... format]
- ... [collection
- ... ["[0]" dictionary {"+" Dictionary}]]]
- ... ["[0]" macro]
- ... [host {"+" import:}]
- ... [tool
- ... [compiler
- ... [reference {"+" Register}]
- ... ["[0]" name]
- ... ["[0]" phase]]]
- ... ]
- ]
- ... [luxc
- ... [lang
- ... [host
- ... ["[0]" jvm
- ... [type]]]]]
- )
-
-... (def: .public (with-artifacts action)
-... (All (_ a) (-> (Meta a) (Meta [Artifacts a])))
-... (function (_ state)
-... (case (action (revised@ .#host
-... (|>> (:coerce Host)
-... (with@ #artifacts (dictionary.new text.hash))
-... (:coerce Nothing))
-... state))
-... {try.#Success [state' output]}
-... {try.#Success [(revised@ .#host
-... (|>> (:coerce Host)
-... (with@ #artifacts (|> (value@ .#host state) (:coerce Host) (value@ #artifacts)))
-... (:coerce Nothing))
-... state')
-... [(|> state' (value@ .#host) (:coerce Host) (value@ #artifacts))
-... output]]}
-
-... {try.#Failure error}
-... {try.#Failure error})))
-
-... (def: .public (load-definition state)
-... (-> Lux (-> Name Binary (Try Any)))
-... (function (_ (^@ def-name [def-module def-name]) def-bytecode)
-... (let [normal-name (format (name.normalize def-name) (%n (text#hash def-name)))
-... class-name (format (text.replace-all "/" "." def-module) "." normal-name)]
-... (<| (macro.result state)
-... (do macro.monad
-... [_ (..store-class class-name def-bytecode)
-... class (..load-class class-name)]
-... (case (do try.monad
-... [field (Class::getField [..value-field] class)]
-... (Field::get [{.#None}] field))
-... {try.#Success {.#Some def-value}}
-... (wrap def-value)
-
-... {try.#Success {.#None}}
-... (phase.throw invalid-definition-value (%name def-name))
-
-... {try.#Failure error}
-... (phase.throw cannot-load-definition
-... (format "Definition: " (%name def-name) \n
-... "Error:" \n
-... error))))))))
diff --git a/lux-jvm/source/luxc/lang/translation/jvm/expression.lux b/lux-jvm/source/luxc/lang/translation/jvm/expression.lux
index c2dfe0ace..de8ac3c12 100644
--- a/lux-jvm/source/luxc/lang/translation/jvm/expression.lux
+++ b/lux-jvm/source/luxc/lang/translation/jvm/expression.lux
@@ -13,7 +13,6 @@
[host
[jvm {"+" Phase}]]]]
[//
- ["[0]" common]
["[0]" primitive]
["[0]" structure]
["[0]" reference]
diff --git a/lux-jvm/source/luxc/lang/translation/jvm/extension/host.lux b/lux-jvm/source/luxc/lang/translation/jvm/extension/host.lux
index 137633847..e32e35869 100644
--- a/lux-jvm/source/luxc/lang/translation/jvm/extension/host.lux
+++ b/lux-jvm/source/luxc/lang/translation/jvm/extension/host.lux
@@ -980,7 +980,7 @@
(_.ALOAD (++ register))
(_.PUTFIELD class (///reference.foreign_name register) $Object))))
_.fuse)]
- (_def.method #$.Public $.noneM "<init>" (anonymous_init_method env)
+ (_def.method {$.#Public} $.noneM "<init>" (anonymous_init_method env)
(|>> (_.ALOAD 0)
((_.fuse (list#each product.right inputsTI)))
(_.INVOKESPECIAL super_class "<init>" (type.method [(list) (list#each product.left inputsTI) type.void (list)]))
@@ -1132,7 +1132,7 @@
[bodyG (generation.with_context artifact_id
(generate archive bodyS))
.let [argumentsT (list#each product.right arguments)]]
- (in (_def.method #$.Public
+ (in (_def.method {$.#Public}
(if strict_fp?
($_ $.++M $.finalM $.strictM)
$.finalM)
@@ -1143,7 +1143,7 @@
(returnI returnT)))))))
(# ! each _def.fuse))
.let [directive [anonymous_class_name
- (_def.class #$.V1_6 #$.Public $.finalC
+ (_def.class {$.#V1_6} {$.#Public} $.finalC
anonymous_class_name (list)
super_class super_interfaces
(|>> (///function.with_environment total_environment)
diff --git a/lux-jvm/source/luxc/lang/translation/jvm/function.lux b/lux-jvm/source/luxc/lang/translation/jvm/function.lux
index fc8670946..17a246833 100644
--- a/lux-jvm/source/luxc/lang/translation/jvm/function.lux
+++ b/lux-jvm/source/luxc/lang/translation/jvm/function.lux
@@ -127,7 +127,7 @@
(def: (with_reset class arity env)
(-> (Type Class) Arity (Environment Synthesis) Def)
- (def.method #$.Public $.noneM "reset" (reset_method class)
+ (def.method {$.#Public} $.noneM "reset" (reset_method class)
(if (poly_arg? arity)
(let [env_size (list.size env)
captureI (|> (case env_size
@@ -151,7 +151,7 @@
(def: (with_implementation arity @begin bodyI)
(-> Nat Label Inst Def)
- (def.method #$.Public $.strictM "impl" (implementation_method arity)
+ (def.method {$.#Public} $.strictM "impl" (implementation_method arity)
(|>> (_.label @begin)
bodyI
_.ARETURN)))
@@ -189,7 +189,7 @@
(_.PUTFIELD class (reference.partial_name idx) //.$Value)))))
_.fuse)
function.identity)]
- (def.method #$.Public $.noneM "<init>" (init_method env arity)
+ (def.method {$.#Public} $.noneM "<init>" (init_method env arity)
(|>> (_.ALOAD 0)
(function_init arity env_size)
store_capturedI
@@ -253,7 +253,7 @@
_.ARETURN))
))))
_.fuse)]
- (def.method #$.Public $.noneM //runtime.apply_method (//runtime.apply_signature apply_arity)
+ (def.method {$.#Public} $.noneM //runtime.apply_method (//runtime.apply_signature apply_arity)
(|>> get_amount_of_partialsI
(_.TABLESWITCH +0 (|> num_partials -- .int)
@default @labels)
@@ -264,7 +264,7 @@
(-> (Environment Synthesis) Def)
(|>> list.enumeration
(list@each (.function (_ [env_idx env_source])
- (def.field #$.Private $.finalF (reference.foreign_name env_idx) //.$Value)))
+ (def.field {$.#Private} $.finalF (reference.foreign_name env_idx) //.$Value)))
def.fuse))
(def: (with_partial arity)
@@ -272,7 +272,7 @@
(if (poly_arg? arity)
(|> (enum.range n.enum 0 (n.- 2 arity))
(list@each (.function (_ idx)
- (def.field #$.Private $.finalF (reference.partial_name idx) //.$Value)))
+ (def.field {$.#Private} $.finalF (reference.partial_name idx) //.$Value)))
def.fuse)
function.identity))
@@ -287,12 +287,12 @@
(list@each (with_apply classD env arity @begin bodyI))
(list& (with_implementation arity @begin bodyI))
def.fuse)
- (def.method #$.Public $.strictM //runtime.apply_method (//runtime.apply_signature 1)
+ (def.method {$.#Public} $.strictM //runtime.apply_method (//runtime.apply_signature 1)
(|>> (_.label @begin)
bodyI
_.ARETURN))))
functionD (: Def
- (|>> (def.int_field #$.Public ($_ $.++F $.staticF $.finalF) arity_field (.int arity))
+ (|>> (def.int_field {$.#Public} ($_ $.++F $.staticF $.finalF) arity_field (.int arity))
(with_environment env)
(with_partial arity)
(with_init classD env arity)
@@ -322,7 +322,7 @@
.let [function_class (//.class_name function_context)]
[functionD instanceI] (..with_function generate archive @begin function_class env arity bodyI)
.let [directive [function_class
- (def.class #$.V1_6 #$.Public $.finalC
+ (def.class {$.#V1_6} {$.#Public} $.finalC
function_class (list)
//.$Function (list)
functionD)]]
diff --git a/lux-jvm/source/luxc/lang/translation/jvm/runtime.lux b/lux-jvm/source/luxc/lang/translation/jvm/runtime.lux
index cb62ddb4b..ae14639f0 100644
--- a/lux-jvm/source/luxc/lang/translation/jvm/runtime.lux
+++ b/lux-jvm/source/luxc/lang/translation/jvm/runtime.lux
@@ -122,7 +122,7 @@
(let [store_leftsI (|>> _.DUP _.ICONST_0 (_.ILOAD 0) (_.wrap type.int) _.AASTORE)
store_flagI (|>> _.DUP _.ICONST_1 (_.ALOAD 1) _.AASTORE)
store_valueI (|>> _.DUP _.ICONST_2 (_.ALOAD 2) _.AASTORE)]
- (|>> ($d.method #$.Public $.staticM "variant_make"
+ (|>> ($d.method {$.#Public} $.staticM "variant_make"
(type.method [(list) (list $Lefts $Right? $Value) //.$Variant (list)])
(|>> _.ICONST_3
(_.ANEWARRAY $Value)
@@ -133,7 +133,7 @@
(def: frac_methods
Def
- (|>> ($d.method #$.Public $.staticM "decode_frac" (type.method [(list) (list $Text) //.$Variant (list)])
+ (|>> ($d.method {$.#Public} $.staticM "decode_frac" (type.method [(list) (list $Text) //.$Variant (list)])
(tryI
(|>> (_.ALOAD 0)
(_.INVOKESTATIC (type.class "java.lang.Double" (list)) "parseDouble" (type.method [(list) (list $Text) type.double (list)]))
@@ -169,13 +169,13 @@
(|>> sub_leftsI (_.ISTORE 1)
sub_tupleI (_.ASTORE 0)
(_.GOTO @loop))))]
- (|>> ($d.method #$.Public $.staticM "pm_fail" throw_methodT
+ (|>> ($d.method {$.#Public} $.staticM "pm_fail" throw_methodT
(|>> (illegal_state_exception "Invalid expression for pattern-matching.")
_.ATHROW))
- ($d.method #$.Public $.staticM "apply_fail" throw_methodT
+ ($d.method {$.#Public} $.staticM "apply_fail" throw_methodT
(|>> (illegal_state_exception "Error while applying function.")
_.ATHROW))
- ($d.method #$.Public $.staticM "pm_push" (type.method [(list) (list $Stack $Value) $Stack (list)])
+ ($d.method {$.#Public} $.staticM "pm_push" (type.method [(list) (list $Stack $Value) $Stack (list)])
(|>> _.ICONST_2
(_.ANEWARRAY $Value)
_.DUP
@@ -187,7 +187,7 @@
(_.ALOAD 1)
_.AASTORE
_.ARETURN))
- ($d.method #$.Public $.staticM "pm_variant" (type.method [(list) (list //.$Variant $Lefts $Right?) $Value (list)])
+ ($d.method {$.#Public} $.staticM "pm_variant" (type.method [(list) (list //.$Variant $Lefts $Right?) $Value (list)])
(<| _.with_label (function (_ @loop))
_.with_label (function (_ @perfect_match!))
_.with_label (function (_ @lefts_match!))
@@ -261,7 +261,7 @@
... _.POP2
$variant ::value
_.ARETURN)))
- ($d.method #$.Public $.staticM "tuple_left" (type.method [(list) (list //.$Tuple $Index) $Value (list)])
+ ($d.method {$.#Public} $.staticM "tuple_left" (type.method [(list) (list //.$Tuple $Index) $Value (list)])
(<| _.with_label (function (_ @loop))
_.with_label (function (_ @recursive))
(let [left_accessI (|>> (_.ALOAD 0) left_indexI _.AALOAD)])
@@ -272,7 +272,7 @@
(_.label @recursive)
... Recursive
(recurI @loop))))
- ($d.method #$.Public $.staticM "tuple_right" (type.method [(list) (list //.$Tuple $Index) $Value (list)])
+ ($d.method {$.#Public} $.staticM "tuple_right" (type.method [(list) (list //.$Tuple $Index) $Value (list)])
(<| _.with_label (function (_ @loop))
_.with_label (function (_ @not_tail))
_.with_label (function (_ @slice))
@@ -323,7 +323,7 @@
(_.boolean true)
(_.INVOKESPECIAL PrintWriter "<init>" (type.method [(list) (list (type.class "java.io.Writer" (list)) type.boolean) type.void (list)]))
)]
- (|>> ($d.method #$.Public $.staticM "try" ..try
+ (|>> ($d.method {$.#Public} $.staticM "try" ..try
(<| _.with_label (function (_ @from))
_.with_label (function (_ @to))
_.with_label (function (_ @handler))
@@ -356,7 +356,7 @@
(def: translate_runtime
(Operation [artifact.ID (Maybe Text) Binary])
(let [runtime_class (..reflection //.$Runtime)
- bytecode ($d.class #$.V1_6 #$.Public $.finalC runtime_class (list) (type.class "java.lang.Object" (list)) (list)
+ bytecode ($d.class {$.#V1_6} {$.#Public} $.finalC runtime_class (list) (type.class "java.lang.Object" (list)) (list)
(|>> adt_methods
frac_methods
pm_methods
@@ -374,7 +374,7 @@
(Operation [artifact.ID (Maybe Text) Binary])
(let [applyI (|> (enum.range n.enum 2 num_apply_variants)
(list@each (function (_ arity)
- ($d.method #$.Public $.noneM apply_method (apply_signature arity)
+ ($d.method {$.#Public} $.noneM apply_method (apply_signature arity)
(let [preI (|> (enum.range n.enum 0 (-- arity))
(list@each _.ALOAD)
_.fuse)]
@@ -384,13 +384,13 @@
(_.ALOAD arity)
(_.INVOKEVIRTUAL //.$Function apply_method (apply_signature 1))
_.ARETURN)))))
- (list& ($d.abstract_method #$.Public $.noneM apply_method (apply_signature 1)))
+ (list& ($d.abstract_method {$.#Public} $.noneM apply_method (apply_signature 1)))
$d.fuse)
$Object (type.class "java.lang.Object" (list))
function_class (..reflection //.$Function)
- bytecode ($d.abstract #$.V1_6 #$.Public $.noneC function_class (list) $Object (list)
- (|>> ($d.field #$.Public $.finalF partials_field type.int)
- ($d.method #$.Public $.noneM "<init>" (type.method [(list) (list type.int) type.void (list)])
+ bytecode ($d.abstract {$.#V1_6} {$.#Public} $.noneC function_class (list) $Object (list)
+ (|>> ($d.field {$.#Public} $.finalF partials_field type.int)
+ ($d.method {$.#Public} $.noneM "<init>" (type.method [(list) (list type.int) type.void (list)])
(|>> (_.ALOAD 0)
(_.INVOKESPECIAL $Object "<init>" nullary_init_methodT)
(_.ALOAD 0)
diff --git a/lux-jvm/source/program.lux b/lux-jvm/source/program.lux
index 4484db653..79205fd84 100644
--- a/lux-jvm/source/program.lux
+++ b/lux-jvm/source/program.lux
@@ -144,27 +144,27 @@
unwrap_long (: (-> Synthesis Synthesis)
(|>> (list ($.text jvm/type/box.long)
($.text "long"))
- {#$.Extension "jvm object cast"}))
+ {$.#Extension "jvm object cast"}))
long_to_int (: (-> Synthesis Synthesis)
(|>> (list)
- {#$.Extension "jvm conversion long-to-int"}))
+ {$.#Extension "jvm conversion long-to-int"}))
literal_nat (: (-> Nat Synthesis)
(|>> .i64 $.i64 unwrap_long long_to_int))
write! (: (-> Text Nat Synthesis Synthesis Synthesis)
(function (_ element_class index value array)
- {#$.Extension "jvm array write object"
+ {$.#Extension "jvm array write object"
(list (jvm_type (jvm/type.array (jvm/type.class element_class (list))))
(literal_nat index)
value
array)}))
object_array (: (-> Text Nat Synthesis)
(function (_ class_name size)
- {#$.Extension "jvm array new object"
+ {$.#Extension "jvm array new object"
(list (class_type class_name)
(literal_nat size))}))
class_of (: (-> Synthesis Synthesis)
(function (_ object)
- {#$.Extension "jvm member invoke virtual"
+ {$.#Extension "jvm member invoke virtual"
(list& (class_type "java.lang.Object")
($.text "getClass")
(class_type "java.lang.Class")
@@ -174,7 +174,7 @@
(function (_ value_type value)
($.tuple (list (jvm_type value_type) value))))
- example_object {#$.Extension "jvm member invoke constructor"
+ example_object {$.#Extension "jvm member invoke constructor"
(list& (class_type "java.lang.Object")
(list))}
phase_arity 3
@@ -182,7 +182,7 @@
$archive ($.variable/local 2)
$input ($.variable/local 3)
$state ($.variable/local 4)
- apply_method {#$.Extension "jvm member invoke virtual"
+ apply_method {$.#Extension "jvm member invoke virtual"
(list& (class_type "java.lang.Class")
($.text "getMethod")
(class_type "java.lang.reflect.Method")
@@ -194,7 +194,7 @@
(write! "java.lang.Class" 0 (class_of example_object))
(write! "java.lang.Class" 1 (class_of example_object))
(write! "java.lang.Class" 2 (class_of example_object))))))}]
- {#$.Extension "jvm member invoke virtual"
+ {$.#Extension "jvm member invoke virtual"
(list& (class_type "java.lang.reflect.Method")
($.text "invoke")
(class_type "java.lang.Object")
diff --git a/stdlib/source/library/lux.lux b/stdlib/source/library/lux.lux
index c912c6bb1..6eb000a79 100644
--- a/stdlib/source/library/lux.lux
+++ b/stdlib/source/library/lux.lux
@@ -4051,7 +4051,8 @@
(macro: .public (# tokens)
(case tokens
(^ (list struct [_ {#Identifier member}]))
- (in_meta (list (` (let [(^open (~ (text$ (alias_stand_in 0)))) (~ struct)] (~ (identifier$ member))))))
+ (in_meta (list (` (let [(^open (~ (text$ (alias_stand_in 0)))) (~ struct)]
+ (~ (identifier$ member))))))
(^ (list& struct member args))
(in_meta (list (` ((..# (~ struct) (~ member)) (~+ args)))))
diff --git a/stdlib/source/library/lux/ffi.jvm.lux b/stdlib/source/library/lux/ffi.jvm.lux
index 2d753a3cd..4b7d33f51 100644
--- a/stdlib/source/library/lux/ffi.jvm.lux
+++ b/stdlib/source/library/lux/ffi.jvm.lux
@@ -445,7 +445,7 @@
(def: (parser->replacer p ast)
(-> (Parser Code) (-> Code Code))
(case (<>.result p (list ast))
- {.#Right [.#End ast']}
+ {.#Right [{.#End} ast']}
ast'
_
@@ -1585,42 +1585,42 @@
{#FieldAccessDecl fad}
(do meta.monad
- [.let [(^open "[0]") fad
- getter_name (code.identifier ["" (..import_name import_format method_prefix import_field_name)])
- setter_name (code.identifier ["" (..import_name import_format method_prefix (format import_field_name "!"))])]
+ [.let [(^open "_[0]") fad
+ getter_name (code.identifier ["" (..import_name import_format method_prefix _#import_field_name)])
+ setter_name (code.identifier ["" (..import_name import_format method_prefix (format _#import_field_name "!"))])]
getter_interop (with_identifiers [g!obj]
- (let [getter_call (if import_field_static?
+ (let [getter_call (if _#import_field_static?
(` ((~ getter_name) []))
(` ((~ getter_name) [(~ g!obj) (~! <code>.any)])))
- getter_body (<| (with_automatic_output_conversion import_field_mode)
- [import_field_type
- (if import_field_static?
- (get_static_field full_name import_field_name)
- (get_virtual_field full_name import_field_name (..un_quoted g!obj)))])
- getter_body (if import_field_maybe?
+ getter_body (<| (with_automatic_output_conversion _#import_field_mode)
+ [_#import_field_type
+ (if _#import_field_static?
+ (get_static_field full_name _#import_field_name)
+ (get_virtual_field full_name _#import_field_name (..un_quoted g!obj)))])
+ getter_body (if _#import_field_maybe?
(` ((~! ???) (~ getter_body)))
getter_body)
- getter_body (if import_field_setter?
+ getter_body (if _#import_field_setter?
(` ((~! io.io) (~ getter_body)))
getter_body)]
(in (` ((~! syntax:) (~ getter_call)
((~' in) (.list (.` (~ getter_body)))))))))
setter_interop (: (Meta (List Code))
- (if import_field_setter?
+ (if _#import_field_setter?
(with_identifiers [g!obj g!value]
- (let [setter_call (if import_field_static?
+ (let [setter_call (if _#import_field_static?
(` ((~ setter_name) [(~ g!value) (~! <code>.any)]))
(` ((~ setter_name) [(~ g!value) (~! <code>.any)
(~ g!obj) (~! <code>.any)])))
- setter_value (|> [import_field_type (..un_quoted g!value)]
- (with_automatic_input_conversion import_field_mode))
- setter_value (if import_field_maybe?
+ setter_value (|> [_#import_field_type (..un_quoted g!value)]
+ (with_automatic_input_conversion _#import_field_mode))
+ setter_value (if _#import_field_maybe?
(` ((~! !!!) (~ setter_value)))
setter_value)
- setter_command (format (if import_field_static? "jvm putstatic" "jvm putfield")
- ":" full_name ":" import_field_name)
+ setter_command (format (if _#import_field_static? "jvm putstatic" "jvm putfield")
+ ":" full_name ":" _#import_field_name)
g!obj+ (: (List Code)
- (if import_field_static?
+ (if _#import_field_static?
(list)
(list (..un_quoted g!obj))))]
(in (list (` ((~! syntax:) (~ setter_call)
diff --git a/stdlib/source/library/lux/tool/compiler/language/lux/phase/analysis.lux b/stdlib/source/library/lux/tool/compiler/language/lux/phase/analysis.lux
index 22840635e..ace3fcee8 100644
--- a/stdlib/source/library/lux/tool/compiler/language/lux/phase/analysis.lux
+++ b/stdlib/source/library/lux/tool/compiler/language/lux/phase/analysis.lux
@@ -68,7 +68,7 @@
(^ {.#Variant (list& [_ {.#Nat lefts}] [_ {.#Bit right?}]
values)})
(case values
- {.#Item value .#End}
+ {.#Item value {.#End}}
(/structure.sum compile lefts right? archive value)
_
diff --git a/stdlib/source/library/lux/tool/compiler/language/lux/phase/analysis/case.lux b/stdlib/source/library/lux/tool/compiler/language/lux/phase/analysis/case.lux
index 95fdfdc45..146ea09cf 100644
--- a/stdlib/source/library/lux/tool/compiler/language/lux/phase/analysis/case.lux
+++ b/stdlib/source/library/lux/tool/compiler/language/lux/phase/analysis/case.lux
@@ -153,6 +153,56 @@
outputA next]
(in [output outputA]))))
+(def: (analyse_tuple_pattern analyse_pattern inputT sub_patterns next)
+ (All (_ a)
+ (-> (-> (Maybe Nat) Type Code (Operation a) (Operation [Pattern a]))
+ Type (List Code) (Operation a) (Operation [Pattern a])))
+ (do [! ///.monad]
+ [inputT' (simplify_case inputT)]
+ (.case inputT'
+ {.#Product _}
+ (let [matches (loop [types (type.flat_tuple inputT')
+ patterns sub_patterns
+ output (: (List [Type Code])
+ {.#End})]
+ (.case [types patterns]
+ [{.#End} {.#End}]
+ output
+
+ [{.#Item headT {.#End}} {.#Item headP {.#End}}]
+ {.#Item [headT headP] output}
+
+ [remainingT {.#Item headP {.#End}}]
+ {.#Item [(type.tuple remainingT) headP] output}
+
+ [{.#Item headT {.#End}} remainingP]
+ {.#Item [headT (code.tuple remainingP)] output}
+
+ [{.#Item headT tailT} {.#Item headP tailP}]
+ (recur tailT tailP {.#Item [headT headP] output})
+
+ _
+ (undefined)))]
+ (do !
+ [[memberP+ thenA] (list#mix (: (All (_ a)
+ (-> [Type Code] (Operation [(List Pattern) a])
+ (Operation [(List Pattern) a])))
+ (function (_ [memberT memberC] then)
+ (do !
+ [[memberP [memberP+ thenA]] ((:as (All (_ a) (-> (Maybe Nat) Type Code (Operation a) (Operation [Pattern a])))
+ analyse_pattern)
+ {.#None} memberT memberC then)]
+ (in [(list& memberP memberP+) thenA]))))
+ (do !
+ [nextA next]
+ (in [(list) nextA]))
+ matches)]
+ (in [(/.pattern/tuple memberP+)
+ thenA])))
+
+ _
+ (/.except ..cannot_match_with_pattern [inputT' (code.tuple sub_patterns)]))))
+
... This function handles several concerns at once, but it must be that
... way because those concerns are interleaved when doing
... pattern-matching and they cannot be separated.
@@ -195,78 +245,35 @@
(analyse_pattern {.#None} inputT singleton next)
[location {.#Tuple sub_patterns}]
- (do [! ///.monad]
- [record (//structure.normal sub_patterns)
- record_size,members,recordT (: (Operation (Maybe [Nat (List Code) Type]))
- (.case record
- {.#Some record}
- (//structure.order record)
-
- {.#None}
- (in {.#None})))]
- (.case record_size,members,recordT
- {.#Some [record_size members recordT]}
- (do !
- [_ (.case inputT
- {.#Var _id}
- (//type.with_env
- (check.check inputT recordT))
-
- _
- (in []))]
- (analyse_pattern {.#Some record_size} inputT [location {.#Tuple members}] next))
-
- {.#None}
- (/.with_location location
- (do [! ///.monad]
- [inputT' (simplify_case inputT)]
- (.case inputT'
- {.#Product _}
- (let [matches (loop [types (type.flat_tuple inputT')
- patterns sub_patterns
- output (: (List [Type Code])
- {.#End})]
- (.case [types patterns]
- [{.#End} {.#End}]
- output
-
- [{.#Item headT {.#End}} {.#Item headP {.#End}}]
- {.#Item [headT headP] output}
-
- [remainingT {.#Item headP {.#End}}]
- {.#Item [(type.tuple remainingT) headP] output}
-
- [{.#Item headT {.#End}} remainingP]
- {.#Item [headT (code.tuple remainingP)] output}
-
- [{.#Item headT tailT} {.#Item headP tailP}]
- (recur tailT tailP {.#Item [headT headP] output})
-
- _
- (undefined)))]
- (do !
- [[memberP+ thenA] (list#mix (: (All (_ a)
- (-> [Type Code] (Operation [(List Pattern) a])
- (Operation [(List Pattern) a])))
- (function (_ [memberT memberC] then)
- (do !
- [[memberP [memberP+ thenA]] ((:as (All (_ a) (-> (Maybe Nat) Type Code (Operation a) (Operation [Pattern a])))
- analyse_pattern)
- {.#None} memberT memberC then)]
- (in [(list& memberP memberP+) thenA]))))
- (do !
- [nextA next]
- (in [(list) nextA]))
- matches)]
- (in [(/.pattern/tuple memberP+)
- thenA])))
+ (/.with_location location
+ (do [! ///.monad]
+ [record (//structure.normal sub_patterns)
+ record_size,members,recordT (: (Operation (Maybe [Nat (List Code) Type]))
+ (.case record
+ {.#Some record}
+ (//structure.order record)
+
+ {.#None}
+ (in {.#None})))]
+ (.case record_size,members,recordT
+ {.#Some [record_size members recordT]}
+ (do !
+ [_ (.case inputT
+ {.#Var _id}
+ (//type.with_env
+ (check.check inputT recordT))
+
+ _
+ (in []))]
+ (.case members
+ (^ (list singleton))
+ (analyse_pattern {.#None} inputT singleton next)
_
- (/.except ..cannot_match_with_pattern [inputT' pattern]))))))
-
- [location {.#Tag tag}]
- (/.with_location location
- (analyse_pattern {.#None} inputT (` {(~ pattern)}) next))
+ (analyse_tuple_pattern analyse_pattern inputT members next)))
+
+ {.#None}
+ (analyse_tuple_pattern analyse_pattern inputT sub_patterns next))))
(^ [location {.#Variant (list& [_ {.#Nat lefts}] [_ {.#Bit right?}] values)}])
(/.with_location location
@@ -307,7 +314,7 @@
_
(/.except ..cannot_match_with_pattern [inputT' pattern]))))
- (^ [location {.#Variant (list& [_ {.#Tag tag}] values)}])
+ (^ [location {.#Variant (list& [_ {.#Identifier tag}] values)}])
(/.with_location location
(do ///.monad
[tag (///extension.lifted (meta.normal tag))
diff --git a/stdlib/source/library/lux/tool/compiler/language/lux/phase/analysis/module.lux b/stdlib/source/library/lux/tool/compiler/language/lux/phase/analysis/module.lux
index 877566e72..cd0004d31 100644
--- a/stdlib/source/library/lux/tool/compiler/language/lux/phase/analysis/module.lux
+++ b/stdlib/source/library/lux/tool/compiler/language/lux/phase/analysis/module.lux
@@ -181,8 +181,8 @@
{.#Some module}
{try.#Success [state
(case (value@ .#module_state module)
- <tag> #1
- _ #0)]}
+ {<tag>} #1
+ _ #0)]}
{.#None}
((/.except' unknown_module module_name) state)))))]
diff --git a/stdlib/source/library/lux/tool/compiler/language/lux/phase/analysis/structure.lux b/stdlib/source/library/lux/tool/compiler/language/lux/phase/analysis/structure.lux
index c01f6970b..dc96cfd4d 100644
--- a/stdlib/source/library/lux/tool/compiler/language/lux/phase/analysis/structure.lux
+++ b/stdlib/source/library/lux/tool/compiler/language/lux/phase/analysis/structure.lux
@@ -76,19 +76,19 @@
[(exception: .public (<name> [key Name
record (List [Name Code])])
(exception.report
- ["Tag" (%.code (code.tag key))]
+ ["Tag" (%.code (code.identifier key))]
["Record" (%.code (code.tuple (|> record
(list#each (function (_ [keyI valC])
- (list (code.tag keyI) valC)))
+ (list (code.identifier keyI) valC)))
list#conjoint)))]))]
- [cannot_repeat_tag]
+ [cannot_repeat_slot]
)
(exception: .public (slot_does_not_belong_to_record [key Name
type Type])
(exception.report
- ["Tag" (%.code (code.tag key))]
+ ["Tag" (%.code (code.identifier key))]
["Type" (%.type type)]))
(exception: .public (record_size_mismatch [expected Nat
@@ -101,7 +101,7 @@
["Type" (%.type type)]
["Expression" (%.code (|> record
(list#each (function (_ [keyI valueC])
- (list (code.tag keyI) valueC)))
+ (list (code.identifier keyI) valueC)))
list#conjoint
code.tuple))]))
@@ -310,7 +310,7 @@
output (: (List [Name Code])
{.#End})]
(case input
- (^ (list& [_ {.#Tag slotH}] valueH tail))
+ (^ (list& [_ {.#Identifier slotH}] valueH tail))
(do ///.monad
[slotH (///extension.lifted (meta.normal slotH))]
(recur tail {.#Item [slotH valueH] output}))
@@ -354,7 +354,7 @@
(case (dictionary.value key tag->idx)
{.#Some idx}
(if (dictionary.key? idx->val idx)
- (/.except ..cannot_repeat_tag [key record])
+ (/.except ..cannot_repeat_slot [key record])
(in (dictionary.has idx val idx->val)))
{.#None}
@@ -380,7 +380,7 @@
(^ (list singletonC))
(analyse archive singletonC)
- (^ (list [_ {.#Tag pseudo_slot}] singletonC))
+ (^ (list [_ {.#Identifier pseudo_slot}] singletonC))
(do [! ///.monad]
[head_k (///extension.lifted (meta.normal pseudo_slot))
slot (///extension.lifted (meta.try (meta.slot head_k)))]
diff --git a/stdlib/source/library/lux/tool/compiler/meta/io/archive.lux b/stdlib/source/library/lux/tool/compiler/meta/io/archive.lux
index 8c8df0a6f..5328ecf74 100644
--- a/stdlib/source/library/lux/tool/compiler/meta/io/archive.lux
+++ b/stdlib/source/library/lux/tool/compiler/meta/io/archive.lux
@@ -231,7 +231,7 @@
(case artifact_category
{artifact.#Anonymous}
(do !
- [.let [output (row.suffix [artifact_id .#None data] output)]
+ [.let [output (row.suffix [artifact_id {.#None} data] output)]
_ (# host re_learn context {.#None} directive)]
(in [definitions
[analysers
diff --git a/stdlib/source/library/lux/world/service/authentication.lux b/stdlib/source/library/lux/world/service/authentication.lux
deleted file mode 100644
index 069eac560..000000000
--- a/stdlib/source/library/lux/world/service/authentication.lux
+++ /dev/null
@@ -1,26 +0,0 @@
-(.module:
- [library
- [lux "*"
- [control
- [try {"+" Try}]
- [security
- [capability {"+" Capability}]]]]])
-
-(type: .public (Can_Register ! account secret value)
- (Capability [account secret value] (! (Try Any))))
-
-(type: .public (Can_Authenticate ! account secret value)
- (Capability [account secret] (! (Try value))))
-
-(type: .public (Can_Reset ! account secret)
- (Capability [account secret] (! (Try Any))))
-
-(type: .public (Can_Forget ! account)
- (Capability [account] (! (Try Any))))
-
-(type: .public (Service ! account secret value)
- (Record
- [#can_register (Can_Register ! account secret value)
- #can_authenticate (Can_Authenticate ! account secret value)
- #can_reset (Can_Reset ! account secret)
- #can_forget (Can_Forget ! account)]))
diff --git a/stdlib/source/library/lux/world/service/crud.lux b/stdlib/source/library/lux/world/service/crud.lux
deleted file mode 100644
index db6145c55..000000000
--- a/stdlib/source/library/lux/world/service/crud.lux
+++ /dev/null
@@ -1,35 +0,0 @@
-(.module:
- [library
- [lux "*"
- [control
- ["[0]" try {"+" Try}]
- [security
- ["!" capability {"+" capability:}]]]
- [time
- ["[0]" instant {"+" Instant}]]]])
-
-(type: .public ID Nat)
-
-(type: .public Time
- (Record
- [#created Instant
- #updated Instant]))
-
-(capability: .public (Can_Create ! entity)
- (can_create [Instant entity] (! (Try ID))))
-
-(capability: .public (Can_Retrieve ! entity)
- (can_retrieve ID (! (Try [Time entity]))))
-
-(capability: .public (Can_Update ! entity)
- (can_update [ID Instant entity] (! (Try Any))))
-
-(capability: .public (Can_Delete ! entity)
- (can_delete ID (! (Try Any))))
-
-(type: .public (CRUD ! entity)
- (Record
- [#can_create (Can_Create ! entity)
- #can_retrieve (Can_Retrieve ! entity)
- #can_update (Can_Update ! entity)
- #can_delete (Can_Delete ! entity)]))
diff --git a/stdlib/source/library/lux/world/service/inventory.lux b/stdlib/source/library/lux/world/service/inventory.lux
deleted file mode 100644
index 114227887..000000000
--- a/stdlib/source/library/lux/world/service/inventory.lux
+++ /dev/null
@@ -1,34 +0,0 @@
-(.module:
- [library
- [lux "*"
- [control
- [try {"+" Try}]
- [security
- ["!" capability {"+" capability:}]]]]])
-
-(type: .public ID
- Nat)
-
-(type: .public Ownership
- (Record
- [#owner ID
- #property ID]))
-
-(capability: .public (Can_Own !)
- (can_own Ownership (! (Try Any))))
-
-(capability: .public (Can_Disown !)
- (can_disown Ownership (! (Try Any))))
-
-(capability: .public (Can_Check !)
- (can_check Ownership (! (Try Bit))))
-
-(capability: .public (Can_List_Property !)
- (can_list_property ID (! (Try (List ID)))))
-
-(type: .public (Inventory !)
- (Record
- [#can_own (Can_Own !)
- #can_disown (Can_Disown !)
- #can_check (Can_Check !)
- #can_list_property (Can_List_Property !)]))
diff --git a/stdlib/source/library/lux/world/service/journal.lux b/stdlib/source/library/lux/world/service/journal.lux
deleted file mode 100644
index 49ac101ba..000000000
--- a/stdlib/source/library/lux/world/service/journal.lux
+++ /dev/null
@@ -1,53 +0,0 @@
-(.module:
- [library
- [lux "*"
- [control
- [equivalence {"+" Equivalence}]
- [interval {"+" Interval}]
- [try {"+" Try}]
- [security
- ["!" capability {"+" capability:}]]]
- [data
- ["[0]" text ("[1]#[0]" equivalence)]]
- [time
- ["[0]" instant {"+" Instant} ("[1]#[0]" equivalence)]]]])
-
-(type: .public (Entry a)
- (Record
- [#what a
- #why Text
- #how Text
- #who Text
- #where Text
- #when Instant]))
-
-(type: .public Range
- (Interval Instant))
-
-(def: .public (range start end)
- (-> Instant Instant Range)
- (implementation
- (def: &enum instant.enum)
- (def: bottom start)
- (def: top end)))
-
-(implementation: .public (equivalence (^open "_#[0]"))
- (All (_ a) (-> (Equivalence a) (Equivalence (Entry a))))
- (def: (= reference sample)
- (and (_#= (value@ #what reference) (value@ #what sample))
- (text#= (value@ #why reference) (value@ #why sample))
- (text#= (value@ #how reference) (value@ #how sample))
- (text#= (value@ #who reference) (value@ #who sample))
- (text#= (value@ #where reference) (value@ #where sample))
- (instant#= (value@ #when reference) (value@ #when sample)))))
-
-(capability: .public (Can_Write ! a)
- (can_write (Entry a) (! (Try Any))))
-
-(capability: .public (Can_Read ! a)
- (can_read Range (! (Try (List (Entry a))))))
-
-(type: .public (Journal ! a)
- (Record
- [#can_write (Can_Write ! a)
- #can_read (Can_Read ! a)]))
diff --git a/stdlib/source/library/lux/world/service/mail.lux b/stdlib/source/library/lux/world/service/mail.lux
deleted file mode 100644
index 6f189d485..000000000
--- a/stdlib/source/library/lux/world/service/mail.lux
+++ /dev/null
@@ -1,20 +0,0 @@
-(.module:
- [library
- [lux "*"
- [control
- [try {"+" Try}]
- [concurrency
- [frp {"+" Channel}]]
- [security
- ["!" capability {"+" capability:}]]]]])
-
-(capability: .public (Can_Send ! address message)
- (can_send [address message] (! (Try Any))))
-
-(capability: .public (Can_Subscribe ! address message)
- (can_subscribe [address] (! (Try (Channel message)))))
-
-(type: .public (Service ! address message)
- (Record
- [#can_send (Can_Send ! address message)
- #can_subscribe (Can_Subscribe ! address message)]))
diff --git a/stdlib/source/library/lux/world/shell.lux b/stdlib/source/library/lux/world/shell.lux
index c5f626e09..83cf1aeda 100644
--- a/stdlib/source/library/lux/world/shell.lux
+++ b/stdlib/source/library/lux/world/shell.lux
@@ -293,9 +293,9 @@
(implementation: .public default
(Shell IO)
- (def: (execute [environment working_directory command arguments])
+ (def: (execute [environment working_directory the_command arguments])
(do [! (try.with io.monad)]
- [.let [builder (|> (list& command arguments)
+ [.let [builder (|> (list& the_command arguments)
..jvm::arguments_array
java/lang/ProcessBuilder::new
(java/lang/ProcessBuilder::directory (java/io/File::new working_directory)))]