Samuel wrote:There's one little issue with the attribute setters, in that they do not modify the original data, but rather make a new object with the changed attribute.
Although I'm still working my way through understanding the potential of functional object-oriented programming, I would say this particular characteristic—immutable objects—seems the most natural way to make objects functional.
This idea isn't so far-fetched, either. At the cellular level, we are not the same bodies we were when we started. Cells die off, replaced by new cells constantly. Creating a new object each time may seem wasteful, but since a list is used to represent objects, the overhead is negligible.
It's possible to do object references by using and passing symbols, but after spending time with the shapes and hydroponic garden examples, I'm less inclined to introduce the added complexity. If we wanted to do objects the "regular" way, as Lutz points out often, there are better languages to turn to. But I see something in newLISP I've not seen in other languages. newLISP feels like an
individual's language. A language where one person is able to do grand things because of the simplicity it encourages.
I'm posting the current state of the shapes code. I've bummed it quite a bit and added a little more complexity ;-)
Code: Select all
;; M I X I N
(constant (global 'mixin)
(fn () (set 's (args -1)) (map (fn (e) (new e s)) (0 -1 (args))))
)
;; D I S P L A Y A B L E
(define (displayable:print d) (print ((context (d 0) 'string) d)))
(define (displayable:println d) (set 's (:print d)) (println) s)
(define (displayable:string d) (string d))
(define (displayable? d) (set 'c (d 0)) (and c:string c:print c:println true))
;; C O M P A R A B L E
(define (comparable:=) (apply = (map rest (args))))
(define (comparable:<) (apply < (map rest (args))))
(define (comparable:>) (apply > (map rest (args))))
(define (comparable:<=) (apply <= (map rest (args))))
(define (comparable:>=) (apply >= (map rest (args))))
(define (comparable:!=) (apply != (map rest (args))))
(define (comparable? n) (set 'c (n 0)) (and c:= c:< c:> c:<= c:>= c:!= true))
;; R O T A T A B L E
(define (rotatable:rotate r rv) (cons (r 0) (rotate (rest r) rv)))
(define (rotatable? r) (true? (context (r 0) 'rotate)))
;; N U M E R I C
(define (numeric:+) (numeric:apply + (args)))
(define (numeric:-) (numeric:apply - (args)))
(define (numeric:*) (numeric:apply * (args)))
(define (numeric:add) (numeric:apply add (args)))
(define (numeric:sub) (numeric:apply sub (args)))
(define (numeric:mul) (numeric:apply mul (args)))
(define (numeric:apply op ags)
(cons (ags 0 0) (apply map (cons op (map (fn (e) (1 e)) ags))))
)
(define (numeric? n) (set 'c (n 0)) (and c:+ c:- c:* c:add c:sub c:mul true))
;; P O I N T
(mixin displayable comparable numeric 'point)
(define (point:point (x 0) (y 0)) (list point x y))
(define (point:move p dx dy) (:+ p (point dx dy)))
(define (point:distance p o)
(sqrt (add (pow (sub (o 1) (p 1)) 2) (pow (sub (o 2) (p 2)) 2)))
)
(define (point:string p) (string (p 1) "@" (p 2)))
(define (point? p) (= (p 0) point))
;; S E G M E N T
(mixin displayable comparable rotatable 'segment)
(define (segment:segment (a (point)) (b (point))) (list segment a b))
(define (segment:distance s) (:distance (s 1) (s 2)))
(define (segment:move s dx dy)
(segment (:move (s 1) dx dy) (:move (s 2) dx dy))
)
(define (segment:move-point s p dx dy)
(case p
(1 (segment (:move (s 1) dx dy) (s 2)))
(2 (segment (s 1) (:move (s 2) dx dy)))
)
)
(define (segment:string s)
(string "(" (:string (s 1)) " " (:string (s 2)) ")")
)
(define (segment? s) (= (s 0) segment))
;; S H A P E
(mixin displayable comparable rotatable 'shape)
;; T R I A N G L E
(new shape 'triangle)
(define (triangle:triangle (ab (segment)) (bc (segment)) (ca (segment)))
(list triangle ab bc ca)
)
(define (triangle:move t dx dy)
(triangle (:move (t 1) dx dy) (:move (t 2) dx dy) (:move (t 3) dx dy))
)
(define (triangle:move-segment t s dx dy)
(set 't (:rotate t (- s 1)))
(triangle
(:move (t 1) dx dy)
(:move-point (t 2) 1 dx dy)
(:move-point (t 3) 2 dx dy)
)
)
(define (triangle:string t)
(string "(" (:string (t 1)) " " (:string (t 2)) " " (:string (t 3)) ")")
)
(define (triangle? t) (= (t 0) triangle))
;; R E C T A N G L E
(new shape 'rectangle)
(define (rectangle:rectangle (width (segment)) (height (segment)))
(list rectangle width height)
)
(define (rectangle:width r) (:distance (r 1)))
(define (rectangle:height r) (:distance (r 2)))
(define (rectangle:perimeter r) (mul (add (:width r) (:height r)) 2))
(define (rectangle:area r) (mul (:width r) (:height r)))
(define (rectangle:move r dx dy)
(rectangle (:move (r 1) dx dy) (:move (r 2) dx dy))
)
(define (rectangle:string r)
(string "(" (:string (r 1)) " " (:string (r 2)) ")")
)
(define (rectangle? r) (= (r 0) rectangle))
;; S A M P L E R U N
(println "\nMaking three points:")
(:println (set 'a (point)))
(:println (set 'b (point 20 1)))
(:println (set 'c (point 10 5)))
(println "\nPerforming point addition, subtraction, and multiplication:")
(:println (:+ a b c))
(:println (:- a b c))
(:println (:* (point 2 43) '(point 22 1) c))
(println "\nPerforming the same operations with floats:")
(:println (:add (point 23.4 65.4) (point 33.2) (point 54.6 93.1)))
(:println (:sub (point 23.4 65.4) (point 33.2) (point 54.6 93.1)))
(:println (:mul (point 2.5 43.2) '(point 22.1 1.5) c))
(println "\nComparing points (=, <, >=, etc.):")
(println (:= a b c))
(println (:= (point (* 10 2) 1) '(point 20 1) b))
(println (:< a b c))
(println (:> b c a))
(println (:< a b c))
(println (:!= a b c))
(println "\nMaking three segments:")
(:println (set 'ab (segment a b)))
(:println (set 'bc (segment b c)))
(:println (set 'ca (segment c a)))
(println "\nChecking the distance between a segment's points:")
(map println (map (curry :distance) (list ab bc ca)))
(println "\nComparing segments:")
(println (:= ab bc ca))
(println (:= ab (segment a b) (list segment a b)))
(println (:< bc ca))
(println (:> bc ca))
(println (:!= ab bc ca))
(println "\nRotating a segment one revolution:")
(:println (:rotate ab 1))
(println "\nMoving segment ab's a point and ca's b point by (5 5):")
(:println (set 'ab (:move-point ab 1 5 5)))
(:println (set 'ca (:move-point ca 2 5 5)))
(println "\nMaking a triangle:")
(:println (set 'tri (triangle ab bc ca)))
(println "\nMoving the triangle by (30 5):")
(:println (set 'tri (:move tri 30 5)))
(println "\nMoving the triangle's ab segment by (11 11):")
(:println (set 'tri (:move-segment tri 1 11 11)))
(println "\nRotating the triangle full circle:")
(:println (:rotate tri 1))
(:println (:rotate tri 2))
(:println (:rotate tri 3))
(println "\nMaking a rectangle:")
(:println (set 'rec (rectangle bc ca)))
(println "\nChecking the rectangle's width, height, area, and perimeter:")
(println (:width rec))
(println (:height rec))
(println (:area rec))
(println (:perimeter rec))
(println "\nPolymorphically sending 'move' and 'println' to a list of shapes:")
(map (curry :println) (map (fn (e) (:move e 12 12)) (list a ab tri rec)))
(println)
;; T H E E N D
Also, for anyone interested: I made an alternative version in which the
def-type macro allows for attribute defaults and a type predicate. The accessors have also been simplified to be regular functions. But be forewarned: Lutz prefers the clarity of the above code :-)
Code: Select all
(define-macro (def-type)
(letn
(
ctx (context (args 0 0))
defs (1 (args 0))
atts (if (list? (defs 0)) (map first defs) defs)
lst (cons 'list (cons ctx atts))
)
(set
(default ctx) (expand '(lambda defs lst) 'defs 'lst)
(sym (string ctx "?") MAIN)
(letex (ctxs (string ctx)) '(lambda (o) (= (string (o 0)) ctxs)))
)
(dolist (item atts)
(set
'idx (+ $idx 1)
(sym item ctx) (expand
'(lambda (o v) (if v (set-nth (o idx) v) (o idx)))
'idx
)
)
)
ctx
)
)
And here's the shapes code modified to use
def-type and the resulting accessors:
Code: Select all
;; D E P E N D E N C I E S
(load "def-type.lsp")
;; M I X I N
(constant (global 'mixin)
(fn () (set 's (args -1)) (map (fn (e) (new e s)) (0 -1 (args))))
)
;; D I S P L A Y A B L E
(define (displayable:print d) (print ((context (d 0) 'string) d)))
(define (displayable:println d) (set 's (:print d)) (println) s)
(define (displayable:string d) (string d))
(define (displayable? d) (set 'c (d 0)) (and c:string c:print c:println true))
;; C O M P A R A B L E
(define (comparable:=) (apply = (map rest (args))))
(define (comparable:<) (apply < (map rest (args))))
(define (comparable:>) (apply > (map rest (args))))
(define (comparable:<=) (apply <= (map rest (args))))
(define (comparable:>=) (apply >= (map rest (args))))
(define (comparable:!=) (apply != (map rest (args))))
(define (comparable? n) (set 'c (n 0)) (and c:= c:< c:> c:<= c:>= c:!= true))
;; R O T A T A B L E
(define (rotatable:rotate r rv)
(cons (r 0) (rotate (rest r) rv))
)
(define (rotatable? r) (true? (context (r 0) 'rotate)))
;; N U M E R I C
(define (numeric:+) (numeric:apply + (args)))
(define (numeric:-) (numeric:apply - (args)))
(define (numeric:*) (numeric:apply * (args)))
(define (numeric:add) (numeric:apply add (args)))
(define (numeric:sub) (numeric:apply sub (args)))
(define (numeric:mul) (numeric:apply mul (args)))
(define (numeric:apply op ags)
(cons (ags 0 0) (apply map (cons op (map (fn (e) (1 e)) ags))))
)
(define (numeric? n) (set 'c (n 0)) (and c:+ c:- c:* c:add c:sub c:mul true))
;; P O I N T
(def-type (point (x 0) (y 0)))
(mixin displayable comparable numeric 'point)
(define (point:move p dx dy) (:+ p (point dx dy)))
(define (point:distance p o)
(sqrt (add (pow (sub (:x o) (:x p)) 2) (pow (sub (:y o) (:y p)) 2)))
)
(define (point:string p) (string (:x p) "@" (:y p)))
;; S E G M E N T
(def-type (segment (a (point)) (b (point))))
(mixin displayable comparable rotatable 'segment)
(define (segment:distance s) (:distance (:a s) (:b s)))
(define (segment:move s dx dy)
(segment (:move (:a s) dx dy) (:move (:b s) dx dy))
)
(define (segment:move-point s p dx dy)
(case p
(1 (segment (:move (:a s) dx dy) (:b s)))
(2 (segment (:a s) (:move (:b s) dx dy)))
)
)
(define (segment:string s)
(string "(" (:string (:a s)) " " (:string (:b s)) ")")
)
;; S H A P E
(mixin displayable comparable rotatable 'shape)
;; T R I A N G L E
(def-type (triangle (ab (segment)) (bc (segment)) (ca (segment))))
(new shape 'triangle)
(define (triangle:move t dx dy)
(triangle (:move (:ab t) dx dy) (:move (:bc t) dx dy) (:move (:ca t) dx dy))
)
(define (triangle:move-segment t s dx dy)
(set 't (:rotate t (- s 1)))
(triangle
(:move (:ab t) dx dy)
(:move-point (:bc t) 1 dx dy)
(:move-point (:ca t) 2 dx dy)
)
)
(define (triangle:string t)
(string
"(" (:string (:ab t)) " " (:string (:bc t)) " " (:string (:ca t)) ")"
)
)
;; R E C T A N G L E
(def-type (rectangle (width (segment)) (height (segment))))
(new shape 'rectangle)
(define (rectangle:width r) (:distance (r 1)))
(define (rectangle:height r) (:distance (r 2)))
(define (rectangle:perimeter r) (mul (add (:width r) (:height r)) 2))
(define (rectangle:area r) (mul (:width r) (:height r)))
(define (rectangle:move r dx dy)
(rectangle (:move (r 1) dx dy) (:move (r 2) dx dy))
)
(define (rectangle:string r)
(string "(" (:string (r 1)) " " (:string (r 2)) ")")
)
;; S A M P L E R U N
(println "\nMaking three points:")
(:println (set 'a (point)))
(:println (set 'b (point 20 1)))
(:println (set 'c (point 10 5)))
(println "\nPerforming point addition, subtraction, and multiplication:")
(:println (:+ a b c))
(:println (:- a b c))
(:println (:* (point 2 43) '(point 22 1) c))
(println "\nPerforming the same operations with floats:")
(:println (:add (point 23.4 65.4) (point 33.2) (point 54.6 93.1)))
(:println (:sub (point 23.4 65.4) (point 33.2) (point 54.6 93.1)))
(:println (:mul (point 2.5 43.2) '(point 22.1 1.5) c))
(println "\nComparing points (=, <, >=, etc.):")
(println (:= a b c))
(println (:= (point (* 10 2) 1) '(point 20 1) b))
(println (:< a b c))
(println (:> b c a))
(println (:< a b c))
(println (:!= a b c))
(println "\nMaking three segments:")
(:println (set 'ab (segment a b)))
(:println (set 'bc (segment b c)))
(:println (set 'ca (segment c a)))
(println "\nChecking the distance between a segment's points:")
(map println (map (curry :distance) (list ab bc ca)))
(println "\nComparing segments:")
(println (:= ab bc ca))
(println (:= ab (segment a b) (list segment a b)))
(println (:< bc ca))
(println (:> bc ca))
(println (:!= ab bc ca))
(println "\nRotating a segment one revolution:")
(:println (:rotate ab 1))
(println "\nMoving segment ab's a point and ca's b point by (5 5):")
(:println (set 'ab (:move-point ab 1 5 5)))
(:println (set 'ca (:move-point ca 2 5 5)))
(println "\nMaking a triangle:")
(:println (set 'tri (triangle ab bc ca)))
(println "\nMoving the triangle by (30 5):")
(:println (set 'tri (:move tri 30 5)))
(println "\nMoving the triangle's ab segment by (11 11):")
(:println (set 'tri (:move-segment tri 1 11 11)))
(println "\nRotating the triangle full circle:")
(:println (:rotate tri 1))
(:println (:rotate tri 2))
(:println (:rotate tri 3))
(println "\nMaking a rectangle:")
(:println (set 'rec (rectangle bc ca)))
(println "\nChecking the rectangle's width, height, area, and perimeter:")
(println (:width rec))
(println (:height rec))
(println (:area rec))
(println (:perimeter rec))
(println "\nPolymorphically sending 'move' and 'println' to a list of shapes:")
(map (curry :println) (map (fn (e) (:move e 12 12)) (list a ab tri rec)))
(println)
;; T H E E N D
I guess that's enough code for now ;-)
m i c h a e l
