;;;; utils.lisp -- some random utils I collect. might be useful, probably won't be.

(if (boundp '*-utils-lisp*) "Already loaded" (progn

;;; --- internally maintained config, don't put anything above these!!

(defparameter *-utils-lisp* t)
(defparameter *-utils-depends* '(#:cl-ppcre))

(defparameter *-utils-version* "0.0.2")

;;; -- Handle internal exporting --

(defmacro insystem? (thing &optional (else nil))
  `(if (boundp '*-utils-system*)
     ,thing
     ,else))

(defmacro export? (val)
  `(if (boundp '*-utils-system*)
     (export ',val)
     nil))

(defmacro export* (&rest syms) 
  `(mapc #'export '(,@syms)))

(defmacro export*! (&rest syms) 
  `(mapc #'export (list ,@syms)))

(export? export*)
(export? export*!)

(defmacro export*? (&rest val)
  `(insystem? (export*! ,@val) (progn ,@val)))

(defun file-get-contents (filename)
  (with-open-file (stream filename)
    (let ((contents (make-string (file-length stream))))
      (read-sequence contents stream)
      contents)))
(export? file-get-contents)

(defun utils->system (input output &key (name :utils) (description "Some random utilities") (author "Ringo <flanchan@cumallover.me>") (license "None"))
  "Write this file to an ASDF system."
  (let ((this (cadddr (read-from-string (file-get-contents input))))
	(sysdef `(asdf:defsystem ,name
				 :description ,description
				 :author ,author
				 :license ,license
				 :version ,*-utils-version*
				 :serial t
				 :depends-on ,*-utils-depends*
				 :components ((:file ,(car (last (cl-ppcre:split "/" output))))))))
    (rplaca this `(defpackage ,name (:use #:cl)))
    (rplaca (cdr this) `(in-package ,name))
    (rplaca (cddr this) '(defparameter *-utils-system* t))
    (with-open-file (output-lisp (concatenate 'string output ".lisp") :direction :output :if-exists :supersede)
      (with-open-file (output-asd (concatenate 'string output ".asd") :direction :output :if-exists :supersede)
	(mapc #'(lambda (stmt) (write stmt :stream output-lisp)) this)
	(write sysdef :stream output-asd :case :downcase )))))

(export*?

;;; --- actual (exported) code goes here ---

(defmacro popto (li val &key (test #'eql))
  "pop() list <li> until (car li) is equal to <val>, return elements pop()ed in new list"
  `(loop while (not (funcall ,test (car ,li) ,val))
	 collect (pop ,li)))

(defmacro popn (li n)
  "pop() list <li> <n> times, return elements pop()ed in a new list."
  (if (numberp n)
    (list 'let '((tmp 'nil))
	  (apply #'list 'progn
		 (loop for x from 1 to n
		       collect `(setf tmp (cons (pop ,li) tmp))))
	  '(reverse tmp))
    `(loop for x from 1 to ,n collect (pop ,li))))

(defun make-paged-vector (blocksize &key (element-type 'integer))
  "Vector that increases size in blocks"
  (list (make-array blocksize :element-type element-type :fill-pointer 0 :adjustable t) blocksize 0 1))

(defun paged-vector<-size (vec) (caddr vec))
(defun paged-vector<-blocksize (vec) (cadr vec))
(defun paged-vector<-blocks (vec) (cadddr vec))

(defmacro paged-vector->push (vec elem)
  "add <elem> to end, extending if needed"
  `(if (>= (1+ (mod (paged-vector<-size ,vec) (paged-vector<-blocksize ,vec))) (paged-vector<-blocksize ,vec))
     (progn 
       (adjust-array (car ,vec)
		  (* (1+ (paged-vector<-blocks ,vec))
		     (paged-vector<-blocksize ,vec)))
       (incf (cadddr ,vec))
       (incf (caddr ,vec))
       (vector-push ,elem (car ,vec))
       ,vec)
     (progn (incf (caddr ,vec)) (vector-push ,elem (car ,vec)) ,vec)))

(defun make-paged-vector-s (elements blocksize)
  "make-paged-vector with default elements"
  (let ((out (make-paged-vector blocksize)))
    (mapc #'(lambda (x) (paged-vector->push out x)) elements) out))

(defmacro paged-vector<- (vec) `(car ,vec))

) ;; -- end export

(mapc #'fmakunbound '(insystem? export? export*?))

)) ;; -- end guard