1:":"; exec mzscheme -r $0 "$@"
   2:
   3:;;; ----------------------------------------------------
   4:;;; Filename: BUP2.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 BUP2.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:(define buparse
  36:  (lambda (tokens goal agenda)
  37:    (printf "Looking at: ~a\n" tokens)
  38:    (let window ([w (length tokens)])
  39:      (let ([tmpagenda '()])
  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:                            (set! tmpagenda (append tmpagenda (list parse)))))
  50:                        vals)))
  51:          (unless (>= (+ i w) (length tokens))
  52:            (loop (+ i 1))))
  53:        ; prepend tmpagenda to agenda
  54:        (set! agenda (append tmpagenda agenda)))
  55:      (unless (<= w 1)
  56:        (window (- w 1))))
  57:    
  58:    (if (member goal agenda)
  59:        #t ; if goal in agenda, success
  60:        (if (> (length agenda) 0) ; else
  61:            (buparse (car agenda) goal (cdr agenda)) ; if some path on agenda
  62:            #f)))) ; else fail
  63:
  64:
  65:
  66:
  67:;;; -----------------------------
  68:(load-grammar "grammar.txt")
  69:(if (< 0 (vector-length argv))
  70:    (if (buparse (map-in-order (lambda (x)
  71:                                 (string->symbol x))
  72:                               (vector->list argv))
  73:                 (list 'S)
  74:                 '())
  75:        (printf "Success!\n")
  76:        (printf "Fail!\n")))
  77:
  78:
  79: