fork download
  1. ; Make your DSL expressions scalable
  2. ; ------------------------------
  3. ; The Little Lisper 3rd Edition
  4. ; Chapter 7
  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-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. (defun notatom (lat)
  17. (not (atom lat)))
  18.  
  19. (defun sub1 (n)
  20. (- n 1))
  21.  
  22. (defun isoperator (a)
  23. (cond
  24. ((null a) NIL)
  25. ((eq a '+) t)
  26. ((eq a '*) t)
  27. ((eq a '^) t)
  28. (t NIL)))
  29.  
  30. (defun operator (aexp_)
  31. (car (cdr aexp_)))
  32.  
  33. (defun numbered? (aexp_)
  34. (cond
  35. ((atom aexp_) (numberp aexp_)) ;note use of primitive numberp
  36. (t (and
  37. (numbered? (car aexp_))
  38. (numbered?
  39. (car (cdr (cdr aexp_))))))))
  40. ;numbered? tests whether a representation of an arithmetic expression only contains numbers besides the +, * and ^
  41.  
  42. (print (numbered? '(1 + 2)))
  43. ;T
  44. (print (numbered? '(1 + a)))
  45. ;NIL (false)
  46.  
  47. (defun 1st-sub-exp (aexp_)
  48. (car aexp_))
  49.  
  50. (print (1st-sub-exp '(1 + 2)))
  51.  
  52. (defun 2nd-sub-exp (aexp_)
  53. (car (cdr (cdr aexp_))))
  54.  
  55. (print (2nd-sub-exp '(1 + 2)))
  56.  
  57.  
  58. ;value returns what we think is the natural value of a numbered arithemetic expression
  59. (defun value__ (aexp_)
  60. (cond
  61. ((numberp aexp_) aexp_)
  62. ((eq (operator aexp_) '+)
  63. (+ (value__ (1st-sub-exp aexp_))
  64. (value__ (2nd-sub-exp aexp_))))
  65. ((eq (operator aexp_) '*)
  66. (* (value__ (1st-sub-exp aexp_))
  67. (value__ (2nd-sub-exp aexp_))))
  68. (t
  69. (^ (value__ (1st-sub-exp aexp_))
  70. (value__ (2nd-sub-exp aexp_))))))
  71.  
  72. (print (value__ '(1 + 2)))
  73.  
  74. ;define numbered? for arbitrary length list
  75. (defun numbered_? (aexp_)
  76. (cond
  77. ((null aexp_) t)
  78. ((notatom (car aexp_))
  79. (and
  80. (numbered? (car aexp_))
  81. (numbered_? (cdr aexp_))))
  82. ((numberp (car aexp_))
  83. (numbered_? (cdr aexp_)))
  84. (t NIL)))
  85.  
  86. (defun numbered? (aexp_)
  87. (cond
  88. ((null aexp_) NIL)
  89. ((isoperator (car aexp_))
  90. (numbered_? (cdr aexp_)))
  91. (t nil)))
  92.  
  93. (print (numbered?'(+ 1 2 3 4 5)))
  94. ;T
  95.  
  96. (print (numbered?'(+ 1 2 3 (* 3 4))))
  97. ;T
  98.  
  99. ;define value? for an arbitrary length list
  100. (defun addvec (vec)
  101. (cond
  102. ((null vec) 0)
  103. ((notatom (car vec))
  104. (+ (value_ (car vec))
  105. (addvec (cdr vec))))
  106. (t (+ (car vec)(addvec (cdr vec))))))
  107.  
  108. (print (addvec '(1 2 3)))
  109. ;6
  110.  
  111. (defun multvec (vec)
  112. (cond
  113. ((null vec) 1)
  114. ((notatom (car vec))
  115. (* (value_ (car vec))
  116. (multvec (cdr vec))))
  117. (t (* (car vec)(multvec (cdr vec))))))
  118.  
  119. (print (multvec '(1 2 3)))
  120. ;6
  121.  
  122. (defun ^_ (n m)
  123. (cond
  124. ((= 0 m) 1)
  125. (t (* n (^_ n (sub1 m))))))
  126.  
  127. (^_ 2 3)
  128. ;8
  129.  
  130. (defun value_ (aexp_)
  131. (cond
  132. ((numberp aexp_) aexp_)
  133. ((notatom (car aexp_))
  134. (value_ (car aexp_))
  135. (value_ (cdr aexp_)))
  136. ((eq (car aexp_) '+)
  137. (addvec (cdr aexp_)))
  138. ((eq (car aexp_) '*)
  139. (multvec (cdr aexp_)))
  140. (t
  141. (^_ (value_ (1st-sub-expr aexp_))
  142. (value_ (2nd-sub-expr aexp_))))))
  143.  
  144. (print (value_ '(+ 3 2 (* 7 8))))
  145. ;61
  146.  
  147. (print (value_ '(* 3 4 5 6)))
  148. ;360
  149.  
Success #stdin #stdout 0.02s 10568KB
stdin
Standard input is empty
stdout
T 
NIL 
1 
2 
3 
T 
T 
6 
6 
61 
360