commit af0b0a99e820aec238ffb00b5db8da349c3836af
parent 0cdfa40f05c1aab8802e2b246795520a0e4f46e8
Author: Alexander Burger <abu@software-lab.de>
Date: Mon, 9 Jul 2012 10:45:35 +0200
Simplified: Using 'queue' instead of 'conc'
Diffstat:
9 files changed, 26 insertions(+), 37 deletions(-)
diff --git a/doc/refA.html b/doc/refA.html
@@ -493,7 +493,7 @@ href="refR.html#retract">retract</a></code>.
-> a
: (asserta '(a (1))) # Insert new fact in front
--> (((1)) ((2)) ((3)))
+-> ((1))
: (? (a @N)) # Query
@N=1
@@ -534,7 +534,7 @@ href="refR.html#retract">retract</a></code>.
-> a
: (assertz '(a (3))) # Append new fact at the end
--> (((1)) ((2)) ((3)))
+-> ((3))
: (? (a @N)) # Query
@N=1
diff --git a/ersatz/lib.l b/ersatz/lib.l
@@ -1,4 +1,4 @@
-# 13apr12abu
+# 09jul12abu
# (c) Software Lab. Alexander Burger
(setq *OS (java (java "java.lang.System" "getProperty" "os.name")))
@@ -566,8 +566,7 @@
(nond
(*Allow)
(Flg (idx *Allow X T))
- ((member X (cdr *Allow))
- (conc *Allow (cons X)) ) )
+ ((member X (cdr *Allow)) (queue '*Allow X)) )
X )
### Telephone ###
@@ -764,7 +763,7 @@
(de clause (CL)
(with (car CL)
(if (== *Rule This)
- (=: T (conc (: T) (cons (cdr CL))))
+ (queue (:: T) (cdr CL))
(=: T (cons (cdr CL)))
(setq *Rule This) )
This ) )
@@ -773,12 +772,10 @@
(conc (get *Rule T) (get *Rule T)) )
(de asserta (CL)
- (with (car CL)
- (=: T (cons (cdr CL) (: T))) ) )
+ (push (prop CL 1 T) (cdr CL)) )
(de assertz (CL)
- (with (car CL)
- (=: T (conc (: T) (cons (cdr CL)))) ) )
+ (queue (prop CL 1 T) (cdr CL)) )
(de retract (X)
(if (sym? X)
diff --git a/ersatz/picolisp.jar b/ersatz/picolisp.jar
Binary files differ.
diff --git a/lib/db.l b/lib/db.l
@@ -1,4 +1,4 @@
-# 21may12abu
+# 09jul12abu
# (c) Software Lab. Alexander Burger
# *Dbs *Jnl *Blob upd
@@ -55,7 +55,7 @@
(let? A (: aux)
(while (and (args) (== (pop 'A) (arg 1)))
(next)
- (conc Key (cons (next))) )
+ (queue 'Key (next)) )
(and (: ub) (setq Key (ubZval Key))) )
(let Q (init Tree Key (append Key T))
(loop
@@ -647,9 +647,8 @@
(with *Class
(for A (car Lst)
(if (asoq A (: Aux))
- (conc @ (cons Var))
- (=: Aux
- (conc (: Aux) (cons (list A Var))) ) ) ) )
+ (queue '@ Var)
+ (queue (:: Aux) (list A Var)) ) ) )
(extra Var (cdr Lst)) )
(de relAux (Obj Var Old Lst)
diff --git a/lib/form.l b/lib/form.l
@@ -1,4 +1,4 @@
-# 15jun12abu
+# 09jul12abu
# (c) Software Lab. Alexander Burger
# *PRG *Top *Gui *Btn *Get *Got *Form *Evt *Lock *Spans
@@ -21,9 +21,7 @@
(if *PRG
(get "*Lst" (- "*Cnt" *Get) *Form)
(prog1 (setq *Top (new NIL NIL 'able T 'evt 0))
- (conc
- (get "*Lst" (- "*Cnt" *Get))
- (cons *Top) ) ) )
+ (queue (nth "*Lst" (- "*Cnt" *Get)) *Top) ) )
(let "Lst" (get "*Lst" (- "*Cnt" *Get) 1)
(for ("F" . "L") "Lst"
(let *Form (- "F" (length "Lst"))
@@ -78,8 +76,7 @@
(let L (last (: gui))
(when (get L X)
(inc (:: rows))
- (conc (: gui)
- (list (setq L (need (: cols)))) ) )
+ (queue (:: gui) (setq L (need (: cols)))) )
(let Fld (pass new)
(set (nth L X) Fld)
(put Fld 'chart (list This (: rows) X))
@@ -94,7 +91,7 @@
Fld ) ) ) ) )
((get "*App" X) (quit "gui conflict" X))
(T (put "*App" X (pass new))) )
- (=: home gui (conc (: home gui) (cons This)))
+ (queue (:: home gui) This)
(unless (: chart) (init> This))
(when (: id)
(let *Gui (val "*App")
@@ -1617,8 +1614,7 @@
# (cols [put [get]])
(dm T (N Put Get)
(setq "*Chart" This)
- (put (=: home "*App") 'chart
- (conc (get "*App" 'chart) (cons This)) )
+ (queue (prop (=: home "*App") 'chart) This)
(=: rows 1)
(when N
(=: gui (list (need (=: cols N)))) )
@@ -2145,7 +2141,7 @@
(and
(> (: ofs) (- (length (: data)) (max (: rows) (: iniR))))
(; (prove (: query)) @@) )
- (=: data (conc (: data) (cons @))) )
+ (queue (:: data) @) )
(super) )
(dm txt> (Flg)
diff --git a/lib/misc.l b/lib/misc.l
@@ -1,4 +1,4 @@
-# 28jan12abu
+# 07jul12abu
# (c) Software Lab. Alexander Burger
# *Allow *Tmp
@@ -205,8 +205,7 @@
(nond
(*Allow)
(Flg (idx *Allow X T))
- ((member X (cdr *Allow))
- (conc *Allow (cons X)) ) )
+ ((member X (cdr *Allow)) (queue '*Allow X)) )
X )
### Telephone ###
diff --git a/lib/pilog.l b/lib/pilog.l
@@ -1,4 +1,4 @@
-# 31mar12abu
+# 09jul12abu
# (c) Software Lab. Alexander Burger
# *Rule
@@ -9,7 +9,7 @@
(de clause (CL)
(with (car CL)
(if (== *Rule This)
- (=: T (conc (: T) (cons (cdr CL))))
+ (queue (:: T) (cdr CL))
(=: T (cons (cdr CL)))
(setq *Rule This) )
This ) )
@@ -18,12 +18,10 @@
(conc (get *Rule T) (get *Rule T)) )
(de asserta (CL)
- (with (car CL)
- (=: T (cons (cdr CL) (: T))) ) )
+ (push (prop CL 1 T) (cdr CL)) )
(de assertz (CL)
- (with (car CL)
- (=: T (conc (: T) (cons (cdr CL)))) ) )
+ (queue (prop CL 1 T) (cdr CL)) )
(de retract (X)
(if (sym? X)
diff --git a/src/vers.h b/src/vers.h
@@ -1 +1 @@
-static byte Version[4] = {3,1,0,8};
+static byte Version[4] = {3,1,0,9};
diff --git a/src64/version.l b/src64/version.l
@@ -1,6 +1,6 @@
-# 28jun12abu
+# 09jul12abu
# (c) Software Lab. Alexander Burger
-(de *Version 3 1 0 8)
+(de *Version 3 1 0 9)
# vi:et:ts=3:sw=3
