ネタ言語 primefu*k

ネタ言語を実装しました。

;; 素数リストの作成
(defun make-prime-list (n)
  (let ((arr (make-array n :initial-element 0 :element-type '(integer 0 1))))
    (setf (aref arr 0) 1)
    (setf (aref arr 1) 1)
    (loop
       :for i from 2 below n
       :when (zerop (aref arr i))
       :do (loop
	      :for j from (* i 2) below n by i
	      :do (setf (aref arr j) 1)))
    (loop
       :for i from 0 below n
       :when (zerop (aref arr i))
       :collect i)))

(defparameter
    *primes*
  (coerce (make-prime-list 100000) 'vector))

;; 素因数分解
(defun integer-factorization (n prime-vector)
  (let ((result nil))
    (loop
       :for x across prime-vector
       :until (= n 1)
       :do
       (loop
	  :while (zerop (mod n x))
	  :do (setf n (/ n x))
	  :sum 1 into acc
	  :finally (push (cons x acc) result)))
    (nreverse result)))

;; 数値を引き数として受け取り、Common Lispプログラムを返す
(defun n->cl (n primes)
  (let ((operators
	 (mapcar #'cdr (integer-factorization n primes))))
    (let ((tags nil)
	  (result nil))
      (dolist (op operators)
	(case op
	  ((0) ;; >: ptr++
	   (push `(incf ptr) result))
	  ((1) ;; <: ptr--
	   (push `(decf ptr) result))
	  ((2) ;; +: (*ptr)++
	   (push `(incf (aref memory ptr)) result))
	  ((3) ;; -: (*ptr)--
	   (push `(decf (aref memory ptr)) result))
	  ((4) ;; .: putchar(*ptr)
	   (push `(write-char (code-char (aref memory ptr)))
		 result))
	  ((5) ;; ,: *ptr=getchar()
	   (push `(setf (aref memory ptr) (char-code (read-char)))
		 result))
	  ((6) ;; [: while(*ptr){
	   (let ((from (gensym))
		 (to (gensym)))
	     (push (cons from to) tags)
	     (push
	      `(when (zerop (aref memory ptr))
		 (go ,to))
	      result)
	     (push from result)))
	  ((7) ;; ]: }
	   (destructuring-bind (from . to) (pop tags)
	     (push
	      `(unless (zerop (aref memory ptr))
		 (go ,from))
	      result)
	     (push to result)))
	  (T (error "unexpected operator"))))
      `(let ((memory (make-array 30000
				 :initial-element 0
				 :element-type '(unsigned-byte 8)))
	     (ptr 0))
	 (tagbody
	    ,@(nreverse result))))))

(defvar *bf-char->op*
  "><+-.<[]")

;; Brainfu*kプログラムを数値に変換
(defun bf->n (bf-string primes)
  (let ((result 1))
    (loop
       :for ch across bf-string
       :for p across primes
       :do (setf result
		 (* result
		    (expt p (position ch *bf-char->op*)))))
    result))

(defvar *helloworld-bf*
  "+++++++++[>++++++++>+++++++++++>+++++<<<-]>.>++.+++++++..+++.>-.------------.<++++++++.--------.+++.------.--------.>+.")


(defun execute (n &optional (primes *primes*))
  (eval (n->cl n primes)))

;; test
(execute (bf->n *helloworld-bf* *primes*))

名前のとおり、中身はBrainfu*kです。

入力となるソースコードは数値で、素因数分解によって命令列が作成されます。

例えば"Hello, world!"と出力するプログラムは以下の値です。 (10進数、25桁ごとに改行)

4502303465384972596608528
2944087262557401643378529
8625080698782925063959121
7719172880530482008491550
8597084354818091584552183
1319098036757291006692817
9301283601343001317452270
0376267461517920956544956
5153324663016284459064839
1911228540917237768596719
1754627268505767395202314
3109320783377732443055786
7415159648646742451459077
8603291732011810376948079
2004773113078228397846041
4399383865663430345291483
4231649128778405945758270
3488234290362476776792281
3785655092937989870582015
2313906809006976695583076
4202816254753054328113083
3788768481801880471791973
8660596785756596281519027
4112020595197735280186913
1838747769408930883235538
9738739557566706588749933
2671373192590205308149393
8139362300