aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--stdlib/source/lux.lux63
-rw-r--r--stdlib/source/lux/data/coll/dict.lux20
-rw-r--r--stdlib/source/lux/data/error.lux4
-rw-r--r--stdlib/source/lux/data/text/regex.lux1
-rw-r--r--stdlib/source/lux/host.jvm.lux8
-rw-r--r--stdlib/source/lux/macro.lux17
-rw-r--r--stdlib/source/lux/type.lux18
-rw-r--r--stdlib/source/lux/type/check.lux32
8 files changed, 98 insertions, 65 deletions
diff --git a/stdlib/source/lux.lux b/stdlib/source/lux.lux
index 08ef10e51..8be7f8d26 100644
--- a/stdlib/source/lux.lux
+++ b/stdlib/source/lux.lux
@@ -143,7 +143,7 @@
TypeList
(_lux_case (+4 Type Type)
TypePair
- (+11 (+9 (+0)
+ (+11 (+9 #Nil
(+3 ## "lux;HostT"
(+4 Text TypeList)
(+3 ## "lux;VoidT"
@@ -195,7 +195,7 @@
## (Ex [a] a))
(_lux_def Top
(#NamedT ["lux" "Top"]
- (#ExQ (+0) (#BoundT +1)))
+ (#ExQ #Nil (#BoundT +1)))
(#Cons [["lux" "type?"] (+0 true)]
(#Cons [["lux" "export?"] (+0 true)]
(#Cons [["lux" "doc"] (+6 "The type of things whose type does not matter.
@@ -207,7 +207,7 @@
## (All [a] a))
(_lux_def Bottom
(#NamedT ["lux" "Bottom"]
- (#UnivQ (+0) (#BoundT +1)))
+ (#UnivQ #Nil (#BoundT +1)))
(#Cons [["lux" "type?"] (+0 true)]
(#Cons [["lux" "export?"] (+0 true)]
(#Cons [["lux" "doc"] (+6 "The type of things whose type is unknown or undefined.
@@ -351,18 +351,11 @@
(#Cons [["lux" "type-args"] (#ListA (#Cons (#TextA "m") (#Cons (#TextA "v") #;Nil)))]
default-def-meta-exported))))
-(_lux_def Analysis
- (#NamedT ["lux" "Analysis"]
- (#AppT (#AppT Meta
- (#ProdT Type Cursor))
- Void))
- default-def-meta-exported)
-
## (type: Scope
## {#name (List Text)
## #inner-closures Int
-## #locals (Bindings Text Analysis)
-## #closure (Bindings Text Analysis)})
+## #locals (Bindings Text Void)
+## #closure (Bindings Text Void)})
(_lux_def Scope
(#NamedT ["lux" "Scope"]
(#ProdT ## "lux;name"
@@ -370,9 +363,9 @@
(#ProdT ## "lux;inner-closures"
Int
(#ProdT ## "lux;locals"
- (#AppT (#AppT Bindings Text) Analysis)
+ (#AppT (#AppT Bindings Text) Void)
## "lux;closure"
- (#AppT (#AppT Bindings Text) Analysis)))))
+ (#AppT (#AppT Bindings Text) Void)))))
(#Cons [["lux" "tags"] (#ListA (#Cons (#TextA "name")
(#Cons (#TextA "inner-closures")
(#Cons (#TextA "locals")
@@ -400,7 +393,7 @@
(#BoundT +1)))
AST
(_lux_case (#AppT [List AST])
- ASTList
+ AST-List
(#UnivQ #Nil
(#SumT ## "lux;BoolS"
Bool
@@ -421,9 +414,9 @@
(#SumT ## "lux;TagS"
Ident
(#SumT ## "lux;FormS"
- ASTList
+ AST-List
(#SumT ## "lux;TupleS"
- ASTList
+ AST-List
## "lux;RecordS"
(#AppT List (#ProdT AST AST))
)))))))))))
@@ -454,7 +447,7 @@
(#Cons [["lux" "doc"] (#TextA "The type of AST nodes for Lux syntax.")]
default-def-meta-exported))
-(_lux_def ASTList
+(_lux_def AST-List
(#AppT List AST)
default-def-meta-unexported)
@@ -663,7 +656,7 @@
## (-> (List AST) (Lux (List AST))))
(_lux_def Macro
(#NamedT ["lux" "Macro"]
- (#FunctionT ASTList (#AppT Lux ASTList)))
+ (#FunctionT AST-List (#AppT Lux AST-List)))
(#Cons [["lux" "doc"] (#TextA "Functions that run at compile-time and allow you to transform and extend the language in powerful ways.")]
default-def-meta-exported))
@@ -3737,7 +3730,7 @@
(if rec?
(if (empty? args)
(let [g!param (symbol$ ["" ""])
- prime-name (symbol$ ["" (Text/append name "'")])
+ prime-name (symbol$ ["" name])
type+ (replace-syntax (list [name (` ((~ prime-name) (~ g!param)))]) type)]
(#Some (` ((All (~ prime-name) [(~ g!param)] (~ type+))
Void))))
@@ -4118,11 +4111,13 @@
(function [env]
(case env
{#name _ #inner-closures _ #locals {#counter _ #mappings locals} #closure {#counter _ #mappings closure}}
- (try-both (find (: (-> [Text Analysis] (Maybe Type))
- (function [[bname [[type _] _]]]
- (if (Text/= name bname)
- (#Some type)
- #None))))
+ (try-both (find (: (-> [Text Void] (Maybe Type))
+ (function [[bname analysis]]
+ (let [[[type _] _] (:! (Meta [Type Cursor] Void)
+ analysis)]
+ (if (Text/= name bname)
+ (#Some type)
+ #None)))))
locals
closure))))
scopes)))
@@ -4461,16 +4456,28 @@
(macro: #export (|>. tokens)
{#;doc "## Similar to the piping macro, but rather than taking an initial object to work on, creates a function for taking it.
- (|> (map Int/encode) (interpose \" \") (fold Text/append \"\"))
+ (|>. (map Int/encode) (interpose \" \") (fold Text/append \"\"))
## =>
- (function [<something>]
+ (function [<arg>]
(fold Text/append \"\"
(interpose \" \"
- (map Int/encode <something>))))"}
+ (map Int/encode <arg>))))"}
(do Monad<Lux>
[g!arg (gensym "arg")]
(return (list (` (function [(~ g!arg)] (|> (~ g!arg) (~@ tokens))))))))
+(macro: #export (<|. tokens)
+ {#;doc "## Similar to the piping macro, but rather than taking an initial object to work on, creates a function for taking it.
+ (<|. (fold Text/append \"\") (interpose \" \") (map Int/encode))
+ ## =>
+ (function [<arg>]
+ (fold Text/append \"\"
+ (interpose \" \"
+ (map Int/encode <arg>))))"}
+ (do Monad<Lux>
+ [g!arg (gensym "arg")]
+ (return (list (` (function [(~ g!arg)] (<| (~@ tokens) (~ g!arg))))))))
+
(def: (imported-by? import-name module-name)
(-> Text Text (Lux Bool))
(do Monad<Lux>
diff --git a/stdlib/source/lux/data/coll/dict.lux b/stdlib/source/lux/data/coll/dict.lux
index 6a11dcc77..47929c72f 100644
--- a/stdlib/source/lux/data/coll/dict.lux
+++ b/stdlib/source/lux/data/coll/dict.lux
@@ -572,28 +572,28 @@
(let [[Hash<K> node] dict]
(get' root-level (:: Hash<K> hash key) key Hash<K> node)))
-(def: #export (contains? key table)
+(def: #export (contains? key dict)
(All [K V] (-> K (Dict K V) Bool))
- (case (get key table)
+ (case (get key dict)
#;None false
(#;Some _) true))
-(def: #export (put~ key val table)
+(def: #export (put~ key val dict)
{#;doc "Only puts the KV-pair if the key is not already present."}
(All [K V] (-> K V (Dict K V) (Dict K V)))
- (if (contains? key table)
- table
- (put key val table)))
+ (if (contains? key dict)
+ dict
+ (put key val dict)))
-(def: #export (update key f table)
+(def: #export (update key f dict)
{#;doc "Transforms the value located at key (if available), using the given function."}
(All [K V] (-> K (-> V V) (Dict K V) (Dict K V)))
- (case (get key table)
+ (case (get key dict)
#;None
- table
+ dict
(#;Some val)
- (put key (f val) table)))
+ (put key (f val) dict)))
(def: #export size
(All [K V] (-> (Dict K V) Nat))
diff --git a/stdlib/source/lux/data/error.lux b/stdlib/source/lux/data/error.lux
index 65a0733ff..f614305e0 100644
--- a/stdlib/source/lux/data/error.lux
+++ b/stdlib/source/lux/data/error.lux
@@ -61,6 +61,10 @@
(All [M a] (-> (Monad M) (-> (M a) (M (Error a)))))
(liftM Monad<M> (:: Monad<Error> wrap)))
+(def: #export (succeed value)
+ (All [a] (-> a (Error a)))
+ (#Success value))
+
(def: #export (fail message)
(All [a] (-> Text (Error a)))
(#Error message))
diff --git a/stdlib/source/lux/data/text/regex.lux b/stdlib/source/lux/data/text/regex.lux
index b7101a48a..231dfaddf 100644
--- a/stdlib/source/lux/data/text/regex.lux
+++ b/stdlib/source/lux/data/text/regex.lux
@@ -174,7 +174,6 @@
(&;after (&;text "\\S") (wrap (` (->Text (&;not &;space)))))
(&;after (&;text "\\w") (wrap (` (->Text word^))))
(&;after (&;text "\\W") (wrap (` (->Text (&;not word^)))))
- (&;after (&;text "\\d") (wrap (` (->Text &;digit))))
(&;after (&;text "\\p{Lower}") (wrap (` (->Text &;lower))))
(&;after (&;text "\\p{Upper}") (wrap (` (->Text &;upper))))
diff --git a/stdlib/source/lux/host.jvm.lux b/stdlib/source/lux/host.jvm.lux
index 9bdaeac54..0552df165 100644
--- a/stdlib/source/lux/host.jvm.lux
+++ b/stdlib/source/lux/host.jvm.lux
@@ -1621,10 +1621,10 @@
[return-type
(let [g!temp (ast;symbol ["" "Ω"])]
(` (let [(~ g!temp) (~ return-term)]
- (if (null? (:! (host (~' java.lang.Object))
- (~ g!temp)))
- (error! "Cannot produce null references from method calls.")
- (~ g!temp)))))])
+ (if (not (null? (:! (host (~' java.lang.Object))
+ (~ g!temp))))
+ (~ g!temp)
+ (error! "Cannot produce null references from method calls.")))))])
_
[return-type return-term]))
diff --git a/stdlib/source/lux/macro.lux b/stdlib/source/lux/macro.lux
index 4569eeac6..5a3d3829d 100644
--- a/stdlib/source/lux/macro.lux
+++ b/stdlib/source/lux/macro.lux
@@ -10,7 +10,7 @@
[product]
[ident "Ident/" Codec<Text,Ident>]
maybe
- [error #- fail])))
+ ["E" error #- fail])))
## (type: (Lux a)
## (-> Compiler (Error [Compiler a])))
@@ -424,16 +424,20 @@
{#;doc "Looks-up the type of a local variable somewhere in the environment."}
(-> Text (Lux Type))
(function [state]
- (let [test (: (-> [Text Analysis] Bool)
+ (let [test (: (-> [Text (Meta [Type Cursor] Void)] Bool)
(|>. product;left (Text/= name)))]
(case (do Monad<Maybe>
[scope (find (function [env]
- (or (any? test (get@ [#;locals #;mappings] env))
- (any? test (get@ [#;closure #;mappings] env))))
+ (or (any? test (:! (List [Text (Meta [Type Cursor] Void)])
+ (get@ [#;locals #;mappings] env)))
+ (any? test (:! (List [Text (Meta [Type Cursor] Void)])
+ (get@ [#;closure #;mappings] env)))))
(get@ #;scopes state))
[_ [[type _] _]] (try-both (find test)
- (get@ [#;locals #;mappings] scope)
- (get@ [#;closure #;mappings] scope))]
+ (:! (List [Text (Meta [Type Cursor] Void)])
+ (get@ [#;locals #;mappings] scope))
+ (:! (List [Text (Meta [Type Cursor] Void)])
+ (get@ [#;closure #;mappings] scope)))]
(wrap type))
(#;Some var-type)
(#;Right [state var-type])
@@ -586,6 +590,7 @@
(#;Some scopes)
(#;Right [state
(List/map (|>. (get@ [#;locals #;mappings])
+ (:! (List [Text (Meta [Type Cursor] Void)]))
(List/map (function [[name [[type cursor] analysis]]]
[name type])))
scopes)]))))
diff --git a/stdlib/source/lux/type.lux b/stdlib/source/lux/type.lux
index be6f282e1..d125b8b98 100644
--- a/stdlib/source/lux/type.lux
+++ b/stdlib/source/lux/type.lux
@@ -323,3 +323,21 @@
[univq #;UnivQ]
[exq #;ExQ]
)
+
+(def: #export (quantified? type)
+ (-> Type Bool)
+ (case type
+ (#;NamedT [module name] _type)
+ (quantified? _type)
+
+ (#;AppT F A)
+ (default false
+ (do Monad<Maybe>
+ [applied (apply-type F A)]
+ (wrap (quantified? applied))))
+
+ (^or (#;UnivQ _) (#;ExQ _))
+ true
+
+ _
+ false))
diff --git a/stdlib/source/lux/type/check.lux b/stdlib/source/lux/type/check.lux
index 73092a308..4d93c9024 100644
--- a/stdlib/source/lux/type/check.lux
+++ b/stdlib/source/lux/type/check.lux
@@ -18,13 +18,13 @@
(type: #export Id Nat)
-(type: #export Fixpoints (List [[Type Type] Bool]))
+(type: #export Fixed (List [[Type Type] Bool]))
(type: #export Context
{#var-counter Id
#ex-counter Id
#bindings (dict;Dict Id (Maybe Type))
- #fixpoints Fixpoints
+ #fixed Fixed
})
(type: #export (Check a)
@@ -113,7 +113,7 @@
(#;Right [(update@ #ex-counter n.inc context)
[id (#;ExT id)]]))))
-(def: (bound? id)
+(def: #export (bound? id)
(-> Id (Check Bool))
(function [context]
(case (|> context (get@ #bindings) (dict;get id))
@@ -175,7 +175,7 @@
#;None
(#;Left (format "Unknown type-var: " (%n id))))))
-(def: (clean t-id type)
+(def: #export (clean t-id type)
(-> Id Type (Check Type))
(case type
(#;VarT id)
@@ -259,7 +259,7 @@
[]])))]
[get-bindings set-bindings #bindings (dict;Dict Id (Maybe Type))]
- [get-fixpoints set-fixpoints #fixpoints Fixpoints]
+ [get-fixed set-fixed #fixed Fixed]
)
(def: #export (delete-var id)
@@ -308,7 +308,7 @@
{#var-counter +0
#ex-counter +0
#bindings (dict;new number;Hash<Nat>)
- #fixpoints (list)
+ #fixed (list)
})
(def: (attempt op)
@@ -343,17 +343,17 @@
(#;Left _)
(right context))))
-(def: (fp-get [e a] fixpoints)
- (-> [Type Type] Fixpoints (Maybe Bool))
+(def: (fx-get [e a] fixed)
+ (-> [Type Type] Fixed (Maybe Bool))
(:: Monad<Maybe> map product;right
(list;find (function [[[fe fa] status]]
(and (Type/= e fe)
(Type/= a fa)))
- fixpoints)))
+ fixed)))
-(def: (fp-put ea status fixpoints)
- (-> [Type Type] Bool Fixpoints Fixpoints)
- (#;Cons [ea status] fixpoints))
+(def: (fx-put ea status fixed)
+ (-> [Type Type] Bool Fixed Fixed)
+ (#;Cons [ea status] fixed))
(def: #export (check expected actual)
{#;doc "Type-check to ensure that the 'expected' type subsumes the 'actual' type."}
@@ -419,9 +419,9 @@
[(#;AppT F A) _]
(do Monad<Check>
- [#let [fp-pair [expected actual]]
- fixpoints get-fixpoints]
- (case (fp-get fp-pair fixpoints)
+ [#let [fx-pair [expected actual]]
+ fixed get-fixed]
+ (case (fx-get fx-pair fixed)
(#;Some ?)
(if ?
success
@@ -430,7 +430,7 @@
#;None
(do Monad<Check>
[expected' (apply-type! F A)
- _ (set-fixpoints (fp-put fp-pair true fixpoints))]
+ _ (set-fixed (fx-put fx-pair true fixed))]
(check expected' actual))))
[_ (#;AppT F A)]