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

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

@ -4,5 +4,5 @@ Test
Unit tests for the dlambda special function.
| 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$/ |

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

@ -4,7 +4,7 @@ Test
Shows object composition, a default method, and two different ways of referencing objects.
| 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) | 2 |
| check | evaluate | (funcall my-fruits2 :dec-bananas) | 9999 |

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.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.dlambda||10:12:59 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 percent (n percentage)
(defun percent-of-number (n percentage)
(if (> percentage 0)
(/ (+ (* n percentage) 50) 100)
(/ (- (* n percentage) 50) 100)
)
)
(/ (- (* n percentage) 50) 100)))
(defun compound-interest (principal interest-rate years)
(if (< years 1)
principal
(compound-interest
(+ principal (percent principal interest-rate))
(+ principal (percent-of-number principal 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
leap-year
)
first-payday-day
)
two-weeks
)
1
)
)
leap-year)
first-payday-day)
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")
(defun test-dlambda ()
@ -9,65 +9,48 @@
(defun empty-dlambda ()
(assert-equal
'(lambda (&rest arguments) (case (first arguments)))
(dlambda)
)
)
(dlambda)))
(defun dlambda-default-method-only ()
(assert-equal
'(lambda (&rest arguments)
(case (first arguments)
(t (apply (lambda () (print "nothing")) arguments))
)
)
(t (apply (lambda () (print "nothing")) arguments))))
(dlambda
(t () (print "nothing"))
)
)
)
(t () (print "nothing")))))
(defun dlambda-named-method-only ()
(assert-equal
'(lambda (&rest arguments)
(case (first arguments)
(:write (apply (lambda () (print "something")) (rest arguments)))
)
)
(:write (apply (lambda () (print "something")) (rest arguments)))))
(dlambda
(:write () (print "something"))
)
)
)
(:write () (print "something")))))
(defun dlambda-named-and-default-method ()
(assert-equal
'(lambda (&rest arguments)
(case (first arguments)
(:write (apply (lambda () (print "something")) (rest arguments)))
(t (apply (lambda () (print "nothing")) arguments))
)
)
(t (apply (lambda () (print "nothing")) arguments))))
(dlambda
(:write () (print "something"))
(t () (print "nothing"))
)
)
)
(t () (print "nothing")))))
(defun dlambda-methods-with-arguments ()
(assert-equal
'(lambda (&rest arguments)
(case (first 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
(:write (message) (print message))
(t (&rest messages) (print messages))
)
)
)
(t (&rest messages) (print messages)))))
(defun dlambda-methods-with-multiple-arguments ()
(assert-equal
@ -77,39 +60,21 @@
(apply
(lambda (message &rest other-stuff)
(print message)
(print other-stuff)
)
(rest arguments)
)
)
(print other-stuff))
(rest arguments)))
(t
(apply
(lambda (message1 message2 &rest other-stuff)
(print message1)
(print message2)
(print other-stuff)
)
arguments
)
)
)
)
(print other-stuff))
arguments))))
(dlambda
(:write (message &rest other-stuff)
(print message)
(print other-stuff)
)
(print other-stuff))
(t (message1 message2 &rest other-stuff)
(print message1)
(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)
(if (null ls)
()
(cons
(funcall fn (first ls))
(mapcar fn (rest ls))
)
)
)
(load "functions.lisp")
(define-macro dlambda (&rest methods)
(cons
@ -28,25 +20,9 @@
(cons
(cons
(quote lambda)
(rest method)
)
(rest method))
(list
(if (equal t (car method))
(quote arguments)
(quote (rest arguments))
)
)
)
)
)
)
)
methods
)
)
)
)
)
)
)
(quote (rest arguments)))))))))
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)
(if the-list
(append
(reverse (rest the-list))
(list (first the-list))
)
)
)
(list (first the-list)))))
(defun deep-reverse (the-list)
(if the-list
@ -14,10 +13,4 @@
(list
(if (listp (first the-list))
(deep-reverse (first the-list))
(first the-list)
)
)
)
)
)
(first the-list))))))

81
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)
(let ((count initial-count))
@ -7,29 +7,19 @@
(dlambda
(:inc ()
(setf count (+ count 1))
)
(setf count (+ count 1)))
(:dec ()
(setf count (- count 1))
)
(setf count (- count 1)))
(:get ()
count
)
count)
(:set (value)
(setf count value)
)
(setf count value))))))
)
)
)
)
(defun fruit-counter (initial-count)
(let ((apple-counter (counter initial-count))
(banana-counter (counter initial-count))
(coconut-counter (counter initial-count)))
@ -38,66 +28,59 @@
(dlambda
(:inc-apples ()
(funcall apple-counter :inc)
)
(funcall apple-counter :inc))
(:dec-apples ()
(funcall apple-counter :dec)
)
(funcall apple-counter :dec))
(:get-apples ()
(funcall apple-counter :get)
)
(funcall apple-counter :get))
(:set-apples (value)
(funcall apple-counter :set value)
)
(funcall apple-counter :set value))
(:inc-bananas ()
(funcall banana-counter :inc)
)
(funcall banana-counter :inc))
(:dec-bananas ()
(funcall banana-counter :dec)
)
(funcall banana-counter :dec))
(:get-bananas ()
(funcall banana-counter :get)
)
(funcall banana-counter :get))
(:set-bananas (value)
(funcall banana-counter :set value)
)
(funcall banana-counter :set value))
(:inc-coconuts ()
(funcall coconut-counter :inc)
)
(funcall coconut-counter :inc))
(:dec-coconuts ()
(funcall coconut-counter :dec)
)
(funcall coconut-counter :dec))
(:get-coconuts ()
(funcall coconut-counter :get)
)
(funcall coconut-counter :get))
(:set-coconuts (value)
(funcall coconut-counter :set value)
)
(funcall coconut-counter :set value))
(t (&rest arguments)
(list
(list 'apples (funcall apple-counter :get))
(list 'bananas (funcall banana-counter :get))
(list 'coconuts (funcall coconut-counter :get))
)
)
(list 'coconuts (funcall coconut-counter :get))))))))
)
)
)
)
; Create an instance
;
@ -106,8 +89,7 @@
; 23
;
(let ((instance (fruit-counter 0)))
(defun my-fruits (&rest args) (apply instance args))
)
(defun my-fruits (&rest args) (apply instance args)))
; Another way
;
@ -116,4 +98,3 @@
; 23
;
(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)
(let ((count initial-count)
@ -12,46 +12,32 @@
(dlambda
(:inc ()
(setf count (+ count 1))
)
(setf count (+ count 1)))
(:inc-3 ()
(funcall this :inc)
(funcall this :inc)
(funcall this :inc)
)
(funcall this :inc))
(:dec ()
(setf count (- count 1))
)
(setf count (- count 1)))
(:dec-3 ()
(funcall this :dec)
(funcall this :dec)
(funcall this :dec)
)
(funcall this :dec))
(:get ()
count
)
count)
(:set (value)
(setf count value)
)
(setf count value))
(t ()
(cons name count)
)
(cons name count)))))))
)
)
)
)
)
(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))

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

@ -1,6 +1,3 @@
(defun fact (x)
(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)
(if (< n 1) nil
(cons n (problem (- n 1)))
)
)
(cons n (problem (- n 1)))))
(setf y (problem 20))
(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.
(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.
(defun letter-to-decimal (letter)
@ -12,19 +11,10 @@
(cond
((null lst) ())
((eq (car (car lst)) letter) (car lst))
(t (funcall f (cdr lst) f))
)
)
(t (funcall f (cdr lst) f))))
roman-number-list
(lambda (lst f)
(cond
((null 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)
(progn
(print (cons t unit-test))
t
)
t)
(progn
(print (cons 'f unit-test))
nil
)
)
)
nil)))
(defun run-test-suite (test-suite)
(if test-suite
(cons
(run-unit-test (car test-suite))
(run-test-suite (cdr test-suite))
)
)
)
(run-test-suite (cdr 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)
(if (funcall comparison expected actual)
t
(progn
(print (list expected 'is 'not comparison actual))
nil
)
)
)
nil)))
(defun assert= (expected actual)
(assert '= expected actual)
)
(assert '= expected actual))
(defun assert-equal (expected actual)
(assert 'equal expected actual)
)
(assert 'equal expected actual))