1  ; Lambda The Ultimate
 2  ; little lisper
 3  ; july 25 2005
 4
 5  ;=============================================================================
 6  ; rember-f
 7  ;=============================================================================
 8  (defun rember-f (test? a l)
 9    (cond
10     ((null l) (quote ()))
11     ((funcall test? (car l) a) (cdr l))
12     (t (cons (car l) (rember-f test? a (cdr l))))
13    )
14  )
15
16  (rember-f (function =) 5 '(6 2 5 3))
17
18  ;=============================================================================
19  ; eq?-c
20  ;=============================================================================
21  (defun eq?-c (a)
22    (function
23     (lambda (x)
24       (eq x a)
25     )
26    )
27  )
28
29  (funcall (eq?-c 'salad) 'salad)
30  (funcall (eq?-c 'salad) 'tuna)
31
32  (defun rember-f (test?)
33    (function
34     (lambda (a l)
35       (cond
36        ((null l) (quote()))
37        ((funcall test? (car l) a) (cdr l))
38        (t (cons (car l) (funcall (rember-f test?) a (cdr l))))
39       )
40      )
41     )
42  )
43
44  (funcall (rember-f #'eq) 'tuna '(tuna salad is good))
45  (funcall (rember-f #'eq) 'tuna '(shrimp salad and tuna salad))
46
47  ;=============================================================================
48  ; insert-g
49  ;=============================================================================
50  (defun insert-g (seq)
51    (function
52     (lambda (new old l)
53       (cond
54        ((null l) (quote()))
55        ((eq (car l) old) (funcall seq new old (cdr l)))
56        (t (cons (car l) (funcall (insert-g seq) new old (cdr l))))
57       )
58     )
59    )
60  )
61
62  ;=============================================================================
63  ; seqL
64  ;=============================================================================
65  (defun seqL (new old l)
66       (cons new (cons old l))
67  )
68  ;=============================================================================
69  ; seqR
70  ;=============================================================================
71  (defun seqR (new old l)
72       (cons old (cons new l))
73  )
74
75  ;(funcall (seqL) 'new 'old '(one two three))
76
77  (setq insertL (insert-g #'seqL))
78
79  (funcall insertL 'new 'old '(one two three new old))