fork download 
  1. ; Add binary operators into the evaluation of your DSL
  2. ; ------------------------------
  3. ; The Little Lisper 3rd Edition
  4. ; Chapter 7
  5. ; Exercise 10
  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. (OR t f t f)
  22. ;T
  23.  
  24. (AND t NIL t NIL)
  25. ;NIL false
  26.  
  27. (defun Mlexp (x y))
  28.  
  29. (defun Mlexp-OR (lat alist)
  30.   (cond
  31.    ((null alist) NIL)
  32.    ((null lat) NIL)
  33.    (t
  34.     (OR
  35.      (Mlexp (car lat) alist)
  36.      (Mlexp-OR (cdr lat) alist)))))
  37.  
  38. (Mlexp-OR '(x y z) '((x 1)(y 1)(z 0)))
  39. ;T
  40.  
  41. (Mlexp-OR '(x y z) '((x 1)))
  42. ;T
  43.  
  44. (defun lookup (a lat)
  45.   (cond
  46.    ((null a) NIL)
  47.    ((null lat) NIL)
  48.    ((eq a (car (car lat)))
  49.     (cdr (car lat)))
  50.    (t 
  51.     (lookup a (cdr lat)))))
  52.  
  53. (lookup 'x '((x 1)(y 1)(z 0)))
  54. ;(1)
  55.  
  56. (defun Mlexp-AND (lat alist)
  57.   (cond
  58.    ((null alist) NIL)
  59.    ((null lat) t)
  60.    (t
  61.     (AND
  62.      (Mlexp (car lat) alist)
  63.      (Mlexp-AND (cdr lat) alist)))))
  64.  
  65. (Mlexp-AND '(x y z) '((x 1)(y 1)(z 0)))
  66. ;NIl false
  67.  
  68. (Mlexp-AND '(x) '((x 0)))
  69. ;NIL false
  70.  
  71. (Mlexp-AND '(x) '((y 1)(x 0)))
  72. ;NIL false
  73.  
  74. (Mlexp-AND '(x y) '((x 1)(y 1)(z 0)))
  75. ;T 
  76.  
  77. (defun operator (aexp_)
  78.   (car aexp_))
  79.  
  80. (defun 1st-sub-expr (aexp_)
  81.   (car (cdr aexp_)))
  82.  
  83. (defun Mlexp (lexp_ alist_)
  84.   (cond
  85.    ((null lexp_) NIL)
  86.    ((null alist_) NIL)
  87.    ((atom lexp_)
  88.     (cond
  89.      ;((eq lexp_ 't) t)
  90.      ((= 1 (car(lookup lexp_ alist_))) t)
  91.      (t NIL)))
  92.    ((eq (operator lexp_) 'AND)
  93.     (Mlexp-AND (cdr lexp_) alist_))
  94.    ((eq (operator lexp_) 'OR)
  95.      (Mlexp-OR (cdr lexp_) alist_))
  96.    ((eq (operator lexp_) 'NOT)
  97.      (cond
  98.     ((not
  99.      (Mlexp (1st-sub-expr lexp_) alist_))
  100.       't)
  101.      (t NIL)))
  102.    (t NIL)))
  103.  
  104. (print (Mlexp lexp1 '((x 1)(y 0)(z 0))))
  105. ;NIKL false
  106.  
  107. (print (setf lexp2 '(AND (NOT y)(OR u v))))
  108. (Mlexp lexp2 '((y 0)(u 0)(v 1)))
  109. ;T
  110.  
  111. (print (Mlexp '(OR u v) '((y 0)(u 0)(v 1))))
  112. ;T
  113.  
  114. (print (Mlexp '(OR u (OR u v)) '((y 0)(u 0)(v 1))))
  115. ;T
  116.  
  117. (print (Mlexp '(NOT y) '((y 0)(u 0)(v 1))))
  118. ;T
  119.  
  120. (print (Mlexp '(AND v v) '((y 0)(u 0)(v 1))))
  121. ;T
  122.  
  123. (print (Mlexp '(AND (AND v v) v) '((y 0)(u 0)(v 1))))
  124. ;T
  125.  
  126. (print (Mlexp lexp4 '((x 1)(y 0)(z 0))))
  127. ;NIL false
  128.  
  129.  
  130.  
  131. (print (Mlexp '(AND x y z) '((x 1)(y 0)(z 0))));F;correct
  132. (print (Mlexp '(NOT(AND x y z)) '((x 1)(y 0)(z 0))));T;correct
  133. (print (Mlexp '(OR z z (NOT(AND x y z))) '((x 1)(y 0)(z 0))));T;correct
  134.  
Success #stdin #stdout 0.01s 10608KB
comments (?)
stdin 
Standard input is empty
stdout 
NIL 
(AND (NOT Y) (OR U V)) 
T 
T 
T 
T 
T 
NIL 
NIL 
T 
T
https://ideone.com/Ng7xQ
language:
Common Lisp (clisp 2.49.92)
created:
15 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!