aboutsummaryrefslogtreecommitdiff
path: root/source/lux.lux
diff options
context:
space:
mode:
authorEduardo Julian2015-09-06 19:52:07 -0400
committerEduardo Julian2015-09-06 19:52:07 -0400
commit514d03851b20c2f8b818ee26194a93515a685ae5 (patch)
treec4630ab3f849ed73b5f071b98b56965beef674ab /source/lux.lux
parent0f596a44ffc486b7e0369eebd3b79d22315e8814 (diff)
- Added type-inference when constructing tuples.
Diffstat (limited to 'source/lux.lux')
-rw-r--r--source/lux.lux126
1 files changed, 61 insertions, 65 deletions
diff --git a/source/lux.lux b/source/lux.lux
index 76ca9517f..c1e7b0046 100644
--- a/source/lux.lux
+++ b/source/lux.lux
@@ -305,7 +305,6 @@
Ident
#Nil))))))))
(_lux_export DefData')
-(_lux_declare-tags [#ValueD #TypeD #MacroD #AliasD] DefData')
## (deftype LuxVar
## (| (#Local Int)
@@ -409,6 +408,12 @@
ASTList))))
(_lux_export Macro)
+(_lux_def DefData
+ (#NamedT ["lux" "DefData"]
+ (#AppT DefData' Macro)))
+(_lux_export DefData)
+(_lux_declare-tags [#ValueD #TypeD #MacroD #AliasD] DefData)
+
## Base functions & macros
## (def _cursor
## Cursor
@@ -925,13 +930,12 @@
(reverse tokens)))))))
(defmacro' (lambda' tokens)
- (let'' [name tokens'] (_lux_: (, Text ($' List AST))
- (_lux_case tokens
- (#Cons [[_ (#SymbolS ["" name])] tokens'])
- [name tokens']
+ (let'' [name tokens'] (_lux_case tokens
+ (#Cons [[_ (#SymbolS ["" name])] tokens'])
+ [name tokens']
- _
- ["" tokens]))
+ _
+ ["" tokens])
(_lux_case tokens'
(#Cons [[_ (#TupleS args)] (#Cons [body #Nil])])
(_lux_case args
@@ -1277,7 +1281,7 @@
(def''' (untemplate replace? subst token)
(-> Bool Text AST ($' Lux AST))
- (_lux_case (_lux_: (, Bool AST) [replace? token])
+ (_lux_case [replace? token]
[_ [_ (#BoolS value)]]
(return (wrap-meta (form$ (@list (tag$ ["lux" "BoolS"]) (bool$ value)))))
@@ -1470,9 +1474,8 @@
(defmacro' #export (do-template tokens)
(_lux_case tokens
(#Cons [[_ (#TupleS bindings)] (#Cons [[_ (#TupleS templates)] data])])
- (_lux_case (_lux_: (, ($' Maybe ($' List Text)) ($' Maybe ($' List ($' List AST))))
- [(map% Maybe/Monad get-name bindings)
- (map% Maybe/Monad tuple->list data)])
+ (_lux_case [(map% Maybe/Monad get-name bindings)
+ (map% Maybe/Monad tuple->list data)]
[(#Some bindings') (#Some data')]
(let' [apply (_lux_: (-> RepEnv ($' List AST))
(lambda' [env] (map (apply-template env) templates)))]
@@ -1553,7 +1556,7 @@
[$module (get module modules)
gdef (let' [{#module-aliases _ #defs bindings #imports _ #tags tags #types types} (_lux_: ($' Module Compiler) $module)]
(get name bindings))]
- (_lux_case (_lux_: (, Bool ($' DefData' Macro)) gdef)
+ (_lux_case (_lux_: (, Bool DefData) gdef)
[exported? (#MacroD macro')]
(if exported?
(#Some macro')
@@ -1801,20 +1804,18 @@
(fail "Wrong syntax for Rec")))
(defmacro' #export (deftype tokens)
- (let' [[export? tokens'] (: (, Bool (List AST))
- (_lux_case tokens
- (#Cons [_ (#TagS "" "export")] tokens')
- [true tokens']
-
- _
- [false tokens]))
- [rec? tokens'] (: (, Bool (List AST))
- (_lux_case tokens'
- (#Cons [_ (#TagS "" "rec")] tokens')
+ (let' [[export? tokens'] (_lux_case tokens
+ (#Cons [_ (#TagS "" "export")] tokens')
[true tokens']
_
- [false tokens']))
+ [false tokens])
+ [rec? tokens'] (_lux_case tokens'
+ (#Cons [_ (#TagS "" "rec")] tokens')
+ [true tokens']
+
+ _
+ [false tokens'])
parts (: (Maybe (, Text (List AST) AST))
(_lux_case tokens'
(#Cons [_ (#SymbolS "" name)] (#Cons type #Nil))
@@ -1885,13 +1886,12 @@
(fail "Wrong syntax for exec")))
(defmacro' (def' tokens)
- (let' [[export? tokens'] (: (, Bool (List AST))
- (_lux_case tokens
- (#Cons [_ (#TagS "" "export")] tokens')
- [true tokens']
+ (let' [[export? tokens'] (_lux_case tokens
+ (#Cons [_ (#TagS "" "export")] tokens')
+ [true tokens']
- _
- [false tokens]))
+ _
+ [false tokens])
parts (: (Maybe (, AST (List AST) (Maybe AST) AST))
(_lux_case tokens'
(#Cons [_ (#FormS (#Cons name args))] (#Cons type (#Cons body #Nil)))
@@ -2097,13 +2097,12 @@
(fail "Wrong syntax for lambda")))
(defmacro' #export (def tokens)
- (let [[export? tokens'] (: (, Bool (List AST))
- (case tokens
- (#Cons [_ (#TagS "" "export")] tokens')
- [true tokens']
+ (let [[export? tokens'] (case tokens
+ (#Cons [_ (#TagS "" "export")] tokens')
+ [true tokens']
- _
- [false tokens]))
+ _
+ [false tokens])
parts (: (Maybe (, AST (List AST) (Maybe AST) AST))
(case tokens'
(\ (@list [_ (#FormS (#Cons name args))] type body))
@@ -2145,13 +2144,12 @@
(fail "Wrong syntax for def"))))
(defmacro' #export (defmacro tokens)
- (let [[exported? tokens] (: (, Bool (List AST))
- (case tokens
- (\ (@list& [_ (#TagS ["" "export"])] tokens'))
- [true tokens']
+ (let [[exported? tokens] (case tokens
+ (\ (@list& [_ (#TagS ["" "export"])] tokens'))
+ [true tokens']
- _
- [false tokens]))
+ _
+ [false tokens])
name+args+body?? (: (Maybe (, Ident (List AST) AST))
(case tokens
(\ (@list [_ (#;FormS (@list& [_ (#SymbolS name)] args))] body))
@@ -2179,13 +2177,12 @@
(fail "Wrong syntax for defmacro"))))
(defmacro #export (defsig tokens)
- (let [[export? tokens'] (: (, Bool (List AST))
- (case tokens
- (\ (@list& [_ (#TagS "" "export")] tokens'))
- [true tokens']
+ (let [[export? tokens'] (case tokens
+ (\ (@list& [_ (#TagS "" "export")] tokens'))
+ [true tokens']
- _
- [false tokens]))
+ _
+ [false tokens])
?parts (: (Maybe (, Ident (List AST) (List AST)))
(case tokens'
(\ (@list& [_ (#FormS (@list& [_ (#SymbolS name)] args))] sigs))
@@ -2206,7 +2203,7 @@
(lambda [token]
(case token
(\ [_ (#FormS (@list [_ (#SymbolS _ "_lux_:")] type [_ (#SymbolS ["" name])]))])
- (wrap (: (, Text AST) [name type]))
+ (wrap [name type])
_
(fail "Signatures require typed members!"))))
@@ -2530,7 +2527,7 @@
(\ [_ (#FormS (@list [_ (#SymbolS _ "_lux_def")] [_ (#SymbolS "" tag-name)] value))])
(case (get tag-name tag-mappings)
(#Some tag)
- (wrap (: (, AST AST) [tag value]))
+ (wrap [tag value])
_
(fail (text:++ "Unknown structure member: " tag-name)))
@@ -2541,13 +2538,12 @@
(wrap (@list (record$ members)))))
(defmacro #export (defstruct tokens)
- (let [[export? tokens'] (: (, Bool (List AST))
- (case tokens
- (\ (@list& [_ (#TagS "" "export")] tokens'))
- [true tokens']
+ (let [[export? tokens'] (case tokens
+ (\ (@list& [_ (#TagS "" "export")] tokens'))
+ [true tokens']
- _
- [false tokens]))
+ _
+ [false tokens])
?parts (: (Maybe (, AST (List AST) AST (List AST)))
(case tokens'
(\ (@list& [_ (#FormS (@list& name args))] type defs))
@@ -2623,10 +2619,10 @@
(-> (List AST) (Lux (, (Maybe Text) (List AST))))
(case tokens
(\ (@list& [_ (#TagS "" "as")] [_ (#SymbolS "" alias)] tokens'))
- (return (: (, (Maybe Text) (List AST)) [(#Some alias) tokens']))
+ (return [(#Some alias) tokens'])
_
- (return (: (, (Maybe Text) (List AST)) [#None tokens]))))
+ (return [#None tokens])))
(def (parse-referrals tokens)
(-> (List AST) (Lux (, Referrals (List AST))))
@@ -2634,23 +2630,23 @@
(\ (@list& [_ (#TagS "" "refer")] referral tokens'))
(case referral
[_ (#TagS "" "all")]
- (return (: (, Referrals (List AST)) [#All tokens']))
+ (return [#All tokens'])
(\ [_ (#FormS (@list& [_ (#TagS "" "only")] defs))])
(do Lux/Monad
[defs' (extract-defs defs)]
- (return (: (, Referrals (List AST)) [(#Only defs') tokens'])))
+ (return [(#Only defs') tokens']))
(\ [_ (#FormS (@list& [_ (#TagS "" "exclude")] defs))])
(do Lux/Monad
[defs' (extract-defs defs)]
- (return (: (, Referrals (List AST)) [(#Exclude defs') tokens'])))
+ (return [(#Exclude defs') tokens']))
_
(fail "Incorrect syntax for referral."))
_
- (return (: (, Referrals (List AST)) [#Nothing tokens]))))
+ (return [#Nothing tokens])))
(def (extract-symbol syntax)
(-> AST (Lux Ident))
@@ -2667,10 +2663,10 @@
(\ (@list& [_ (#TagS "" "open")] [_ (#FormS (@list& [_ (#TextS prefix)] structs))] tokens'))
(do Lux/Monad
[structs' (map% Lux/Monad extract-symbol structs)]
- (return (: (, (Maybe Openings) (List AST)) [(#Some prefix structs') tokens'])))
+ (return [(#Some prefix structs') tokens']))
_
- (return (: (, (Maybe Openings) (List AST)) [#None tokens]))))
+ (return [#None tokens])))
(def (decorate-imports super-name tokens)
(-> Text (List AST) (Lux (List AST)))
@@ -2708,7 +2704,7 @@
#let [[openings extra] openings+extra]
extra (decorate-imports m-name extra)
sub-imports (parse-imports extra)]
- (wrap (case (: (, Referrals (Maybe Text) (Maybe Openings)) [referral alias openings])
+ (wrap (case [referral alias openings]
[#Nothing #None #None] sub-imports
_ (@list& [m-name alias referral openings] sub-imports))))
@@ -2741,7 +2737,7 @@
#cursor cursor}
(case (get module modules)
(#Some =module)
- (let [to-alias (map (: (-> (, Text (, Bool (DefData' (-> (List AST) (StateE Compiler (List AST))))))
+ (let [to-alias (map (: (-> (, Text (, Bool DefData))
(List Text))
(lambda [gdef]
(let [[name [export? _]] gdef]