home *** CD-ROM | disk | FTP | other *** search
/ Oakland CPM Archive / oakcpm.iso / sigm / vol166 / evalcom.lsp < prev    next >
Encoding:
Text File  |  1984-04-29  |  2.3 KB  |  92 lines

  1.  
  2. [EVALCOM.LSP]
  3. [a compiler analogous to EVAL]
  4. [compiles LISP into REC without ALIST]
  5. [January 1, 1981]
  6.  
  7. [[
  8. Type a LISP function - use round parentheses.
  9. ]]
  10.  
  11.  
  12.  
  13. [ASSOC]
  14. (a ((lambda (0 1) (cond
  15.     ((null 1) 0)
  16.     ((eq 0 (car 1)) (cadr 1))
  17.     ((and) (a 0 (cddr 1)))
  18.     ))))
  19.  
  20. [EVALCOM]
  21. (c ((lambda (1) (cond
  22.     ((atom 1) (cons 1 (quote ($ryG))))
  23.     ((eq (car 1) (quote quote)) (list (qu (cadr 1))))
  24.     ((atom (car 1)) (d (car 1) (v (cdr 1))))
  25.     ((eq (caar 1) (quote lambda))
  26.         (m (v (cdr 1)) (cadr (car 1)) (c (cadr (cdar 1))) ))
  27.         ))))
  28.  
  29. (d ((lambda (1 2) (cond
  30.     ((eq 1 (quote if)) (p (list (car 2) (quote ('T'=))
  31.         (cadr 2) (quote (;L)) (car (cddr 2)) (quote (;)) )))
  32.     ((eq 1 (quote list)) (l 2))
  33.     ((eq 1 (quote and)) (list (n 2)))
  34.     ((eq 1 (quote or)) (list (o 2)))
  35.     ((and) (e))
  36.     ))))
  37.  
  38. [primitive atomic function forms]
  39. (e ((lambda () (cond
  40.     ((eq 1 (quote car)) (append (car 2) (quote (@1))))
  41.     ((eq 1 (quote cdr)) (append (car 2) (quote (@2))))
  42.     ((eq 1 (quote cons)) (append (car 2) (append (cadr 2)
  43.         (quote (@3)))))
  44.     ((eq 1 (quote atom)) (append (car 2) (quote (@4))))
  45.     ((eq 1 (quote eq)) (append (car 2) (append (cadr 2)
  46.         (quote (@5)))))
  47.     ((and) (f))
  48.     ))))
  49.  
  50. (f ((lambda () (cond
  51.     ((eq 0 (quote not)) (not (e (car 1) 2)))
  52.     ((eq 0 (quote append)) (append (e (car 1) 2) (e (cadr 1) 2)))
  53.     ((eq 0 (quote cond)) (m 1))
  54.     ((and) (h))
  55.     ))))
  56.  
  57. [COMLIS - compile the function LIST]
  58. (l ((lambda (1) (if (null 1) (quote ('()'))
  59.      (p (list (car 1) (l (cdr 1)) (quote (@3)))) ))))
  60.  
  61. [COMLAM compile a LAMBDA]
  62. (m ((lambda (0 1 2) (p (append 0 (list (s 1) 2 (r 1))) ))))
  63.  
  64. [COMAND]
  65. (n ((lambda (1) (if (null 1) (quote ('T';;))
  66.    (p (list (car 1) (quote ('T'=)) (n (cdr 1))))
  67.    ))))
  68.  
  69. [EVOR - evaluate an OR]
  70. (o ((lambda (1) (if (null 1) (quote ('F';))
  71.     (p (list (car 1) (quote ('T'='T';L)) (o (cdr 1))))
  72.     ))))
  73.  
  74. [multiple APPEND]
  75. (p ((lambda (1) (if (null 1) 1 (append (car 1) (p (cdr 1))) ))))
  76. [restore]
  77. (r ((lambda (1) (if (null 1) 1 (append (quote (nLnn$S)) (r (cdr 1)))))))
  78.  
  79. [save]
  80. (s ((lambda (1) (if (null 1) 1
  81.     (append (list (car 1) (quote pGm$rmml) (car 1) (quote $S))
  82.      (s (cdr 1)) ) ))))
  83.  
  84. [EVLIST - compile all the elements of a list]
  85. (v ((lambda (1) (if (null 1) 1
  86.     (cons (c (car 1)) (v (cdr 1))) ))))
  87.  
  88. [main program]
  89. (* ((lambda (0) (c 0))))
  90.  
  91. [end]
  92.