fork download
copy 
  1. ; Use a continuation function instead of an evaluator
  2. ; ------------------------------
  3. ; The Little Lisper 3rd Edition
  4. ; Chapter 9
  5. ; Exercise 5
  6. ; Common Lisp
  7. ; http://t...content-available-to-author-only...r.com/thelittlelisper
  8. ; http://t...content-available-to-author-only...t.com/2010/06/little-lisper-chapter-9-lamdba-ultimate.html
  9. ; http://t...content-available-to-author-only...t.com/2010/06/little-lisper.html
  10. ; ------------------------------
  11.  
  12. ;Note multi-subst is from chapter 5 exercises - accumulators in 6
  13. ;original
  14. (setf x 'comma)
  15. (setf y 'dot)
  16. (setf a 'kiwis)
  17. (setf b 'plums)
  18. (setf lat1 '(bananas kiwis))
  19. (setf lat3 '(kiwis pears plums bananas cherries))
  20.  
  21. (defun multisubst2 (new o1 o2 lat)
  22.   (cond
  23.   ((null lat) '())
  24.   (t (cond 
  25.       ((eq (car lat) o1)
  26.        (multisubst2 new o1 o2 (cons new (cdr lat))))
  27.       ((eq (car lat) o2)
  28.        (multisubst2 new o1 o2 (cons new (cdr lat))))
  29.       (t (cons (car lat)
  30.                (multisubst2 new 
  31.                             o1 o2 (cdr lat))))))))
  32.  
  33. (print (multisubst2 x a b lat1))
  34. ;(bananas comma);
  35.  
  36. (print (multisubst2 y a b lat3))
  37. ;(dot pears dot bananas cherries)
  38.  
  39. (print (multisubst2 a x y lat1))
  40. ;(bananas kiwis)
  41.  
  42. (defun multisubst (new old lat)
  43.   (cond
  44.    ((null lat) '())
  45.    (t (cond
  46.        ((eq (car lat) old)
  47.         (cons new 
  48.               (multisubst 
  49.                new old (cdr lat))))
  50.        (t (cons (car lat)
  51.                 (multisubst
  52.                  new old (cdr lat))))))))
  53.  
  54. (print (multisubst 'sandwich 'club '(sandwich club sandwich club)))
  55. ;(SANDWICH SANDWICH SANDWICH SANDWICH)
  56.  
  57. (defun multisubst-k (new old lat k)
  58.   (cond
  59.    ((null lat) (funcall k '()))
  60.    ((eq (car lat) old)
  61.     (multisubst-k new old (cdr lat)
  62.                   (lambda (d)
  63.                     (funcall k (cons new d)))))
  64.    (t (multisubst-k new old (cdr lat)
  65.                     (lambda (d)
  66.                       (funcall k (cons (car lat) d)))))))
  67.  
  68. (print (multisubst-k 'sandwich 'club '(sandwich club sandwich club) (function (lambda (x) x))))
  69. ;(SANDWICH SANDWICH SANDWICH SANDWICH)
  70.  
  71. (print (multisubst-k 'y 'x '(u v x x y z z) (function (lambda (x) x))))
  72. ;(U V Y Y Y Z Z)
  73.  
  74. ;Comparison of steps
  75.  
  76. ; Things you need to do when you return from a recursive function 
  77. ; corresponding continuation function
  78. ; Instead of just returning a (quote()) function - you need to send the quote 
  79. ; function to the continuation - and let it return it
  80. ; otherwise you call the continuation to escape the recursion ?
  81. ; so instead of consing the result of the recursion on the parent function
  82. ; you're consing the results of the continuation...
  83.  
  84.  
Success #stdin #stdout 0.01s 10608KB
comments (?)
stdin
copy 
Standard input is empty
stdout
copy 
(BANANAS COMMA) 
(DOT PEARS DOT BANANAS CHERRIES) 
(BANANAS KIWIS) 
(SANDWICH SANDWICH SANDWICH SANDWICH) 
(SANDWICH SANDWICH SANDWICH SANDWICH) 
(U V Y Y Y Z Z)
https://ideone.com/aticV
language:
Common Lisp (clisp 2.49.92)
created:
13 years ago
visibility:
public

Share or Embed source code

Discover > Sphere Engine API

The brand new service which powers Ideone!

Discover > IDE Widget

Widget for compiling and running the source code in a web browser!