s-expressionists/Khazern

Docs for extending

Opened this issue · 3 comments

phoe commented

Is there any documentation or pointers for extending this LOOP implementation? For instance, how would one start implementing a hypothetical hash-in iteration clause as shown below?

;;; proposed extension
CL-USER> (let ((hash-table (alexandria:plist-alist '(:a 1 :b 2 :c 3))))
           (loop for (key value) hash-in hash-table 
                 do (print (list key value))))

;;; ...equivalent to this standard CL
CL-USER> (let ((hash-table (alexandria:plist-hash-table '(:a 1 :b 2 :c 3))))
           (loop for key being the hash-key of hash-table using (hash-value value)
                 do (print (list key value))))

;;; ...results in this being printed
(:A 1) 
(:B 2) 
(:C 3) 

I'm gonna have to write documentation. There is a paper in the SICL repo, but it is 7 years old so it may not be of help.

In the interim I'll see if I can come up with an example.

I think there is a fair amount of work to do in making the "extensibility" accessible and well defined. Most of the functions and classes that are needed are not currently exported. Also the clause parser definitions are currently shared by the intrinsic and extrinsic interfaces. Therefore if a user adds a new clause like "hash-in" to the extrinsic LOOP it will also be added to the intrinsic interface. Right now this is probably not a problem, but if an implementation aside from SICL actually adopts Khazern as its own builtin LOOP it could become an issue.

I've included a clause extension for extensible sequences below as reference. I'll probably start exploring defining a good extension API on a separate branch.

(in-package #:khazern-sequence)

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;
;;; Clause FOR-AS-OVER

(defclass for-as-over (khazern::for-as-subclause khazern::var-and-type-spec-mixin)
  (;; This slot contains a copy of the tree contained in the VAR-SPEC
   ;; slot except that the non-NIL leaves have been replaced by
   ;; GENSYMs.
   (%temp-vars :initarg :temp-vars :reader temp-vars)
   ;; This slot contains a list of pairs.  Each pair is a CONS cell
   ;; where the CAR is a variable in VAR-SPEC and the CDR is the
   ;; corresponding variable in TEMP-VARS.
   (%dictionary :initarg :dictionary :reader dictionary)
   (%sequence-form :initarg :sequence-form :reader sequence-form)
   (%form-var :initform (gensym) :reader form-var)
   (%length-var :initform (gensym) :reader length-var)
   (%state-var :initform (gensym) :reader state-var)
   (%limit-var :initform (gensym) :reader limit-var)
   (%from-end-var :initform (gensym) :reader from-end-var)
   (%step-var :initform (gensym) :reader step-var)
   (%endp-var :initform (gensym) :reader endp-var)
   (%read-var :initform (gensym) :reader read-var)))

(defmethod initialize-instance :after
    ((clause for-as-over) &key &allow-other-keys)
  (multiple-value-bind (temp-vars dictionary)
      (khazern::fresh-variables (khazern::var-spec clause))
    (reinitialize-instance clause
                           :temp-vars temp-vars
                           :dictionary dictionary)))

;;; The FOR-AS-OVER clasue binds all the variables in the VAR-SPEC
;;; of the clause, so this method should return a list of all those
;;; variables.
(defmethod khazern::bound-variables ((clause for-as-over))
  (mapcar #'car
          (khazern::extract-variables (khazern::var-spec clause) nil)))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;
;;; Parser

(khazern::define-parser for-as-over-parser
  (khazern::consecutive (lambda (var type-spec across sequence-form)
                          (declare (ignore across))
                          (make-instance 'for-as-over
                                         :var-spec var
                                         :type-spec type-spec
                                         :sequence-form sequence-form))
                        'khazern::anything-parser
                        'khazern::optional-type-spec-parser
                        (khazern::keyword-parser 'over)
                        'khazern::anything-parser))

(khazern::add-for-as-subclause-parser 'for-as-over-parser)

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;
;;; Compute bindings.

(defmethod khazern::initial-bindings ((clause for-as-over))
  `((,(form-var clause) ,(sequence-form clause))
    ,(state-var clause)
    ,(from-end-var clause)
    ,(limit-var clause)
    ,(step-var clause)
    ,(endp-var clause)
    ,(read-var clause)
    ,(write-var clause)
    ,(index-var clause)))

(defmethod khazern::final-bindings ((clause for-as-over))
  `((,(length-var clause) (length ,(form-var clause)))
    ,@(mapcar (lambda (entry)
                `(,(car entry) nil))
              (dictionary clause))))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;
;;; Compute declarations.

(defmethod khazern::declarations ((clause for-as-over))
  (mapcar (lambda (entry)
            `(cl:type (or null ,(second entry)) ,(first entry)))
          (khazern::extract-variables (khazern::var-spec clause) (khazern::type-spec clause))))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;
;;; Compute prologue-form.

(defmethod khazern::prologue-form ((clause for-as-over) end-tag)
  `(progn (multiple-value-setq (,(state-var clause) ,(limit-var clause) ,(from-end-var clause)
                                ,(step-var clause) ,(endp-var clause) ,(read-var clause))
                               (sequence:make-sequence-iterator ,(form-var clause)))
          ,(khazern::termination-form clause end-tag)
          ,(khazern::generate-assignments (khazern::var-spec clause)
                                          `(funcall ,(read-var clause) ,(form-var clause)
                                                    ,(state-var clause)))
          (funcall ,(step-var clause) ,(form-var clause) ,(state-var clause) ,(from-end-var clause))))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;
;;; Compute termination-form

(defmethod khazern::termination-form ((clause for-as-over) end-tag)
  `(when (funcall ,(endp-var clause) ,(form-var clause) ,(state-var clause)
                  ,(limit-var clause) ,(from-end-var clause))
     (go ,end-tag)))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;
;;; Compute step-form.

(defmethod khazern::step-form ((clause for-as-over))
  `(progn ,(khazern::generate-assignments (khazern::var-spec clause)
                                          `(funcall ,(read-var clause) ,(form-var clause)
                                                    ,(state-var clause)))
          (setf ,(state-var clause)
                (funcall ,(step-var clause) ,(form-var clause)
                         ,(state-var clause) ,(from-end-var clause)))))

I'm still tweaking an initial attempt at defining an extension API, but it appears workable now. If you want to try it out it is here #4.

There is an extension included based on the sequence iterator protocol as above.

* (ql:quickload :khazern-sequence-intrinsic)
To load "khazern-sequence-intrinsic":
  Load 1 ASDF system:
    khazern-sequence-intrinsic
; Loading "khazern-sequence-intrinsic"
.
(:KHAZERN-SEQUENCE-INTRINSIC)
* (loop for i over #(a b c) collect i)
(A B C)
* (loop for i at j over #(a b c) collect (cons j i))
((0 . A) (1 . B) (2 . C))

When you define the clause parser you also define where that clause appears. Right now there are three extension points: body-clauses, selectable-clauses, and for-as-subclauses.

(khazern:define-parser for-as-over (:for-as-subclause)
(khazern:consecutive (lambda (var type-spec other-var across sequence-form)
(declare (ignore across))
(make-instance 'for-as-over
:var-spec var
:type-spec type-spec
:other-var other-var
:sequence-form sequence-form))
'khazern:anything
'khazern:optional-type-spec
(khazern:optional nil
(khazern:consecutive (lambda (at other-var)
(declare (ignore at))
other-var)
(khazern:keyword 'at)
'khazern:anything))
(khazern:keyword 'over)
'khazern:anything))