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: