(module logic mzscheme

(provide (all-defined))
(require (lib "lex.ss" "parser-tools"))
(require (prefix : (lib "lex-sre.ss" "parser-tools")))
(require (lib "yacc.ss" "parser-tools"))

(define-empty-tokens keyword-tokens (AND OR LPAREN RPAREN EOF))
(define-tokens value-tokens (ID))

(define-lex-abbrevs
  (scheme-whitespace (:or #\newline #\return #\tab #\space #\vtab)))

(define-lex-abbrevs
  (identifier (:+ (:or (:/ "a" "z") (:/ #\A #\Z)))))

(define simple-lexer
  (lexer
    ;; skip whitespace
    (scheme-whitespace (simple-lexer input-port))
    (identifier (token-ID lexeme))
    ("&" 'AND)
    ("|" 'OR)
    ("(" 'LPAREN)
    (")" 'LPAREN)
    ((eof) 'EOF)))


(define simple-parser
  (parser
    (start t)
    (end EOF)
    (error (lambda (token-ok token-name token-value)
             (printf "oops near ~a~%" token-name)))
    (tokens keyword-tokens value-tokens)
    (precs (left OR)
           (left AND))
    (grammar
      (t ((ID) $1)
         ((t AND t) (list 'and $1 $3))
         ((t OR t) (list 'or $1 $3))
         ((LPAREN t RPAREN) $2)))))

(define (parse-string s)
  (let ((port (open-input-string s)))
    (simple-parser (lambda () (simple-lexer port)))))

)