test.scm

#lang scheme
 
(define grammar1
  '((T (R))
    (T ("a" T "c"))
    (R ())
    (R (R "b" R))))
 
(define grammar2
  '((T (R))
    (R ("a" T "c"))
    (R (R "b" R))))
 
(define (union x y)
  (cond
    ((null? y) x)
    ((member (car y) x) (union x (cdr y)))
    (else (union (cons (car y) x) (cdr y)))))
 
(define (nonterminal? t grammar)
  (not (false? (assoc t grammar))))
 
(define (terminal? t)
  (string? t))
 
(define (productions t grammar)
  (let loop ((g grammar) (result '()))
    (cond
      ((null? g) result)
      ((eq? (caar g) t) (loop (cdr g) (cons (cadar g) result)))
      (else (loop (cdr g) result)))))
 
(define (nullable? x grammar (nts '()))
  (let ((g-nullable?
         (lambda (n) (nullable? n grammar (cons x nts))))
        (seen-it?
         (lambda (n) (member n nts))))
    (cond
      ((null? x) #t)
      ((list? x) (andmap (lambda (n) (or (seen-it? n) (g-nullable? n))) x))
      ((terminal? x) #f)
      ((nonterminal? x grammar) (ormap g-nullable? (productions x grammar))))))
 
(define (first-productions x grammar)
  (let ((nullable (nullable? x grammar)))
    (let loop ((p (productions x grammar))
               (result '()))
      (cond ((null? p) result)
            ((null? (car p)) (loop (cdr p) result)) ;empty production
            ((eq? x (caar p)) ; our production has x as the first symbol, we can get rid of it if it's nullable
             (cond (nullable (loop (cdr p) (cons (cdar p) result)))
                   (else (loop (cdr p) result))))
            (else
             (loop (cdr p) (cons (car p) result)))))))
 
(define (first x grammar)
  (cond ((null? x) '())
        ((terminal? x) (list x))
        ((list? x)
         (if (nullable? (car x) grammar)
             (union (first (car x) grammar) (first (cdr x) grammar ))
             (first (car x) grammar )))
        ((nonterminal? x grammar)
         (foldl union '() (map (lambda (n) (first n grammar )) (first-productions x grammar))))
        (else (raise x))))
 
 
 
(first 'T grammar1)
(first 'R grammar1)
 
 
(first 'T grammar2)
(first 'R grammar2)