picolisp

commit ac00e263278bd597d2f5e51c3a5aee4f3e4b8f6d
parent e70f6447faa1ecce110be17062bd68fb4d5cac34
Author: Alexander Burger <abu@software-lab.de>
Date:   Sat,  7 Apr 2012 10:42:09 +0200

Generalized 'scl'
Diffstat:
M
CHANGES
 | 
1
+
M
doc/refS.html
 | 
13
++++++++++---
M
ersatz/lib.l
 | 
8
+++++---
M
lib.l
 | 
8
+++++---
M
test/lib.l
 | 
3
++-

5 files changed, 23 insertions(+), 10 deletions(-)
diff --git a/CHANGES b/CHANGES
@@ -1,4 +1,5 @@
 * XXmmm12 picoLisp-3.0.10
+   Generalized 'scl'
    Pilog 'for/[2-4]' predicate
    Bug in 'isLifeE_F' (64-bit)
    Bug in 'firstByteA_B' (64-bit)
diff --git a/doc/refS.html b/doc/refS.html
@@ -163,9 +163,12 @@ href="refS.html#step">step</a></code>.
 -> {7-6}
 </code></pre>
 
-<dt><a name="scl"><code>(scl 'num) -> num</code></a>
-<dd>Sets <code><a href="refS.html#*Scl">*Scl</a></code> globally to
-<code>num</code>. See also <a href="ref.html#num-io">Numbers</a>.
+<dt><a name="scl"><code>(scl 'num [. prg]) -> num</code></a>
+<dd>If <code>prg</code> is given, it binds <code><a
+href="refS.html#*Scl">*Scl</a></code> dynamically to <code>num</code> during the
+execution of <code>prg</code>. Otherwise, it sets <code><a
+href="refS.html#*Scl">*Scl</a></code> globally to <code>num</code>. See also <a
+href="ref.html#num-io">Numbers</a>.
 
 <pre><code>
 : (scl 0)
@@ -181,6 +184,10 @@ href="refS.html#step">step</a></code>.
 -> 3
 : (str "123.45")
 -> (123450)
+: (scl 1 (str "123.45"))
+-> (1235)
+: *Scl
+-> 3
 </code></pre>
 
 <dt><a name="script"><code>(script 'any ..) -> any</code></a>
diff --git a/ersatz/lib.l b/ersatz/lib.l
@@ -1,4 +1,4 @@
-# 28jan12abu
+# 07apr12abu
 # (c) Software Lab. Alexander Burger
 
 (setq *OS (java (java "java.lang.System" "getProperty" "os.name")))
@@ -226,8 +226,10 @@
    (apply meta X This) )
 
 ### Math ###
-(de scl (N)
-   (setq *Scl N) )
+(de scl ("N" . "Prg")
+   (if "Prg"
+      (let *Scl "N" (run "Prg"))
+      (setq *Scl "N") ) )
 
 (de sqrt (N F)
    (cond
diff --git a/lib.l b/lib.l
@@ -1,4 +1,4 @@
-# 03jan12abu
+# 07apr12abu
 # (c) Software Lab. Alexander Burger
 
 (de task (Key . Prg)
@@ -273,8 +273,10 @@
    (apply meta X This) )
 
 ### Math ###
-(de scl (N)
-   (setq *Scl N) )
+(de scl ("N" . "Prg")
+   (if "Prg"
+      (let *Scl "N" (run "Prg"))
+      (setq *Scl "N") ) )
 
 (de sqrt (N F)
    (cond
diff --git a/test/lib.l b/test/lib.l
@@ -1,4 +1,4 @@
-# 08nov11abu
+# 07apr12abu
 # (c) Software Lab. Alexander Burger
 
 ### task ###
@@ -90,6 +90,7 @@
 (scl 0)
 (test 123 (any "123.45")))
 (scl 1)
+(test (1235) (scl 1 (str "123.45")))
 (test 1235 (any "123.45")))
 (scl 3)
 (test 123450 (any "123.45")))