Implementing OOP within AutoLisp

[doaiena]

Hello all,

I thought about implementing some sort of object oriented features within AutoLisp, similar to other OOP languages. As a proof of concept i wrote a few lines of code, but i'm stuck now.

My initial idea was to create a "custom object" withing AutoLisp and have the ability GET/SET its properties, in a similar way to VisualLisp objects.

I wrote a simple constructor for the object and a getter and setter, to read/write the object's properties. The getter works fine, but i can't get the setter function to work as i want it to.

For purposes of demonstration i've prepared a person object to illustrate my point:

(defun NewPerson (name gender heigt weight occupation)
  (list	(cons "NAME" name)
	(cons "GENDER" gender)
	(cons "HEIGHT" heigt)
	(cons "WEIGHT" weight)
	(cons "OCCUPATION" occupation)
  )
) ;defun

(defun Get (obj prop)
  (cdr (assoc (vl-symbol-name prop) obj))
) ;defun

(defun Put (obj prop val)
  (if (assoc (vl-symbol-name prop) obj)
    (subst (cons (vl-symbol-name prop) val) (assoc (vl-symbol-name prop) obj) obj)
    (append obj (list (cons (vl-symbol-name prop) val)))
  )
) ;defun

I can create a new person object using:

_$ (setq person1 (NewPerson "Bill" "Male" 191 98 "Car Dealer"))
(("NAME" . "Bill") ("GENDER" . "Male") ("HEIGHT" . 191) ("WEIGHT" . 98) ("OCCUPATION" . "Car Dealer"))

I can get a property using:

_$ (get person1 'height)
191

And here comes my question. I want to be able to write (put person1 'height 185) and save the property within the person1 object.

The only way i can get it to work is to write (setq person1 (put person1 'height 185) ).

Is it possible to retrieve the variable name of an agrument that is supplied to a function. I want to be able to get the symbol name of the variable person1, without writing it as a quoted symbol: (put 'person1 'height 185).

In other words, is it possible to find out within my PUT function, that (obj = person1), without supplying person1 as a quoted symbol.

This is a proof of concept i want to show to a friend, who told me "Lisp is a functional programming language that is inferior to the modern object oriented programming languages."

I want to show him that Lisp is much more powerfull as a programming language, than many people think, but i want my demo to be perfect.

Im aiming for this syntax:

(get person1 'height)

(put person1 'height 185)

[Satish_Rajdev]

I don't think there is a way to do it without using quote but you can overwrite variable in Put function itself as shown below :

(defun Put (obj prop val)
  (set obj
       (if (assoc (vl-symbol-name prop) (eval obj))
	 (subst	(cons (vl-symbol-name prop) val)
		(assoc (vl-symbol-name prop) (eval obj))
		(eval obj)
	 )
	 (append (eval obj) (list (cons (vl-symbol-name prop) val)))
       )
  )
)

Example:

_$ (put 'person1 'HEIGHT 185)
(("NAME" . "Bill") ("GENDER" . "Male") ("HEIGHT" . 185) ("WEIGHT" . 98) ("OCCUPATION" . "Car Dealer"))
_$ person1
(("NAME" . "Bill") ("GENDER" . "Male") ("HEIGHT" . 185) ("WEIGHT" . 98) ("OCCUPATION" . "Car Dealer"))

_$ (put (quote person1) 'HEIGHT 185)
(("NAME" . "Bill") ("GENDER" . "Male") ("HEIGHT" . 185) ("WEIGHT" . 98) ("OCCUPATION" . "Car Dealer"))
_$ person1
(("NAME" . "Bill") ("GENDER" . "Male") ("HEIGHT" . 185) ("WEIGHT" . 98) ("OCCUPATION" . "Car Dealer"))

Alternate method, You can use variable as string as well if required (but I don't find this much useful):

(defun Put (obj prop val)
  (set (read obj)
       (if (assoc (vl-symbol-name prop) (eval (read obj)))
	 (subst	(cons (vl-symbol-name prop) val)
		(assoc (vl-symbol-name prop) (eval (read obj)))
		(eval (read obj))
	 )
	 (append (eval (read obj))
		 (list (cons (vl-symbol-name prop) val))
	 )
       )
  )
)

_$ (put "person1" 'HEIGHT 185)
(("NAME" . "Bill") ("GENDER" . "Male") ("HEIGHT" . 185) ("WEIGHT" . 98) ("OCCUPATION" . "Car Dealer"))
_$ person1
(("NAME" . "Bill") ("GENDER" . "Male") ("HEIGHT" . 185) ("WEIGHT" . 98) ("OCCUPATION" . "Car Dealer"))

[martti.halminen · Accepted solution]

Unless you have access to the compiler internals, i.e. work at Autodesk, there is no built-in way to get back to the variable from its value. The function call receives just the evaluated value, which is just a single memory address.

- You could do that if all your own tools maintain a reverse lookup table (another association list, in practice) where you could connect the value back to a reference to the object.

- another way would be to have the symbol used to access the object also as the value of a slot in the object, put there by the function that creates the object.

Your handling of association lists is extremely inefficient. There is no need to use SUBST, just cons the new value in front of the list. Using APPEND is also senseless, use CONS here, too.

- for very long-lived lists you may need to do some garbage collection, dropping all but the first occurrence of a key occasionally.

The problem with this approach is that AutoLISP/Visual Lisp is extremely crippled compared to full-size Lisps, so most of the tools that make building an OOP system on top of Lisp quite feasible do not exist in AutoLISP outside the compiler internals.

Reini Urban did some serious work last century trying to implement the missing stuff on top of AutoLISP, some of his work can still be found with Google, probably even more with some web archive sites.

 Full-size Lisp, these days Common Lisp, has much better tools for building new language features. It already also has an extremely powerful OOP system, CLOS.

http://www.aiai.ed.ac.uk/~jeff/clos-guide.html

https://en.wikipedia.org/wiki/Common_Lisp_Object_System

https://www.cs.northwestern.edu/academics/courses/325/readings/clos.php

https://www.quora.com/Why-is-Common-Lisp-Object-System-CLOS-considered-so-powerful-How-does-it-compa...

So, if you just wanted to do OOP in Lisp with AutoCAD, it would be easier to build the parts of your application using OOP in Common Lisp, and have it communicate with AutoLISP (or just AutoCAD with ActiveX, if you can withstand the problems (and have one of the commercial CL implementations that have ActiveX)).

-- 

[doaiena]

Thank you for all your input @martti.halminen. This was a quick and dirty experiment to check whether such an approach is possible at all within AutoLisp. Efficiency was the last thing on my mind. I am interested in all the trickery and non standard approaches to coding within AutoLisp.

[serag.hassouna]

Check out this other proof of concept for the implementation of the concept of encapsulation in OOP.

;|
Author: Serag Hassouna
Purpose: Implementation example of the concept of encapsulation from the OOP paradigm.
Design Idea: 1- Define a class object, this object stores the initialization values of the attributes (aka. properties)
and the methods' definitions.
2- Allow instanciation of objects, the object should mainly know how to retrieve its relevant class object.
Instances should store the minimal amount of data, i.e store only the modified values from the initialized ones.

The list of data stored in the class object is as follows
(properies_list methods_list)
properties_list: ((property_name . property_value) ..) [A list of association lists of properties]
methods_list: ((method_name method_value_as_USUBR) ..) [A list of association list of methods]

The list of data stored in the instance object is as follows
(class_symbol mod_only_props)
class_symbol: the symbol of the instance's parent class
mod_only_props: a list of the modified only properties and their values
note that when the object is instanciated, its data list is in the form "(class_symbol)" [hence, its length = 1]
|;

;|
[1]function: def_class_person: a class function that returns a list consisting of:
1- A list of properties and their initialized values
2- A list of defined methods
|;
(defun def_class_person 
;VARIABLES
(
name
height
hair_color
/
proplist ;list of properties
methods ;list of defined methods
put_enc ;"put" method encapsulated
get_enc ;"get" method encapsulated
)
;[1] set the "VALUE" of property list
(setq proplist (list (cons "NAME" name) (cons "HEIGHT" height) (cons "HAIR COLOR" hair_color) (cons "CLASS" "PERSON")))
;notice that the class name is assigned as an attribute.
;[2] define "put" and "get" methods
(setq put_enc
       ;|[1] method: put: this function sets the value of any attribute to the assigned object
       |;
  (defun put (obj_symbol propname propval / obj_vals cls_proplist obj_proplist ret)
    (setq obj_vals (eval obj_symbol))
    (setq cls_proplist (car (eval (car obj_vals)))) ;the list of all class properties
    (if
      (member (assoc propname cls_proplist) cls_proplist);truth condition, check the property existance within the class object
      (if
	(= (length obj_vals) 1) ;truth condition, check if there's no modified property yet
	(set obj_symbol (list (car obj_vals) (list (cons propname propval))))
	(progn
	  (setq obj_proplist (cadr obj_vals))
	  (if
	    (member (assoc propname obj_proplist) obj_proplist);truth condition, check the "modified" property existance within the instance object
	    (set obj_symbol (list (car obj_vals) (subst (cons propname propval) (assoc propname obj_proplist) obj_proplist)));the property has been modified
	    (set obj_symbol (list (car obj_vals) (append obj_proplist (list (cons propname propval)))));the property isn't modified yet
	    );if
	);else part [progn contains another if statement]
	);then part [the property exists within the class object]
      (progn
	(princ "\nError: The property isn't defined in the instance's class.\n")
	(setq ret "not")
	);else part, progn [the property doesn't exist within the class object]
      );if
    
    (if
      (eq ret "not")
      (setq ret nil)
      (setq ret propval)
      );if [what the function returns]
  );defun put
);setq of put_enc

(setq get_enc
       ;|[2] method: get: returns the property value
       |;
  (defun get (obj_symbol propname / obj_vals cls_proplist obj_proplist ret)
    (setq obj_vals (eval obj_symbol))
    (setq cls_proplist (car (eval (car obj_vals)))) ;the list of all class properties
    (if
      (member (assoc propname cls_proplist) cls_proplist);truth condition, check the property existance within the class object
      (if
	(= (length obj_vals) 1) ;truth condition, check if there's no modified property yet
	(setq ret (cdr (assoc propname cls_proplist)))
	(progn
	  (setq obj_proplist (cadr obj_vals))
	  (setq ret (member (assoc propname obj_proplist) obj_proplist))
	  (if
	    ret;truth condition, check the "modified" property existance within the instance object
	    (setq ret (cdr (assoc propname obj_proplist)));the property has been modified
	    (setq ret (cdr (assoc propname cls_proplist)));the property isn't modified yet
	    );if
	);else part [progn contains another if statement]
	);then part [the property exists within the class object]
      (princ "\nError: The property isn't defined in the instance's class.\n");else part [the property doesn't exist within the class object]
      );if
    ret
  );defun get
);setq get_enc

(setq methods (list (cons "PUT" put_enc) (cons "GET" get_enc)))
;[3] return the class list of properties and defined methods
(list proplist methods)
);defun class_person

;|[2] function: instanciate: a function to instanciate the object of class "PERSON"
notice: this function is implemented in a naive way
Because the defined methods [PUT & GET] in this proof of concept are primarily for the editing and retrieval of instances' properties,
the feature of supplying the intended values at the same time of instanciation is omitted.
|;
(defun instanciate (obj_symbol ;the quoted instance symbol
		    cls_symbol ;the quoted class symbol
		    )
  (set obj_symbol (list cls_symbol))
  );defun instanciate

;[3] function: apply_method: a function to apply a method for a specified instance
(defun apply_method (
		     obj_symbol ;the quoted symbol of the instance object
		     method_name
		     arglist ;arguments list
		     /
		     cls_methods ;association list of class methods
		     method ;the method
		     )
  (setq cls_methods (cadr (eval (car (eval obj_symbol)))))
  (if
    (member (assoc method_name cls_methods) cls_methods);truth condition, check if the method is defined within the class
    (apply (cdr (assoc method_name cls_methods)) (append (list obj_symbol) arglist));then part
    (princ "\nError: The method isn't defined within the instance's class.\n");else part
    );if
  );defun apply_method

;the main function
(defun main (/ $person_class samy hany)
  (setq $person_class (def_class_person "Somebody" 172 "Black")) ;define the class object

  (princ "\nCLASS DATA: ")
  (print $person_class)
  (princ "\n____________\n")

  (print ";Apply some operations on an instance called Samy")
  (instanciate 'samy '$person_class) ;instanciate a person instance
  (print samy)
  (apply_method 'samy "PUT" (list "HAIR COLOR" "Ginger"))
  (print samy)
  (apply_method 'samy "PUT" (list "HAIR COLOR" "Blonde"));notice: you can change property value for any number of times
  (print samy)
  (apply_method 'samy "PUT" (list "NAME" "Samy"))
  (print samy)

  (princ "\nNAME: ")
  (princ (apply_method 'samy "GET" '("NAME"))) ;NAME is modified
  (princ "\nHAIR COLOR: ")
  (princ (apply_method 'samy "GET" '("HAIR COLOR"))) ;HAIR COLOR is modified
  (princ "\nHEIGHT: ")
  (princ (apply_method 'samy "GET" '("HEIGHT"))) ;HEIGHT isn't modified
  (princ "\n____________\n")


  (print "Apply some operations on an instance called Hany")
  (instanciate 'hany '$person_class)
  (print hany)
  (apply_method 'hany "PUT" (list "HEIGHT" 165))
  (print hany)
  (apply_method 'hany "PUT" (list "NAME" "Hany"))
  (print hany)

  (princ "\nNAME: ")
  (princ (apply_method 'hany "GET" '("NAME"))) ;NAME is modified
  (princ "\nHAIR COLOR: ")
  (princ (apply_method 'hany "GET" '("HAIR COLOR"))) ;HAIR COLOR isn't modified
  (princ "\nHEIGHT: ")
  (princ (apply_method 'hany "GET" '("HEIGHT"))) ;HEIGHT is modified
  
  );defun main

(main)

..................
Now, what if we have multiple classes that need to take the same "method name"?
This means that for every class there must be different names for their relevant function definitions.

e.g. the part

("PUT" . PUT)

would be instead

("PUT" . PUT_PERSON)

[_gile]

Hi,

Just my 2 cents.

Beyond the difficulty (or impossibility) of implementing the fundamental concepts of OOP (inheritance, encapsulation, polymorphism) with AutoLISP and its probable inefficiency, I find this idea very curious at a time when the AutoCAD .NET API makes it possible to use a true robust OOP environment and where most OOP programming environments tend to add features from functional programming (LISP was the first functional programming language).

[Sea-Haven]

My $0.05 Xdata does what you want get property height is valid. Why reinvent the wheel.

Make a xdata library "Mystaff" and have the definitions you want for data then can do the search by the description you want.

[serag.hassouna]

Hi,
I think that trying to implement OOP concepts in AutoLISP is a good exercise on some features, namely:

1. Symbols: dealing with them by reference and by value.
   My previous code demonstrates the use of quoted symbols as a way to deal with symbols by reference, in the VLX namespace (or simply speaking, the main scope).
   However, I still wonder, how setq and defun are implemented, these are the kind of functions which @doaiena wants to use their feature of supplying the variable name without quoting it, do they have kind of special glasses to recognize the variables? 
2. Functions as First-Class Objects: This feature is built-in in python ,the beauty of this feature (as far as I know till now) is that it makes the function transcend its scope and enable its usage at any other function.
   Some days before, I've written a python script to demonstrate the use of this feature and how to deal with it into a method definition.

[_gile]

"Functions as First-Class Objects" is rather a functional programming feature than an OOP feature, and with (Auto)LISP, functions are first class objects.

You get anonymous functions (lambda).

You get built-in higher order functions which take functions as argument (apply, mapcar, ...).

You can build higher order functions which return a function:

(defun createAdder (x)
  ((lambda (z) (defun adder (y) (+ z y))) x)
  adder
)
;; (createadder 2) returns #<USUBR @0000000037c3c570 ADDER>
;; (adder 5) returns 7

You can assign a function to a variable

(setq sqr (lambda (x) (* x x))) 
;; (sqr 3) returns 9
(setq foo sqr) 
;; (foo 3) returns 9 
;; (= sqr foo) returns T

You can use lists of functions

(defun sqrt_parse (v)
  (foreach f (list atof abs sqrt)
    (setq v (f v))
  )
)
;; (sqrt_parse "-9") returns 3.0

If you enjoy functional and object oriented programming, you should have a look at F#.

[_gile]

Here's a better implementation for an example of a function returning function (closure)

(defun adder (n)
  (eval (list 'lambda '(x) (list '+ 'x n)))
)

((adder 2) 5) returns 7

Create a new function

(defun add2 (x) ((adder 2) x))

(add2 5) returns 7

Bind the closure to a symbol

(setq add3 (adder 3))

(add3 5) returns 8

Return a list of functions

(mapcar
  '(lambda (n)
     (set (read (strcat "add" (itoa n))) (adder n))
   )
  '(10 20 30)
)

(add10 5) returns 15

(add20 5) returns 25