#lang scheme/base
(require "primitive.ss"
"combinator.ss"
"basic.ss"
"input.ss"
mzlib/defmacro
(for-syntax scheme/base
scheme/match
)
scheme/list
)
(define (token parser (delim whitespaces))
(seq delim
t <- parser
delim
(return t)))
(define (token/pre parser (delim whitespaces))
(seq delim t <- parser (return t)))
(define-macro (tokens/by tokenizer . exps)
(define (body exps)
(match exps
((list exp) (list exp))
((list-rest v '<- exp rest)
`(,v <- (,tokenizer ,exp) . ,(body rest)))
((list-rest exp rest)
`((,tokenizer ,exp) . ,(body rest)))))
`(seq . ,(body exps)))
(define-macro (tokens . exps)
`(tokens/by token . ,exps))
(define-macro (tokens-ci . exps)
`(tokens/by (compose token literal-ci) . ,exps))
(define (alternate parser1 parser2)
(tokens v <- parser1
v2 <- (zero-many (seq v1 <- parser2
v3 <- parser1
(return (list v1 v3))))
(return (flatten (cons v v2)))))
(define (delimited parser delim (tokenizer token))
(tokens/by tokenizer
v <- parser
v2 <- (zero-many (tokens/by tokenizer
v3 <- delim
v4 <- parser
(return v4)))
(return (cons v v2))))
(define (bracket open parser close)
(tokens open
v <- parser
close
(return v)))
(define (bracket/delimited open parser delim close)
(tokens open v <- (zero-one (delimited parser delim) '())
close
(return v)))
(provide token
token/pre
tokens/by
tokens
tokens-ci
alternate
delimited
bracket
bracket/delimited
)