fork download
  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
stdin
Standard input is empty
stdout
1 
1 
2 
T 
T 
NIL 
1 
2 
NOT 
T 
NIL 
T 
T 
T 
T 
T 
T 
T 
T