fork download
copy 
  1. ; Can you write your function as a thunk?
  2. ; ------------------------------
  3. ; The Little Lisper 3rd Edition
  4. ; Chapter 9
  5. ; Exercise 8
  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. (defun member? (a lat)
  13.   (cond
  14.    ((null lat) NIL)
  15.    ((eq a (car lat)) t)
  16.    (t
  17.     (member? a (cdr lat)))))
  18.  
  19. (print (member? 'x '(a b c d e f)))
  20. (print (member? 'f '(a b c d e f)))
  21.  
  22. (defun subset? (lat lat2)
  23.   (cond
  24.    ((null lat) t)
  25.    (t
  26.     (and (member? (car lat) lat2)
  27.          (subset? (cdr lat) lat2)))))
  28.  
  29. (print (subset? '(a b) '(a c d)))
  30. (print (subset? '(a c) '(a c d)))
  31.  
  32. (defun intersect? (lat lat2)
  33.   (cond
  34.    ((null lat) t)
  35.    (t
  36.     (or (member? (car lat) lat2)
  37.          (intersect? (cdr lat) lat2)))))
  38.  
  39. (print (intersect? '(a b) '(a c d)))
  40. (print (intersect? '(a c) '(a c d)))
  41.  
  42. (defun or-func (or1 or2)
  43.       (or (funcall or1)(funcall or2)))
  44.  
  45. (defun and-func (or1 or2)
  46.       (and (funcall or1)(funcall or2)))
  47.  
  48. (setf (symbol-function 'set-f?)
  49.   (lambda (current-function)
  50.   (function 
  51.    (lambda (cond1 cond2)
  52.      (funcall current-function cond1 cond2)))))
  53.  
  54.  
  55.  
  56. (print (funcall (set-f? 'or-func) (lambda() (= 1 1)) (lambda() (= 1 2))))
  57. ;T
  58. (print (or-func (lambda() (= 1 1)) (lambda() (= 1 2))))
  59. ;T
  60.  
  61. (print (funcall (set-f? 'and-func) (lambda() (= 1 1)) (lambda() (= 1 2))))
  62. ;NIL false
  63.  
  64. (print (and-func (lambda() (= 1 1)) (lambda() (= 1 2))))
  65.  
  66.  
  67. (defun intersect-func? (lat lat2)
  68.   (cond
  69.    ((null lat) t)
  70.    (t
  71.     (or-func (lambda() (member? (car lat) lat2))
  72.              (lambda() (intersect-func? (cdr lat) lat2))))))
  73.  
  74. (print (intersect-func? '(a) '(a)))
  75. ; T
  76.  
  77. (print (intersect-func? '(a b) '(a c d)))
  78. ; T
  79.  
  80. (print (intersect-func? '(a c) '(a c d)))
  81. ; T
  82.  
  83. (defun subset-func? (lat lat2)
  84.   (cond
  85.    ((null lat) t)
  86.    (t
  87.     (and-func (lambda() (member? (car lat) lat2))
  88.          (lambda() (subset-func? (cdr lat) lat2))))))
  89.  
  90. (print (subset-func? '(a b) '(a c d)))
  91. ; NIL false
  92.  
  93. (print (subset-func? '(a c) '(a c d)))
  94. ; T
  95.  
Success #stdin #stdout 0s 10608KB
comments (?)
stdin
copy 
Standard input is empty
stdout
copy 
NIL 
T 
NIL 
T 
T 
T 
T 
T 
NIL 
NIL 
T 
T 
T 
NIL 
T
https://ideone.com/B2Bjq
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!