Permalink
Browse files

dual namespace support - set/value vars live in the shen.globalsCloju…

…re ns
  • Loading branch information...
1 parent 2d92a1e commit 749dc55e6a0a0f752e696212a2edd714beff850f @hraberg committed Mar 20, 2012
Showing with 37 additions and 22 deletions.
  1. +2 −2 src/shen/install.clj
  2. +5 −5 src/shen/overwrite.clj
  3. +21 −15 src/shen/primitives.clj
  4. +9 −0 test/shen/test.clj
View
@@ -76,8 +76,8 @@
(write-clj-file to-dir "shen"
(concat [(header 'shen)]
[`(clojure.core/declare ~@(filter symbol? dcl))]
- ['(core/intern 'shen (core/with-meta '*language* {:dynamic true}) "Clojure")]
- [(concat '(core/intern 'shen (core/with-meta '*port* {:dynamic true}))
+ ['(core/intern 'shen.globals (core/with-meta '*language* {:dynamic true}) "Clojure")]
+ [(concat '(core/intern 'shen.globals (core/with-meta '*port* {:dynamic true}))
[(project-version)])]
(map #(shen.primitives/shen-kl-to-clj %)
(remove string? shen))
View
@@ -4,13 +4,13 @@
(:use [shen.primitives])
(:require [clojure.core :as core]))
-(def ^:dynamic *language* "Clojure")
-(def ^:dynamic *implementation* (core/str "Clojure " (core/clojure-version)
+(set '*language* "Clojure")
+(set '*implementation* (core/str "Clojure " (core/clojure-version)
" [jvm "(System/getProperty "java.version")"]"))
-(def ^:dynamic *porters* "Håkan Råberg")
+(set '*porters* "Håkan Råberg")
-(def ^:dynamic *stinput* core/*in*)
-(def ^:dynamic *home-directory* (System/getProperty "user.dir"))
+(set '*stinput* core/*in*)
+(set '*home-directory* (System/getProperty "user.dir"))
(shen-initialise_environment)
View
@@ -10,6 +10,8 @@
[java.util Arrays])
(:gen-class))
+(create-ns 'shen.globals)
+
(def string? core/string?)
(def number? core/number?)
@@ -134,23 +136,27 @@
(core/defmacro cond [& CS]
`(core/cond ~@(apply concat CS)))
+(defn set* [X Y ns]
+ @(core/intern (the-ns ns)
+ (with-meta X {:dynamic true :declared true})
+ Y))
+
(defn set
([X] (partial set X))
- ([X Y]
- @(core/intern (the-ns 'shen)
- (with-meta X {:dynamic true :declared true})
- Y)))
+ ([X Y] (set* X Y 'shen.globals)))
-(defn value [X]
- (core/let [v (and (symbol? X) (ns-resolve 'shen X))]
+(defn ^:private value* [X ns]
+ (core/let [v (and (symbol? X) (ns-resolve ns X))]
(condp = X
'and and-fn
'or or-fn
@v)))
+(defn value [X] (value* X 'shen.globals))
+
(defn function [fn]
(if (fn? fn) fn
- (value fn)))
+ (value* fn 'shen)))
(defn simple-error [String]
(throw (RuntimeException. ^String String)))
@@ -210,9 +216,9 @@
clj))
(defn ^:private define* [name body]
- (core/let [kl ((value 'shen-shen->kl) name body)]
+ (core/let [kl ((function 'shen-shen->kl) name body)]
(binding [*ns* (the-ns 'shen)]
- ((value 'eval) kl)
+ ((function 'eval) kl)
name)))
(defn ^:private shen-elim-define [X]
@@ -225,7 +231,7 @@
(core/let [body (walk/postwalk cleanup-clj body)]
(binding [*ns* (the-ns 'shen)]
(->> body
- (map (value 'eval))
+ (map (function 'eval))
last))))
(core/defmacro eval-shen [& body]
@@ -237,7 +243,7 @@
(core/defmacro define [name & body]
`(core/let [fn# (eval-shen ~(concat ['define name] body))]
(defn ~(with-meta name {:dynamic true})
- [& ~'args] (apply (value fn#) ~'args))))
+ [& ~'args] (apply (function fn#) ~'args))))
(doseq [[name args] '{defmacro [name] defprolog [name] prolog? [] package [name exceptions]}]
(eval
@@ -269,7 +275,7 @@
(catch RuntimeException e
(if-let [s (missing-symbol (.getMessage e))]
(do
- (set (symbol s) nil)
+ (set* (symbol s) nil 'shen)
(eval-and-declare-missing kl))
(throw e))))))
@@ -384,11 +390,11 @@
(print-method (vec o) w))
(defn ^:private read-bytes [s]
- ((value (intern "@p")) (map int s) ()))
+ ((function (intern "@p")) (map int s) ()))
(defn parse-shen [s]
- (core/let [<st_input> (value 'shen-<st_input>)
- snd (value 'snd)]
+ (core/let [<st_input> (function 'shen-<st_input>)
+ snd (function 'snd)]
(-> s read-bytes <st_input> snd)))
(defn parse-and-eval-shen [s]
View
@@ -187,6 +187,15 @@
))
+(deftest dual-namespace
+ (set 'dual-namespace true)
+ (is (true? @(resolve 'shen.globals/dual-namespace)))
+ (is (true? (value 'dual-namespace)))
+ (is (nil? (resolve 'shen/dual-namespace)))
+
+ (set 'element? nil)
+ (is (nil? (value 'element?)))
+ (is (fn? shen/element?)))
(deftest parser
(are [kl-str clj] (= clj (-> kl-str parse-shen first

0 comments on commit 749dc55

Please sign in to comment.