fork download
  1. ; Count the operators in your DSL
  2. ; ------------------------------
  3. ; The Little Lisper 3rd Edition
  4. ; Chapter 7
  5. ; Exercise 3
  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 aexp1 '(1 + (3 * 4)))
  14. (setf aexp2 '((3 ^ 4) + 5))
  15. (setf aexp4 5)
  16. ; ------------------------------
  17.  
  18.  
  19. (defun sub1 (n)
  20. (- n 1))
  21.  
  22. (defun operator (aexp_)
  23. (car (cdr aexp_)))
  24.  
  25. (print (operator '(1 + 2)))
  26. ;+
  27.  
  28. (defun isoperator (a)
  29. (cond
  30. ((null a) NIL)
  31. ((eq a '+) t)
  32. ((eq a '*) t)
  33. ((eq a '^) t)
  34. (t NIL)))
  35.  
  36.  
  37. (print (isoperator '^))
  38. ;T
  39.  
  40. (defun 1st-sub-expr (aexp_)
  41. (car aexp_))
  42.  
  43. (print (1st-sub-expr '(1 + 2)))
  44. ;1
  45.  
  46. (defun 2nd-sub-expr (aexp_)
  47. (car (cdr (cdr aexp_))))
  48.  
  49. (print (2nd-sub-expr '(1 + 2)))
  50. ;2
  51.  
  52. (defun number_ (n)
  53. (cond
  54. ((null n) t)
  55. (t (and
  56. (null (car n))
  57. (number_ (cdr n))))))
  58.  
  59. (defun notatom (lat)
  60. (not (atom lat)))
  61.  
  62. (defun number__ (n)
  63. (cond
  64. ((null n) nil)
  65. ((notatom n) nil)
  66. ((= 0 n) t)
  67. (t (number__ (sub1 n)))))
  68.  
  69.  
  70. (defun mk+exp (aexp1_ aexp2_)
  71. (cons aexp1_
  72. (cons '+
  73. (cons aexp2_ '()))))
  74.  
  75. (defun mk*exp (aexp1_ aexp2_)
  76. (cons aexp1_
  77. (cons '*
  78. (cons aexp2_ '()))))
  79.  
  80. (setf aexp1 (mk+exp 1 (mk*exp 3 4)))
  81. (setf aexp3 (mk*exp 3 (mk*exp 4 (mk*exp 5 6))))
  82.  
  83. (defun count-op (aexp_)
  84. (cond
  85. ((null aexp_) 0)
  86. ((number__ aexp_) 0)
  87. ((isoperator (operator aexp_))
  88. (+
  89. (+ 1 (count-op (1st-sub-expr aexp_)))
  90. (count-op (2nd-sub-expr aexp_)))
  91. )
  92. (t 0)))
  93.  
  94. (print (count-op '(1 + 2)))
  95. ;1
  96.  
  97. (print (count-op aexp1))
  98. ;2
  99.  
  100. (print (count-op aexp3))
  101. ;3
  102.  
  103. (print (count-op aexp4))
  104. ;0
  105.  
  106. (defun countatomplus (a)
  107. (cond
  108. ((null a) 0)
  109. ((eq a '+) 1)
  110. (t 0)))
  111.  
  112. (print (countatomplus '*))
  113. ;0
  114.  
  115. (print (countatomplus '+))
  116. ;1
  117.  
  118. (defun count+ (aexp_)
  119. (cond
  120. ((null aexp_) 0)
  121. ((number__ aexp_) 0)
  122. ((isoperator (operator aexp_))
  123. (+
  124. (+ (countatomplus(operator aexp_)) (count+ (1st-sub-expr aexp_)))
  125. (count+ (2nd-sub-expr aexp_)))
  126. )
  127. (t 0)))
  128.  
  129. (print (count+ aexp1))
  130. ;1
  131.  
  132. (defun countatomtimes (a)
  133. (cond
  134. ((null a) 0)
  135. ((eq a '*) 1)
  136. (t 0)))
  137.  
  138. (defun count* (aexp_)
  139. (cond
  140. ((null aexp_) 0)
  141. ((number__ aexp_) 0)
  142. ((isoperator (operator aexp_))
  143. (+
  144. (+ (countatomtimes(operator aexp_)) (count* (1st-sub-expr aexp_)))
  145. (count* (2nd-sub-expr aexp_)))
  146. )
  147. (t 0)))
  148.  
  149. (print (count* aexp1))
  150. ;1
  151.  
  152.  
  153. (print (count* aexp3))
  154.  
  155. (defun countatomexp (a)
  156. (cond
  157. ((null a) 0)
  158. ((eq a '^) 1)
  159. (t 0)))
  160.  
  161. (defun count^ (aexp_)
  162. (cond
  163. ((null aexp_) 0)
  164. ((number__ aexp_) 0)
  165. ((isoperator (operator aexp_))
  166. (+
  167. (+ (countatomexp(operator aexp_)) (count^ (1st-sub-expr aexp_)))
  168. (count^ (2nd-sub-expr aexp_)))
  169. )
  170. (t 0)))
  171.  
  172. (print (count^ aexp1))
  173. ;0
  174.  
  175.  
Success #stdin #stdout 0.02s 10568KB
stdin
Standard input is empty
stdout
+ 
T 
1 
2 
1 
2 
3 
0 
0 
1 
1 
1 
3 
0