diff options
Diffstat (limited to 'source')
| -rw-r--r-- | source/lux.lux | 117 | ||||
| -rw-r--r-- | source/lux/data/char.lux | 3 | ||||
| -rw-r--r-- | source/lux/data/io.lux | 3 | ||||
| -rw-r--r-- | source/lux/data/number.lux | 8 | ||||
| -rw-r--r-- | source/lux/host/java.lux | 84 | ||||
| -rw-r--r-- | source/lux/meta/lux.lux | 7 | ||||
| -rw-r--r-- | source/lux/meta/syntax.lux | 2 | ||||
| -rw-r--r-- | source/program.lux | 2 |
8 files changed, 133 insertions, 93 deletions
diff --git a/source/lux.lux b/source/lux.lux index 50f8f1af2..8f7e4fa04 100644 --- a/source/lux.lux +++ b/source/lux.lux @@ -1069,7 +1069,7 @@ _ #Nil)) -(def'' #export (text:= x y) +(def'' (text:= x y) (-> Text Text Bool) (_jvm_invokevirtual java.lang.Object equals [java.lang.Object] x [y])) @@ -1196,7 +1196,7 @@ (-> Bool Bool) (if x false true)) -(def'' #export (text:++ x y) +(def'' (text:++ x y) (-> Text Text Text) (_jvm_invokevirtual java.lang.String concat [java.lang.String] x [y])) @@ -1883,8 +1883,11 @@ (#Exclude (List Text)) #Nothing)) +(deftype Openings + (, Text (List Ident))) + (deftype Import - (, Text (Maybe Text) Referrals)) + (, Text (Maybe Text) Referrals (Maybe Openings))) (def (extract-defs defs) (-> (List Syntax) (Lux (List Text))) @@ -1932,6 +1935,26 @@ _ (return (: (, Referrals (List Syntax)) [#Nothing tokens])))) +(def (extract-symbol syntax) + (-> Syntax (Lux Ident)) + (case syntax + (#Meta [_ (#SymbolS ident)]) + (return ident) + + _ + (fail "Not a symbol."))) + +(def (parse-openings tokens) + (-> (List Syntax) (Lux (, (Maybe Openings) (List Syntax)))) + (case tokens + (\ (list& (#Meta [_ (#TagS ["" "open"])]) (#Meta [_ (#FormS (list& (#Meta [_ (#TextS prefix)]) structs))]) tokens')) + (do Lux/Monad + [structs' (map% Lux/Monad extract-symbol structs)] + (return (: (, (Maybe Openings) (List Syntax)) [(#Some [prefix structs']) tokens']))) + + _ + (return (: (, (Maybe Openings) (List Syntax)) [#None tokens])))) + (def (decorate-imports super-name tokens) (-> Text (List Syntax) (Lux (List Syntax))) (map% Lux/Monad @@ -1951,33 +1974,31 @@ (def (parse-imports imports) (-> (List Syntax) (Lux (List Import))) (do Lux/Monad - [referrals' (map% Lux/Monad - (: (-> Syntax (Lux (List Import))) - (lambda [token] - (case token - (#Meta [_ (#SymbolS ["" m-name])]) - (;return (list [m-name #None #All])) - - (\ (#Meta [_ (#FormS (list& (#Meta [_ (#SymbolS ["" m-name])]) extra))])) - (do Lux/Monad - [alias+extra' (parse-alias extra) - #let [[alias extra'] (: (, (Maybe Text) (List Syntax)) - alias+extra')] - referral+extra'' (parse-referrals extra') - #let [[referral extra''] (: (, Referrals (List Syntax)) - referral+extra'')] - extra''' (decorate-imports m-name extra'') - sub-imports (parse-imports extra''')] - (;return (case referral - #Nothing (case alias - #None sub-imports - (#Some _) (list& [m-name alias referral] sub-imports)) - _ (list& [m-name alias referral] sub-imports)))) - - _ - (fail "Wrong syntax for import")))) - imports)] - (;return (list:join referrals')))) + [imports' (map% Lux/Monad + (: (-> Syntax (Lux (List Import))) + (lambda [token] + (case token + (#Meta [_ (#SymbolS ["" m-name])]) + (;return (list [m-name #None #All #None])) + + (\ (#Meta [_ (#FormS (list& (#Meta [_ (#SymbolS ["" m-name])]) extra))])) + (do Lux/Monad + [alias+extra (parse-alias extra) + #let [[alias extra] alias+extra] + referral+extra (parse-referrals extra) + #let [[referral extra] referral+extra] + openings+extra (parse-openings extra) + #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)))) + + _ + (fail "Wrong syntax for import")))) + imports)] + (;return (list:join imports')))) (def (module-exists? module state) (-> Text (Lux Bool)) @@ -2131,16 +2152,16 @@ (: (-> Import (Lux Import)) (lambda [import] (case import - [m-name m-alias m-referrals] + [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])))))) + (;return (: Import [m-name m-alias m-referrals m-openings])))))) imports) unknowns' (map% Lux/Monad (: (-> Import (Lux (List Text))) (lambda [import] (case import - [m-name _ _] + [m-name _ _ _] (do Lux/Monad [? (module-exists? m-name)] (;return (if ? @@ -2155,7 +2176,7 @@ (: (-> Import (Lux (List Syntax))) (lambda [import] (case import - [m-name m-alias m-referrals] + [m-name m-alias m-referrals m-openings] (do Lux/Monad [defs (case m-referrals #All @@ -2172,7 +2193,18 @@ (;return (filter (. not (is-member? -defs)) *defs))) #Nothing - (;return (list)))] + (;return (list))) + #let [openings (: (List Syntax) + (case m-openings + #None + (list) + + (#Some [prefix structs]) + (map (: (-> Ident Syntax) + (lambda [struct] + (let [[_ name] struct] + (` (open (~ (symbol$ [m-name name])) (~ (text$ prefix))))))) + structs)))]] (;return ($ list:++ (list (` (_lux_import (~ (text$ m-name))))) (case m-alias @@ -2181,7 +2213,8 @@ (map (: (-> Text Syntax) (lambda [def] (` ((~ (symbol$ ["" "_lux_def"])) (~ (symbol$ ["" def])) (~ (symbol$ [m-name def])))))) - defs))))))) + defs) + openings)))))) imports)] (;return (list:join output'))) @@ -2583,16 +2616,22 @@ (defmacro #export (open tokens) (case tokens - (\ (list (#Meta [_ (#SymbolS struct-name)]))) + (\ (list& (#Meta [_ (#SymbolS struct-name)]) tokens')) (do Lux/Monad - [struct-type (find-var-type struct-name)] + [#let [prefix (case tokens' + (\ (list (#Meta [_ (#TextS prefix)]))) + prefix + + _ + "")] + struct-type (find-var-type struct-name)] (case (resolve-struct-type struct-type) (#Some (#RecordT slots)) (return (map (: (-> (, Text Type) Syntax) (lambda [slot] (let [[sname stype] slot [module name] (split-slot sname)] - (` (_lux_def (~ (symbol$ ["" name])) + (` (_lux_def (~ (symbol$ ["" (text:++ prefix name)])) (get@ (~ (tag$ [module name])) (~ (symbol$ struct-name)))))))) slots)) diff --git a/source/lux/data/char.lux b/source/lux/data/char.lux index 42e57509e..5dac9a3c7 100644 --- a/source/lux/data/char.lux +++ b/source/lux/data/char.lux @@ -8,7 +8,8 @@ (;import lux (.. (eq #as E) - (show #as S))) + (show #as S) + (text #as T #open ("text:" Text/Monoid)))) ## [Structures] (defstruct #export Char/Eq (E;Eq Char) diff --git a/source/lux/data/io.lux b/source/lux/data/io.lux index c08023df5..17e8d727a 100644 --- a/source/lux/data/io.lux +++ b/source/lux/data/io.lux @@ -10,7 +10,8 @@ (lux/meta macro) (lux/control (functor #as F) (monad #as M)) - lux/data/list) + (.. list + (text #as T #open ("text:" Text/Monoid)))) ## Types (deftype #export (IO a) diff --git a/source/lux/data/number.lux b/source/lux/data/number.lux index 8da674d88..b222de15c 100644 --- a/source/lux/data/number.lux +++ b/source/lux/data/number.lux @@ -8,10 +8,10 @@ (;import lux (lux/control (monoid #as m)) - (lux/data (eq #as E) - (ord #as O) - (bounded #as B) - (show #as S))) + (.. (eq #as E) + (ord #as O) + (bounded #as B) + (show #as S))) ## Signatures (defsig #export (Number n) diff --git a/source/lux/host/java.lux b/source/lux/host/java.lux index 12525d3f2..9bd0c838c 100644 --- a/source/lux/host/java.lux +++ b/source/lux/host/java.lux @@ -10,14 +10,12 @@ (lux (control (monoid #as m) (functor #as F) (monad #as M #refer (#only do))) - (data list + (data (list #as l #refer #all #open ("" List/Functor)) (text #as text)) (meta lux macro syntax))) -## (open List/Functor) - ## [Utils/Parsers] (def finally^ (Parser Syntax) @@ -110,29 +108,29 @@ (defsyntax #export (try body [catches (*^ catch^)] [finally (?^ finally^)]) (emit (list (` (_jvm_try (~ body) - (~@ (list:++ (:: List/Functor (F;map (: (-> (, Text Ident Syntax) Syntax) - (lambda [catch] - (let [[class ex body] catch] - (` (_jvm_catch (~ (text$ class)) (~ (symbol$ ex)) (~ body)))))) - catches)) - (case finally - #;None - (list) - - (#;Some finally) - (list (` (_jvm_finally (~ finally)))))))))))) + (~@ (:: List/Monoid (m;++ (map (: (-> (, Text Ident Syntax) Syntax) + (lambda [catch] + (let [[class ex body] catch] + (` (_jvm_catch (~ (text$ class)) (~ (symbol$ ex)) (~ body)))))) + catches) + (case finally + #;None + (list) + + (#;Some finally) + (list (` (_jvm_finally (~ finally))))))))))))) (defsyntax #export (definterface [name local-symbol^] [supers (tuple^ (*^ local-symbol^))] [members (*^ method-decl^)]) (do Lux/Monad [current-module get-module-name #let [full-name (:: text;Text/Monoid (m;++ (text;replace "/" "." current-module) name))]] - (let [members' (:: List/Functor (F;map (: (-> (, (List Text) Text (List Text) Text) Syntax) - (lambda [member] - (let [[modifiers name inputs output] member] - (` ((~ (symbol$ ["" name])) [(~@ (:: List/Functor (F;map text$ inputs)))] (~ (text$ output)) [(~@ (:: List/Functor (F;map text$ modifiers)))]))))) - members))] - (emit (list (` (_jvm_interface (~ (text$ full-name)) [(~@ (:: List/Functor (F;map text$ supers)))] + (let [members' (map (: (-> (, (List Text) Text (List Text) Text) Syntax) + (lambda [member] + (let [[modifiers name inputs output] member] + (` ((~ (symbol$ ["" name])) [(~@ (map text$ inputs))] (~ (text$ output)) [(~@ (map text$ modifiers))]))))) + members)] + (emit (list (` (_jvm_interface (~ (text$ full-name)) [(~@ (map text$ supers))] (~@ members')))))))) (defsyntax #export (defclass [name local-symbol^] [super local-symbol^] [interfaces (tuple^ (*^ local-symbol^))] @@ -142,35 +140,35 @@ [current-module get-module-name #let [full-name (:: text;Text/Monoid (m;++ (text;replace "/" "." current-module) name)) - fields' (:: List/Functor (F;map (: (-> (, (List Text) Text Text) Syntax) - (lambda [field] - (let [[modifiers name class] field] - (` ((~ (symbol$ ["" name])) - (~ (text$ class)) - [(~@ (:: List/Functor (F;map text$ modifiers)))]))))) - fields)) - methods' (:: List/Functor (F;map (: (-> (, (List Text) Text (List (, Text Text)) Text Syntax) Syntax) - (lambda [methods] - (let [[modifiers name inputs output body] methods] - (` ((~ (symbol$ ["" name])) - [(~@ (:: List/Functor (F;map (: (-> (, Text Text) Syntax) - (lambda [in] - (let [[left right] in] - (form$ (list (text$ left) - (text$ right)))))) - inputs)))] - (~ (text$ output)) - [(~@ (:: List/Functor (F;map text$ modifiers)))] - (~ body)))))) - methods))]] + fields' (map (: (-> (, (List Text) Text Text) Syntax) + (lambda [field] + (let [[modifiers name class] field] + (` ((~ (symbol$ ["" name])) + (~ (text$ class)) + [(~@ (map text$ modifiers))]))))) + fields) + methods' (map (: (-> (, (List Text) Text (List (, Text Text)) Text Syntax) Syntax) + (lambda [methods] + (let [[modifiers name inputs output body] methods] + (` ((~ (symbol$ ["" name])) + [(~@ (map (: (-> (, Text Text) Syntax) + (lambda [in] + (let [[left right] in] + (form$ (list (text$ left) + (text$ right)))))) + inputs))] + (~ (text$ output)) + [(~@ (map text$ modifiers))] + (~ body)))))) + methods)]] (emit (list (` (_jvm_class (~ (text$ full-name)) (~ (text$ super)) - [(~@ (:: List/Functor (F;map text$ interfaces)))] + [(~@ (map text$ interfaces))] [(~@ fields')] [(~@ methods')])))))) (defsyntax #export (new [class local-symbol^] [arg-classes (tuple^ (*^ local-symbol^))] [args (tuple^ (*^ id^))]) (emit (list (` (_jvm_new (~ (text$ class)) - [(~@ (:: List/Functor (F;map text$ arg-classes)))] + [(~@ (map text$ arg-classes))] [(~@ args)]))))) (defsyntax #export (instance? [class local-symbol^] obj) diff --git a/source/lux/meta/lux.lux b/source/lux/meta/lux.lux index a28d6e5d4..99ca200cf 100644 --- a/source/lux/meta/lux.lux +++ b/source/lux/meta/lux.lux @@ -14,7 +14,8 @@ (lux/data list maybe (show #as S) - (number #as N))) + (number #as N) + (text #as T #open ("text:" Text/Monoid Text/Eq)))) ## [Types] ## (deftype (Lux a) @@ -209,10 +210,10 @@ (lambda [b] (let [[label _] b] label)))) (:: List/Functor) (interpose " ") - (foldL text:++ "")))))) + (foldL text:++ text:unit)))))) (:: List/Functor) (interpose "\n") - (foldL text:++ ""))) + (foldL text:++ text:unit))) (def (try-both f x1 x2) (All [a b] diff --git a/source/lux/meta/syntax.lux b/source/lux/meta/syntax.lux index 1fe85c32f..83702f75d 100644 --- a/source/lux/meta/syntax.lux +++ b/source/lux/meta/syntax.lux @@ -14,7 +14,7 @@ (data (eq #as E) (bool #as b) (char #as c) - (text #as t) + (text #as t #open ("text:" Text/Monoid Text/Eq)) list))) ## [Utils] diff --git a/source/program.lux b/source/program.lux index 052c0bf41..18a2a76ab 100644 --- a/source/program.lux +++ b/source/program.lux @@ -30,7 +30,7 @@ (reader #as r) show state - (text #as t) + (text #as t #open ("text:" Text/Monoid)) writer) (host java) (meta lux |