;Copyright (C) 1993 by Matthew Belmonte.
;
;This is a lexical scanner for a language of well-formed formulae (WFF's) in the
;propositional calculus.  It demonstrates techniques to be understood and used
;in the design of your PURPLE scanner, part of the final project for Theoretical
;Foundations of Computer Science at CTY.  This version of the WFF scanner was
;prepared by Matthew Belmonte, based on his implementation of the same algorithm
;in Pascal.

;data abstractors for tokens

(define make-token
  (lambda (type value)
    (cons type (cons value '()))))

(define type first)

(define value
  (lambda (token)
    (first (rest token))))

;top-level function
(define next-token
  (lambda ()
    (decide-next-token (next-char))))

(define decide-next-token
  (lambda (current-char)
    (cond
      [(space? current-char) (decide-next-token (next-char))] ;discard white space
      [(letter? current-char) (letter-start current-char)]
      [(symbol? current-char) (symbol-start current-char)]
      [else (error "Illegal character: " current-char)])))

;The straightforward way to decide what token to produce is to use all these nested conds.
;You can do it more efficiently using a helping function that takes as its parameter an assoc
;list mapping from characters to tokens.  However, for the purposes of this example (and in
;order not to give away _everything_ about the final project), I'm using the naive method here.
(define letter-start
  (lambda (current-char)
    (cond
      [(eq? current-char #\A) (check-for-and-token (next-char))]
      [(eq? current-char #\O) (check-for-or-token (next-char))]
      [else (make-token 'identifier-token current-char)])))

(define check-for-and-token
  (lambda (following-char)
    (cond
      [(eq? #\N following-char) (make-token 'and-token '())]
      [else (begin (save-char following-char) (make-token 'identifier-token #\A))])))

(define check-for-or-token
  (lambda (following-char)
    (cond
      [(eq? #\R following-char) (make-token 'or-token '())]
      [else (begin (save-char following-char) (make-token 'identifier-token #\O))])))

(define symbol-start
  (lambda (current-char)
    (cond
      [(eq? current-char #\~) (make-token 'not-token '())]
      [(eq? current-char #\=) (check-for-implies-token (next-char))]
      [(eq? current-char #\() (make-token 'left-p-token '())]
      [(eq? current-char #\)) (make-token 'right-p-token '())]
      [(eq? current-char #\.) (make-token 'end-token '())]
      [else (error "illegal character " current-char)])))

(define check-for-implies-token
  (lambda (following-char)
    (cond
      [(eq? #\> following-char) (make-token 'implies-token '())]
      [else (begin (save-char following-char) (make-token 'equiv-token '()))])))