aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
Diffstat
-rw-r--r--source/lux.lux220
-rw-r--r--source/lux/codata/stream.lux2
-rw-r--r--source/lux/control/monad.lux15
-rw-r--r--source/lux/data/text.lux2
-rw-r--r--source/lux/host/jvm.lux16
-rw-r--r--source/lux/meta/lux.lux16
-rw-r--r--source/lux/meta/syntax.lux20
-rw-r--r--src/lux/analyser.clj18
-rw-r--r--src/lux/analyser/case.clj7
-rw-r--r--src/lux/analyser/host.clj17
-rw-r--r--src/lux/analyser/lambda.clj24
-rw-r--r--src/lux/analyser/lux.clj167
12 files changed, 270 insertions, 254 deletions
diff --git a/source/lux.lux b/source/lux.lux
index 36a0997f4..7110cc709 100644
--- a/source/lux.lux
+++ b/source/lux.lux
@@ -1010,14 +1010,14 @@
(`' (;let' (~ value) (~ body')))
_
- (`' (;bind (_lux_lambda (~ (symbol$ ["" ""]))
- (~ var)
- (~ body'))
- (~ value)))))))
+ (`' (bind (_lux_lambda (~ (symbol$ ["" ""]))
+ (~ var)
+ (~ body'))
+ (~ value)))))))
body
(reverse (as-pairs bindings)))]
(return (list (`' (_lux_case (~ monad)
- {#;return ;return #;bind ;bind}
+ {#;return wrap #;bind bind}
(~ body'))))))
_
@@ -1031,16 +1031,16 @@
(-> (B' a) ($' (B' m) (B' b)))
($' List (B' a))
($' (B' m) ($' List (B' b)))))
- (let' [{#;return ;return #;bind _} m]
+ (let' [{#;return wrap #;bind _} m]
(_lux_case xs
#Nil
- (;return #Nil)
+ (wrap #Nil)
(#Cons [x xs'])
(do m
[y (f x)
ys (map% m f xs')]
- (;return (#Cons [y ys])))
+ (wrap (#Cons [y ys])))
)))
(def''' (. f g)
@@ -1373,7 +1373,7 @@
["" name]
(do Lux/Monad
[module-name get-module-name]
- (;return (_lux_: Ident [module-name name])))
+ (wrap (_lux_: Ident [module-name name])))
_
(return ident)))
@@ -1387,7 +1387,7 @@
(#Meta [_ (#TagS ident)])
(do Lux/Monad
[ident (normalize ident)]
- (;return (`' [(~ (text$ (ident->text ident))) (;,)])))
+ (wrap (`' [(~ (text$ (ident->text ident))) (;,)])))
(#Meta [_ (#FormS (#Cons [(#Meta [_ (#TagS ident)]) values]))])
(do Lux/Monad
@@ -1397,12 +1397,12 @@
#Nil (`' Unit)
(#Cons value #Nil) value
_ (`' (, (~@ values)))))]]
- (;return (`' [(~ (text$ (ident->text ident))) (~ case-body)])))
+ (wrap (`' [(~ (text$ (ident->text ident))) (~ case-body)])))
_
(fail "Wrong syntax for |"))))
tokens)]
- (;return (list (`' (#;VariantT (~ (untemplate-list pairs))))))))
+ (wrap (list (`' (#;VariantT (~ (untemplate-list pairs))))))))
(defmacro #export (& tokens)
(if (not (multiple? 2 (length tokens)))
@@ -1415,12 +1415,12 @@
[(#Meta [_ (#TagS ident)]) value]
(do Lux/Monad
[ident (normalize ident)]
- (;return (`' [(~ (text$ (ident->text ident))) (~ value)])))
+ (wrap (`' [(~ (text$ (ident->text ident))) (~ value)])))
_
(fail "Wrong syntax for &"))))
(as-pairs tokens))]
- (;return (list (`' (#;RecordT (~ (untemplate-list pairs)))))))))
+ (wrap (list (`' (#;RecordT (~ (untemplate-list pairs)))))))))
(def''' (->text x)
(-> (^ java.lang.Object) Text)
@@ -1451,7 +1451,7 @@
(do Lux/Monad
[expansion (macro args)
expansion' (map% Lux/Monad macro-expand expansion)]
- (;return (list:join expansion')))
+ (wrap (list:join expansion')))
#None
(return (list token))))
@@ -1471,23 +1471,23 @@
(do Lux/Monad
[expansion (macro args)
expansion' (map% Lux/Monad macro-expand-all expansion)]
- (;return (list:join expansion')))
+ (wrap (list:join expansion')))
#None
(do Lux/Monad
[parts' (map% Lux/Monad macro-expand-all (list& (symbol$ macro-name) args))]
- (;return (list (form$ (list:join parts')))))))
+ (wrap (list (form$ (list:join parts')))))))
(#Meta [_ (#FormS (#Cons [harg targs]))])
(do Lux/Monad
[harg+ (macro-expand-all harg)
targs+ (map% Lux/Monad macro-expand-all targs)]
- (;return (list (form$ (list:++ harg+ (list:join targs+))))))
+ (wrap (list (form$ (list:++ harg+ (list:join targs+))))))
(#Meta [_ (#TupleS members)])
(do Lux/Monad
[members' (map% Lux/Monad macro-expand-all members)]
- (;return (list (tuple$ (list:join members')))))
+ (wrap (list (tuple$ (list:join members')))))
_
(return (list syntax))))
@@ -1516,7 +1516,7 @@
[type+ (macro-expand-all type)]
(_lux_case type+
(#Cons type' #Nil)
- (;return (list (walk-type type')))
+ (wrap (list (walk-type type')))
_
(fail "The expansion of the type-syntax had to yield a single element.")))
@@ -1718,13 +1718,13 @@
(do Lux/Monad
[expansion (macro-expand (form$ (list& (symbol$ macro-name) body macro-args)))
expansions (map% Lux/Monad expander (as-pairs expansion))]
- (;return (list:join expansions)))
+ (wrap (list:join expansions)))
_
- (;return (list branch))))))
+ (wrap (list branch))))))
(as-pairs branches))]
- (;return (list (`' (_lux_case (~ value)
- (~@ (|> expansions list:join (map rejoin-pair) list:join)))))))
+ (wrap (list (`' (_lux_case (~ value)
+ (~@ (|> expansions list:join (map rejoin-pair) list:join)))))))
_
(fail "Wrong syntax for case")))
@@ -1736,7 +1736,7 @@
[pattern+ (macro-expand-all pattern)]
(case pattern+
(#Cons pattern' #Nil)
- (;return (list pattern' body))
+ (wrap (list pattern' body))
_
(fail "\\ can only expand to 1 pattern.")))
@@ -1754,8 +1754,8 @@
_
(do Lux/Monad
[patterns' (map% Lux/Monad macro-expand-all patterns)]
- (;return (list:join (map (lambda' [pattern] (list pattern body))
- (list:join patterns'))))))
+ (wrap (list:join (map (lambda' [pattern] (list pattern body))
+ (list:join patterns'))))))
_
(fail "Wrong syntax for \\or")))
@@ -1765,7 +1765,7 @@
[module-name get-module-name]
(case tokens
(\ (list template))
- (;return (list (untemplate true module-name template)))
+ (wrap (list (untemplate true module-name template)))
_
(fail "Wrong syntax for `"))))
@@ -1849,13 +1849,13 @@
(let [g!blank (symbol$ ["" ""])
g!name (symbol$ ident)
body+ (: AST (foldL (: (-> AST AST AST)
- (lambda' [body' arg]
- (if (symbol? arg)
- (` (_lux_lambda (~ g!blank) (~ arg) (~ body')))
- (` (_lux_lambda (~ g!blank) (~ g!blank)
- (case (~ g!blank) (~ arg) (~ body')))))))
- body
- (reverse tail)))]
+ (lambda' [body' arg]
+ (if (symbol? arg)
+ (` (_lux_lambda (~ g!blank) (~ arg) (~ body')))
+ (` (_lux_lambda (~ g!blank) (~ g!blank)
+ (case (~ g!blank) (~ arg) (~ body')))))))
+ body
+ (reverse tail)))]
(return (list (if (symbol? head)
(` (_lux_lambda (~ g!name) (~ head) (~ body+)))
(` (_lux_lambda (~ g!name) (~ g!blank) (case (~ g!blank) (~ head) (~ body+))))))))
@@ -1922,7 +1922,7 @@
#envs envs #types types #host host
#seed (i+ 1 seed) #eval? eval? #expected expected
#cursor cursor}
- (symbol$ ["__gensym__" (->text seed)]))))
+ (symbol$ ["" ($ text:++ "__gensym__" prefix (->text seed))]))))
(defmacro #export (sig tokens)
(do Lux/Monad
@@ -1934,17 +1934,17 @@
(\ (#Meta _ (#FormS (list (#Meta _ (#SymbolS _ "_lux_:")) type (#Meta _ (#SymbolS name))))))
(do Lux/Monad
[name' (normalize name)]
- (;return (: (, Ident AST) [name' type])))
+ (wrap (: (, Ident AST) [name' type])))
_
(fail "Signatures require typed members!"))))
(list:join tokens'))]
- (;return (list (` (#;RecordT (~ (untemplate-list (map (: (-> (, Ident AST) AST)
- (lambda [pair]
- (let [[name type] pair]
- (` [(~ (|> name ident->text text$))
- (~ type)]))))
- members)))))))))
+ (wrap (list (` (#;RecordT (~ (untemplate-list (map (: (-> (, Ident AST) AST)
+ (lambda [pair]
+ (let [[name type] pair]
+ (` [(~ (|> name ident->text text$))
+ (~ type)]))))
+ members)))))))))
(defmacro #export (defsig tokens)
(let [[export? tokens'] (: (, Bool (List AST))
@@ -2216,7 +2216,7 @@
(\ (#Meta _ (#FormS (list (#Meta _ (#SymbolS _ "_lux_def")) (#Meta _ (#SymbolS ["" name])) value))))
(case (get name translations)
(#Some tag-name)
- (;return (: (, AST AST) [(tag$ tag-name) value]))
+ (wrap (: (, AST AST) [(tag$ tag-name) value]))
_
(fail "Structures require defined members"))
@@ -2224,7 +2224,7 @@
_
(fail "Structures members must be unqualified."))))
(list:join tokens'))]
- (;return (list (record$ members))))
+ (wrap (list (record$ members))))
_
(fail "struct can only use records."))))
@@ -2384,7 +2384,7 @@
(lambda [token]
(case token
(#Meta _ (#SymbolS "" m-name))
- (;return (list [m-name #None #All #None]))
+ (wrap (list [m-name #None #All #None]))
(\ (#Meta _ (#FormS (list& (#Meta _ (#SymbolS "" m-name)) extra))))
(do Lux/Monad
@@ -2396,14 +2396,14 @@
#let [[openings extra] openings+extra]
extra (decorate-imports m-name extra)
sub-imports (parse-imports extra)]
- (;return (case (: (, Referrals (Maybe Text) (Maybe Openings)) [referral alias openings])
- [#Nothing #None #None] sub-imports
- _ (list& [m-name alias referral openings] sub-imports))))
+ (wrap (case (: (, Referrals (Maybe Text) (Maybe Openings)) [referral alias openings])
+ [#Nothing #None #None] sub-imports
+ _ (list& [m-name alias referral openings] sub-imports))))
_
(fail "Wrong syntax for import"))))
imports)]
- (;return (list:join imports'))))
+ (wrap (list:join imports'))))
(def (module-exists? module state)
(-> Text (Lux Bool))
@@ -2527,7 +2527,7 @@
[m-name m-alias m-referrals m-openings]
(do Lux/Monad
[m-name (clean-module m-name)]
- (;return (: Import [m-name m-alias m-referrals m-openings]))))))
+ (wrap (: Import [m-name m-alias m-referrals m-openings]))))))
imports)
unknowns' (map% Lux/Monad
(: (-> Import (Lux (List Text)))
@@ -2536,9 +2536,9 @@
[m-name _ _ _]
(do Lux/Monad
[? (module-exists? m-name)]
- (;return (if ?
- (list)
- (list m-name)))))))
+ (wrap (if ?
+ (list)
+ (list m-name)))))))
imports)
#let [unknowns (list:join unknowns')]]
(case unknowns
@@ -2557,15 +2557,15 @@
(#Only +defs)
(do Lux/Monad
[*defs (exported-defs m-name)]
- (;return (filter (is-member? +defs) *defs)))
+ (wrap (filter (is-member? +defs) *defs)))
(#Exclude -defs)
(do Lux/Monad
[*defs (exported-defs m-name)]
- (;return (filter (. not (is-member? -defs)) *defs)))
+ (wrap (filter (. not (is-member? -defs)) *defs)))
#Nothing
- (;return (list)))
+ (wrap (list)))
#let [openings (: (List AST)
(case m-openings
#None
@@ -2577,24 +2577,24 @@
(let [[_ name] struct]
(` (open (~ (symbol$ [m-name name])) (~ (text$ prefix)))))))
structs)))]]
- (;return ($ list:++
- (list (` (_lux_import (~ (text$ m-name)))))
- (case m-alias
- #None (list)
- (#Some alias) (list (` (_lux_alias (~ (text$ alias)) (~ (text$ m-name))))))
- (map (: (-> Text AST)
- (lambda [def]
- (` (_lux_def (~ (symbol$ ["" def])) (~ (symbol$ [m-name def]))))))
- defs)
- openings))))))
+ (wrap ($ list:++
+ (list (` (_lux_import (~ (text$ m-name)))))
+ (case m-alias
+ #None (list)
+ (#Some alias) (list (` (_lux_alias (~ (text$ alias)) (~ (text$ m-name))))))
+ (map (: (-> Text AST)
+ (lambda [def]
+ (` (_lux_def (~ (symbol$ ["" def])) (~ (symbol$ [m-name def]))))))
+ defs)
+ openings))))))
imports)]
- (;return (list:join output')))
+ (wrap (list:join output')))
_
- (;return (: (List AST)
- (list:++ (map (lambda [m-name] (` (_lux_import (~ (text$ m-name)))))
- unknowns)
- (list (` (import (~@ tokens))))))))))
+ (wrap (: (List AST)
+ (list:++ (map (lambda [m-name] (` (_lux_import (~ (text$ m-name)))))
+ unknowns)
+ (list (` (import (~@ tokens))))))))))
(def (try-both f x1 x2)
(All [a b]
@@ -2604,26 +2604,25 @@
(#;Some y) (#;Some y)))
(def (find-in-env name state)
- (-> Ident Compiler (Maybe Type))
- (let [vname' (ident->text name)]
- (case state
- {#source source #modules modules
- #envs envs #types types #host host
- #seed seed #eval? eval? #expected expected
- #cursor cursor}
- (some (: (-> (Env Text (, LuxVar Type)) (Maybe Type))
- (lambda [env]
- (case env
- {#name _ #inner-closures _ #locals {#counter _ #mappings locals} #closure {#counter _ #mappings closure}}
- (try-both (some (: (-> (, Text (, LuxVar Type)) (Maybe Type))
- (lambda [binding]
- (let [[bname [_ type]] binding]
- (if (text:= vname' bname)
- (#Some type)
- #None)))))
- locals
- closure))))
- envs))))
+ (-> Text Compiler (Maybe Type))
+ (case state
+ {#source source #modules modules
+ #envs envs #types types #host host
+ #seed seed #eval? eval? #expected expected
+ #cursor cursor}
+ (some (: (-> (Env Text (, LuxVar Type)) (Maybe Type))
+ (lambda [env]
+ (case env
+ {#name _ #inner-closures _ #locals {#counter _ #mappings locals} #closure {#counter _ #mappings closure}}
+ (try-both (some (: (-> (, Text (, LuxVar Type)) (Maybe Type))
+ (lambda [binding]
+ (let [[bname [_ type]] binding]
+ (if (text:= name bname)
+ (#Some type)
+ #None)))))
+ locals
+ closure))))
+ envs)))
(def (show-envs envs)
(-> (List (Env Text (, LuxVar Type))) Text)
@@ -2675,22 +2674,34 @@
## def (get v-name defs)
## #let [[_ def-data] def]]
## (case def-data
-## #TypeD (;return Type)
-## (#ValueD type) (;return type)
-## (#MacroD m) (;return Macro)
+## #TypeD (wrap Type)
+## (#ValueD type) (wrap type)
+## (#MacroD m) (wrap Macro)
## (#AliasD name') (find-in-defs name' state))))))
-(def (find-var-type name)
+(def (find-var-type ident)
(-> Ident (Lux Type))
(do Lux/Monad
- [name' (normalize name)]
+ [#let [[module name] ident]
+ current-module get-module-name]
(lambda [state]
- (case (find-in-env name state)
- (#Some struct-type)
- (#Right state struct-type)
+ (if (text:= "" module)
+ (case (find-in-env name state)
+ (#Some struct-type)
+ (#Right state struct-type)
- _
- (case (find-in-defs name' state)
+ _
+ (case (find-in-defs [current-module name] state)
+ (#Some struct-type)
+ (#Right state struct-type)
+
+ _
+ (let [{#source source #modules modules
+ #envs envs #types types #host host
+ #seed seed #eval? eval? #expected expected
+ #cursor cursor} state]
+ (#Left ($ text:++ "Unknown var: " (ident->text ident) "\n\n" (show-envs envs))))))
+ (case (find-in-defs ident state)
(#Some struct-type)
(#Right state struct-type)
@@ -2699,7 +2710,8 @@
#envs envs #types types #host host
#seed seed #eval? eval? #expected expected
#cursor cursor} state]
- (#Left ($ text:++ "Unknown var: " (ident->text name) "\n\n" (show-envs envs)))))))))
+ (#Left ($ text:++ "Unknown var: " (ident->text ident) "\n\n" (show-envs envs))))))
+ )))
(def (use-field field-name type)
(-> Text Type (, AST AST))
@@ -2982,7 +2994,7 @@
(lambda [env] (map (apply-template env) templates)))]
(|> data'
(join-map (. apply (make-env bindings')))
- ;return))))
+ wrap))))
(#Some output)
(return output)
diff --git a/source/lux/codata/stream.lux b/source/lux/codata/stream.lux
index 871c50821..728adc174 100644
--- a/source/lux/codata/stream.lux
+++ b/source/lux/codata/stream.lux
@@ -132,4 +132,4 @@
(do List/Monad
[pattern (l;reverse patterns)]
(list (` [(~ pattern) (~ g!s)]) (` (L;! (~ g!s))))))]]
- (M;wrap (list g!s (` (;let [(~@ patterns+)] (~ body)))))))
+ (wrap (list g!s (` (;let [(~@ patterns+)] (~ body)))))))
diff --git a/source/lux/control/monad.lux b/source/lux/control/monad.lux
index 53ab7301b..c87c4fdc3 100644
--- a/source/lux/control/monad.lux
+++ b/source/lux/control/monad.lux
@@ -9,7 +9,8 @@
(;import lux
(.. (functor #as F)
(monoid #as M))
- lux/meta/macro)
+ (lux/meta macro
+ ast))
## [Utils]
(def (foldL f init xs)
@@ -54,7 +55,9 @@
(case tokens
## (\ (list monad (#;Meta [_ (#;TupleS bindings)]) body))
(#;Cons [monad (#;Cons [(#;Meta [_ (#;TupleS bindings)]) (#;Cons [body #;Nil])])])
- (let [body' (foldL (: (-> AST (, AST AST) AST)
+ (let [g!map (symbol$ ["" " map "])
+ g!join (symbol$ ["" " join "])
+ body' (foldL (: (-> AST (, AST AST) AST)
(lambda [body' binding]
(let [[var value] binding]
(case var
@@ -62,15 +65,13 @@
(` (;let (~ value) (~ body')))
_
- (` (;case ;;_functor
- {#F;map F;map}
- (;|> (~ value) (F;map (;lambda [(~ var)] (~ body'))) (;;join))))
+ (` (;|> (~ value) ((~ g!map) (;lambda [(~ var)] (~ body'))) (~ g!join)))
## (` (;|> (~ value) (F;map (;lambda [(~ var)] (~ body'))) (;:: ;;_functor) (;;join)))
))))
body
(reverse (as-pairs bindings)))]
(#;Right [state (#;Cons [(` (;case (~ monad)
- {#;;_functor ;;_functor #;;wrap ;;wrap #;;join ;;join}
+ {#;;_functor {#F;map (~ g!map)} #;;wrap (~ (' wrap)) #;;join (~ g!join)}
(~ body')))
#;Nil])]))
@@ -95,5 +96,5 @@
(do m
[y (f x)
ys (map% m f xs')]
- (;;wrap (#;Cons [y ys])))
+ (wrap (#;Cons [y ys])))
))
diff --git a/source/lux/data/text.lux b/source/lux/data/text.lux
index f691be397..81a642698 100644
--- a/source/lux/data/text.lux
+++ b/source/lux/data/text.lux
@@ -155,7 +155,7 @@
post-idx (index-of "}" in)
[var post] (split post-idx in)
[_ post] (split 1 post)]
- (M;wrap [pre var post])))
+ (wrap [pre var post])))
(def (unravel-template template)
(-> Text (List AST))
diff --git a/source/lux/host/jvm.lux b/source/lux/host/jvm.lux
index f136bd73b..4f3d6df8a 100644
--- a/source/lux/host/jvm.lux
+++ b/source/lux/host/jvm.lux
@@ -24,7 +24,7 @@
(form^ (do Parser/Monad
[_ (symbol?^ ["" "finally"])
expr id^]
- (M;wrap expr))))
+ (wrap expr))))
(def catch^
(Parser (, Text Ident AST))
@@ -33,7 +33,7 @@
ex-class local-symbol^
ex symbol^
expr id^]
- (M;wrap [ex-class ex expr]))))
+ (wrap [ex-class ex expr]))))
(def method-decl^
(Parser (, (List Text) Text (List Text) Text))
@@ -42,7 +42,7 @@
name local-symbol^
inputs (tuple^ (*^ local-symbol^))
output local-symbol^]
- (M;wrap [modifiers name inputs output]))))
+ (wrap [modifiers name inputs output]))))
(def field-decl^
(Parser (, (List Text) Text Text))
@@ -50,14 +50,14 @@
[modifiers (*^ local-tag^)
name local-symbol^
class local-symbol^]
- (M;wrap [modifiers name class]))))
+ (wrap [modifiers name class]))))
(def arg-decl^
(Parser (, Text Text))
(form^ (do Parser/Monad
[arg-name local-symbol^
arg-class local-symbol^]
- (M;wrap [arg-name arg-class]))))
+ (wrap [arg-name arg-class]))))
(def method-def^
(Parser (, (List Text) Text (List (, Text Text)) Text AST))
@@ -67,7 +67,7 @@
inputs (tuple^ (*^ arg-decl^))
output local-symbol^
body id^]
- (M;wrap [modifiers name inputs output body]))))
+ (wrap [modifiers name inputs output body]))))
(def method-call^
(Parser (, Text (List Text) (List AST)))
@@ -78,9 +78,9 @@
_ (: (Parser (,))
(if (i= (size arity-classes)
(size arity-args))
- (M;wrap [])
+ (wrap [])
(lambda [_] #;None)))]
- (M;wrap [method arity-classes arity-args])
+ (wrap [method arity-classes arity-args])
)))
## [Syntax]
diff --git a/source/lux/meta/lux.lux b/source/lux/meta/lux.lux
index 4d6c15bde..d1bc4e219 100644
--- a/source/lux/meta/lux.lux
+++ b/source/lux/meta/lux.lux
@@ -114,7 +114,7 @@
["" name]
(do Lux/Monad
[module-name get-module-name]
- (M;wrap (: Ident [module-name name])))
+ (wrap (: Ident [module-name name])))
_
(:: Lux/Monad (M;wrap ident))))
@@ -131,7 +131,7 @@
(do Lux/Monad
[expansion (macro args)
expansion' (M;map% Lux/Monad macro-expand expansion)]
- (M;wrap (:: List/Monad (M;join expansion'))))
+ (wrap (:: List/Monad (M;join expansion'))))
#;None
(:: Lux/Monad (M;wrap (list syntax)))))
@@ -151,23 +151,23 @@
(do Lux/Monad
[expansion (macro args)
expansion' (M;map% Lux/Monad macro-expand-all expansion)]
- (M;wrap (:: List/Monad (M;join expansion'))))
+ (wrap (:: List/Monad (M;join expansion'))))
#;None
(do Lux/Monad
[parts' (M;map% Lux/Monad macro-expand-all (list& (symbol$ macro-name) args))]
- (M;wrap (list (form$ (:: List/Monad (M;join parts'))))))))
+ (wrap (list (form$ (:: List/Monad (M;join parts'))))))))
(#;Meta [_ (#;FormS (#;Cons [harg targs]))])
(do Lux/Monad
[harg+ (macro-expand-all harg)
targs+ (M;map% Lux/Monad macro-expand-all targs)]
- (M;wrap (list (form$ (list:++ harg+ (:: List/Monad (M;join (: (List (List AST)) targs+))))))))
+ (wrap (list (form$ (list:++ harg+ (:: List/Monad (M;join (: (List (List AST)) targs+))))))))
(#;Meta [_ (#;TupleS members)])
(do Lux/Monad
[members' (M;map% Lux/Monad macro-expand-all members)]
- (M;wrap (list (tuple$ (:: List/Monad (M;join members'))))))
+ (wrap (list (tuple$ (:: List/Monad (M;join members'))))))
_
(:: Lux/Monad (M;wrap (list syntax)))))
@@ -175,7 +175,7 @@
(def #export (gensym prefix state)
(-> Text (Lux AST))
(#;Right [(update@ #;seed (i+ 1) state)
- (symbol$ ["__gensym__" (:: I;Int/Show (S;show (get@ #;seed state)))])]))
+ (symbol$ ["" ($ text:++ "__gensym__" prefix (:: I;Int/Show (S;show (get@ #;seed state))))])]))
(def #export (emit datum)
(All [a]
@@ -195,7 +195,7 @@
[token+ (macro-expand token)]
(case token+
(\ (list token'))
- (M;wrap token')
+ (wrap token')
_
(fail "Macro expanded to more than 1 element."))))
diff --git a/source/lux/meta/syntax.lux b/source/lux/meta/syntax.lux
index a69a89cb3..f1644cdb5 100644
--- a/source/lux/meta/syntax.lux
+++ b/source/lux/meta/syntax.lux
@@ -166,7 +166,7 @@
#;None (#;Some [tokens (list)])
(#;Some [tokens' x]) (run-parser (do Parser/Monad
[xs (*^ p)]
- (M;wrap (list& x xs)))
+ (wrap (list& x xs)))
tokens')))
(def #export (+^ p)
@@ -175,7 +175,7 @@
(do Parser/Monad
[x p
xs (*^ p)]
- (M;wrap (list& x xs))))
+ (wrap (list& x xs))))
(def #export (&^ p1 p2)
(All [a b]
@@ -183,7 +183,7 @@
(do Parser/Monad
[x1 p1
x2 p2]
- (M;wrap [x1 x2])))
+ (wrap [x1 x2])))
(def #export (|^ p1 p2 tokens)
(All [a b]
@@ -192,7 +192,7 @@
(#;Some [tokens' x1]) (#;Some [tokens' (#;Left x1)])
#;None (run-parser (do Parser/Monad
[x2 p2]
- (M;wrap (#;Right x2)))
+ (wrap (#;Right x2)))
tokens)))
(def #export (||^ ps tokens)
@@ -230,10 +230,10 @@
(case arg
(\ (#;Meta [_ (#;TupleS (list (#;Meta [_ (#;SymbolS var-name)])
parser))]))
- (M;wrap [(symbol$ var-name) parser])
+ (wrap [(symbol$ var-name) parser])
(\ (#;Meta [_ (#;SymbolS var-name)]))
- (M;wrap [(symbol$ var-name) (` id^)])
+ (wrap [(symbol$ var-name) (` id^)])
_
(l;fail "Syntax pattern expects 2-tuples or symbols."))))
@@ -256,10 +256,10 @@
macro-def (: AST
(` (m;defmacro ((~ (symbol$ ["" name])) (~ g!tokens))
(~ body'))))]]
- (M;wrap (list& macro-def
- (if exported?
- (list (` (_lux_export (~ (symbol$ ["" name])))))
- (list)))))
+ (wrap (list& macro-def
+ (if exported?
+ (list (` (_lux_export (~ (symbol$ ["" name])))))
+ (list)))))
_
(l;fail "Wrong syntax for defsyntax"))))
diff --git a/src/lux/analyser.clj b/src/lux/analyser.clj
index d18c2cfcf..7dc4c7607 100644
--- a/src/lux/analyser.clj
+++ b/src/lux/analyser.clj
@@ -24,15 +24,18 @@
(matchv ::M/objects [token]
[["lux;Meta" [meta ["lux;FormS" ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" [_ "_jvm_catch"]]]]
["lux;Cons" [["lux;Meta" [_ ["lux;TextS" ?ex-class]]]
- ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" [_ ?ex-arg]]]]
+ ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" ["" ?ex-arg]]]]
["lux;Cons" [?catch-body
["lux;Nil" _]]]]]]]]]]]]]
- (&/T (&/|++ catch+ (&/|list (&/T ?ex-class ?ex-arg ?catch-body))) finally+)
+ (return (&/T (&/|++ catch+ (&/|list (&/T ?ex-class ?ex-arg ?catch-body))) finally+))
[["lux;Meta" [meta ["lux;FormS" ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" [_ "_jvm_finally"]]]]
["lux;Cons" [?finally-body
["lux;Nil" _]]]]]]]]]
- (&/T catch+ (&/V "lux;Some" ?finally-body))))
+ (return (&/T catch+ (&/V "lux;Some" ?finally-body)))
+
+ [_]
+ (fail (str "[Analyser Error] Wrong syntax for exception handler: " (&/show-ast token)))))
(defn ^:private aba7 [analyse eval! compile-module compile-token exo-type token]
(matchv ::M/objects [token]
@@ -74,7 +77,7 @@
;; Programs
[["lux;FormS" ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" [_ "_jvm_program"]]]]
- ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" ?args]]]
+ ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" ["" ?args]]]]
["lux;Cons" [?body
["lux;Nil" _]]]]]]]]]
(&&host/analyse-jvm-program analyse compile-token ?args ?body)
@@ -246,7 +249,8 @@
[["lux;FormS" ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" [_ "_jvm_try"]]]]
["lux;Cons" [?body
?handlers]]]]]]
- (&&host/analyse-jvm-try analyse exo-type ?body (&/fold parse-handler (&/T (&/|list) (&/V "lux;None" nil)) ?handlers))
+ (|do [catches+finally (&/fold% parse-handler (&/T (&/|list) (&/V "lux;None" nil)) ?handlers)]
+ (&&host/analyse-jvm-try analyse exo-type ?body catches+finally))
[["lux;FormS" ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" [_ "_jvm_throw"]]]]
["lux;Cons" [?ex
@@ -398,8 +402,8 @@
(&&lux/analyse-case analyse exo-type ?value ?branches)
[["lux;FormS" ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" [_ "_lux_lambda"]]]]
- ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" ?self]]]
- ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" ?arg]]]
+ ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" ["" ?self]]]]
+ ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" ["" ?arg]]]]
["lux;Cons" [?body
["lux;Nil" _]]]]]]]]]]]
(&&lux/analyse-lambda analyse exo-type ?self ?arg ?body)
diff --git a/src/lux/analyser/case.clj b/src/lux/analyser/case.clj
index 77f8c418c..7f2c34924 100644
--- a/src/lux/analyser/case.clj
+++ b/src/lux/analyser/case.clj
@@ -116,12 +116,15 @@
(matchv ::M/objects [pattern]
[["lux;Meta" [_ pattern*]]]
(matchv ::M/objects [pattern*]
- [["lux;SymbolS" ?ident]]
- (|do [=kont (&env/with-local (&/ident->text ?ident) value-type
+ [["lux;SymbolS" ["" name]]]
+ (|do [=kont (&env/with-local name value-type
kont)
idx &env/next-local-idx]
(return (&/T (&/V "StoreTestAC" idx) =kont)))
+ [["lux;SymbolS" ident]]
+ (fail (str "[Pattern-matching Error] Symbols must be unqualified: " (&/ident->text ident)))
+
[["lux;BoolS" ?value]]
(|do [_ (&type/check value-type &type/Bool)
=kont kont]
diff --git a/src/lux/analyser/host.clj b/src/lux/analyser/host.clj
index 663c650e7..d03d0e65c 100644
--- a/src/lux/analyser/host.clj
+++ b/src/lux/analyser/host.clj
@@ -299,10 +299,10 @@
["lux;Nil" _]]]]]]]]]]]]]]]]
(|do [=method-inputs (&/map% (fn [minput]
(matchv ::M/objects [minput]
- [["lux;Meta" [_ ["lux;FormS" ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" ?input-name]]]
+ [["lux;Meta" [_ ["lux;FormS" ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" ["" ?input-name]]]]
["lux;Cons" [["lux;Meta" [_ ["lux;TextS" ?input-type]]]
["lux;Nil" _]]]]]]]]]
- (return (&/T (&/ident->text ?input-name) ?input-type))
+ (return (&/T ?input-name ?input-type))
[_]
(fail "[Analyser Error] Wrong syntax for method input.")))
@@ -358,7 +358,7 @@
(|do [:let [[?catches ?finally] ?catches+?finally]
=body (&&/analyse-1 analyse exo-type ?body)
=catches (&/map% (fn [[?ex-class ?ex-arg ?catch-body]]
- (|do [=catch-body (&&env/with-local (str ";" ?ex-arg) (&/V "lux;DataT" ?ex-class)
+ (|do [=catch-body (&&env/with-local ?ex-arg (&/V "lux;DataT" ?ex-class)
(&&/analyse-1 analyse exo-type ?catch-body))
idx &&env/next-local-idx]
(return (&/T ?ex-class idx =catch-body))))
@@ -434,9 +434,8 @@
)
(defn analyse-jvm-program [analyse compile-token ?args ?body]
- (|let [[_module _name] ?args]
- (|do [=body (&/with-scope ""
- (&&env/with-local (str _module ";" _name) (&/V "lux;AppT" (&/T &type/List &type/Text))
- (&&/analyse-1 analyse (&/V "lux;AppT" (&/T &type/IO &type/Unit)) ?body)))
- _ (compile-token (&/V "jvm-program" =body))]
- (return (&/|list)))))
+ (|do [=body (&/with-scope ""
+ (&&env/with-local ?args (&/V "lux;AppT" (&/T &type/List &type/Text))
+ (&&/analyse-1 analyse (&/V "lux;AppT" (&/T &type/IO &type/Unit)) ?body)))
+ _ (compile-token (&/V "jvm-program" =body))]
+ (return (&/|list))))
diff --git a/src/lux/analyser/lambda.clj b/src/lux/analyser/lambda.clj
index b1b9e2c22..7c7b80577 100644
--- a/src/lux/analyser/lambda.clj
+++ b/src/lux/analyser/lambda.clj
@@ -16,26 +16,22 @@
;; [Resource]
(defn with-lambda [self self-type arg arg-type body]
- (|let [[?module1 ?name1] self
- [?module2 ?name2] arg]
- (&/with-closure
- (|do [scope-name &/get-scope-name]
- (&env/with-local (str ?module1 ";" ?name1) self-type
- (&env/with-local (str ?module2 ";" ?name2) arg-type
- (|do [=return body
- =captured &env/captured-vars]
- (return (&/T scope-name =captured =return)))))))))
+ (&/with-closure
+ (|do [scope-name &/get-scope-name]
+ (&env/with-local self self-type
+ (&env/with-local arg arg-type
+ (|do [=return body
+ =captured &env/captured-vars]
+ (return (&/T scope-name =captured =return))))))))
-(defn close-over [scope ident register frame]
+(defn close-over [scope name register frame]
(matchv ::M/objects [register]
[[_ register-type]]
(|let [register* (&/T (&/V "captured" (&/T scope
(->> frame (&/get$ &/$CLOSURE) (&/get$ &/$COUNTER))
register))
- register-type)
- [?module ?name] ident
- full-name (str ?module ";" ?name)]
+ register-type)]
(&/T register* (&/update$ &/$CLOSURE #(->> %
(&/update$ &/$COUNTER inc)
- (&/update$ &/$MAPPINGS (fn [mps] (&/|put full-name register* mps))))
+ (&/update$ &/$MAPPINGS (fn [mps] (&/|put name register* mps))))
frame)))))
diff --git a/src/lux/analyser/lux.clj b/src/lux/analyser/lux.clj
index c86df3027..7aba5dd39 100644
--- a/src/lux/analyser/lux.clj
+++ b/src/lux/analyser/lux.clj
@@ -143,90 +143,91 @@
?elems)]
(return (&/|list (&/T (&/V "record" =slots) (&/V "lux;RecordT" exo-type))))))
+(defn ^:private analyse-global [analyse exo-type module name]
+ (|do [[[r-module r-name] $def] (&&module/find-def module name)
+ ;; :let [_ (prn 'analyse-symbol/_1.1 r-module r-name)]
+ endo-type (matchv ::M/objects [$def]
+ [["lux;ValueD" [?type _]]]
+ (return ?type)
+
+ [["lux;MacroD" _]]
+ (return &type/Macro)
+
+ [["lux;TypeD" _]]
+ (return &type/Type))
+ _ (if (and (clojure.lang.Util/identical &type/Type endo-type)
+ (clojure.lang.Util/identical &type/Type exo-type))
+ (return nil)
+ (&type/check exo-type endo-type))]
+ (return (&/|list (&/T (&/V "lux;Global" (&/T r-module r-name))
+ endo-type)))))
+
+(defn ^:private analyse-local [analyse exo-type name]
+ (fn [state]
+ (|let [stack (&/get$ &/$ENVS state)
+ no-binding? #(and (->> % (&/get$ &/$LOCALS) (&/get$ &/$MAPPINGS) (&/|contains? name) not)
+ (->> % (&/get$ &/$CLOSURE) (&/get$ &/$MAPPINGS) (&/|contains? name) not))
+ [inner outer] (&/|split-with no-binding? stack)]
+ (matchv ::M/objects [outer]
+ [["lux;Nil" _]]
+ (&/run-state (|do [module-name &/get-module-name]
+ (analyse-global analyse exo-type module-name name))
+ state)
+
+ [["lux;Cons" [?genv ["lux;Nil" _]]]]
+ (do ;; (prn 'analyse-symbol/_2 ?module name name (->> ?genv (&/get$ &/$LOCALS) (&/get$ &/$MAPPINGS) &/|keys &/->seq))
+ (if-let [global (->> ?genv (&/get$ &/$LOCALS) (&/get$ &/$MAPPINGS) (&/|get name))]
+ (do ;; (prn 'analyse-symbol/_2.1 ?module name name (aget global 0))
+ (matchv ::M/objects [global]
+ [[["lux;Global" [?module* name*]] _]]
+ ((|do [[[r-module r-name] $def] (&&module/find-def ?module* name*)
+ ;; :let [_ (prn 'analyse-symbol/_2.1.1 r-module r-name)]
+ endo-type (matchv ::M/objects [$def]
+ [["lux;ValueD" [?type _]]]
+ (return ?type)
+
+ [["lux;MacroD" _]]
+ (return &type/Macro)
+
+ [["lux;TypeD" _]]
+ (return &type/Type))
+ _ (if (and (clojure.lang.Util/identical &type/Type endo-type)
+ (clojure.lang.Util/identical &type/Type exo-type))
+ (return nil)
+ (&type/check exo-type endo-type))]
+ (return (&/|list (&/T (&/V "lux;Global" (&/T r-module r-name))
+ endo-type))))
+ state)
+
+ [_]
+ (do ;; (prn 'analyse-symbol/_2.1.2 ?module name name)
+ (fail* "[Analyser Error] Can't have anything other than a global def in the global environment."))))
+ (fail* "_{_ analyse-symbol _}_")))
+
+ [["lux;Cons" [top-outer _]]]
+ (do ;; (prn 'analyse-symbol/_3 ?module name)
+ (|let [scopes (&/|tail (&/folds #(&/|cons (&/get$ &/$NAME %2) %1)
+ (&/|map #(&/get$ &/$NAME %) outer)
+ (&/|reverse inner)))
+ [=local inner*] (&/fold2 (fn [register+new-inner frame in-scope]
+ (|let [[register new-inner] register+new-inner
+ [register* frame*] (&&lambda/close-over (&/|reverse in-scope) name register frame)]
+ (&/T register* (&/|cons frame* new-inner))))
+ (&/T (or (->> top-outer (&/get$ &/$LOCALS) (&/get$ &/$MAPPINGS) (&/|get name))
+ (->> top-outer (&/get$ &/$CLOSURE) (&/get$ &/$MAPPINGS) (&/|get name)))
+ (&/|list))
+ (&/|reverse inner) scopes)]
+ ((|do [btype (&&/expr-type =local)
+ _ (&type/check exo-type btype)]
+ (return (&/|list =local)))
+ (&/set$ &/$ENVS (&/|++ inner* outer) state))))
+ ))))
+
(defn analyse-symbol [analyse exo-type ident]
- (|do [module-name &/get-module-name]
- (fn [state]
- (|let [[?module ?name] ident
- ;; _ (prn 'analyse-symbol/_0 ?module ?name)
- local-ident (str ?module ";" ?name)
- stack (&/get$ &/$ENVS state)
- no-binding? #(and (->> % (&/get$ &/$LOCALS) (&/get$ &/$MAPPINGS) (&/|contains? local-ident) not)
- (->> % (&/get$ &/$CLOSURE) (&/get$ &/$MAPPINGS) (&/|contains? local-ident) not))
- [inner outer] (&/|split-with no-binding? stack)]
- (matchv ::M/objects [outer]
- [["lux;Nil" _]]
- (do ;; (prn 'analyse-symbol/_1
- ;; [?module ?name]
- ;; [(if (.equals "" ?module) module-name ?module)
- ;; ?name])
- ((|do [[[r-module r-name] $def] (&&module/find-def (if (.equals "" ?module) module-name ?module)
- ?name)
- ;; :let [_ (prn 'analyse-symbol/_1.1 r-module r-name)]
- endo-type (matchv ::M/objects [$def]
- [["lux;ValueD" [?type _]]]
- (return ?type)
-
- [["lux;MacroD" _]]
- (return &type/Macro)
-
- [["lux;TypeD" _]]
- (return &type/Type))
- _ (if (and (clojure.lang.Util/identical &type/Type endo-type)
- (clojure.lang.Util/identical &type/Type exo-type))
- (return nil)
- (&type/check exo-type endo-type))]
- (return (&/|list (&/T (&/V "lux;Global" (&/T r-module r-name))
- endo-type))))
- state))
-
- [["lux;Cons" [?genv ["lux;Nil" _]]]]
- (do ;; (prn 'analyse-symbol/_2 ?module ?name local-ident (->> ?genv (&/get$ &/$LOCALS) (&/get$ &/$MAPPINGS) &/|keys &/->seq))
- (if-let [global (->> ?genv (&/get$ &/$LOCALS) (&/get$ &/$MAPPINGS) (&/|get local-ident))]
- (do ;; (prn 'analyse-symbol/_2.1 ?module ?name local-ident (aget global 0))
- (matchv ::M/objects [global]
- [[["lux;Global" [?module* ?name*]] _]]
- ((|do [[[r-module r-name] $def] (&&module/find-def ?module* ?name*)
- ;; :let [_ (prn 'analyse-symbol/_2.1.1 r-module r-name)]
- endo-type (matchv ::M/objects [$def]
- [["lux;ValueD" [?type _]]]
- (return ?type)
-
- [["lux;MacroD" _]]
- (return &type/Macro)
-
- [["lux;TypeD" _]]
- (return &type/Type))
- _ (if (and (clojure.lang.Util/identical &type/Type endo-type)
- (clojure.lang.Util/identical &type/Type exo-type))
- (return nil)
- (&type/check exo-type endo-type))]
- (return (&/|list (&/T (&/V "lux;Global" (&/T r-module r-name))
- endo-type))))
- state)
-
- [_]
- (do ;; (prn 'analyse-symbol/_2.1.2 ?module ?name local-ident)
- (fail* "[Analyser Error] Can't have anything other than a global def in the global environment."))))
- (fail* "_{_ analyse-symbol _}_")))
-
- [["lux;Cons" [top-outer _]]]
- (do ;; (prn 'analyse-symbol/_3 ?module ?name)
- (|let [scopes (&/|tail (&/folds #(&/|cons (&/get$ &/$NAME %2) %1)
- (&/|map #(&/get$ &/$NAME %) outer)
- (&/|reverse inner)))
- [=local inner*] (&/fold2 (fn [register+new-inner frame in-scope]
- (|let [[register new-inner] register+new-inner
- [register* frame*] (&&lambda/close-over (&/|reverse in-scope) ident register frame)]
- (&/T register* (&/|cons frame* new-inner))))
- (&/T (or (->> top-outer (&/get$ &/$LOCALS) (&/get$ &/$MAPPINGS) (&/|get local-ident))
- (->> top-outer (&/get$ &/$CLOSURE) (&/get$ &/$MAPPINGS) (&/|get local-ident)))
- (&/|list))
- (&/|reverse inner) scopes)]
- ((|do [btype (&&/expr-type =local)
- _ (&type/check exo-type btype)]
- (return (&/|list =local)))
- (&/set$ &/$ENVS (&/|++ inner* outer) state))))
- )))
+ (|do [:let [[?module ?name] ident]]
+ (if (= "" ?module)
+ (analyse-local analyse exo-type ?name)
+ (analyse-global analyse exo-type ?module ?name))
))
(defn ^:private analyse-apply* [analyse exo-type fun-type ?args]
generated by cgit v1.2.3 (git 2.25.1) at 2024-12-25 18:30:23 +0000