1:":"; exec mzscheme -r $0 "$@"
   2:
   3:;;; ----------------------------------------------------
   4:;;; Filename: BUP3.scm
   5:;;; Author:   Damir Cavar <dcavar@me.com>
   6:;;;
   7:;;; (C) 2006 by Damir Cavar
   8:;;;
   9:;;; This code is published under the restrictive GPL!
  10:;;; Please find the text of the GPL here:
  11:;;; http://www.gnu.org/licenses/gpl.txt
  12:;;; 
  13:;;; It is free for use, change, etc. as long as the copyright
  14:;;; note above is included in any modified version of the code.
  15:;;; 
  16:;;; This script assumes that the text is raw and encoded in UTF8.
  17:;;;
  18:;;; Functions:
  19:;;; 1. Reads in a grammar from files named grammar*.txt.
  20:;;; 2. Parses the words given as command line arguments.
  21:;;; 3. Returns true or false (parsed or not parsed).
  22:;;;
  23:;;; Usage:
  24:;;; mzscheme -r BUP3.scm John kissed Mary
  25:;;; ----------------------------------------------------
  26:
  27:(require (lib "list.ss"))
  28:(require (lib "list.ss"   "srfi" "1" ))
  29:(require (lib "string.ss" "srfi" "13"))
  30:(require (lib "hash.ss"   "srfi" "69"))
  31:(load "list-extra.ss")
  32:(load "grammar.scm")
  33:
  34:
  35:
  36:(define buparse
  37:  (lambda (tokens goal agenda)
  38:    (printf "Looking at: ~a\n" tokens)
  39:    (let window ([w (length tokens)])
  40:      (let loop ([i 0])
  41:        (let ([x (sublist tokens i (+ i w))])
  42:          (let ([vals  (hash-table-get rhs x '())]
  43:                [parse '()])
  44:            (for-each (lambda (y)
  45:                        (set! parse (concatenate (list (take tokens i)
  46:                                                       (list y)
  47:                                                       (take-right tokens (- (length tokens) (+ i w))))))
  48:                        (unless (member parse agenda)
  49:                          ; prepend to agenda
  50:                          (set! agenda (append (list parse) agenda))))
  51:                      vals)))
  52:        (unless (>= (+ i w) (length tokens))
  53:          (loop (+ i 1))))
  54:      (unless (<= w 1)
  55:        (window (- w 1))))
  56:    
  57:    (if (member goal agenda)
  58:        #t ; if goal in agenda, success
  59:        (if (> (length agenda) 0) ; else
  60:            (buparse (car agenda) goal (cdr agenda)) ; if some path on agenda
  61:            #f)))) ; else fail
  62:
  63:
  64:
  65:;;; -----------------------------
  66:(load-grammar "grammar.txt")
  67:(if (< 0 (vector-length argv))
  68:    (if (buparse (map-in-order (lambda (x)
  69:                                 (string->symbol x))
  70:                               (vector->list argv))
  71:                 (list 'S)
  72:                 '())
  73:        (printf "Success!\n")
  74:        (printf "Fail!\n")))
  75:
  76:
  77: