picolisp

Unnamed repository; edit this file to name it for gitweb.
git clone https://logand.com/git/picolisp.git/
Log | Files | Refs | README | LICENSE

commit 7d49f22ea64f370afc15b465d312fa6ea53fac59
parent df107bed5a083367bcb459a895c8e63f2db096a2
Author: Alexander Burger <abu@software-lab.de>
Date:   Mon,  4 Mar 2013 08:14:44 +0100

'idxRel' factorization and '+IdxFold' class
Diffstat:
MCHANGES | 2+-
Mlib/db.l | 94++++++++++++++++++++++++++++++++++++++++++++++++++++++-------------------------
2 files changed, 65 insertions(+), 31 deletions(-)

diff --git a/CHANGES b/CHANGES @@ -1,4 +1,4 @@ -* DDmmm13 picoLisp-3.1.2 +* DDmar13 picoLisp-3.1.2 'fold' analog to 'lowc' / 'uppc' 'fold' second arg default zero Removed 'dbg' startup script diff --git a/lib/db.l b/lib/db.l @@ -1,4 +1,4 @@ -# 25feb13abu +# 03mar13abu # (c) Software Lab. Alexander Burger # *Dbs *Jnl *Blob upd @@ -448,7 +448,7 @@ (extra Var (cdr Lst)) ) -# (+Key) hook +# (+Key +relation) [hook] (class +Key +index) (dm mis> (Val Obj Hook) @@ -486,7 +486,7 @@ (extra Obj Val Hook) ) -# (+Ref) hook +# (+Ref +relation) [hook] (class +Ref +index) # aux ub @@ -565,7 +565,7 @@ (extra Obj Val Hook) ) -# (+Idx) cnt hook +# (+Idx +relation) [cnt [hook]] (class +Idx +Ref) # min @@ -573,51 +573,48 @@ (=: min (or (car Lst) 3)) (super Var (cdr Lst)) ) -(dm rel> (Obj Old New Hook) +(de idxRel (Obj Old Olds New News Hook) (let (Tree (tree (: var) (: cls) (or Hook (get Obj (: hook)))) - Aux (conc (mapcar '((S) (get Obj S)) (: aux)) Obj) - Aux2 (conc (mapcar '((S) (get Obj S)) (: aux)) (cons Obj)) ) + Aux (mapcar '((S) (get Obj S)) (: aux)) + Aux2 (append Aux (cons Obj)) ) + (setq Aux (conc Aux Obj)) (when Old (store Tree (cons Old Aux) NIL (: dbf)) - (for S (split (cdr (chop Old)) " " "^J") + (for S Olds (while (nth S (: min)) (store Tree (cons (pack S) Aux2) NIL (: dbf)) (pop 'S) ) ) ) (when (and New (not (get Obj T))) (store Tree (cons New Aux) Obj (: dbf)) - (for S (split (cdr (chop New)) " " "^J") + (for S News (while (nth S (: min)) (store Tree (cons (pack S) Aux2) Obj (: dbf)) - (pop 'S) ) ) ) ) + (pop 'S) ) ) ) ) ) + +(dm rel> (Obj Old New Hook) + (idxRel Obj + Old (split (cdr (chop Old)) " " "^J") + New (split (cdr (chop New)) " " "^J") + Hook ) (extra Obj Old New Hook) ) (dm lose> (Obj Val Hook) - (let - (Tree (tree (: var) (: cls) (or Hook (get Obj (: hook)))) - Aux (conc (mapcar '((S) (get Obj S)) (: aux)) Obj) - Aux2 (conc (mapcar '((S) (get Obj S)) (: aux)) (cons Obj)) ) - (store Tree (cons Val Aux) NIL (: dbf)) - (for S (split (cdr (chop Val)) " " "^J") - (while (nth S (: min)) - (store Tree (cons (pack S) Aux2) NIL (: dbf)) - (pop 'S) ) ) ) + (idxRel Obj + Val (split (cdr (chop Val)) " " "^J") + NIL NIL + Hook ) (extra Obj Val Hook) ) (dm keep> (Obj Val Hook) - (let - (Tree (tree (: var) (: cls) (or Hook (get Obj (: hook)))) - Aux (conc (mapcar '((S) (get Obj S)) (: aux)) Obj) - Aux2 (conc (mapcar '((S) (get Obj S)) (: aux)) (cons Obj)) ) - (store Tree (cons Val Aux) Obj (: dbf)) - (for S (split (cdr (chop Val)) " " "^J") - (while (nth S (: min)) - (store Tree (cons (pack S) Aux2) Obj (: dbf)) - (pop 'S) ) ) ) + (idxRel Obj + NIL NIL + Val (split (cdr (chop Val)) " " "^J") + Hook ) (extra Obj Val Hook) ) -# (+Sn +index) hook +# (+Sn +index) [hook] (class +Sn) (dm rel> (Obj Old New Hook) @@ -644,7 +641,7 @@ (extra Obj Val Hook) ) -# (+Fold +index) hook +# (+Fold +index) [hook] (class +Fold) (dm has> (Val X) @@ -661,6 +658,43 @@ (extra Obj (fold Val) Hook) ) +# (+IdxFold +relation) [cnt [hook]] +(class +IdxFold +Fold +Ref) + +(dm T (Var Lst) + (=: min (or (car Lst) 3)) + (super Var (cdr Lst)) ) + +(dm rel> (Obj Old New Hook) + (idxRel Obj + (fold Old) + (extract '((L) (extract fold L)) + (split (cdr (chop Old)) " " "^J") ) + (fold New) + (extract '((L) (extract fold L)) + (split (cdr (chop New)) " " "^J") ) + Hook ) + (extra Obj Old New Hook) ) + +(dm lose> (Obj Val Hook) + (idxRel Obj + (fold Val) + (extract '((L) (extract fold L)) + (split (cdr (chop Val)) " " "^J") ) + NIL NIL + Hook ) + (extra Obj Val Hook) ) + +(dm keep> (Obj Val Hook) + (idxRel Obj + NIL NIL + (fold Val) + (extract '((L) (extract fold L)) + (split (cdr (chop Val)) " " "^J") ) + Hook ) + (extra Obj Val Hook) ) + + # (+Aux) lst (class +Aux)