nobsun

Happy hacking!

Self Introduction

• SICP で初めて、Scheme に触れました。 Scheme のなんでも、やりたいようにできるところが好きです。

• Kahua
• Teach Yourself Scheme in Fixnum Days の日本語訳(独習Scheme三週間)

• Haskell だいすき。

• nobsun:log

Parser Combinator

(2005/11/17 16:40:08 PST) util.stream の練習に書いてみた．

(use srfi-1)
(use util.match)
(use util.stream)

;; type Parser token a = [token] -> [(a,[token])]

;; p-unit :: a -> Parser token a
(define (p-unit x)
  (lambda (ts)
    (stream-delay
     (stream (cons x ts)))))

;; p-alt :: Parser token a -> Parser token a -> Parser token a
(define (p-alt p q)
  (lambda (ts)
    (stream-delay
     (stream-append (p ts) (q ts)))))

;; p-then :: Parser token a -> Parser token b -> Parser token (a,b)
(define (p-then p q)
  (lambda (ts)
    (stream-delay
     (stream-concatenate
      (stream-map
       (lambda (r1)
         (receive (v1 ts1) (car+cdr r1)
           (stream-map (lambda (r2)
                         (receive (v2 ts2) (car+cdr r2)
                           (cons (cons v1 v2) ts2)))
                       (q ts1))))
       (p ts))))))

;; p-apply :: Parser token a -> (a -> b) -> Parser token b
(define (p-apply p f)
  (lambda (ts)
    (stream-delay
     (stream-map (match-lambda
                  (`(,x . ,ts1)
                   (cons (f x) ts1)))
                 (p ts)))))

;; p-many1 :: Parser token a -> Parser token [a]
(define (p-many1 p)
  (p-apply (p-then p (p-many p))
           (match-lambda (`(,x . ,xs)
                          (stream-delay (stream-cons x xs))))))

;; p-many :: Parser token a -> Parser token [a]
(define (p-many p)
  (define (q ts)
    (stream-delay
     ((p-alt (p-apply (p-then p q)
                      (match-lambda (`(,x . ,xs)
                                     (stream-delay (stream-cons x xs)))))
             (p-unit stream-null)) ts)))
  q)

;; p-sat :: (token -> Bool) -> Parser token token
(define (p-sat pred)
  (lambda (ts)
    (stream-delay
     (if (stream-null? ts)
         stream-null
         (let ((x (stream-car ts))
               (xs (stream-cdr ts)))
           (if (pred x)
               (stream (cons x xs))
               stream-null))))))

;; p-always :: Parser token token
(define p-always (p-sat (lambda (_) #t)))

;; p-lit :: String -> Parser String String
(define (p-lit s) (p-sat (cut string=? s <>)))

• Shiro(2005/11/17 21:56:35 PST): match-lambdaはその使いかたならbackquote要らないと 思います。(match-lambda ((x . xs) (stream-delay ...))) で。 matchでbackquoteが活きるのは、 リテラルシンボルを含むパターンにマッチさせたい場合ですね。