From b27c3a5093a6731daaad0cdf7e07383246c7816b Mon Sep 17 00:00:00 2001
From: Ringo Watanabe <flanchan@cumallover.me>
Date: Sat, 26 Jan 2019 17:58:04 +0000
Subject: [PATCH] Added yield stuffs

---
 utils.lisp | 65 +++++++++++++++++++++++++++++++++++++++++++++++++-----
 1 file changed, 60 insertions(+), 5 deletions(-)

diff --git a/utils.lisp b/utils.lisp
index e62cdaa..65d978d 100644
--- a/utils.lisp
+++ b/utils.lisp
@@ -21,8 +21,11 @@
      (export ',val)
      nil))
 
-(defmacro export* (&rest syms) 
-  `(mapc #'export '(,@syms)))
+;(defmacro export* (&rest syms) 
+;  `(mapc #'export '(,@syms)))
+
+(defmacro export* (&rest syms)
+  (cons 'progn (mapcan #'(lambda (x) `((export ',x))) syms)))
 
 (defmacro eval-all (syms)
   `(mapcar #'eval '(,@syms)))
@@ -70,7 +73,7 @@
 	(mapc #'(lambda (stmt) (write stmt :stream output-lisp :pretty nil)) this)
 	(write sysdef :stream output-asd :case :downcase )))))
 
-(defun utils->create-for (utils for &key (name 'flan-utils) (package nil) ) ;;; TODO: Make this work /for structs/ at all
+(defun utils->create-for (utils for &key (name 'flan-utils) ) ;;; TODO: Make this work /for structs/ at all
   "Export `utils' functions used in file into own file"
   (let ((this (cadddr (read-from-string (file-get-contents utils))))
 	(for (read-from-string (file-get-contents for))))
@@ -212,10 +215,10 @@
 		   strs)
 	   0 -2))))
 
-(defun export-struct (struct &optional (symbols nil))
+(defun export-struct (struct &optional (symbols nil)) ;;XXX: Export make-*
   (mapc #'export (symbol-match (strcat "^" (write-to-string struct) "-?") symbols)))
 
-(defun -export*-struct (structs &optional (symbols nil))
+(defun -export*-struct (structs &optional (symbols nil)) ;;XXX: Export make-*
   (mapc #'export (symbol-match 
 		   (strcat
 		     "^("
@@ -235,6 +238,9 @@
 	  (flatten-top-level lists))
     ret))
 
+(defun cyclic (list)
+  (cdr (rplacd (last list) list)))
+
 (defun map1 (lam &rest lists)
   "Map and return first"
   (let ((ret '())
@@ -266,6 +272,8 @@
   (apply #'values
 	 (mapcar lam (flatten-top-level args))))
 
+(defmacro lexical-boundp (lex)
+  `(when (ignore-errors ,lex) t))
 ;; --- progressive evals
 
 (defmacro progen (&rest things)
@@ -283,8 +291,55 @@
 (defmacro progel (&rest things)
   `(mapcar #'eval '(,@things)))
 
+(defmacro yield-return (&rest things)
+  "Create yield block, returns list of push()ed outputs of yield() (so, last is first etc)"
+  `(let ((--yield-vars '()))
+     (declare (special --yield-vars))
+     ,@things
+     --yield-vars))
+
+(defmacro yield (value)
+   `(when (boundp '--yield-vars)
+     (push ,value --yield-vars)))
+
+(defparameter *yield-global-vars* '())
+
+(defmacro yield-return-global (name &rest things)
+  "Like yield-return but stores values by key in alist and is accessable outside of current lexenv"
+  `(car (yield-return
+     (push (cons ,name '()) *yield-global-vars*)
+     ,@things
+     (yield (cdr (assoc ,name *yield-global-vars*)))
+     (setf *yield-global-vars* (remove ,name *yield-global-vars* :key #'car :count 1)))))
+
+(defmacro yield-global (name value)
+  `(when (assoc ,name *yield-global-vars*)
+     (push ,value (cdr (assoc ,name *yield-global-vars*)))))
+
 ;; ---
 
+(defmacro push-unique (thing things &key (key nil) (test #'eql))
+  `(let ((lex-thing ,thing))
+     (if (member lex-thing ,things :key ,key :test ,test)
+       (values ,things nil)
+       (values (push lex-thing ,things) t))))
+
+(defmacro import* (&rest args)
+  (cons 'progn (mapcan #'(lambda (x) `((import ',x))) args)))
+
+(defmacro shadowing-import* (&rest args)
+  (cons 'progn (mapcan #'(lambda (x) `((shadowing-import ',x))) args)))
+
+(defmacro import*! (&rest args)
+  `(mapc #'import (progel ,args)))
+
+(defmacro shadowing-import*! (&rest args)
+  `(mapc #'shadowing-import (progel ,args)))
+
+(defmacro import*-from (package &rest args)
+  (let ((ret (mapcar #'(lambda (x) (read-from-string (strcat (subseq (write-to-string package) 1) ":" (write-to-string x)))) args)))
+    `(shadowing-import* @,ret)))
+
 (defun restrain-index (i max)
   (if nil
   (if (>= i max) (1- max)