aboutsummaryrefslogtreecommitdiff
path: root/source/lux/meta/lux.lux
diff options
context:
space:
mode:
Diffstat (limited to 'source/lux/meta/lux.lux')
-rw-r--r--source/lux/meta/lux.lux366
1 files changed, 0 insertions, 366 deletions
diff --git a/source/lux/meta/lux.lux b/source/lux/meta/lux.lux
deleted file mode 100644
index b6ff09f59..000000000
--- a/source/lux/meta/lux.lux
+++ /dev/null
@@ -1,366 +0,0 @@
-## Copyright (c) Eduardo Julian. All rights reserved.
-## This Source Code Form is subject to the terms of the Mozilla Public License, v. 2.0.
-## If a copy of the MPL was not distributed with this file,
-## You can obtain one at http://mozilla.org/MPL/2.0/.
-
-(;import lux
- (.. ast)
- (lux/control (monoid #as m)
- (functor #as F)
- (monad #as M #refer (#only do))
- (show #as S))
- (lux/data (list #refer #all #open ("list:" List/Monoid List/Functor))
- (text #as T #open ("text:" Text/Monoid Text/Eq))
- (number/int #as I #open ("i" Int/Number))
- (tuple #as t)
- ident))
-
-## [Types]
-## (deftype (Lux a)
-## (-> Compiler (Either Text (, Compiler a))))
-
-## [Utils]
-(def (ident->text ident)
- (-> Ident Text)
- (let [[pre post] ident]
- ($ text:++ pre ";" post)))
-
-## [Structures]
-(defstruct #export Lux/Functor (F;Functor Lux)
- (def (map f fa)
- (lambda [state]
- (case (fa state)
- (#;Left msg)
- (#;Left msg)
-
- (#;Right [state' a])
- (#;Right [state' (f a)])))))
-
-(defstruct #export Lux/Monad (M;Monad Lux)
- (def _functor Lux/Functor)
- (def (wrap x)
- (lambda [state]
- (#;Right [state x])))
- (def (join mma)
- (lambda [state]
- (case (mma state)
- (#;Left msg)
- (#;Left msg)
-
- (#;Right [state' ma])
- (ma state')))))
-
-## Functions
-(def #export (get-module-name state)
- (Lux Text)
- (case (reverse (get@ #;envs state))
- #;Nil
- (#;Left "Can't get the module name without a module!")
-
- (#;Cons [env _])
- (#;Right [state (get@ #;name env)])))
-
-(def (get k plist)
- (All [a]
- (-> Text (List (, Text a)) (Maybe a)))
- (case plist
- #;Nil
- #;None
-
- (#;Cons [k' v] plist')
- (if (text:= k k')
- (#;Some v)
- (get k plist'))))
-
-(def (find-macro' modules current-module module name)
- (-> (List (, Text (Module Compiler))) Text Text Text
- (Maybe Macro))
- (case (get module modules)
- (#;Some $module)
- (case (|> (: (Module Compiler) $module) (get@ #;defs) (get name))
- (#;Some gdef)
- (case (: Definition gdef)
- [exported? (#;MacroD macro')]
- (if (or exported? (text:= module current-module))
- (#;Some macro')
- #;None)
-
- [_ (#;AliasD [r-module r-name])]
- (find-macro' modules current-module r-module r-name)
-
- _
- #;None)
-
- _
- #;None)
-
- _
- #;None))
-
-(def #export (find-macro ident)
- (-> Ident (Lux (Maybe Macro)))
- (do Lux/Monad
- [current-module get-module-name]
- (let [[module name] ident]
- (: (Lux (Maybe Macro))
- (lambda [state]
- (#;Right [state (find-macro' (get@ #;modules state) current-module module name)]))))))
-
-(def #export (normalize ident)
- (-> Ident (Lux Ident))
- (case ident
- ["" name]
- (do Lux/Monad
- [module-name get-module-name]
- (wrap [module-name name]))
-
- _
- (:: Lux/Monad (wrap ident))))
-
-(def #export (macro-expand syntax)
- (-> AST (Lux (List AST)))
- (case syntax
- [_ (#;FormS (#;Cons [[_ (#;SymbolS macro-name)] args]))]
- (do Lux/Monad
- [macro-name' (normalize macro-name)
- ?macro (find-macro macro-name')]
- (case ?macro
- (#;Some macro)
- (do Lux/Monad
- [expansion (macro args)
- expansion' (M;map% Lux/Monad macro-expand expansion)]
- (wrap (:: List/Monad (join expansion'))))
-
- #;None
- (:: Lux/Monad (wrap (@list syntax)))))
-
- _
- (:: Lux/Monad (wrap (@list syntax)))))
-
-(def #export (macro-expand-all syntax)
- (-> AST (Lux (List AST)))
- (case syntax
- [_ (#;FormS (#;Cons [[_ (#;SymbolS macro-name)] args]))]
- (do Lux/Monad
- [macro-name' (normalize macro-name)
- ?macro (find-macro macro-name')]
- (case ?macro
- (#;Some macro)
- (do Lux/Monad
- [expansion (macro args)
- expansion' (M;map% Lux/Monad macro-expand-all expansion)]
- (wrap (:: List/Monad (join expansion'))))
-
- #;None
- (do Lux/Monad
- [parts' (M;map% Lux/Monad macro-expand-all (@list& (symbol$ macro-name) args))]
- (wrap (@list (form$ (:: List/Monad (join parts'))))))))
-
- [_ (#;FormS (#;Cons [harg targs]))]
- (do Lux/Monad
- [harg+ (macro-expand-all harg)
- targs+ (M;map% Lux/Monad macro-expand-all targs)]
- (wrap (@list (form$ (list:++ harg+ (:: List/Monad (join (: (List (List AST)) targs+))))))))
-
- [_ (#;TupleS members)]
- (do Lux/Monad
- [members' (M;map% Lux/Monad macro-expand-all members)]
- (wrap (@list (tuple$ (:: List/Monad (join members'))))))
-
- _
- (:: Lux/Monad (wrap (@list syntax)))))
-
-(def #export (gensym prefix state)
- (-> Text (Lux AST))
- (#;Right [(update@ #;seed (i+ 1) state)
- (symbol$ ["" ($ text:++ "__gensym__" prefix (:: I;Int/Show (show (get@ #;seed state))))])]))
-
-(def #export (emit datum)
- (All [a]
- (-> a (Lux a)))
- (lambda [state]
- (#;Right [state datum])))
-
-(def #export (fail msg)
- (All [a]
- (-> Text (Lux a)))
- (lambda [_]
- (#;Left msg)))
-
-(def #export (macro-expand-1 token)
- (-> AST (Lux AST))
- (do Lux/Monad
- [token+ (macro-expand token)]
- (case token+
- (\ (@list token'))
- (wrap token')
-
- _
- (fail "Macro expanded to more than 1 element."))))
-
-(def #export (module-exists? module state)
- (-> Text (Lux Bool))
- (#;Right [state (case (get module (get@ #;modules state))
- (#;Some _)
- true
-
- #;None
- false)]))
-
-(def #export (exported-defs module state)
- (-> Text (Lux (List Text)))
- (case (get module (get@ #;modules state))
- (#;Some =module)
- (using List/Monad
- (#;Right [state (join (map (: (-> (, Text Definition)
- (List Text))
- (lambda [gdef]
- (let [[name [export? _]] gdef]
- (if export?
- (@list name)
- (@list)))))
- (get@ #;defs =module)))]))
-
- #;None
- (#;Left ($ text:++ "Unknown module: " module))))
-
-(def (try-both f x1 x2)
- (All [a b]
- (-> (-> a (Maybe b)) a a (Maybe b)))
- (case (f x1)
- #;None (f x2)
- (#;Some y) (#;Some y)))
-
-(def #export (find-in-env name state)
- (-> Text Compiler (Maybe Type))
- (case state
- {#;source source #;modules modules
- #;envs envs #;type-vars types #;host host
- #;seed seed #;eval? eval? #;expected expected
- #;cursor cursor}
- (some (: (-> (Env Text (Meta (, Type Cursor) Analysis)) (Maybe Type))
- (lambda [env]
- (case env
- {#;name _ #;inner-closures _ #;locals {#;counter _ #;mappings locals} #;closure {#;counter _ #;mappings closure}}
- (try-both (some (: (-> (, Text (Meta (, Type Cursor) Analysis)) (Maybe Type))
- (lambda [binding]
- (let [[bname [[type _] _]] binding]
- (if (text:= name bname)
- (#;Some type)
- #;None)))))
- locals
- closure))))
- envs)))
-
-(def (find-in-defs' name state)
- (-> Ident Compiler (Maybe Definition))
- (let [[v-prefix v-name] name
- {#;source source #;modules modules
- #;envs envs #;type-vars types #;host host
- #;seed seed #;eval? eval? #;expected expected
- #;cursor cursor} state]
- (case (get v-prefix modules)
- #;None
- #;None
-
- (#;Some {#;defs defs #;module-aliases _ #;imports _ #;tags _ #;types _})
- (case (get v-name defs)
- #;None
- #;None
-
- (#;Some def)
- (case def
- [_ (#;AliasD name')] (find-in-defs' name' state)
- _ (#;Some def)
- )))
- ))
-
-(def #export (find-in-defs name state)
- (-> Ident Compiler (Maybe Type))
- (case (find-in-defs' name state)
- (#;Some [_ def-data])
- (case def-data
- (#;ValueD [type value]) (#;Some type)
- (#;MacroD _) (#;Some Macro)
- (#;TypeD _) (#;Some Type)
- _ #;None)
-
- #;None
- #;None))
-
-(def #export (find-var-type name)
- (-> Ident (Lux Type))
- (do Lux/Monad
- [#let [[_ _name] name]
- name' (normalize name)]
- (: (Lux Type)
- (lambda [state]
- (case (find-in-env _name state)
- (#;Some struct-type)
- (#;Right [state struct-type])
-
- _
- (case (find-in-defs name' state)
- (#;Some struct-type)
- (#;Right [state struct-type])
-
- _
- (#;Left ($ text:++ "Unknown var: " (ident->text name)))))))
- ))
-
-(def #export (find-type name)
- (-> Ident (Lux Type))
- (do Lux/Monad
- [name' (normalize name)]
- (: (Lux Type)
- (lambda [state]
- (case (find-in-defs' name' state)
- (#;Some def-data)
- (case def-data
- [_ (#;TypeD type)] (#;Right [state type])
- _ (#;Left ($ text:++ "Definition is not a type: " (ident->text name))))
-
- _
- (#;Left ($ text:++ "Unknown var: " (ident->text name))))))
- ))
-
-(def #export (defs module-name state)
- (-> Text (Lux (List (, Text Definition))))
- (case (get module-name (get@ #;modules state))
- #;None (#;Left ($ text:++ "Unknown module: " module-name))
- (#;Some module) (#;Right [state (get@ #;defs module)])
- ))
-
-(def #export (exports module-name)
- (-> Text (Lux (List (, Text Definition))))
- (do Lux/Monad
- [defs (defs module-name)]
- (wrap (filter (lambda [[name [exported? data]]] exported?)
- defs))))
-
-(def #export (modules state)
- (Lux (List Text))
- (|> state
- (get@ #;modules)
- (list:map t;first)
- (#;Right state)))
-
-(def #export (find-module name state)
- (-> Text (Lux (Module Compiler)))
- (case (get name (get@ #;modules state))
- (#;Some module)
- (#;Right state module)
-
- _
- (#;Left ($ text:++ "Unknown module: " name))))
-
-(def #export (tags-for [module name])
- (-> Ident (Lux (Maybe (List Ident))))
- (do Lux/Monad
- [module (find-module module)]
- (case (get name (get@ #;types module))
- (#;Some [tags _])
- (wrap (#;Some tags))
-
- _
- (wrap #;None))))
generated by cgit v1.2.3 (git 2.25.1) at 2024-09-12 21:03:54 +0000