This project seems related to the topic at hand.
http://tehran.lain.pl/git.web/function-template
The timing is suspicious.
struct example_node {
typedef int element_t; /* The element type */
element_t& getelem() {...} /* getter */
const element_t& getelem() const {...}
example_node* left(const example_node& nd) const {...} /* How to get to the left node */
example_node* right(const example_node& nd) const {...} /* How to get to the right node */
example_node* parent(const example_node& nd) const {...} /* How to get to the parent node */
enum {has_size = true}; /* Tells whether the node can hold a size value */
size_t size; /* Will hold the number of elements in the subtree determined by the node */
size_t getsize(const example_node& nd) const {...}
};
struct int_less_than {
typedef int element_t; /* The type of the elements */
bool less(const element_t& x, const element_t& y) const {return x < y;} /* The ordering */
};
struct my_rbtree {
typedef example_node node_t; /* The node to manipulate */
typedef int_less_than order_t; /* The ordering */
enum {left = true}; /* Whether to keep track of the leftmost node for getting the min element in O(1) */
enum {right = false}; /* Same for right node */
};
template<typename E> typename E::t gcd(const typename E::t& a, const typename E::t& b) {...}
void gcd(void* result, const void* a, const void* b, bool (*is_zero)(const void*), void (*mod)(void*, const void*, const void*)) {...}
; sorry for possible n00b mistakes
(defstruct euclidean-domain zero? mod)
(defun runtime-gcd (E a b) ...)
; uses (euclidean-domain-zero? E) (euclidean-domain-mod E)
(define-euclidean-domain ed-of-integers zerop mod)
slowcoder wrote:Sorry again for the delay, unquestionably I am not getting mail. I will begin to poll the forum for now on.
slowcoder wrote:It obviously need to be present in the interactive environment, but is there a way for me to remove it in non-interactive mode? It seems to me that your code is just like what I want, but I am unsure whether I have removed every trace of compile-time computation from runtime.
slowcoder wrote:Ok, so now I am writing an example of typical usage of templates in C++.
slowcoder wrote:The code will have some procedures, one of which will be insert, which will insert an element in the tree. insert will in turn call a procedure named insert_fixup, which will mantain the red-black properties, and that one will call both left_rotate and right_rotate, which will do single rotations.
The big point is that insert strongly depends on the ordering of the elements but insert_fixup and the rotations do not. Thus, separting the structures (which will be fed as template arguments to the procedure) allows us to reuse the compiled code for insert_fixup for a tree that sorts ints in increasing and decreasing order, reducing code bloat.
slowcoder wrote:One more example. Suppose we want to compute the gcd of two elements of some euclidean domain. One way would be C++:
slowcoder wrote:In Lisp, we can only hope for doing something like this:
(defgeneric general-zero-p (object))
(defgeneric general-mod (a b))
(defun general-gcd (a b)
;; code using (general-zero-p a/b) and (general-mod a b)
)
;; example for integers
;; in Common Lisp there is a builtin class for integers already
(defmethod general-zero-p ((a integer))
(zerop a))
(defmethod general-mod ((a integer) (b integer))
(mod a b))
slowcoder wrote:#0. Express an algorithm generically over algebraic structures.
slowcoder wrote:#1. Define the structures for runtime or compile-time (or both) with uniform syntax.
slowcoder wrote:#2. Instatiate the algorithms for compile-time/runtime based on my decision with a similar syntax.
slowcoder wrote:#3. Know that the system will instantiate specialized code on demand.
slowcoder wrote:#4. Know that code will be shared as needed.
(defparameter *algorithm-cache* (make-hash-table :test 'equal))
(defun runtime-general-algorithm (template-arguments &rest algorithm-arguments)
(declare (ignore template-arguments algorithm-arguments))
(print :runtime))
(defun construct-algorithm (template-arguments)
(cond ((equal template-arguments '(:spec1))
'(lambda ()
(print :spec1)))))
(defun get-or-construct-algorithm (template-arguments)
(let ((cache (gethash template-arguments *algorithm-cache*)))
(if cache
cache
(let ((algorithm (construct-algorithm template-arguments)))
(if algorithm
(setf (gethash template-arguments *algorithm-cache*) (compile nil algorithm))
#'(lambda ()
(runtime-general-algorithm template-arguments)))))))
(defmacro general-algorithm ((&rest template-arguments) &rest algorithm-arguments)
`(funcall (load-time-value (get-or-construct-algorithm ',template-arguments)) ,@algorithm-arguments))
(defun test-algorithm-cache ()
(general-algorithm (:spec1))
(general-algorithm (:runtime)))
(let ((rbt (make-red-black-tree :test #'< :key-type 'fixnum)))
(insert rbt 2)
(insert rbt 3)
...
rbt)
(defclass red-black-tree ()
((test :initarg :test :accessor red-black-tree-test)
(element-type :initarg :element-type :accessor red-black-tree-element-type)
... ; other relevant fields
))
(defun make-red-black-tree (&rest fiels)
(apply #'make-instance 'red-black-tree fields))
(defvar *red-black-tree-classes* (make-hash-table :test #'equal))
(defun function-form-p (arg)
(and (consp fun)
(member (car fun) '(quote function))
(symbolp (second arg))
(not (cddr arg))))
(defun quoted-argument-p (arg)
(and (consp fun)
(eq (car fun) quote)
(not (cddr arg))))
(defun get-red-black-tree-class (test element-type)
(let ((key (list test element-type)))
(or (gethash key *red-black-tree-classes*)
(let ((class (closer-mop:ensure-class
(gensym) :superclasses (list (find-class 'red-black-tree))
;; other possible fields here (like slots)
)))
(setup-red-black-tree-class class test* element-type*)
(setf (gethash key *red-black-tree-classes*)
class)))))
(define-compiler-macro make-red-black-tree (&rest fiels &key test element-type &allow-other-keys)
(let* ((test* (and (function-form-p test) (second test)))
(element-type* (and (quoted-argument-p element-type) (second element-type)))
(class (get-red-black-tree-class test* element-type*)))
`(make-instance ',class ,@fields)))
(defvar *red-black-tree-insert-function* (make-hash-table :test #'eq))
(defun setup-red-black-tree-class (class test element-type)
(let ((specialized-function (generate-insert-function test element-type)))
(push (list class specialized-function)
(gethash *package* *red-black-tree-insert-function*))
;; define specialized-function to be a method of the generic function %insert
;; specialized to the class here
))
(defgeneric %insert ...
;; create a generic version of the function insert here
)
(defun insert (tree elt)
(%insert tree elt))
(define-compiler-macro insert (tree elt)
(let ((alist (gethash *package* *red-black-tree-insert-function*)))
`(once-only (tree elt)
(typecase ,tree
,@(loop for (class function) in alist
collect `(,class (funcall ,function ,tree ,elt)))
(t (%insert ,tree ,elt))))))
(let ((rbt ...))
(declare (type #.(get-red-black-tree-class :test '< :element-type 'fixnum) rbt))
...)
(deftype tree-<-fixnum ()
(get-red-black-tree-class :test '< :element-type 'fixnum))
(let ((rbt ...))
(declare (type tree-<-fixnum rbt))
...)
Ramarren wrote:I have also thought of another way, although it is questionable how good an idea that is. It is always possible to move to a more C-like compilation model. Although lack of direct compiler support for this would require having to compile everything twice, first collecting templates instantiations substituting them with stubs, generating and compiling code for templates removing duplicates, and then recompile everything substituting invocations properly. This is perhaps the technically simplest (not saying it would be easy, since there are probably any number of edge cases I haven't thought of) way of fulfilling all of slowcoders conditions, with the main problem being having to create a custom build system, since ASDF is not going to like it. The stubs would probably also annoy the type inferencer, but that is either ignorable or solvable.
gugamilare wrote:Instead of compiling twice, what about creating a code walker? There is even a library for code walking cl-walker, which is based on Arnesi's code walker. Using Arnesi's code walker to change CL to a Lisp-1 syntax was easy enough (and, wow, cl-walker even accesses portably the lexical environment!). A code walker would be the best, it would allow to associate the compile-time structures to the variables and to change the functions to whatever code / function call you want, but it would also be more extensive and require more work.
In the RB tree example, you would need to create a specialized syntax for every kind of ordering (#'<, #'>, #'whatever), which, I agree, is not ideal. Correct me if I am wrong, but the compile-time structures you were talking about is information about the variables being used, right? Suppose that this is John's code:
Users browsing this forum: No registered users and 1 guest