order.lisp

(defun eltstr->sexp (eltstr base-expr)
  (loop :with x := base-expr
     :with gensym := (gensym)
     :for i :in (mapcar #'(lambda (x) (mapcar (lambda (x) (or (= (length x) 0)
                                                    (parse-integer x))) (split-sequence:split-sequence #\_ x)))
                        (split-sequence:split-sequence #\/ eltstr))
     :do (setq x (cond ((eql (length i) 1)
                        (if (minusp (first i))
                            `(let ((,gensym ,x))
                               (nth (+ (length ,gensym) ,(first i)) ,gensym))
                            `(nth ,(first i) ,x)))
                       ((eql (length i) 2)
                        (if (or (minusp (first i))
                                (and (not (eql t (second i)))
                                     (minusp (second i))))
                            `(let ((,gensym ,x))
                               (subseq ,gensym
                                       ,(if (minusp (first i))
                                            `(+ (length ,gensym) ,(first i))
                                            (first i))
                                       ,(unless (eql t (second i))
                                                (if (minusp (second i))
                                                    `(+ (length ,gensym) ,(second i))
                                                    (second i)))))
                            `(subseq ,x
                                     ,(first i)
                                     ,(unless (eql t (second i))
                                              (second i)))))))
     :finally (return x)))

(defmacro order (base elt &rest not-single)
  (let ((base% (gensym))
        (list (cons elt not-single)))
    (labels ((f (lis &optional apply)
               (loop
                  :with name
                  :with at
                  :for j :on lis
                  :for i := (first j)
                  :collect (cond
                             ((keywordp i)
                              (setq name (symbol-name i))
                              (cond
                                ((not (find-if (complement #'(lambda (x) (or (digit-char-p x)
                                                                        (member x `(#\/ #\- #\_))))) name))
                                 (eltstr->sexp name base%))
                                ((and (= (length name) 1)
                                      (char= (aref name 0) #\@))
                                 (setf at t
                                       j (cdr j)
                                       i (progn (first j)
                                                `(:@ apply 'append ,(f (list (first j)))))))
                                (t i)))
                             ((listp i)
                              (cond
                                ((eql (first i) 'quote) i)
                                ((eql (ignore-errors (caar i)) 'function)
                                 `(apply ,(car i) ,(f (cdr i) t)))
                                (t (f i))))
                             (t i)) :into result
                  :finally (return (cons (if at 'append 'list)
                                         (mapcar (if at
                                                     #'(lambda (x)
                                                         (if (and (listp x)
                                                                  (eql (first x) :@))
                                                             (rest x)
                                                             `(list ,x)))
                                                     #'identity)
                                                 result))))))
      `(let ((,base% ,base))
         ,(funcall (if not-single #'identity #'second) (f list))))))

#+nil
(order '(1 (2 (3))) :1/1/0) ;; == (first (second (second x)))

#+nil
(let ((x '(1 2 3 4 5 6 7 8 9 10 11)))
  (order x 'a :@(#'list :0 :@ :2_) :@ (:1_3) (:@ :-1_) 7 :hage)) ;; == `(a ,@(append (apply  #'list (first x) (subseq x 2))) (,@(subseq x 1 3)) (,@ (subseq x (- (length x) 1))) 7 :hage)