csnagoya 宿題の続き

study

csnagoya でやってるコンパイラの方の宿題をやってるます．
Haskell は，タイムオーバということでまた今度やろう．
次のを考えていて思ったというか，Pugs んとこ見てて思ったんだけど，
Perl6 でやるってのも面白そうです．
とりあえず忘れよう．

;;; mycompiler 

(use srfi-13) ; 文字列用

(define (compile port)
  (let ((buffer (port->string port))
        (tokens '())
        (result '()))
    (while (and (set! result (tokenize buffer))
                (not (null? (car result))))
           (set! buffer (cadr result))
           (let ((new-token (car result)))
             (when (not (eq? 'space (cdar new-token)))
                   (format #t "def:~s str:~s\n"
                           (cdar new-token) (cdadr new-token))
                   (set! tokens (append tokens (list new-token))))))))

(define (tokenize str)
  (let ((token (rxmatch-case str
                             [#/^[[:space:]]+/ (m)
                                 `((def . space)      (str . ,m))]
                             [#/^MODULE\b/ (m)
                                 `((def . module)     (str . ,m))]
                             [#/^BEGIN\b/ (m)
                                 `((def . begin)      (str . ,m))]
                             [#/^END\b/ (m) 
                                 `((def . end)        (str . ,m))]
                             [#/^\./ (m)
                                 `((def . period)     (str . ,m))]
                             [#/^\)/ (m)
                                 `((def . open)       (str . ,m))]
                             [#/^\(/ (m)
                                 `((def . close)      (str . ,m))]
                             [#/^:/ (m)
                                 `((def . colon)      (str . ,m))]
                             [#/^\;/ (m)
                                 `((def . semicolon)  (str . ,m))]
                             [#/^"[^"\\]*(\\.[^"\\]*)*"/ (m)
                                 `((def . str)         (str . ,m))]
                             [#/^[[:alpha:]][[:alnum:]]*/ (m)
                                 `((def . identifier) (str . ,m))]
                             [else '()])))
    (list token (if (null? token)
                    str
                    (substring str (string-length (cdadr token))
                               (string-length str))))))

(define (main args)
  (if (null? (cdr args))
      (compile (current-input-port))
      (for-each (lambda (file)
                  (call-with-input-file file
                    (lambda (in)
                      (compile in))))
                (cdr args)))
  0)