yaneu.lisp

できました。cl-ppcre つかったら一発だったりして。

(asdf:oos 'asdf:load-op 'cl-ppcre)

(defvar xoutput 'nil)
(defvar youtput 'nil)
(defvar all-output 'nil)
;(setf wq (string #\"))
;(setf wq (coerce wq 'string))
(defun |#%-reader| (stream sub-char numarg)
  (declare (ignore sub-char numarg))
  (let (chars)
    (do ((curr (read-char stream)
	       (read-char stream)))
      ((char= #\newline curr))
      (push curr chars))
    (let* ((pattern (nreverse chars))
	   (pointer pattern)
	   (start-pattern '(#\/ #\/ #\%))
	   (start-pointer start-pattern)
	   (all-output)
	   (output)
	   (flag)
	   (tmp-oneline)
	   (tmp-str))
      (do ((curr (read-char stream)
		 (read-char stream)))
	((null pointer))

	(push curr all-output)
	(if (char= #\' curr) (setf curr #\") nil)

	(if (char= #\newline curr)
	  (let ((oneline (coerce (nreverse tmp-oneline) 'string))
		sym)
	    (setf tmp-oneline 'nil)
	    (if (null start-pointer)
	      (progn
		(if tmp-str 
		  (push (string-concat " \"" tmp-str "\"") output))
		(setf tmp-str nil)
		;(push (string-concat "(write-comment \"" oneline "\")") output)
		(push (substring oneline 3) output))
	      (setf tmp-str (string-concat (if tmp-str tmp-str "") 
					   oneline 
					   (string #\newline))))
	    (setf start-pointer start-pattern))
	  (push curr tmp-oneline))

	(setf start-pointer
	      (cond ((null start-pointer) 'nil)
		    ((char= (car start-pointer) curr) (cdr start-pointer))
		    (t start-pattern)))

	(setf pointer
	      (if (char= (car pointer) curr)
		(cdr pointer)
		pattern))
	(if (null pointer)
	  (return)))
      ;-- end do
      (string-concat
	(string-concat
	  "(write-comment \""
	   (coerce (nreverse all-output) 'string)
	   "\")")
	(reduce #'string-concat (nreverse output)))
      )))

(set-dispatch-macro-character
  #\# #\% #'|#%-reader|)

(setf xoutput
#%//% END
//% (write
inline int x_A(x,y) { return x + y; }
inline int x_B(x,y) { return x + y*2; }
inline int x_C(x,y) { return x*2 + y; }

inline int y_A(x,y) { return x + y; }
inline int y_B(x,y) { return x + y*4; }
inline int y_C(x,y) { return x*4 + y; }
//% )
//% (let list 'x_A' 'x_B' 'x_C')
//% (let list2 'y_A' 'y_B' 'y_C')
//% (foreach e2 list2
//% (foreach e list ( write
//% (replace (replace
void function_XXX_YYY()
{
  for(int y = 0; y<10; ++y)
    for(int x = 0; x<10; ++x)
    {
      FUNC_XXX(x,y) * FUNC_YYY(x,y);
    }
}
//% 'XXX' e)
//% 'YYY' e2)
//% )))
//% END
)

(defun my-replace (str org_str rep_str) 
  (cl-ppcre:regex-replace-all org_str str rep_str))

(setf youtput (string-concat "(" xoutput ")"))
(setf yanae
      (with-input-from-string (s youtput)
	(read s)))


(defmacro my-let (var &rest rest)
  `(setf ,var (list ,@rest)))

(defun my-write (str)
  (princ str))

;(defun my-replace (str key word)
(defmacro old-my-foreach (iter ln &rest body)
  `(loop for ,iter in ,ln do ,@body))

(defmacro my-x (iter ln body)
  `(list ,iter ,ln ,body))

;(my-foreach e2 '("abc" "def")

(defmacro my-foreach (iter ln &rest body)
  `(loop for ,iter in ,ln do ,@body))

(defun my-replace-list (str o_str ln)
  (mapcar (lambda (v-str) (my-replace str o_str v-str)) 
	  ln))

(defun xj ()
  (my-foreach e2 '("abc" "def")
	      (my-foreach e '("xyz" "qrs")
			  (my-write
			    (list
			      (my-replace 
				(my-replace "ooAAAoo ooXXXoo" "AAA" e)
				"XXX" e2))))))

(defun my-convert-one(sym)
  (cond ((not (symbolp sym)) sym)
	((eq sym 'write) 'my-write)
	((eq sym 'foreach) 'my-foreach)
	((eq sym 'replace) 'my-replace)
	((eq sym 'let) 'my-let)
	(t sym)))

(defun write-comment (str)
  (princ str))

(defun my-convert (ln)
  (if (atom ln) ln
    (let ((it (car ln)))
      (cons (my-convert-one it)
	    (mapcar #'my-convert (cdr ln))))))

(setf new-yanase (mapcar #'my-convert yanae))

(defun eval-yanae (ln)
  (progn
    (mapcar (lambda (x)
	      (eval x))
	    ln)
    nil))

(defun ev () (eval-yanae new-yanase))
(with-open-stream (*standard-output* (open "output.cs" :direction :output))
	(ev))