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: