Text only | Text with Images

newLISP Fan Club

Forum => newLISP newS => Topic started by: Lutz on October 23, 2007, 03:57:40 PM

Title: A simple minimal OO system for newLISP
Post by: Lutz on October 23, 2007, 03:57:40 PM
(1) An object is represented by a list in which the first member is a symbol identifying the class of which this object is an instance.



(2) Methods are defined in a context with the class name.


Code Select
(define (rectangle:area p)
(mul (p 3) (p 4)))

(define (circle:area c)
(mul (pow (c 3) 2) (acos 0) 2))

(set 'myrect '(rectangle 5 5 10 20)) ; x y width height
(set 'mycircle '(circle 1 2 10)) ; x y radius


Note, that the methods should be defined first to establish 'rectangle' and 'circle' as context symbols. In a similar fashion 'rectangle:move' and 'circle:move' could be defined.



(3) we define the : (colon) as a function which extracts the class name from the object, constructs the class:method symbol and applies it to the object:


Code Select
(define-macro (: _func _obj)
(let (_data (eval _obj))
(apply (sym _func (_data 0)) (list _data))))

now we can code:


Code Select
(:area myrect) => 200
(:area mycircle) => 314.1592654

Visually and in an intuitive manner this looks like the type polymorphic application of a generic functor ':area' to an object 'myrect' or 'mycircle', both of different types. But in reality this is the ':' function taking the symbol 'area' as the method name and extracting the correct class from the object. The newLISP parser allows the colon : to be attached directly to the following symbol.



The above macro will be a built-in primitive in the next development version for maximum speed an minimum overhead. The : function solves the polymorphism problem. Objects defined as in rule (1) can be anonymous and can be nested.



Lutz



ps:



- defining the : colon doesn't disturb any existing functionality related to contexts



- subclassing is done using (new 'Class 'Subclass) and adding or overwriting methods in 'Subclass' doing: (define (Subclass:some-method) ...)



- multiple inheritance is possible using repeated 'new' (new 'Aclass 'Subclass), (new 'Bclass 'Subclass). This can add methods from 'Aclass and 'Bclass to an already existing 'Subclass.



- 'def-new' can be used to do mix-ins of single methods.



- a 'def-type' macro could be used to define <class-name>:<class-name> as a default functor to construct objects (<class-name> p1 p2 ...), but isn't really essential although convenient.
Title:
Post by: m i c h a e l on October 23, 2007, 06:34:47 PM
Hi Lutz,



Thank you! I know you're not overly fond of OOP, so for you to spend time on it means a lot to me.



What a great idea to use :. I didn't even know you could define it as a function! And you're right, it is intuitive.



m i c h a e l
Title:
Post by: Jeff on October 24, 2007, 05:11:58 AM
Can a Shape type contain multiple Side objects?
Title:
Post by: Lutz on October 24, 2007, 05:45:55 AM
Nothing new here really ;-), you can do whatever you can do when nesting functions and lists in newLISP. The : colon macro is just a special 'apply' which constructs the functor on the fly with info found in the object. It helps creating type polymorphism used in OO. (:area ...) will call two different functions depending on the object type following.



Lutz
Title:
Post by: Jeff on October 24, 2007, 05:48:06 AM
So these are not being created as contexts then?
Title:
Post by: Lutz on October 24, 2007, 05:50:28 AM
contexts are only created to hold the methods. The context symbol in the object as in 'rectangle' (rectangle x y width height) is just like pointer indicating where to look up the method.



Lutz
Title:
Post by: Jeff on October 24, 2007, 05:58:39 AM
So the built-in def-type macro will internally store these references and simulate context symbols pointing to other contexts?  Or must all types be declared in the main namespace?  So that, for example, first I must define Side, and then Shape can use Sides?
Title:
Post by: Lutz on October 24, 2007, 08:14:51 AM
There is no built-in 'def-type'. The 'def-type' macro can be used to spit out a constructor and basic accessors, but is not necessary. The only thing really necessary is what you see in my post at the beginning of this thread. The contexts only hold methods. There is no nesting of contexts only nesting of classic Lisp lists. The lists are the objects. The first field in the object list is the symbol of the method context.



All types (represented by contexts) are part of the main name space, but don't need to be declared there. You can declare them inside a module/context as shown in the following code:


Code Select
(define-macro (: _func _obj)
(let (_data (eval _obj))
(apply (sym _func (_data 0)) (list _data))))
(global ':)

(context 'Foo)

(define (rectangle:area p)
(mul (p 3) (p 4)))

(set 'myrect '(rectangle 5 5 10 20)) ; x y width height

(:area myrect) => 200

(context MAIN)

(:area Foo:myrect) => 200

Quotefirst I must define Side, and then Shape can use Sides?


normally yes, but you can even define the 'rectangle:area' function after using 'rectangle' in an object, but then you must predeclare 'rectangle:area' as in here:


Code Select
(define-macro (: _func _obj)
(let (_data (eval _obj))
(apply (sym _func (_data 0)) (list _data))))
(global ':)

(context 'Foo)

(define rectangle:area) ; pre declaration

(set 'myrect '(rectangle 5 5 10 20)) ; x y width height

(define (rectangle:area p)
(mul (p 3) (p 4)))

(:area myrect) => 200

(context MAIN)

(:area Foo:myrect) => 200


The pre declaration can be inside or outside of Foo.



Lutz



ps: all this code runs now in the normal release, does not need new built-in primitives, but the colon : definition will be built-in in the future for speed and convenience.
Title:
Post by: m i c h a e l on October 24, 2007, 08:26:36 AM
Hi Jeff!



Note: I wrote the following before Lutz responded. I'll post it anyway, but there is one confusing part in Lutz's answer that I wanted to clear up first:


Quote from: "Lutz"There is now nesting of contexts only nesting of classic Lisp lists.


I think he meant to say: "There is no nesting of contexts, only nesting of classic Lisp lists".



----



Objects are lists. The first element in the list is its type. The object's methods are stored in a context. The name of the context is the same as the type.



Here is a minimal example using the new : (colon) macro:


Code Select
> (define (side:string) "a side")
(lambda () "a side")
> (define (shape:string sh) (string "a shape with " (length (1 sh)) " sides"))
(lambda (sh) (string "a shape with " (length (1 sh)) " sides"))
> (set 's '(shape (side) (side) (side)))
(shape (side) (side) (side))
> (:string s)
"a shape with 3 sides"
> (:string (s 1))
"a side"
> _


The def-type macro is really just for convenience (notice I didn't use it in the above example). It makes a constructor and accessors for the type being defined (in a context with the same name) but is itself totally optional (at least for now ;-)



You must create the context before making the first object, as I did with side:string and shape:string, which created the side and shape contexts.



Hopefully I answered your question in there somewhere :-)



m i c h a e l
Title:
Post by: Lutz on October 24, 2007, 08:40:02 AM
Quote from: "michael"I think he meant to say: "There is no nesting of contexts, only nesting of classic Lisp lists"


yes, I meant "no nesting of contexts", sorry for the confusion (corrected my last post)



Lutz
Title:
Post by: Jeff on October 24, 2007, 08:49:47 AM
Gotcha.  That's what I was asking.
Title:
Post by: Lutz on October 24, 2007, 08:50:40 AM
Quote from: "michael"You must create the context before making the first object, as I did with side:string and shape:string, which created the side and shape contexts.


yes, and there are many ways to do it, the important thing is: the first time newLISP  sees the symbol in question it must know "this is a context symbol, not a normal symbol". All of the following methods are Ok:


Code Select

(context 'Foo)     ; 1
(set 'Foo:bar)      ; 2
(define Foo:bar)  ; 3
(define (Foo:bar x y) ....) ; 4


the 1 might be dangerous because it also switches to Foo, which we only want when writing modules.



2 and 3 are actually exactly the same thing, but using (define Foo:bar) doesn't need the quote and it also shows better our intention, which is "define"ing something.



4 is defining the symbol right away as a function as as used in our program.



All of the above establish Foo as a context symbol when newLISP reads in the code and parses/translates it.

Lutz
Title:
Post by: Dmi on October 24, 2007, 12:36:00 PM
Wow!



I like it!
Title: Re: A simple minimal OO system for newLISP
Post by: Fanda on October 24, 2007, 01:05:40 PM
Quote from: "Lutz"In a similar fashion 'rectangle:move' and 'circle:move' could be defined.


I believe that at this moment, we cannot define these methods, because macro ':' doesn't allow for any additional parameters. Also any set-x,y,width,height,radius methods cannot be created.



Also, any access to inner attributes has to be done using indexing. We cannot use x, y, width, p1, p2 or other symbols as attribute names. For example, line defined as:
Code Select
(line (point x y) (point x y))
will have line:length for example defined as:
Code Select
(define (line:length l)
  (sqrt (apply add (map pow (map sub (rest (l 1)) (rest (l 2)))))))

Because of this we cannot change position of attributes in an object list and we always have to add new attributes at the end, so that there is a bigger chance that we don't break existing functionality.



Fanda
Title:
Post by: m i c h a e l on October 24, 2007, 01:33:47 PM
Need to map a polymorphic function over a list of objects? Use curry:


Code Select
> ; Note: The following uses the ':' macro.
(define (point:point (x 0) (y 0)) (list point x y))
(lambda ((x 0) (y 0)) (list point x y))
(define (point:print pt) (string (pt 1) "@" (pt 2)))
(lambda (pt) (string (pt 1) "@" (pt 2)))
> (map (curry :print) (map point '(23 54 76 34) '(43 76 34 23)))
23@43
54@76
76@34
34@23
("23@43" "54@76" "76@34" "34@23")
> ; now for some polymorphism . . .
> (define (pixel:print px) (println (string "x" (px 1) ":y" (px 2))))
(lambda (px) (println (string "x" (px 1) ":y" (px 2))))
> (map (curry :print) '((point 23 54) (pixel 76 34) (point 43 76) (pixel 34 23)))
23@54
x76:y34
43@76
x34:y23
("23@54" "x76:y34" "43@76" "x34:y23")
> _


:-)



m i c h a e l
Title:
Post by: Fanda on October 24, 2007, 02:36:24 PM
This version allows for more parameters:
Code Select
(define-macro (: _func _obj)
   (let (_data (eval _obj))
      (apply (sym _func (_data 0)) (cons _data (args)))))


But... I am still having problems with "setters" (methods). Can anyone implement circle:set-xy or circle:set-radius???
Title:
Post by: Lutz on October 24, 2007, 06:33:36 PM
setters are not possible this way when using the : macro, its pure functional. But you could do the following:


Code Select
(set 'mypoint (:move mypoint 3 4))


Lutz



ps: thanks for adding the missing additional parameters
Title:
Post by: m i c h a e l on October 24, 2007, 07:58:02 PM
Based on Lutz's last response, I've rewritten the Elica example in the FOO (functional object-oriented) style. Before I could get it to work, though, I needed to modify the : macro:


Code Select
(define-macro (: _func _obj)
(let (_data (eval _obj))
(apply (sym _func (_data 0)) (cons _data (map eval (args))))
)
)


Code Select
(load "colon.lsp") ; this contains the ':' macro

;; D I S P L A Y A B L E
(define (displayable:string obj) (string obj))
(define (displayable:print obj) (println ((context (obj 0) 'string) obj) ""))

;; P O I N T
(new displayable 'point)
(define (point:point (x 0) (y 0)) (list point x y))
(define (point:string pt) (string (pt 1) "@" (pt 2)))
(define (point:move pt dx dy) (point (+ dx (pt 1)) (+ dy (pt 2))))
(define (point:oper op ags)
  (cons point (apply map (cons op (map (fn (e) (1 e)) ags))))
)
(define (point:+) (point:oper + (args)))
(define (point:-) (point:oper - (args)))
(define (point:*) (point:oper * (args)))

;; S E G M E N T
(new displayable 'segment)
(define (segment:segment (a (point)) (b (point))) (list segment a b))
(define (segment:string sg) (string (:string (sg 1)) " to " (:string (sg 2))))
(define (segment:move sg ax ay bx by)
  (list segment (:move (sg 1) ax ay) (:move (sg 2) bx by))
)

;; T R I A N G L E
(new displayable 'triangle)
(define (triangle:triangle (ab (segment)) (bc (segment)) (ca (segment)))
  (list triangle ab bc ca)
)
(define (triangle:string tr)
  (string (:string (tr 1)) ", " (:string (tr 2)) ", " (:string (tr 3)))
)
(define (triangle:move tr sg ax ay bx by)
  (set-nth sg tr (:move (tr sg) ax ay bx by))
)

;; S A M P L E   R U N
(:print (set 'a (point)))
(:print (set 'b (point 20 0)))
(:print (set 'c (point 10 5)))
(:print (set 'tri (triangle (segment a b) (segment b c) (segment c a))))

(println "Move 'bc' segment of 'tri' by (30 5) (20 10):")
(set 'tri (:move tri 2 30 5 20 10))
(:print tri)

(println "Point addition, subtraction, and multiplication:")
(:print (point:+ a b c))
(:print (point:- a b c))
(:print (point:* (point 2 43) (point 22 1) c))

;; E N D


Here's the output:


Code Select
0@0
20@0
10@5
0@0 to 20@0, 20@0 to 10@5, 10@5 to 0@0
Move 'bc' segment of 'tri' by (30 5) (20 10):
0@0 to 20@0, 50@5 to 30@15, 10@5 to 0@0
Point addition, subtraction, and multiplication:
30@5
-30@-5
440@215


m i c h a e l
Title:
Post by: Lutz on October 25, 2007, 07:03:01 AM
I finished implementing the colon : macro natively and it runs your point/segment/triangle and polymorphism example code with identical results :-)



Lutz
Title:
Post by: cormullion on October 25, 2007, 09:09:50 AM
A few questions from someone struggling to keep up ... :)



When i try to run your example, michael, I get this error:


Code Select
string expected in function context : 'MAIN:string
called from user defined function point:print

which is:


Code Select

(define (displayable:print obj)  (println ((context (obj 0) 'string) obj) ""))


I suppose?



What is the 'displayable' here, anyway? Some kind of abstract class, I expect?



And can
Code Select
(:print tri) be read as "applying the method :print to the 'tri' object, which is an instance of class 'triangle', which was created by
Code Select
(set 'tri (triangle (segment a b)...".... (or something similar)?
Title:
Post by: m i c h a e l on October 25, 2007, 10:44:32 AM
Hi Cormullion!



I wondered when you were going to join the party ;-)



I'm not sure why you are getting that error. I re-ran my local copy and even copied it again from the above post (in case it was a formatting issue), and neither produced any errors. Lutz also seems to be able to run it correctly.



Wait! I bet you're using an earlier version of newLISP (before symbols were allowed in context), so changing the following:


Code Select
(define (displayable:print obj)  (println ((context (obj 0) 'string) obj) ""))


to


Code Select
(define (displayable:print obj)  (println ((context (obj 0) "string") obj) ""))


should fix it.


Quote from: "Cormullion"What is the 'displayable' here, anyway? Some kind of abstract class, I expect?


I'm using it as a mixin. What this is saying is: A point, segment, and triangle are displayable. (Really, I was just too lazy to write a print method for each data type ;-)


Quote from: "Cormullion"And can (:print tri) be read as "applying the method :print to the 'tri' object, which is an instance of class 'triangle',


Yes, but to be a little more exact, I would say "polymorphically apply the print method to the triangle object referenced by the symbol tri." Polymorphic is just a fancy word for objects responding to messages according to their type. Notice that :print actually ended up calling point:print. print is really just the first argument to :, which resolves the call by extracting the type from the object (the first element).



Feel free to pick my brain!



m i c h a e l
Title:
Post by: m i c h a e l on October 25, 2007, 11:13:21 AM
Here's a complex example ;-)


Code Select
(load "colon.lsp") ; soon, this won't be necessary ;-)

(define (complex:complex (r 0) (i 0)) (list complex r i))
(define (complex:rad c)
(set 're (c 1) 'im (c 2))
(sqrt (add (mul re re) (mul im im)))
)
(define (complex:theta c) (atan (div (c 1) (c 2))))
(define (complex:add a b) (complex (add (a 1) (b 1)) (add (a 2) (b 2))))
(define (complex:mul a b)
(set
'a.re (a 1) 'a.im (a 2)
'b.re (b 1) 'b.im (b 2)
)
(complex
(sub (mul a.re b.re) (mul a.im b.im))
(add (mul a.re b.im) (mul a.im b.re))
)
)
(define (complex:square c) (:mul c c))


Here is an example of use:


Code Select
> (set 'c1 (complex 34.2 54.2))
(complex 34.2 54.2)
> (set 'c2 (complex 19.8 73.9))
(complex 19.8 73.9)
> (:add c1 c2)
(complex 54 128.1)
> (:mul c1 c2)
(complex -3328.22 3600.54)
> (:rad c1)
64.08806441
> (:theta c1)
0.5628996527
> (:square c2)
(complex -5069.17 2926.44)
> _


I have no idea if I'm using these complex numbers correctly or not :-)



complex still needs sub and div methods, but I've already been distracted by wanting to model the soda-dispensing machine from my Booch book!



m i c h a e l
Title:
Post by: cormullion on October 25, 2007, 11:16:28 AM
Aha - I'm using 9.2.3 - I'd forgotten I was one step behind. You get used to it.



I've been at this party since it started - but I'm just hanging around near the drinks table being inconspicuous, rather than dancing naked in the middle of the room...



I'll read up about mixins, see if it makes more sense.



Currently ':print tri' feels slightly backwards - but that might change as I think about it some more.



Thanks for the explanations...!
Title:
Post by: newdep on October 25, 2007, 01:52:19 PM
This OO issue smells like fresh baked cookies... ;-)







..Cant wait to eat them ;-)
Title:
Post by: m i c h a e l on October 25, 2007, 03:44:27 PM
Quote from: "Cormullion"Currently ':print tri' feels slightly backwards - but that might change as I think about it some more.


Think of it as leaving off the context so the specific method can be determined dynamically. We have point:print, segment:print, and triangle:print. When we leave off the context, as in (:print some-obj), the : macro determines which method to call for us, based on the object passed as the second argument (remember, print is the first argument, even though there is no space between the : and print). If you know for sure an object will always be of a certain type, you can (and should?) call the method directly: (point:print a-point), for example. You only need polymorphism when you are unsure of the type of the object beforehand or you have a list of objects of differing types, each having a method defined with the same name (print in this case).


Quote from: "Cormullion"I'll read up about mixins, see if it makes more sense.


Mixins are just another form of inheritance, used in languages that have only single, rather than multiple inheritance. Ruby uses mixins, for example. Think of them as abilities that can be mixed into objects in various combinations. In my example, I want to give the objects the ability to display themselves, so I mix in displayable. Now any object with this mixed in can display itself and can even override displayable's string method to display itself in an object-sepecific way (as I did with point, segment, and triangle).


Quote from: "Cormullion"I've been at this party since it started - but I'm just hanging around near the drinks table being inconspicuous, rather than dancing naked in the middle of the room...


:-) You'll warn us before you get the urge, won't you, Cormullion? There may be children present!



m i c h a e l
Title:
Post by: m i c h a e l on October 25, 2007, 03:45:59 PM
The following is dedicated to Norman ;-)


Code Select
newLISP v.9.2.4 on OSX UTF-8, execute 'newlisp -h' for more info.

> (define (box:box (contents '()) (design "Plain brown box")) (list box contents design))
(lambda ((contents '()) (design "Plain brown box")) (list box contents
  design))
> (define (cereal:cereal (substance "corn") (kind "flakes")) (list cereal substance kind))
(lambda ((substance "corn") (kind "flakes")) (list cereal substance
  kind))
> (define (bowl:bowl (contents '()) (kind "cereal")) (list bowl contents kind))
(lambda ((contents '()) (kind "cereal")) (list bowl contents kind))
> (define (spoon:spoon (material "silver") (kind "soup")) (list spoon material kind))
(lambda ((material "silver") (kind "soup")) (list spoon material
  kind))
> (define (put obj place) ((place 0) (cons obj (place 1)) (place 2)))
(lambda (obj place) ((place 0) (cons obj (place 1)) (place 2)))
> (put (spoon) (bowl))
(bowl ((spoon "silver" "soup")) "cereal")
> (define (table:table (top '()) (kind "kitchen")) (list table top kind))
(lambda ((top '()) (kind "kitchen")) (list table top kind))
> (put (spoon) (table))
(table ((spoon "silver" "soup")) "kitchen")
> (define (pour container location) ((location 0) (cons (container 1) (location 1)) (location 2)))
(lambda (container location) ((location 0) (cons (container 1) (location
    1))
  (location 2)))
> (pour (box (cereal)) (bowl))
(bowl ((cereal "corn" "flakes")) "cereal")
> (put (spoon) (pour (box (cereal)) (bowl)))
(bowl ((spoon "silver" "soup") (cereal "corn" "flakes")) "cereal")
> (put (put (spoon) (pour (box (cereal)) (bowl))) (table))
(table ((bowl ((spoon "silver" "soup") (cereal "corn" "flakes"))
   "cereal")) "kitchen")
> (define (bottle:bottle (contents '()) (kind "glass")) (list bottle contents kind))
(lambda ((contents '()) (kind "glass")) (list bottle contents kind))
> (define (milk:milk (from "cow") (kind "2%")) (list milk from kind))
(lambda ((from "cow") (kind "2%")) (list milk from kind))
> (bottle (milk))
(bottle (milk "cow" "2%") "glass")
> (put (pour (bottle (milk)) (put (spoon) (pour (box (cereal)) (bowl)))) (table))
(table ((bowl ((milk "cow" "2%") (spoon "silver" "soup") (cereal
     "corn" "flakes")) "cereal")) "kitchen")
> ;; Breakfast is ready!
> _


I told you I think in objects ;-)



m i c h a e l
Title:
Post by: m i c h a e l on October 25, 2007, 10:32:24 PM
This should make you a mixin expert, Cormullion! (said with tongue firmly in cheek)



(//%3C/s%3E%3CURL%20url=%22http://www.neglook.com/images/mixins.png%22%3Ehttp://www.neglook.com/images/mixins.png%3C/URL%3E%3Ce%3E)



If you think of mixins as rubber stamps, it's like we're stamping simpler contexts onto progressively more complex ones. Notice that we only define the first five. The rest are mixed in (using new) from these initial five contexts. Now imagine if, instead of the letters A through E, each context contained a number of functions and symbols. You can see that a very complex context can be made from a few simpler ones. Also, any changes made to C1 are reflected in C6 through C14 (the DRY* principle).



m i c h a e l



* Don't Repeat Yourself
Title:
Post by: cormullion on October 26, 2007, 12:24:16 AM
Quote from: "m i c h a e l"Here's a complex example ;-)


I'm starting to get it!



As any bricoleur knows, the best way to serve complex numbers is with a bit of almond bread:


Code Select
(define (draw)
  (for (y -1 1.1 0.07)
      (for (x -2 1 0.03)
         (set 'z (complex x y) 'c 126 'a z )
         (while (and (< (abs (:rad (set 'z (:add (:mul z z) a)))) 2) (> (dec 'c) 32))
           )
         (print (char c))
      )
  (println)))

(draw)

~~~~~~~~~~~~~~~~~}}}}}}}}}}}}}}}}}}}}}}}}}}}||||||||||{{{{zzywqvwumz{|||||||}}}}}}}}~~~~~~~~~~~~~~~~~
~~~~~~~~~~~~~~~}}}}}}}}}}}}}}}}}}}}}}}}}}||||||||||||{{{{zyyxwuftwxyz{{||||||||}}}}}}}~~~~~~~~~~~~~~~
~~~~~~~~~~~~}}}}}}}}}}}}}}}}}}}}}}}}}}||||||||||||{{{{{zzvtmspT Nsuuxz{{{{|||||||}}}}}}}}~~~~~~~~~~~~
~~~~~~~~~~}}}}}}}}}}}}}}}}}}}}}}}}}}|||||||||||{{{zzzzzyxwtl      Itwyzz{{{{{{||||}}}}}}}}}~~~~~~~~~~
~~~~~~~~}}}}}}}}}}}}}}}}}}}}}}}}}||||||||||{{{zyyyyyyyyxwvt       ftwxxyzzzzzzz{{|||}}}}}}}}}~~~~~~~~
~~~~~~~}}}}}}}}}}}}}}}}}}}}}}}||||||||{{{{{zzywpfptvvrYll^G B     cLjdsdnwxxxxury{{||}}}}}}}}}~~~~~~~
~~~~~}}}}}}}}}}}}}}}}}}}}}}|||||{{{{{{{{{zzzyywul   h                   dasY#genvz{{||}}}}}}}}}}~~~~~
~~~~}}}}}}}}}}}}}}}}}}}||||{{{{{{{{{{{{zzzzyxvvtpd                             vyz{{|||}}}}}}}}}}~~~~
~~~}}}}}}}}}}}}}}}||||{zyzzzzzz{{{zzzzzyyyxvK                                 qwxyz{{|||}}}}}}}}}}~~~
~~}}}}}}}}}||||||||{{{zzwsxxyyyxvuxyyyyyxxwkm                                  /Sqwz{|||}}}}}}}}}}}~~
~~}}}}||||||||||{{{{{zzyxvtbNqttriSspvwwwvtf                                    qwyz{||||}}}}}}}}}}~~
~}}}||||||||||{{{{{{zyyyxwto         SP`sso                                      ey{{||||}}}}}}}}}}}~
~}|||||||||{{{{{{{zwxxwwuo              Yn^                                     sxz{{|||||}}}}}}}}}}~
~||||||||{zzzzzyyyxwujqopT                                                      xz{{{|||||}}}}}}}}}}~
~{{yzzxvevwxvvwwvsssf                                                        swxyz{{{|||||}}}}}}}}}}~
~{{{zzzywyyyzyxxxuvtrk   T                                                    8xyz{{{|||||}}}}}}}}}}~
~|||||||||{{zzzzzyyxWuuts^               e                                     Hvyz{{|||||}}}}}}}}}}~
~}}|||||||||{{{{{{{zyyyxespK            oqV                                     qwz{{||||}}}}}}}}}}}~
~}}}}||||||||||{{{{{{zyyxwumJ k.Q Y /oquutre                                    swyz{||||}}}}}}}}}}}~
~~}}}}}}|||||||||{{{{zzywmttsvwvdevvuwxwwwup                                     nmz{||||}}}}}}}}}}~~
~~~}}}}}}}}}}}||||||{{zzwtxyyyyyyyyyyyyyyxxvslH                                twwvz{|||}}}}}}}}}}~~~
~~~~}}}}}}}}}}}}}}}}}|||{{{{{{{{{{{{{zzzzyyskhem                             puwyzz{{||}}}}}}}}}}~~~~
~~~~~}}}}}}}}}}}}}}}}}}}}||||{{{{{{{{{{{zzzzyxwtm                         f   iuxz{{||}}}}}}}}}}~~~~~
~~~~~~}}}}}}}}}}}}}}}}}}}}}}|||||||{{{{{{{zzzykpG _lrX                 quvsgtsrsz{||}}}}}}}}}}~~~~~~
~~~~~~~}}}}}}}}}}}}}}}}}}}}}}}}||||||||||{{{zy[vmpvwwwtsutspS     pstvvjwyyyyyxtz{||}}}}}}}}}}~~~~~~~
~~~~~~~~~}}}}}}}}}}}}}}}}}}}}}}}}}|||||||||||{{{zzzzzyyyxwp       Dnwxyzzzz{{{{{|||}}}}}}}}}~~~~~~~~~
~~~~~~~~~~~}}}}}}}}}}}}}}}}}}}}}}}}}}||||||||||||{{{zzzyxwtJ&    domuyz{{{{{||||||}}}}}}}}~~~~~~~~~~~
~~~~~~~~~~~~~}}}}}}}}}}}}}}}}}}}}}}}}}}}|||||||||||{{{{{zyxwvpG ntxxz{{{{|||||||}}}}}}}}~~~~~~~~~~~~~
~~~~~~~~~~~~~~~~}}}}}}}}}}}}}}}}}}}}}}}}}}}||||||||||{{{{{zyxwumqvxzz{||||||||}}}}}}}~~~~~~~~~~~~~~~~
~~~~~~~~~~~~~~~~~~~}}}}}}}}}}}}}}}}}}}}}}}}}}}|||||||||{{{{zypuxyywz|||||||}}}}}}}~~~~~~~~~~~~~~~~~~~
~~~~~~~~~~~~~~~~~~~~~~}}}}}}}}}}}}}}}}}}}}}}}}}}}}|||||||{{ymwy{{{||||||}}}}}}}~~~~~~~~~~~~~~~~~~~~~~
Title:
Post by: cormullion on October 26, 2007, 01:14:20 AM
(and I'm studying the rest of your posts...!)
Title:
Post by: newdep on October 26, 2007, 07:41:44 AM
(while (michael does coding)

 (apply (cormullion (dansfloor $idx))

  (catch (lutz) newrelease)

   (unify 'Fanda 'OO)

    (silent newdep))





Fantastic example of objects Michael, I like it..so does the gui display ;-)



...A very nice Bread out of the oven Cormullion.. ;-)





realy great examples...
Title:
Post by: m i c h a e l on October 26, 2007, 07:49:54 AM
Quote from: "Cormullion"As any bricoleur knows, the best way to serve complex numbers is with a bit of almond bread:


Supercool. And on my favorite kind of bread, too: Fractal's Mandelbread ;-)



m i c h a e l
Title:
Post by: m i c h a e l on October 26, 2007, 08:45:36 AM
Quote from: "Norman"(while (michael does coding)

(apply (cormullion (dansfloor $idx))

(catch (lutz) newrelease)

(unify 'Fanda 'OO)

(silent newdep))


LOL :-)


Quote from: "Norman"Fantastic example of objects Michael, I like it..so does the gui display ;-)


Thank you! Even though the example was just for fun, I think is shows the potential for doing FOOP in newLISP.



m i c h a e l



P.S. I've been meaning to compliment you on all your great GS programs, Norman, but I'm forever getting distracted by other things and I forget to. So, thanks for all the cool Gags :-)
Title:
Post by: m i c h a e l on October 26, 2007, 04:46:08 PM
I've updated the shapes code.



What's changed: Made the shape's move methods more sensible (moves the whole shape) and used point's + method to implement its move method. Also changed the name of point's oper method (terrible name) to apply. Changed all the methods to use non-polymorphic calls (I kept them in the reorganized sample run, though). Changed the code to be purely functional (no more state changes).



If Lutz finds an implementation of object references he likes, even keeping state won't be a problem.


Code Select
(load "colon.lsp") ; this contains the ':' macro

;; D I S P L A Y A B L E
(define (displayable:string obj) (string obj))
(define (displayable:print obj) (println ((context (obj 0) 'string) obj) ""))

;; P O I N T
(new displayable 'point)
(define (point:point (x 0) (y 0)) (list point x y))
(define (point:string pt) (string (pt 1) "@" (pt 2)))
(define (point:move pt dx dy) (point:+ pt (point dx dy)))
(define (point:+) (point:apply + (args)))
(define (point:-) (point:apply - (args)))
(define (point:*) (point:apply * (args)))
(define (point:apply op ags)
(cons point (apply map (cons op (map (fn (e) (1 e)) ags))))
)

;; S E G M E N T
(new displayable 'segment)
(define (segment:segment (a (point)) (b (point))) (list segment a b))
(define (segment:string sg)
(string (point:string (sg 1)) " to " (point:string (sg 2)))
)
(define (segment:move sg dx dy)
(segment (point:move (sg 1) dx dy) (point:move (sg 2) dx dy))
)

;; T R I A N G L E
(new displayable 'triangle)
(define (triangle:triangle (ab (segment)) (bc (segment)) (ca (segment)))
(list triangle ab bc ca)
)
(define (triangle:string tr)
(string
(segment:string (tr 1)) ", "
(segment:string (tr 2)) ", "
(segment:string (tr 3))
)
)
(define (triangle:move tr dx dy)
(triangle
(segment:move (tr 1) dx dy)
(segment:move (tr 2) dx dy)
(segment:move (tr 3) dx dy)
)
)

;; S A M P L E   R U N
(println "nMaking three points:")
(:print (set 'a (point)))
(:print (set 'b (point 20 0)))
(:print (set 'c (point 10 5)))

(println "nPoint addition, subtraction, and multiplication:")
(:print (point:+ a b c))
(:print (point:- a b c))
(:print (point:* (point 2 43) '(point 22 1) c))

(println "nMaking a triangle:")
(:print (set 'tri (triangle (segment a b) (segment b c) (segment c a))))

(println "nMove the triangle by delta (30 5):")
(:print (set 'tri (:move tri 30 5)))

(println)

;; E N D


The output:


Code Select

Making three points:
0@0
20@0
10@5

Point addition, subtraction, and multiplication:
30@5
-30@-5
440@215

Making a triangle:
0@0 to 20@0, 20@0 to 10@5, 10@5 to 0@0

Move the triangle by delta (30 5):
30@5 to 50@5, 50@5 to 40@10, 40@10 to 30@5



m i c h a e l
Title:
Post by: Lutz on October 27, 2007, 09:24:39 AM
I think we pretty much nailed it with (1) FOOP based on the colon : operator for polymorphism, (2) objects represented as lists, whose first element is the class they belong too, and (3) classes represented by contexts/namespaces (4) using the default functor of a class-context to hold the object constructor. Even without some mechanism for object references, FOOP is very useful as a simple OO system for newLISP.



Code written this way is almost as speed-efficient as non FOOP code. The overhead required by the colon : function for resolution of context (taken from the object) is minimal.



Michaels code from above is a good reference example to show how it works. The meanwhile the built in colon : operator (to be released in development version 9.2.5) runs all of Michaels FOOP code identical to the hand-written macro.



Perhaps Michael can add his mapping/polymorphism example, he showed earlier, to this example code. It shows that there is no problem of currying and mapping FOOP functions on to a list of objects of different type. The example code could be added to the distribution as it shows all critical elements of FOOP.



The chapter about contexts and OO programming in newLISP will be completely rewritten introducing the colon : operator.



Perhaps somebody would like to write the "Introduction to FOOP" ?



Lutz
Title:
Post by: cormullion on October 27, 2007, 09:36:08 AM
Quote from: "Lutz"
Perhaps somebody would like to write the "Introduction to FOOP" ?


I would certainly like to read it... :-)
Title:
Post by: m i c h a e l on October 27, 2007, 04:31:06 PM
I've been working through the examples in my beloved Booch book, attempting to better understand FOOP. My shift to objects free of side effects was unintended and happened quite naturally. Yes, it requires a different way of thinking about the proper way to do OOP. But considering the failure of OO to live up to its early promises, maybe the time has come to rethink OOP in light of FP. FOOP feels like the best of both worlds.



 I've already grown quite comfortable coding this way and think it fits naturally with newLISP's functional style. I'd still like generated accessors, but doing straight indexing isn't as bad as I thought. Other than that, I'm really happy programming FOOly :-)



I hope to post the latest example (an automatic gardener for a hydroponics farm) as soon as I can stop obsessing over constructing objects completely of objects (ie., no naked numbers, strings, lists, etc.). This  allows keyword-like functionality within methods, as well as being a self-describing data structure.



m i c h a e l



P.S. If no one has any objections, I volunteer myself for FOOP introduction duty ;-)
Title:
Post by: m i c h a e l on October 29, 2007, 01:16:37 PM
Quote from: "Lutz"The overhead required by the colon : function for resolution of context (taken from the object) is minimal.


For what I thought were reasons of efficiency, I added the contexts to all of the methods in the shapes code (the objects weren't used polymorphicly, anyway). Was this unnecessary?




Quote from: "Lutz"Perhaps Michael can add his mapping/polymorphism example, he showed earlier, to this example code.


Okay :-)




Quote from: "Lutz"The example code could be added to the distribution as it shows all critical elements of FOOP.


Oh no. Now the pressure's on ;-)



m i c h a e l
Title:
Post by: m i c h a e l on October 29, 2007, 01:56:16 PM
Here's some more pretend code, where new accepts any number of contexts:


Code Select
(define foo:who)
(define bar:boo)
(define baz:zoo)
(new foo bar baz 'boo)
(symbols boo) ;=> (boo:boo boo:who boo:zoo)
(context 'moo)
(new foo bar baz)
(context MAIN)
(symbols moo) ;=> (moo:boo moo:who moo:zoo)


Instead, it could be a new function (say, mixin)?


Code Select
(define foo:who)
(define bar:boo)
(define baz:zoo)
(mixin foo bar baz 'boo)
(symbols boo) ;=> (boo:boo boo:who boo:zoo)


Or even:


Code Select
(mixin 'boo foo bar baz)


m i c h a e l
Title:
Post by: Fanda on November 05, 2007, 12:34:04 PM
Quote from: "m i c h a e l"This should make you a mixin expert, Cormullion!



(example and graph representation here)



If you think of mixins as rubber stamps, it's like we're stamping simpler contexts onto progressively more complex ones...


I like graph representation, so for anybody, who likes to play with graphs, you can use yEd - Java™ Graph Editor:

http://www.yworks.com/en/products_yed_about.htm

from yWorks:

http://www.yworks.com/en/index.html



After installation see Help - Example Graphs.



Have fun, Fanda



PS: There is also http://www.graphviz.org/  ;-)
Title:
Post by: m i c h a e l on November 06, 2007, 08:51:28 AM
Fanda,



Thanks for pointing out this cool diagramming program! I've already downloaded yEd and am looking forward to seeing what I can do with it.



m i c h a e l



P.S. Graphviz is cool, too, but I already have that one ;-)
Title:
Post by: kinghajj on November 07, 2007, 11:36:58 PM
Looking at Michael's code, I noticed that there are many redundancies with making classes. How about a macro to define classes?


Code Select
;; D I S P L A Y A B L E
(define-class (displayable)
   (define (string)
      (string self))
   (define (print)
      (println (:string self))))

;; P O I N T
(define-class (point (x 0) (y 0))
   (inherits displayable)
   (define (string)
      (string (:x self) "@" (:y self)))
   (define (move dx dy)
      (point:+ self (point dx dy)))
   (define (+) (point:apply + (args)))
   (define (-) (point:apply - (args)))
   (define (*) (point:apply * (args)))
   (define (apply op ags)
      (cons point (apply map (cons op (map (fn (e) (1 e)) ags))))))

;; S E G M E N T
(define-class (segment (a (point)) (b (point)))
   (inherits displayable)
   (define (string)
      (string (:string (:a self)) " to " (:string (:b self))))
   (define (move dx dy)
      (segment (:move (:a self) dx dy) (:move (:b self) dx dy))))

;; T R I A N G L E
(define-class (triangle (ab (segment)) (bc (segment)) (ca (segment)))
   (inherits displayable)
   (define (string)
      (string
         (:string (:ab self)) ", "
         (:string (:bc self)) ", "
         (:string (:ca self))))
   (define (move dx dy)
      (triangle
         (:move (:ab self) dx dy)
         (:move (:bc self) dx dy)
         (:move (:ca self) dx dy))))


As you can see, in my idea, all methods take an implicit "self" argument, and getters/setters for all object variables are automatically defined. There is also a simple way to specify inheritance.



I've begun work on a macro to do this, but it might take me a while. Perhaps this macro could be done better in the C API.
Title:
Post by: kinghajj on November 08, 2007, 09:01:49 PM
OK, Here's the code to my "define-class" macro. 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. However, because newLISP encourages this sort of style, maybe it will stay this way.


Code Select

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; define-class.nlsp
;; by Samuel Fredrickson <kinghajj>
;; Version 0.1, 2007-11-08
;;
;; This "macro" (it's really an entire context) lets newLISP programmers write
;; classes in an easier way. The classes and objects produced by this class
;; follow the standard set in
;; http://www.alh.net/newlisp/phpbb/viewtopic.php?t=1955 by Lutz, and uses some
;; techniques by Michael in that same thread.

; The object-colon macro, by Lutz and Michael. This might become a builtin macro
; in the next version of newLISP, and this will be removed if that happens.
(define-macro (: _func _obj)
(let (_data (eval _obj))
(apply (sym _func (_data 0)) (cons _data (map eval (args))))))

(context 'define-class)

; In Michael's example of "FOOP", he uses defaults in constructor arguments so
; that objects can be created without specifying any arguments. Because that is
; valid newLISP code and has good uses, this function takes the variable names
; and their defaults and extracts just the variable names.
(define (extract-class-vars vars)
(map
(lambda (var)
(if (list? var)
(first var)
(if (symbol? var)
item)))
vars))

; Tests if a list is a method.
(define (method? meth?)
(or
(= (first meth?) 'define)
(= (first meth?) 'define-macro)))

; Extracts methdods from a list.
(define (extract-methods lst)
(filter method? lst))

; Tests if a list specifies a superclass.
(define (inherits? inh?)
(= (sym (first inh?)) 'inherits))

; Returns the name of the superclass.
(define (extract-superclass lst)
((filter inherits? lst) 0 1))

; Fills in missing parts of a method.
(define (mess-up-method method)
(letn
((method-type (first method))
(method-name (sym (method 1 0) class-name))
(method-args (cons method-name (1 (method 1))))
(method-body (2 method)))
(cons method-type (cons method-args method-body))))

; Creates the class context and its constructor.
(define (construct-class)
(let
((constructor-name (cons (sym class-name class-name) class-vars-plain)))
(if class-superclass
(new class-superclass class-name)
(context class-name))
(eval
(list
'define
constructor-name
(cons 'list (cons class-name class-vars))))))

; Creates a getter/setter function for a variable.
(define (create-getter-setter var idx)
(let
((getter-setter-name (sym var class-name)))
(set getter-setter-name
(expand
'(lambda-macro (self value)
(if (setq value (eval value))
(set-nth idx (eval self) value)
((eval self) idx))) 'idx))))

; This is the meat of the macro.
(define-macro (define-class:define-class init)
(letn
((clargs (args))
(class-name (init 0))
(class-superclass (extract-superclass clargs))
(class-vars-plain (1 init))
(class-vars (extract-class-vars class-vars-plain))
(class-methods (map mess-up-method (extract-methods clargs))))
(construct-class)
(map eval class-methods)
(dolist (var class-vars)
(create-getter-setter var (+ $idx 1)))))


Here is an example usage, based on Michael's code. The main difference between this and the idea I posted yesterday is that methods here do not implicitly take self, so it must be specified, a la Python.


Code Select

;; Example usage of define-class, based on code by Michael.
(load "define-class.nlsp")

(define-class (displayable)
(define (string self)
(string self))
(define (print self)
(println (:string self))))

(define-class (point (x 0) (y 0))
(inherits displayable)
(define (string self)
(string "(" (:x self) ", " (:y self) ")"))
(define (move self dx dy)
(point:+ self (point dx dy)))
(define (+) (point:apply + (args)))
(define (-) (point:apply - (args)))
(define (*) (point:apply * (args)))
(define (apply op ags)
(cons point (apply map (cons op (map (fn (e) (1 e)) ags))))))

(define-class (segment (a (point)) (b (point)))
(inherits displayable)
(define (string self)
(string (:string (:a self)) " to " (:string (:b self))))
(define (move self dx dy)
(segment (:move (:a self) dx dy) (:move (:b self) dx dy))))

(define-class (triangle (ab (segment)) (bc (segment)) (ca (segment)))
(inherits displayable)
(define (string self)
(string
(:string (:ab self)) ", "
(:string (:bc self)) ", "
(:string (:ca self))))
(define (move self dx dy)
(triangle
(:move (:ab self) dx dy)
(:move (:bc self) dx dy)
(:move (:ca self) dx dy))))

(println "nMaking three points:")
(:print (set 'a (point)))
(:print (set 'b (point 20 0)))
(:print (set 'c (point 10 5)))

(println "nPoint addition, subtraction, and multiplication:")
(:print (point:+ a b c))
(:print (point:- a b c))
(:print (point:* (point 2 43) '(point 22 1) c))

(println "nMaking a triangle:")
(:print (set 'tri (triangle (segment a b) (segment b c) (segment c a))))

(println "nMove the triangle by delta (30 5):")
(:print (set 'tri (:move tri 30 5)))

(println)
Title:
Post by: m i c h a e l on November 10, 2007, 08:14:27 AM
Quote from: "Samuel"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
;; 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
(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
;; 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
Title:
Post by: cormullion on November 10, 2007, 09:12:32 AM
I'm voting for you (//http), michael ! :-)
Title:
Post by: m i c h a e l on November 10, 2007, 09:39:39 AM
Quote from: "Cormullion"I'm voting for you, michael ! :-)


Wow, thank you! I didn't even know this could be entered. But it still doesn't hold a candle to your regex GS program :-)



m i c h a e l



P.S. Now we're officialy members of the MAS (Mutual Admiration Society ;-)
Title:
Post by: kinghajj on November 10, 2007, 04:14:47 PM
I made some improvements to my define-class module.



  • -The functions documented with newlispdoc.

    -Instead of "inherits", the keyword is now "mixin" or "mixins".

    -Each class can now mixin more than one other class.



//http://kinghajj.home.comcast.net/define-class.tar.bz2
Title:
Post by: m i c h a e l on November 28, 2007, 08:45:45 PM
I keep forgetting to post this diagram of the shapes code, so . . . I'm doing it now :-)



(//%3C/s%3E%3CURL%20url=%22http://www.neglook.com/images/shapes.png%22%3Ehttp://www.neglook.com/images/shapes.png%3C/URL%3E%3Ce%3E)



m i c h a e l



P.S. I made this using the graph editor Fanda mentioned above (yEd).
Title:
Post by: newdep on November 30, 2007, 01:14:04 AM
Michael, your visualisations are a real enlightment.. I like that extra

dimension to a language or theory..especialy when the design is

simple, straight forward and direct.. nice!





Meanwhile I already bought a ticket for the movie premiere of  "FOOP". ;-)
Text only | Text with Images