mike
/
transcendental-lisp
1
1
Fork 0
Code Issues 10 Pull Requests Packages Projects Releases Wiki Activity

Re-organize the lisp files

This commit is contained in:
Mike Cifelli 2017-03-06 11:00:18 -05:00
parent 416627896e
commit e1c544f0ea
18 changed files with 174 additions and 349 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

4
fitnesse/FitNesseRoot/LispInterpreter/ExternalFunctionUnitTests.wiki
View File

@ -4,5 +4,5 @@ Test
Unit tests for the dlambda special function. Unit tests for the dlambda special function.
| script | lisp interpreter fixture | | script | lisp interpreter fixture |
| check | evaluate | (load "lisp/dlambda-test.lisp") | T | | check | evaluate | (load "lisp/lang/dlambda-test.lisp") | T |
| check | evaluate | (test-dlambda) | =~/T$/ | | check | evaluate | (test-dlambda) | =~/T$/ |

16
fitnesse/FitNesseRoot/LispInterpreter/ObjectComposition.wiki
View File

@ -3,11 +3,11 @@ Test
--- ---
Shows object composition, a default method, and two different ways of referencing objects. Shows object composition, a default method, and two different ways of referencing objects.
| script | lisp interpreter fixture | | script | lisp interpreter fixture |
| check | evaluate | (load "lisp/fruit-counter.lisp") | T | | check | evaluate | (load "lisp/object/fruit-counter.lisp") | T |
| check | evaluate | (my-fruits :inc-apples) | 1 | | check | evaluate | (my-fruits :inc-apples) | 1 |
| check | evaluate | (my-fruits :inc-apples) | 2 | | check | evaluate | (my-fruits :inc-apples) | 2 |
| check | evaluate | (funcall my-fruits2 :dec-bananas) | 9999 | | check | evaluate | (funcall my-fruits2 :dec-bananas) | 9999 |
| check | evaluate | (my-fruits :set-coconuts 12) | 12 | | check | evaluate | (my-fruits :set-coconuts 12) | 12 |
| check | evaluate | (my-fruits) | ((APPLES 2) (BANANAS 0) (COCONUTS 12)) | | check | evaluate | (my-fruits) | ((APPLES 2) (BANANAS 0) (COCONUTS 12)) |
| check | evaluate | (funcall my-fruits2) | ((APPLES 10000) (BANANAS 9999) (COCONUTS 10000)) | | check | evaluate | (funcall my-fruits2) | ((APPLES 10000) (BANANAS 9999) (COCONUTS 10000)) |

4
fitnesse/FitNesseRoot/RecentChanges.wiki
View File

@ -1,7 +1,7 @@
|LispInterpreter.ExternalFunctionUnitTests||14:30:55 Fri, Mar 03, 2017| |LispInterpreter.ObjectComposition||10:34:19 Mon, Mar 06, 2017|
|LispInterpreter.ExternalFunctionUnitTests||10:30:46 Mon, Mar 06, 2017|
|LispInterpreter.MultipleMethodObject||14:19:50 Fri, Mar 03, 2017| |LispInterpreter.MultipleMethodObject||14:19:50 Fri, Mar 03, 2017|
|LispInterpreter.LexicalClosures||14:18:39 Fri, Mar 03, 2017| |LispInterpreter.LexicalClosures||14:18:39 Fri, Mar 03, 2017|
|LispInterpreter.ObjectComposition||14:17:58 Fri, Mar 03, 2017|
|LispInterpreter.DlambdaUnitTests||10:16:42 Fri, Mar 03, 2017| |LispInterpreter.DlambdaUnitTests||10:16:42 Fri, Mar 03, 2017|
|LispInterpreter.dlambda||10:12:59 Fri, Mar 03, 2017| |LispInterpreter.dlambda||10:12:59 Fri, Mar 03, 2017|
|LispInterpreter||09:04:51 Fri, Mar 03, 2017| |LispInterpreter||09:04:51 Fri, Mar 03, 2017|

52
lisp/compound-interest-test.lisp
View File

@ -1,52 +0,0 @@
(load "unit-test.lisp")
(load "compound-interest.lisp")
(unit
(list
(defun many-years-with-no-interest-rate ()
(assert= 100000 (compound-interest 100000 0 10))
)
(defun no-years-with-positive-interest-rate ()
(assert= 100000 (compound-interest 100000 10 0))
)
(defun one-year-with-positive-interest-rate ()
(assert= 105000 (compound-interest 100000 5 1))
)
(defun two-years-with-positive-interest-rate ()
(assert= 110250 (compound-interest 100000 5 2))
)
(defun three-years-with-positive-interest-rate ()
(assert= 115763 (compound-interest 100000 5 3))
)
(defun four-years-with-positive-interest-rate ()
(assert= 121551 (compound-interest 100000 5 4))
)
(defun one-year-with-negative-interest-rate ()
(assert= 95000 (compound-interest 100000 -5 1))
)
(defun two-years-with-negative-interest-rate ()
(assert= 90250 (compound-interest 100000 -5 2))
)
(defun three-years-with-negative-interest-rate ()
(assert= 85737 (compound-interest 100000 -5 3))
)
(defun four-years-with-negative-interest-rate ()
(assert= 81450 (compound-interest 100000 -5 4))
)
(defun negative-number-of-years ()
(assert= 100000 (compound-interest 100000 5 -4))
)
)
)

50
lisp/extend.lisp
View File

@ -1,50 +0,0 @@
(defun extend-null (the-list)
(cond
((equal (length the-list) 0) t)
(t nil)
)
)
(defun mapcar (function-name the-list)
(cond
((null the-list) nil)
(t (cons (funcall function-name (first the-list))
(mapcar function-name (rest the-list))))
)
)
(defun maplist (function-name the-list)
(cond
((null the-list) nil)
(t (cons (funcall function-name the-list)
(maplist function-name (rest the-list))))
)
)
(defun extend-apply (function-name param-list)
(eval (cons function-name param-list)))
(defun append (listA listB)
(cond
((null listA) listB)
(t (cons (first listA) (append (rest listA) listB)))
)
)
(defun second (listA) (first (rest listA)))
(defun third (listA) (first (rest (rest listA))))
(defun fourth (listA) (first (rest (rest (rest listA)))))
(defun fifth (listA) (first (rest (rest (rest (rest listA))))))
(defun sixth (listA) (first (rest (rest (rest (rest (rest listA)))))))
(defun seventh (listA) (first (rest (rest (rest (rest (rest (rest listA))))))))
(defun eighth (listA) (first (rest (rest (rest (rest (rest (rest (rest listA)))))))))
(defun ninth (listA) (first (rest (rest (rest (rest (rest (rest (rest (rest listA))))))))))
(defun tenth (listA) (first (rest (rest (rest (rest (rest (rest (rest (rest (rest listA)))))))))))
(defun nth (n listA)
(cond
((equal 0 n) (first listA))
(t (nth (- n 1) (rest listA)))
)
)

38
lisp/finance/compound-interest-test.lisp Normal file
View File

@ -0,0 +1,38 @@
(load "../unit/unit-test.lisp")
(load "compound-interest.lisp")
(unit
(list
(defun many-years-with-no-interest-rate ()
(assert= 100000 (compound-interest 100000 0 10)))
(defun no-years-with-positive-interest-rate ()
(assert= 100000 (compound-interest 100000 10 0)))
(defun one-year-with-positive-interest-rate ()
(assert= 105000 (compound-interest 100000 5 1)))
(defun two-years-with-positive-interest-rate ()
(assert= 110250 (compound-interest 100000 5 2)))
(defun three-years-with-positive-interest-rate ()
(assert= 115763 (compound-interest 100000 5 3)))
(defun four-years-with-positive-interest-rate ()
(assert= 121551 (compound-interest 100000 5 4)))
(defun one-year-with-negative-interest-rate ()
(assert= 95000 (compound-interest 100000 -5 1)))
(defun two-years-with-negative-interest-rate ()
(assert= 90250 (compound-interest 100000 -5 2)))
(defun three-years-with-negative-interest-rate ()
(assert= 85737 (compound-interest 100000 -5 3)))
(defun four-years-with-negative-interest-rate ()
(assert= 81450 (compound-interest 100000 -5 4)))
(defun negative-number-of-years ()
(assert= 100000 (compound-interest 100000 5 -4)))))

13
lisp/compound-interest.lisp → lisp/finance/compound-interest.lisp
View File

@ -1,19 +1,14 @@
(defun decrement (n) (- n 1)) (defun decrement (n) (- n 1))
(defun percent (n percentage) (defun percent-of-number (n percentage)
(if (> percentage 0) (if (> percentage 0)
(/ (+ (* n percentage) 50) 100) (/ (+ (* n percentage) 50) 100)
(/ (- (* n percentage) 50) 100) (/ (- (* n percentage) 50) 100)))
)
)
(defun compound-interest (principal interest-rate years) (defun compound-interest (principal interest-rate years)
(if (< years 1) (if (< years 1)
principal principal
(compound-interest (compound-interest
(+ principal (percent principal interest-rate)) (+ principal (percent-of-number principal interest-rate))
interest-rate interest-rate
(decrement years) (decrement years))))
)
)
)

15
lisp/paydays.lisp → lisp/finance/paydays.lisp
View File

@ -8,14 +8,7 @@
(- (-
(+ (+
days-in-year days-in-year
leap-year leap-year)
) first-payday-day)
first-payday-day two-weeks)
) 1))
two-weeks
)
1
)
)

79
lisp/dlambda-test.lisp → lisp/lang/dlambda-test.lisp
View File

@ -1,4 +1,4 @@
(load "unit-test.lisp") (load "../unit/unit-test.lisp")
(load "dlambda.lisp") (load "dlambda.lisp")
(defun test-dlambda () (defun test-dlambda ()
@ -9,65 +9,48 @@
(defun empty-dlambda () (defun empty-dlambda ()
(assert-equal (assert-equal
'(lambda (&rest arguments) (case (first arguments))) '(lambda (&rest arguments) (case (first arguments)))
(dlambda)
) (dlambda)))
)
(defun dlambda-default-method-only () (defun dlambda-default-method-only ()
(assert-equal (assert-equal
'(lambda (&rest arguments) '(lambda (&rest arguments)
(case (first arguments) (case (first arguments)
(t (apply (lambda () (print "nothing")) arguments)) (t (apply (lambda () (print "nothing")) arguments))))
)
)
(dlambda (dlambda
(t () (print "nothing")) (t () (print "nothing")))))
)
)
)
(defun dlambda-named-method-only () (defun dlambda-named-method-only ()
(assert-equal (assert-equal
'(lambda (&rest arguments) '(lambda (&rest arguments)
(case (first arguments) (case (first arguments)
(:write (apply (lambda () (print "something")) (rest arguments))) (:write (apply (lambda () (print "something")) (rest arguments)))))
)
)
(dlambda (dlambda
(:write () (print "something")) (:write () (print "something")))))
)
)
)
(defun dlambda-named-and-default-method () (defun dlambda-named-and-default-method ()
(assert-equal (assert-equal
'(lambda (&rest arguments) '(lambda (&rest arguments)
(case (first arguments) (case (first arguments)
(:write (apply (lambda () (print "something")) (rest arguments))) (:write (apply (lambda () (print "something")) (rest arguments)))
(t (apply (lambda () (print "nothing")) arguments)) (t (apply (lambda () (print "nothing")) arguments))))
)
)
(dlambda (dlambda
(:write () (print "something")) (:write () (print "something"))
(t () (print "nothing")) (t () (print "nothing")))))
)
)
)
(defun dlambda-methods-with-arguments () (defun dlambda-methods-with-arguments ()
(assert-equal (assert-equal
'(lambda (&rest arguments) '(lambda (&rest arguments)
(case (first arguments) (case (first arguments)
(:write (apply (lambda (message) (print message)) (rest arguments))) (:write (apply (lambda (message) (print message)) (rest arguments)))
(t (apply (lambda (&rest messages) (print messages)) arguments)) (t (apply (lambda (&rest messages) (print messages)) arguments))))
)
)
(dlambda (dlambda
(:write (message) (print message)) (:write (message) (print message))
(t (&rest messages) (print messages)) (t (&rest messages) (print messages)))))
)
)
)
(defun dlambda-methods-with-multiple-arguments () (defun dlambda-methods-with-multiple-arguments ()
(assert-equal (assert-equal
@ -77,39 +60,21 @@
(apply (apply
(lambda (message &rest other-stuff) (lambda (message &rest other-stuff)
(print message) (print message)
(print other-stuff) (print other-stuff))
) (rest arguments)))
(rest arguments)
)
)
(t (t
(apply (apply
(lambda (message1 message2 &rest other-stuff) (lambda (message1 message2 &rest other-stuff)
(print message1) (print message1)
(print message2) (print message2)
(print other-stuff) (print other-stuff))
) arguments))))
arguments
)
)
)
)
(dlambda (dlambda
(:write (message &rest other-stuff) (:write (message &rest other-stuff)
(print message) (print message)
(print other-stuff) (print other-stuff))
)
(t (message1 message2 &rest other-stuff) (t (message1 message2 &rest other-stuff)
(print message1) (print message1)
(print message2) (print message2)
(print other-stuff) (print other-stuff))))))))
)
)
)
)
)
)
)

32
lisp/dlambda.lisp → lisp/lang/dlambda.lisp
View File

@ -1,12 +1,4 @@
(defun mapcar (fn ls) (load "functions.lisp")
(if (null ls)
()
(cons
(funcall fn (first ls))
(mapcar fn (rest ls))
)
)
)
(define-macro dlambda (&rest methods) (define-macro dlambda (&rest methods)
(cons (cons
@ -28,25 +20,9 @@
(cons (cons
(cons (cons
(quote lambda) (quote lambda)
(rest method) (rest method))
)
(list (list
(if (equal t (car method)) (if (equal t (car method))
(quote arguments) (quote arguments)
(quote (rest arguments)) (quote (rest arguments)))))))))
) methods)))))))
)
)
)
)
)
)
methods
)
)
)
)
)
)
)

29
lisp/lang/functions.lisp Normal file
View File

@ -0,0 +1,29 @@
(defun extend-null (the-list)
(cond
((equal (length the-list) 0) t)
(t nil)))
(defun mapcar (function-name the-list)
(if the-list
(cons
(funcall function-name (first the-list))
(mapcar function-name (rest the-list)))))
(defun maplist (function-name the-list)
(cond
((null the-list) nil)
(t (cons (funcall function-name the-list)
(maplist function-name (rest the-list))))))
(defun extend-apply (function-name param-list)
(eval (cons function-name param-list)))
(defun append (listA listB)
(cond
((null listA) listB)
(t (cons (first listA) (append (rest listA) listB)))))
(defun nth (n listA)
(cond
((equal 0 n) (first listA))
(t (nth (- n 1) (rest listA)))))

15
lisp/reverse.lisp → lisp/lang/reverse.lisp
View File

@ -1,11 +1,10 @@
(load "functions.lisp")
(defun reverse (the-list) (defun reverse (the-list)
(if the-list (if the-list
(append (append
(reverse (rest the-list)) (reverse (rest the-list))
(list (first the-list)) (list (first the-list)))))
)
)
)
(defun deep-reverse (the-list) (defun deep-reverse (the-list)
(if the-list (if the-list
@ -14,10 +13,4 @@
(list (list
(if (listp (first the-list)) (if (listp (first the-list))
(deep-reverse (first the-list)) (deep-reverse (first the-list))
(first the-list) (first the-list))))))
)
)
)
)
)

89
lisp/fruit-counter.lisp → lisp/object/fruit-counter.lisp
View File

@ -1,4 +1,4 @@
(load "dlambda.lisp") (load "../lang/dlambda.lisp")
(defun counter (initial-count) (defun counter (initial-count)
(let ((count initial-count)) (let ((count initial-count))
@ -7,29 +7,19 @@
(dlambda (dlambda
(:inc () (:inc ()
(setf count (+ count 1)) (setf count (+ count 1)))
)
(:dec () (:dec ()
(setf count (- count 1)) (setf count (- count 1)))
)
(:get () (:get ()
count count)
)
(:set (value) (:set (value)
(setf count value) (setf count value))))))
)
)
)
)
)
(defun fruit-counter (initial-count) (defun fruit-counter (initial-count)
(let ((apple-counter (counter initial-count)) (let ((apple-counter (counter initial-count))
(banana-counter (counter initial-count)) (banana-counter (counter initial-count))
(coconut-counter (counter initial-count))) (coconut-counter (counter initial-count)))
@ -38,82 +28,73 @@
(dlambda (dlambda
(:inc-apples () (:inc-apples ()
(funcall apple-counter :inc) (funcall apple-counter :inc))
)
(:dec-apples () (:dec-apples ()
(funcall apple-counter :dec) (funcall apple-counter :dec))
)
(:get-apples () (:get-apples ()
(funcall apple-counter :get) (funcall apple-counter :get))
)
(:set-apples (value) (:set-apples (value)
(funcall apple-counter :set value) (funcall apple-counter :set value))
)
(:inc-bananas () (:inc-bananas ()
(funcall banana-counter :inc) (funcall banana-counter :inc))
)
(:dec-bananas () (:dec-bananas ()
(funcall banana-counter :dec) (funcall banana-counter :dec))
)
(:get-bananas () (:get-bananas ()
(funcall banana-counter :get) (funcall banana-counter :get))
)
(:set-bananas (value) (:set-bananas (value)
(funcall banana-counter :set value) (funcall banana-counter :set value))
)
(:inc-coconuts () (:inc-coconuts ()
(funcall coconut-counter :inc) (funcall coconut-counter :inc))
)
(:dec-coconuts () (:dec-coconuts ()
(funcall coconut-counter :dec) (funcall coconut-counter :dec))
)
(:get-coconuts () (:get-coconuts ()
(funcall coconut-counter :get) (funcall coconut-counter :get))
)
(:set-coconuts (value) (:set-coconuts (value)
(funcall coconut-counter :set value) (funcall coconut-counter :set value))
)
(t (&rest arguments) (t (&rest arguments)
(list (list
(list 'apples (funcall apple-counter :get)) (list 'apples (funcall apple-counter :get))
(list 'bananas (funcall banana-counter :get)) (list 'bananas (funcall banana-counter :get))
(list 'coconuts (funcall coconut-counter :get)) (list 'coconuts (funcall coconut-counter :get))))))))
)
)
)
)
)
)
; Create an instance ; Create an instance
; ;
; usage: ; usage:
; ~ (my-fruits :set-apples 23) ; ~ (my-fruits :set-apples 23)
; 23 ; 23
; ;
(let ((instance (fruit-counter 0))) (let ((instance (fruit-counter 0)))
(defun my-fruits (&rest args) (apply instance args)) (defun my-fruits (&rest args) (apply instance args)))
)
; Another way ; Another way
; ;
; usage: ; usage:
; ~ (funcall my-fruits2 :set-apples 23) ; ~ (funcall my-fruits2 :set-apples 23)
; 23 ; 23
; ;
(setf my-fruits2 (fruit-counter 10000)) (setf my-fruits2 (fruit-counter 10000))

32
lisp/this.lisp → lisp/object/this.lisp
View File

@ -1,4 +1,4 @@
(load "dlambda.lisp") (load "../lang/dlambda.lisp")
(defun counter (initial-count) (defun counter (initial-count)
(let ((count initial-count) (let ((count initial-count)
@ -12,46 +12,32 @@
(dlambda (dlambda
(:inc () (:inc ()
(setf count (+ count 1)) (setf count (+ count 1)))
)
(:inc-3 () (:inc-3 ()
(funcall this :inc) (funcall this :inc)
(funcall this :inc) (funcall this :inc)
(funcall this :inc) (funcall this :inc))
)
(:dec () (:dec ()
(setf count (- count 1)) (setf count (- count 1)))
)
(:dec-3 () (:dec-3 ()
(funcall this :dec) (funcall this :dec)
(funcall this :dec) (funcall this :dec)
(funcall this :dec) (funcall this :dec))
)
(:get () (:get ()
count count)
)
(:set (value) (:set (value)
(setf count value) (setf count value))
)
(t () (t ()
(cons name count) (cons name count)))))))
)
)
)
)
)
)
(let ((instance (counter 0))) (let ((instance (counter 0)))
(defun my-counter (&rest args) (apply instance args)) (defun my-counter (&rest args) (apply instance args)))
)
(setf my-counter2 (counter 10000)) (setf my-counter2 (counter 10000))

5
lisp/fact.lisp → lisp/random/fact.lisp
View File

@ -1,6 +1,3 @@
(defun fact (x) (defun fact (x)
(if (< x 2) 1 (if (< x 2) 1
(* x (fact (- x 1))) (* x (fact (- x 1)))))
)
)

5
lisp/problem.lisp → lisp/random/problem.lisp
View File

@ -1,9 +1,6 @@
(defun problem (n) (defun problem (n)
(if (< n 1) nil (if (< n 1) nil
(cons n (problem (- n 1))) (cons n (problem (- n 1)))))
)
)
(setf y (problem 20)) (setf y (problem 20))
(setf x (problem 20000)) (setf x (problem 20000))

16
lisp/roman.lisp → lisp/random/roman.lisp
View File

@ -1,7 +1,6 @@
;; A list containing the values of single-letter Roman numerals. ;; A list containing the values of single-letter Roman numerals.
(setf roman-number-list (setf roman-number-list
'((I 1) (V 5) (X 10) (L 50) (C 100) (D 500) (M 1000)) '((I 1) (V 5) (X 10) (L 50) (C 100) (D 500) (M 1000)))
)
;; Converts a single Roman numeral letter into its equivalent decimal value. ;; Converts a single Roman numeral letter into its equivalent decimal value.
(defun letter-to-decimal (letter) (defun letter-to-decimal (letter)
@ -12,19 +11,10 @@
(cond (cond
((null lst) ()) ((null lst) ())
((eq (car (car lst)) letter) (car lst)) ((eq (car (car lst)) letter) (car lst))
(t (funcall f (cdr lst) f)) (t (funcall f (cdr lst) f))))
)
)
roman-number-list roman-number-list
(lambda (lst f) (lambda (lst f)
(cond (cond
((null lst) ()) ((null lst) ())
((eq (car (car lst)) letter) (car lst)) ((eq (car (car lst)) letter) (car lst))
(t (funcall f (cdr lst) f)) (t (funcall f (cdr lst) f))))))))
)
)
)
)
)
)

29
lisp/unit-test.lisp → lisp/unit/unit-test.lisp
View File

@ -2,43 +2,30 @@
(if (funcall unit-test) (if (funcall unit-test)
(progn (progn
(print (cons t unit-test)) (print (cons t unit-test))
t t)
)
(progn (progn
(print (cons 'f unit-test)) (print (cons 'f unit-test))
nil nil)))
)
)
)
(defun run-test-suite (test-suite) (defun run-test-suite (test-suite)
(if test-suite (if test-suite
(cons (cons
(run-unit-test (car test-suite)) (run-unit-test (car test-suite))
(run-test-suite (cdr test-suite)) (run-test-suite (cdr test-suite)))))
)
)
)
(defun unit (test-suite) (defun unit (test-suite)
(eval (cons 'and (run-test-suite test-suite))) (eval (cons 'and (run-test-suite test-suite))))
)
(defun assert (comparison expected actual) (defun assert (comparison expected actual)
(if (funcall comparison expected actual) (if (funcall comparison expected actual)
t t
(progn (progn
(print (list expected 'is 'not comparison actual)) (print (list expected 'is 'not comparison actual))
nil nil)))
)
)
)
(defun assert= (expected actual) (defun assert= (expected actual)
(assert '= expected actual) (assert '= expected actual))
)
(defun assert-equal (expected actual) (defun assert-equal (expected actual)
(assert 'equal expected actual) (assert 'equal expected actual))
)