aboutsummaryrefslogtreecommitdiff
path: root/stdlib/source
diff options
context:
space:
mode:
Diffstat (limited to '')
-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
13 files changed, 114 insertions, 274 deletions
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)))]