aboutsummaryrefslogtreecommitdiff
path: root/new-luxc/source/luxc/module.lux
diff options
context:
space:
mode:
authorEduardo Julian2017-11-15 19:51:33 -0400
committerEduardo Julian2017-11-15 19:51:33 -0400
commit296d087530cb142efec1dea159770346bb43c3c0 (patch)
treebde43594e5df48af539a0fda3e13cbf6aa36b557 /new-luxc/source/luxc/module.lux
parentc4e928e5805054aa12da40baaeccbb9c522b52d0 (diff)
- Heavy refactoring.
Diffstat (limited to 'new-luxc/source/luxc/module.lux')
-rw-r--r--new-luxc/source/luxc/module.lux173
1 files changed, 0 insertions, 173 deletions
diff --git a/new-luxc/source/luxc/module.lux b/new-luxc/source/luxc/module.lux
deleted file mode 100644
index 7b60af8f2..000000000
--- a/new-luxc/source/luxc/module.lux
+++ /dev/null
@@ -1,173 +0,0 @@
-(;module:
- lux
- (lux (control [monad #+ do]
- ["ex" exception #+ exception:])
- (data [text "text/" Eq<Text>]
- text/format
- ["e" error]
- (coll [list "list/" Fold<List> Functor<List>]))
- [meta]
- (meta [code]))
- (luxc ["&" base]
- ["&;" scope]))
-
-(exception: #export Unknown-Module)
-(exception: #export Cannot-Declare-Tag-Twice)
-(exception: #export Cannot-Declare-Tags-For-Unnamed-Type)
-(exception: #export Cannot-Declare-Tags-For-Foreign-Type)
-
-(def: (new-module hash)
- (-> Nat Module)
- {#;module-hash hash
- #;module-aliases (list)
- #;defs (list)
- #;imports (list)
- #;tags (list)
- #;types (list)
- #;module-annotations (' {})
- #;module-state #;Active})
-
-(def: #export (define (^@ full-name [module-name def-name])
- definition)
- (-> Ident Def (Meta Unit))
- (function [compiler]
- (case (&;pl-get module-name (get@ #;modules compiler))
- (#;Some module)
- (case (&;pl-get def-name (get@ #;defs module))
- #;None
- (#e;Success [(update@ #;modules
- (&;pl-put module-name
- (update@ #;defs
- (: (-> (List [Text Def]) (List [Text Def]))
- (|>. (#;Cons [def-name definition])))
- module))
- compiler)
- []])
-
- (#;Some already-existing)
- (#e;Error (format "Cannot re-define definiton: " (%ident full-name))))
-
- #;None
- (#e;Error (format "Cannot define in unknown module: " module-name)))))
-
-(def: #export (create hash name)
- (-> Nat Text (Meta Module))
- (function [compiler]
- (let [module (new-module hash)]
- (#e;Success [(update@ #;modules
- (&;pl-put name module)
- compiler)
- module]))))
-
-(def: #export (with-module hash name action)
- (All [a] (-> Nat Text (Meta a) (Meta [Module a])))
- (do meta;Monad<Meta>
- [_ (create hash name)
- output (&;with-current-module name
- (&scope;with-scope name action))
- module (meta;find-module name)]
- (wrap [module output])))
-
-(do-template [<flagger> <asker> <tag>]
- [(def: #export (<flagger> module-name)
- (-> Text (Meta Unit))
- (function [compiler]
- (case (|> compiler (get@ #;modules) (&;pl-get module-name))
- (#;Some module)
- (let [active? (case (get@ #;module-state module)
- #;Active true
- _ false)]
- (if active?
- (#e;Success [(update@ #;modules
- (&;pl-put module-name (set@ #;module-state <tag> module))
- compiler)
- []])
- (#e;Error "Can only change the state of a currently-active module.")))
-
- #;None
- (#e;Error (format "Module does not exist: " module-name)))))
- (def: #export (<asker> module-name)
- (-> Text (Meta Bool))
- (function [compiler]
- (case (|> compiler (get@ #;modules) (&;pl-get module-name))
- (#;Some module)
- (#e;Success [compiler
- (case (get@ #;module-state module)
- <tag> true
- _ false)])
-
- #;None
- (#e;Error (format "Module does not exist: " module-name)))
- ))]
-
- [flag-active! active? #;Active]
- [flag-compiled! compiled? #;Compiled]
- [flag-cached! cached? #;Cached]
- )
-
-(do-template [<name> <tag> <type>]
- [(def: (<name> module-name)
- (-> Text (Meta <type>))
- (function [compiler]
- (case (|> compiler (get@ #;modules) (&;pl-get module-name))
- (#;Some module)
- (#e;Success [compiler (get@ <tag> module)])
-
- #;None
- (meta;run compiler (&;throw Unknown-Module module-name)))
- ))]
-
- [tags-by-module #;tags (List [Text [Nat (List Ident) Bool Type]])]
- [types-by-module #;types (List [Text [(List Ident) Bool Type]])]
- [module-hash #;module-hash Nat]
- )
-
-(def: (ensure-undeclared-tags module-name tags)
- (-> Text (List Text) (Meta Unit))
- (do meta;Monad<Meta>
- [bindings (tags-by-module module-name)
- _ (monad;map @
- (function [tag]
- (case (&;pl-get tag bindings)
- #;None
- (wrap [])
-
- (#;Some _)
- (&;throw Cannot-Declare-Tag-Twice (format "Module: " module-name "\n"
- " Tag: " tag))))
- tags)]
- (wrap [])))
-
-(def: #export (declare-tags tags exported? type)
- (-> (List Text) Bool Type (Meta Unit))
- (do meta;Monad<Meta>
- [current-module meta;current-module-name
- [type-module type-name] (case type
- (#;Named type-ident _)
- (wrap type-ident)
-
- _
- (&;throw Cannot-Declare-Tags-For-Unnamed-Type
- (format "Tags: " (|> tags (list/map code;text) code;tuple %code) "\n"
- "Type: " (%type type))))
- _ (ensure-undeclared-tags current-module tags)
- _ (&;assert Cannot-Declare-Tags-For-Foreign-Type
- (format "Tags: " (|> tags (list/map code;text) code;tuple %code) "\n"
- "Type: " (%type type))
- (text/= current-module type-module))]
- (function [compiler]
- (case (|> compiler (get@ #;modules) (&;pl-get current-module))
- (#;Some module)
- (let [namespaced-tags (list/map (|>. [current-module]) tags)]
- (#e;Success [(update@ #;modules
- (&;pl-update current-module
- (|>. (update@ #;tags (function [tag-bindings]
- (list/fold (function [[idx tag] table]
- (&;pl-put tag [idx namespaced-tags exported? type] table))
- tag-bindings
- (list;enumerate tags))))
- (update@ #;types (&;pl-put type-name [namespaced-tags exported? type]))))
- compiler)
- []]))
- #;None
- (meta;run compiler (&;throw Unknown-Module current-module))))))