picolisp

commit 9cd1e870afdaead778b079a306e582f7f5ffeae0
parent 4ef982db061eb433b8b7c2d3085c6f79116d721c
Author: Alexander Burger <abu@software-lab.de>
Date:   Fri, 25 Feb 2011 10:31:12 +0100

Optionally group digits in 'bin', 'oct' and 'hex'
Diffstat:
M
ersatz/lib.l
 | 
15
+++++++++------
M
lib/misc.l
 | 
17
++++++++++-------

2 files changed, 19 insertions(+), 13 deletions(-)
diff --git a/ersatz/lib.l b/ersatz/lib.l
@@ -481,11 +481,12 @@
       (format N *Scl *Sep0 *Sep3) ) )
 
 # Binary notation
-(de bin (X)
+(de bin (X I)
    (cond
       ((num? X)
-         (let (S (and (lt0 X) '-)  L (& 1 X))
+         (let (S (and (lt0 X) '-)  L (& 1 X)  A (cons 0 I))
             (until (=0 (setq X (>> 1 X)))
+               (at A (push 'L " "))
                (push 'L (& 1 X)) )
             (pack S L) ) )
       ((setq X (chop X))
@@ -495,11 +496,12 @@
             (if S (- N) N) ) ) ) )
 
 # Octal notation
-(de oct (X)
+(de oct (X I)
    (cond
       ((num? X)
-         (let (S (and (lt0 X) '-)  L (& 7 X))
+         (let (S (and (lt0 X) '-)  L (& 7 X)  A (cons 0 I))
             (until (=0 (setq X (>> 3 X)))
+               (at A (push 'L " "))
                (push 'L (& 7 X)) )
             (pack S L) ) )
       ((setq X (chop X))
@@ -509,11 +511,12 @@
             (if S (- N) N) ) ) ) )
 
 # Hexadecimal notation
-(de hex (X)
+(de hex (X I)
    (cond
       ((num? X)
-         (let (S (and (lt0 X) '-)  L (hex1 X))
+         (let (S (and (lt0 X) '-)  L (hex1 X)  A (cons 0 I))
             (until (=0 (setq X (>> 4 X)))
+               (at A (push 'L " "))
                (push 'L (hex1 X)) )
             (pack S L) ) )
       ((setq X (chop X))
diff --git a/lib/misc.l b/lib/misc.l
@@ -1,4 +1,4 @@
-# 02feb11abu
+# 25feb11abu
 # (c) Software Lab. Alexander Burger
 
 # *Allow *Tmp
@@ -93,11 +93,12 @@
       (format N *Scl *Sep0 *Sep3) ) )
 
 # Binary notation
-(de bin (X)
+(de bin (X I)
    (cond
       ((num? X)
-         (let (S (and (lt0 X) '-)  L (& 1 X))
+         (let (S (and (lt0 X) '-)  L (& 1 X)  A (cons 0 I))
             (until (=0 (setq X (>> 1 X)))
+               (at A (push 'L " "))
                (push 'L (& 1 X)) )
             (pack S L) ) )
       ((setq X (chop X))
@@ -107,11 +108,12 @@
             (if S (- N) N) ) ) ) )
 
 # Octal notation
-(de oct (X)
+(de oct (X I)
    (cond
       ((num? X)
-         (let (S (and (lt0 X) '-)  L (& 7 X))
+         (let (S (and (lt0 X) '-)  L (& 7 X)  A (cons 0 I))
             (until (=0 (setq X (>> 3 X)))
+               (at A (push 'L " "))
                (push 'L (& 7 X)) )
             (pack S L) ) )
       ((setq X (chop X))
@@ -121,11 +123,12 @@
             (if S (- N) N) ) ) ) )
 
 # Hexadecimal notation
-(de hex (X)
+(de hex (X I)
    (cond
       ((num? X)
-         (let (S (and (lt0 X) '-)  L (hex1 X))
+         (let (S (and (lt0 X) '-)  L (hex1 X)  A (cons 0 I))
             (until (=0 (setq X (>> 4 X)))
+               (at A (push 'L " "))
                (push 'L (hex1 X)) )
             (pack S L) ) )
       ((setq X (chop X))