プログラミング言語 orz

概要

brainf**k とか見て、天才と馬鹿の境界を感じたというか、そういうのが素晴らしいと思って、 WhitespaceとかOokとか見て、むしろ馬鹿のほうに傾いてるんじゃないか、とか思って、 それで、○|￣|＿とか考えた人がすごいとか、それを半角で再現したorzとか、そういった なんか諸々への尊敬とか、そういうのを含めたりは全然無くて、 ただ単に思い付いたっていうのとSchemeで遊んでみたかったっていうだけの言語。

brainf**k について知らない人は ぐぐるさんにでも聞いて。

Schemeによる実装

Scheme使ってなんか書くのは始めてなんで優しい目で見てあげてください…

#!/usr/bin/gosh


;; orz     increment 
;; or2     decrement
;; JTO JTO forward
;; OTL OTL backward
;; JTO OTL input
;; OTL JTO output
;; _no     jump forward
;; on_     jump backward

(if (< (length *argv*) 1) (error "usage: orz progfile-name"))
(define progin (open-input-file (car *argv*)))

(use text.parse)


(define-constant symbol-table (make-hash-table 'string=?))

(define (col-elem-op op col index) (set! (vector-ref col index) (op (vector-ref col index))))

(define (1+ i) (+ i 1))
(define (1- i) (- i 1))

(define (build-computer memsize)
  (let ((databuf (make-vector memsize 0))
        (data-index 0))
    (list
     (lambda () (col-elem-op 1+ databuf data-index))
     (lambda () (col-elem-op 1- databuf data-index))
     (lambda () (set! data-index (1+ data-index)))
     (lambda () (set! data-index (1- data-index)))
     (lambda () (set! (vector-ref databuf data-index) (read-byte)))
     (lambda () (write-byte (vector-ref databuf data-index)))
     (lambda (block)
       (define (loop)
         (if (eq? (vector-ref databuf data-index) 0) ()
             (begin 
               (eval block (current-module))
               (loop))))
       (loop))
     (lambda () (print databuf))  ;最後に付けとく
     )))

(define-values (orz or2 JTOJTO OTLOTL JTOOTL OTLJTO _noon_ orz-end) (apply values (build-computer 64)))

(define blank-chars-list (cons '*eof* (string->list " \t\n")))

(define (get-next-token) 
  (cond
   ((eof-object? (peek-char progin)) 'EOF)
   (else (next-token blank-chars-list blank-chars-list "eof" progin))))


(define (get-next-func get-token)
  (let ((prog-map `(("orz" . ,orz) 
                    ("or2" . ,or2)
                    ("JTO" . (("JTO" . ,JTOJTO) 
                              ("OTL" . ,JTOOTL))) 
                    ("OTL" . (("OTL" . ,OTLOTL)
                              ("JTO" . ,OTLJTO)))))
        (tok (get-token)))
    (define (next tok prog-map)
      (cond ((eq? () prog-map) #f)  ; なんかよくわからないトークン
            (else (let ((cur (car prog-map)))
                    (if (equal? tok (car cur))
                        (let ((func (cdr cur)))
                          (cond ((list? func) (next (get-token) func))
                                (else (cons func ()))))
                        (next tok (cdr prog-map)))))))

    (cond ((eq? tok 'EOF) 'end) 
          ((equal? tok "_no") (list _noon_ `(quote (begin ,@(compile compiler-get-func)))))
          ((equal? tok "on_") 'end)
          (else (next tok prog-map)))))

(define (compile get-func)
  (define (impl tail)
    (let ((func (get-func)))
      (cond ((eq? func #f) (impl tail))
            ((eq? func 'end) tail)
            ;;((eq? func 'end) (cons (cons orz-end ()) tail))
            (else (impl (cons func tail))))))
  (reverse (impl ())))



(define (compiler-get-func) (get-next-func get-next-token))

(define program `(begin ,@(compile compiler-get-func)))

(eval program (current-module))
(orz-end)

サンプル

orzっていう文字列を出力するなんとも自己再帰的なプログラム

JTO JTO orz orz orz _no OTL OTL orz orz orz JTO JTO or2 on_ 
OTL OTL orz orz _no JTO JTO orz orz orz orz orz orz orz orz
orz orz OTL OTL or2 on_ JTO JTO orz OTL JTO orz orz orz
OTL JTO orz orz orz orz orz orz orz orz OTL JTO

入力された数字の中で一番大きいものを出力するなんか。('0'の入力で終了)

保留

戻る   ホーム