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

Refactor some lisp code

This commit is contained in:
Mike Cifelli 2017-03-07 16:27:11 -05:00
parent 736e230de9
commit 6cf45219f1
6 changed files with 68 additions and 62 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

13
lisp/lang/dlambda-test.lisp
View File

@ -28,6 +28,19 @@
(dlambda
(:write () (print "something")))))
(defun dlambda-many-named-methods ()
(assert-equal
'(lambda (&rest arguments)
(case (first arguments)
(:write1 (apply (lambda () (print "something")) (rest arguments)))
(:write2 (apply (lambda () (print "something")) (rest arguments)))
(:write3 (apply (lambda () (print "something")) (rest arguments)))))
(dlambda
(:write1 () (print "something"))
(:write2 () (print "something"))
(:write3 () (print "something")))))
(defun dlambda-named-and-default-method ()
(assert-equal
'(lambda (&rest arguments)

36
lisp/lang/dlambda.lisp
View File

@ -1,19 +1,21 @@
(load "functions.lisp")
(define-special dlambda (&rest methods)
(cons 'lambda
(cons '(&rest arguments)
(list
(cons 'case
(cons '(first arguments)
(mapcar
(lambda (method)
(cons (first method)
(list
(cons 'apply
(cons (cons 'lambda (rest method))
(list
(if (equal t (car method))
'arguments
'(rest arguments))))))))
methods)))))))
(let
((add-method-clause
(lambda (method)
(cons (first method)
(list
(cons 'apply
(cons (cons 'lambda (rest method))
(list
(if (equal t (car method))
'arguments
'(rest arguments))))))))))
(define-special dlambda (&rest methods)
(cons 'lambda
(cons '(&rest arguments)
(list
(cons 'case
(cons '(first arguments)
(mapcar add-method-clause methods))))))))

8
lisp/lang/functions.lisp
View File

@ -1,8 +1,3 @@
(defun extend-null (the-list)
(cond
((equal (length the-list) 0) t)
(t nil)))
(defun mapcar (function-name the-list)
(if the-list
(cons
@ -15,9 +10,6 @@
(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)

40
lisp/object/composition.lisp
View File

@ -7,16 +7,16 @@
(dlambda
(:inc ()
(setf count (+ count 1)))
(setq count (+ count 1)))
(:dec ()
(setf count (- count 1)))
(setq count (- count 1)))
(:get ()
count)
(:set (value)
(setf count value))))))
(setq count value))))))
(defun fruit-counter (initial-count)
@ -28,46 +28,46 @@
(dlambda
(:inc-apples ()
(funcall apple-counter :inc))
(call apple-counter :inc))
(:dec-apples ()
(funcall apple-counter :dec))
(call apple-counter :dec))
(:get-apples ()
(funcall apple-counter :get))
(call apple-counter :get))
(:set-apples (value)
(funcall apple-counter :set value))
(call apple-counter :set value))
(:inc-bananas ()
(funcall banana-counter :inc))
(call banana-counter :inc))
(:dec-bananas ()
(funcall banana-counter :dec))
(call banana-counter :dec))
(:get-bananas ()
(funcall banana-counter :get))
(call banana-counter :get))
(:set-bananas (value)
(funcall banana-counter :set value))
(call banana-counter :set value))
(:inc-coconuts ()
(funcall coconut-counter :inc))
(call coconut-counter :inc))
(:dec-coconuts ()
(funcall coconut-counter :dec))
(call coconut-counter :dec))
(:get-coconuts ()
(funcall coconut-counter :get))
(call coconut-counter :get))
(:set-coconuts (value)
(funcall coconut-counter :set value))
(call 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 'apples (call apple-counter :get))
(list 'bananas (call banana-counter :get))
(list 'coconuts (call coconut-counter :get))))))))
; Create an instance
@ -82,7 +82,7 @@
; Another way
;
; usage:
; ~ (funcall my-fruits2 :set-apples 23)
; ~ (call my-fruits2 :set-apples 23)
; 23
;
(setf my-fruits2 (fruit-counter 10000))
(setq my-fruits2 (fruit-counter 10000))

29
lisp/object/this.lisp
View File

@ -1,37 +1,36 @@
(load "../lang/dlambda.lisp")
(defun counter (initial-count)
(let ((count initial-count)
(name nil)
(this nil))
(let ((this) (name)
(count initial-count))
(setf name "Counter")
(setq name "Counter")
(setf this
(setq this
(eval
(dlambda
(:inc ()
(setf count (+ count 1)))
(setq count (+ count 1)))
(:inc-3 ()
(funcall this :inc)
(funcall this :inc)
(funcall this :inc))
(call this :inc)
(call this :inc)
(call this :inc))
(:dec ()
(setf count (- count 1)))
(setq count (- count 1)))
(:dec-3 ()
(funcall this :dec)
(funcall this :dec)
(funcall this :dec))
(call this :dec)
(call this :dec)
(call this :dec))
(:get ()
count)
(:set (value)
(setf count value))
(setq count value))
(t ()
(cons name count)))))))
@ -40,4 +39,4 @@
(let ((instance (counter 0)))
(defun my-counter (&rest args) (apply instance args)))
(setf my-counter2 (counter 10000))
(setq my-counter2 (counter 10000))

4
lisp/unit/unit-test.lisp
View File

@ -1,5 +1,5 @@
(defun run-unit-test (unit-test)
(if (funcall unit-test)
(if (call unit-test)
(progn
(print (cons t unit-test))
t)
@ -18,7 +18,7 @@
(eval (cons 'and (run-test-suite test-suite))))
(defun assert (comparison expected actual)
(if (funcall comparison expected actual)
(if (call comparison expected actual)
t
(progn
(print (list expected 'is 'not comparison actual))