LARCS/manipulation.org_archive

#    -*- mode: org -*-


Archived entries from file /home/swflint/Projects/lisp-cas/manipulation.org


* WORKING Rewrite Rules [0/5]
:PROPERTIES:
:CREATED:  <2016-04-30 Sat 22:58>
:ARCHIVE_TIME: 2016-05-04 Wed 19:03
:ARCHIVE_FILE: ~/Projects/lisp-cas/manipulation.org
:ARCHIVE_CATEGORY: manipulation
:ARCHIVE_TODO: WORKING
:END:

Foo

** TODO Match Expressions
:PROPERTIES:
:CREATED:  <2016-05-01 Sun 16:26>
:END:

Foo

#+Caption: Match Expressions
#+Name: match-expressions
#+BEGIN_SRC lisp
  (defun generate-match-expression (on arity &optional (type '=))
    (check-type on symbol)
    (check-type type (member = > >=))
    (check-type arity (integer 0))
    (case type
      (=
       `(and (eq function ',on)
           (= arg-count ,arity)))
      (>
       `(and (eq function ',on)
           (> arg-count ,arity)))
      (>=
       `(and (eq function ',on)
           (>= arg-count ,arity)))))
#+END_SRC

** TODO Define Rule
:PROPERTIES:
:CREATED:  <2016-04-30 Sat 23:07>
:END:

Foo

#+Caption: Define Rule
#+Name: define-rule
#+BEGIN_SRC lisp
  (defmacro defrule (name (on arity &optional (type '=)) (&rest arguments) &body expansion)
    (let ((match-expression (generate-match-expression on arity type))
          (test-name (symbolicate name '-test))
          (expansion-name (symbolicate name '-expansion)))

      `(progn
         (defun ,test-name (function &rest arguments &aux (arg-count (length arguments)))
           ,match-expression)
         (defun ,expansion-name (,@arguments)
           ,@expansion)
         (setf (aget *rules* ',name)
               (make-rule :name ',name
                          :test-function #',test-name
                          :expansion-function #',expansion-name))
         ',name)))
#+END_SRC

** TODO Rule Storage
:PROPERTIES:
:CREATED:  <2016-04-30 Sat 23:07>
:END:

Foo

#+Caption: Rule Storage
#+Name: rule-storage
#+BEGIN_SRC lisp
  (defstruct (rule (:type list))
    name test-function expansion-function)

  (defvar *rules* '())
#+END_SRC

** TODO Rule Retrieval
:PROPERTIES:
:CREATED:  <2016-04-30 Sat 23:07>
:END:

Foo

** TODO Rule Application
:PROPERTIES:
:CREATED:  <2016-04-30 Sat 23:08>
:END:

Foo