fork(1) download
copy 
  1. ; In your DSL check you have values for your expressions
  2. ; ------------------------------
  3. ; The Little Lisper 3rd Edition
  4. ; Chapter 7
  5. ; Exercise 7
  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-7-shadows.html
  9. ; http://t...content-available-to-author-only...t.com/2010/06/little-lisper.html
  10. ; ------------------------------
  11. (setf l1 '())
  12. (setf l2 '(3 + (66 6)))
  13. (setf aexp4 5)
  14. ; ------------------------------
  15.  
  16. (setf lexp1 '(AND (OR x y) y))
  17. (setf lexp2 '(AND (NOT y)(OR u v)))
  18. (setf lexp3 '(OR x y))
  19. (setf lexp4 'z)
  20.  
  21. (defun notatom (lat)
  22.   (not (atom lat)))
  23.  
  24. (defun add1 (n)
  25.   (cond
  26.    ((null n) '())
  27.    ((+ n 1))))
  28.  
  29. (add1 1)
  30. ;2
  31.  
  32. (defun occurNa (a1 lat)
  33.   (cond
  34.    ((null lat) 0)
  35.    ((null a1) 0)
  36.    (t (cond
  37.        ((eq (car lat) a1)
  38.         (add1 (occurNa a1 (cdr lat))))
  39.        (t (occurNa a1 (cdr lat)))))))
  40.  
  41. (print (occurNa 'c (list 'a 'b 'c)))
  42. ;1
  43.  
  44. (setf lat2 '(peaches apples bananas))
  45. (print (occurNa 'bananas lat2))
  46. ;1
  47.  
  48. (defun occurN (alat lat)
  49.   (cond 
  50.    ((null alat) 0)
  51.    ((null lat) 0)
  52.    (t (+ (occurNa (car alat) lat)
  53.       (occurN (cdr alat)  lat)))))
  54.  
  55. (print (occurN (list 'bananas) (list 'bananas 'peaches 'bananas)))
  56.  
  57. (defun occur* (a lat)
  58.   (cond
  59.    ((null lat) NIL)
  60.    ((notatom (car lat))
  61.     (or
  62.      (occur* a (car lat))
  63.     (occur* a (cdr lat))))
  64.    ((eq a (car lat) ) t)
  65.    (t (occur* a (cdr lat)))))
  66.  
  67. (print (occur* 'bananas '(bananas peaches)))
  68. ;T
  69. (print (occur* 'bananas '((bananas) peaches)))
  70. ;T
  71. (print (occur* 'kiwis '(bananas peaches)))
  72. ;NIL (false)
  73.  
  74.  
  75. (defun 1st-sub-expr (aexp_)
  76.   (car (cdr aexp_)))
  77.  
  78. (print (1st-sub-expr '(+ 1 2)))
  79. ;1
  80.  
  81. (defun 2nd-sub-expr (aexp_)
  82.   (car (cdr (cdr aexp_))))
  83.  
  84. (print (2nd-sub-expr '(+ 1 2)))
  85. ;2
  86.  
  87. (defun operator (aexp_)
  88.   (car aexp_))
  89.  
  90. (print (operator '(NOT x)))
  91. ; NOT
  92.  
  93. (defun covered? (lexp_ lat)
  94.   (cond
  95.    ((null lexp_) NIL) 
  96.    ;((not (lexp? lexp_)) NIL)
  97.    ((atom lexp_) 
  98.     (occur* lexp_ lat))
  99.    (t (cond
  100.        ((eq (operator lexp_) 'NOT)
  101.         (covered? (1st-sub-expr lexp_) lat))
  102.        (t 
  103.         (and 
  104.          (covered? (1st-sub-expr lexp_) lat)
  105.          (covered? (2nd-sub-expr lexp_) lat)))))))
  106.  
  107. (print (covered? lexp1 '(x y z u)))
  108. ;T
  109.  
  110. (print (covered? lexp2 '(x y z u)))
  111. ;NIL (false)
  112.  
  113. (print (covered? lexp4 '(x y z u)))
  114. ;T
  115.  
  116. (print (covered? '(NOT x) '(x)))
  117. ;T
  118.  
  119. (print (covered? '(NOT x) '(x y)))
  120. ;T
  121.  
  122. (print (covered? '(AND x y) '(x y)))
  123. ;T
  124.  
  125. (print (occur* 'y '(x y)))
  126. ;T
  127. ;(setf lexp1 '(AND (OR x y) y))
  128. (print (covered? '(OR x y) '(x y z u)))
  129. (print (occur* 'x '(x y z u)))
  130. (print (covered? 'y '(x y z u))      )
  131.  
Success #stdin #stdout 0s 10616KB
comments (?)
stdin
copy 
Standard input is empty
stdout
copy 
1 
1 
2 
T 
T 
NIL 
1 
2 
NOT 
T 
NIL 
T 
T 
T 
T 
T 
T 
T 
T
https://ideone.com/CqdAM
language:
Common Lisp (clisp 2.49.92)
created:
14 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!