aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorEduardo Julian2017-12-02 01:10:12 -0400
committerEduardo Julian2017-12-02 01:10:12 -0400
commit46955edbe6cea9f367562b9fb17cef526109d9e0 (patch)
tree65a0ccbd9ea7bd02be39963783adac432d8f5e90
parentf92c4dc2f813b40f14d240491daa665942165e7e (diff)
- Added new "lux in-module" procedure for changing the module while analysing an expression.
Diffstat (limited to '')
-rw-r--r--luxc/src/lux/analyser.clj7
-rw-r--r--luxc/src/lux/base.clj10
-rw-r--r--new-luxc/source/luxc/lang/analysis/procedure/common.lux28
-rw-r--r--stdlib/source/lux.lux20
4 files changed, 53 insertions, 12 deletions
diff --git a/luxc/src/lux/analyser.clj b/luxc/src/lux/analyser.clj
index 13bf3bc61..6e765cb9b 100644
--- a/luxc/src/lux/analyser.clj
+++ b/luxc/src/lux/analyser.clj
@@ -162,6 +162,13 @@
(&/with-cursor cursor
(&&lux/analyse-module analyse optimize eval! compile-module ?meta)))
+ "lux in-module"
+ (|let [(&/$Cons [_ (&/$Text ?module)]
+ (&/$Cons ?expr (&/$Nil))) parameters]
+ (&/with-cursor cursor
+ (&/with-module ?module
+ (analyse exo-type ?expr))))
+
;; else
(&/with-analysis-meta cursor exo-type
(cond (.startsWith ^String ?procedure "jvm")
diff --git a/luxc/src/lux/base.clj b/luxc/src/lux/base.clj
index ae9b2bb47..ee4bcde10 100644
--- a/luxc/src/lux/base.clj
+++ b/luxc/src/lux/base.clj
@@ -1437,6 +1437,16 @@
($Left msg)
($Left msg))))
+(defn with-module [name body]
+ (fn [state]
+ (|case (body (set$ $current-module ($Some name) state))
+ ($Right [state* output])
+ ($Right (T [(set$ $current-module (get$ $current-module state) state*)
+ output]))
+
+ ($Left msg)
+ ($Left msg))))
+
(defn |eitherL [left right]
(fn [compiler]
(|case (run-state left compiler)
diff --git a/new-luxc/source/luxc/lang/analysis/procedure/common.lux b/new-luxc/source/luxc/lang/analysis/procedure/common.lux
index b003edfa7..ecdcd0bfd 100644
--- a/new-luxc/source/luxc/lang/analysis/procedure/common.lux
+++ b/new-luxc/source/luxc/lang/analysis/procedure/common.lux
@@ -20,6 +20,7 @@
[".A" type]))))
(exception: #export Incorrect-Procedure-Arity)
+(exception: #export Invalid-Syntax)
## [Utils]
(type: #export Proc
@@ -80,7 +81,7 @@
## [Analysers]
## "lux is" represents reference/pointer equality.
-(def: (lux-is proc)
+(def: (lux//is proc)
(-> Text Proc)
(function [analyse eval args]
(do macro.Monad<Meta>
@@ -90,7 +91,7 @@
## "lux try" provides a simple way to interact with the host platform's
## error-handling facilities.
-(def: (lux-try proc)
+(def: (lux//try proc)
(-> Text Proc)
(function [analyse eval args]
(case args
@@ -127,6 +128,22 @@
_
(&.throw Incorrect-Procedure-Arity (wrong-arity proc +2 (list.size args))))))
+(def: (lux//in-module proc)
+ (-> Text Proc)
+ (function [analyse eval argsC+]
+ (case argsC+
+ (^ (list [_ (#.Text module-name)] exprC))
+ (&.with-current-module module-name
+ (analyse exprC))
+
+ _
+ (&.throw Invalid-Syntax (format "Procedure: " proc "\n"
+ " Inputs:" (|> argsC+
+ list.enumerate
+ (list/map (function [[idx argC]]
+ (format "\n " (%n idx) " " (%code argC))))
+ (text.join-with "")) "\n")))))
+
(do-template [<name> <analyser>]
[(def: (<name> proc)
(-> Text Proc)
@@ -158,13 +175,14 @@
(def: lux-procs
Bundle
(|> (dict.new text.Hash<Text>)
- (install "is" lux-is)
- (install "try" lux-try)
+ (install "is" lux//is)
+ (install "try" lux//try)
(install "function" lux//function)
(install "case" lux//case)
(install "check" lux//check)
(install "coerce" lux//coerce)
- (install "check type" lux//check//type)))
+ (install "check type" lux//check//type)
+ (install "in-module" lux//in-module)))
(def: io-procs
Bundle
diff --git a/stdlib/source/lux.lux b/stdlib/source/lux.lux
index e7326f34b..22fc75e92 100644
--- a/stdlib/source/lux.lux
+++ b/stdlib/source/lux.lux
@@ -1842,9 +1842,9 @@
#None
(#Left ($_ text/compose "Unknown module: " module " @ " (ident/encode ident)))})))
-(def:''' (splice replace? untemplate elems)
+(def:''' (splice replace? untemplate subst elems)
#Nil
- (-> Bool (-> Code ($' Meta Code)) ($' List Code) ($' Meta Code))
+ (-> Bool (-> Code ($' Meta Code)) Text ($' List Code) ($' Meta Code))
("lux case" replace?
{true
("lux case" (list/reverse elems)
@@ -1855,7 +1855,9 @@
(do Monad<Meta>
[lastO ("lux case" lastI
{[_ (#Form (#Cons [[_ (#Symbol ["" "~+"])] (#Cons [spliced #Nil])]))]
- (wrap spliced)
+ (wrap (if (text/= "" subst)
+ spliced
+ (form$ (list (text$ "lux in-module") (text$ subst) spliced))))
_
(do Monad<Meta>
@@ -1866,7 +1868,9 @@
("lux case" leftI
{[_ (#Form (#Cons [[_ (#Symbol ["" "~+"])] (#Cons [spliced #Nil])]))]
(wrap (form$ (list (symbol$ ["lux" "splice-helper"])
- spliced
+ (if (text/= "" subst)
+ spliced
+ (form$ (list (text$ "lux in-module") (text$ subst) spliced)))
rightO)))
_
@@ -1931,7 +1935,9 @@
(return (wrap-meta (form$ (list (tag$ ["lux" "Symbol"]) (tuple$ (list (text$ module) (text$ name)))))))
[true [_ (#Form (#Cons [[_ (#Symbol ["" "~"])] (#Cons [unquoted #Nil])]))]]
- (return unquoted)
+ (return (if (text/= "" subst)
+ unquoted
+ (form$ (list (text$ "lux in-module") (text$ subst) unquoted))))
[true [_ (#Form (#Cons [[_ (#Symbol ["" "~@"])] (#Cons [ident #Nil])]))]]
(return (wrap-meta (form$ (list (tag$ ["lux" "Symbol"]) ident))))
@@ -1941,13 +1947,13 @@
[_ [meta (#Form elems)]]
(do Monad<Meta>
- [output (splice replace? (untemplate replace? subst) elems)
+ [output (splice replace? (untemplate replace? subst) subst elems)
#let [[_ output'] (wrap-meta (form$ (list (tag$ ["lux" "Form"]) output)))]]
(wrap [meta output']))
[_ [meta (#Tuple elems)]]
(do Monad<Meta>
- [output (splice replace? (untemplate replace? subst) elems)
+ [output (splice replace? (untemplate replace? subst) subst elems)
#let [[_ output'] (wrap-meta (form$ (list (tag$ ["lux" "Tuple"]) output)))]]
(wrap [meta output']))