fork(3) 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
comments (?)
stdin 
Standard input is empty
stdout 
T 
NIL 
1 
2 
3 
T 
T 
6 
6 
61 
360
https://ideone.com/b9GsJ
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!