diff options
| -rw-r--r-- | luxc/src/lux/analyser.clj | 7 | ||||
| -rw-r--r-- | luxc/src/lux/base.clj | 10 | ||||
| -rw-r--r-- | new-luxc/source/luxc/lang/analysis/procedure/common.lux | 28 | ||||
| -rw-r--r-- | stdlib/source/lux.lux | 20 |
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'])) |