token.ss
#lang scheme/base
;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; PARSEQ.PLT
;; A Parser Combinator library.
;;
;; Bonzai Lab, LLC.  All rights reserved.
;;
;; Licensed under LGPL.
;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; token.ss - token-based parser combinators.
;; yc 1/5/2010 - first version
(require "primitive.ss"
         "combinator.ss"
         "basic.ss"
         mzlib/defmacro
         (for-syntax scheme/base
                     scheme/match 
                     ) 
         scheme/list
         )

;; token
;; tokenizing a particular value...
(define (token parser (delim whitespaces)) 
  (seq delim 
       t <- parser 
       (return t))) 

;; tokens
;; generating a sequence of tokens...
(define-macro (tokens . exps) 
  (define (body exps) 
    (match exps 
      ((list exp) (list exp)) 
      ((list-rest v '<- exp rest) 
       `(,v <- (token ,exp) . ,(body rest)))
      ((list-rest exp rest) 
       `((token ,exp) . ,(body rest)))))
  `(seq . ,(body exps)))

;; token-ci
;; the literal tokens for string & character are case-insensitive
(define-macro (tokens-ci . exps)
  (define (body exps) 
    (match exps 
      ((list exp) (list exp)) 
      ((list-rest v '<- exp rest) 
       `(,v <- (token (literal-ci ,exp)) . ,(body rest)))
      ((list-rest exp rest) 
       `((token (literal-ci ,exp)) . ,(body rest)))))
  `(seq . ,(body exps)))

;; alternate
;; alternate between 2 parsers - ideally used for parsing delimited input
;; you can choose whether you want to have the delimiter returned...
(define (alternate parser1 parser2)
  (tokens v <- parser1 
          v2 <- (zero-many (seq v1 <- parser2 
                                v3 <- parser1 
                                (return (list v1 v3))))
          (return (flatten (cons v v2)))))

;; delimited
;; same as alternate, except the delimiters are parsed out and not returned
(define (delimited parser delim) 
  (tokens v <- parser 
          v2 <- (zero-many (tokens v3 <- delim
                                   v4 <- parser
                                   (return v4)))
          (return (cons v v2))))

;; bracket
;; parsing bracketed structures...
(define (bracket open parser close) 
  (tokens open
          v <- parser 
          close 
          (return v))) 

;; bracket/delimited
(define (bracket/delimited open parser delim close) 
  (tokens open ;; even the parser is optional... 
          v <- (zero-one (delimited parser delim) '()) 
          close 
          (return v)))

(provide token 
         tokens
         tokens-ci
         alternate
         delimited 
         bracket
         bracket/delimited
         )