1:":"; exec mzscheme -r $0 "$@"
2:
3:;;; ----------------------------------------------------
4:;;; Filename: BUP1.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 BUP1.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:
32:(load "grammar.scm")
33:
34:
35:(define sublist
36: (lambda (mlist from to)
37: (let ([res '()]
38: [counter 0])
39: (for-each (lambda (x)
40: (if (and (<= from counter) (< counter to))
41: (if (> (length res) 0)
42: (set! res (append res (list x)))
43: (set! res (list x))))
44: (set! counter (+ counter 1)))
45: mlist)
46: res)))
47:
48:
49:
50:(define buparse
51: (lambda (tokens goal agenda)
52: (printf "Looking at: ~a\n" tokens)
53: (let window ([w (length tokens)])
54: (let loop ([i 0])
55: ;(printf "~a pos: ~a window: ~a\n" (sublist tokens i (+ i w)) i w)
56: ;(printf "Rest: ~a - ~a\n" (take tokens i) (take-right tokens (- (length tokens) (+ i w))))
57: (let ([x (sublist tokens i (+ i w))])
58: (let ([vals (hash-table-get rhs x '())]
59: [parse '()])
60: (for-each (lambda (y)
61: (set! parse (concatenate (list (take tokens i)
62: (list y)
63: (take-right tokens (- (length tokens) (+ i w))))))
64: (unless (member parse agenda)
65: (set! agenda (append agenda (list parse)))))
66: vals)))
67: (unless (>= (+ i w) (length tokens))
68: (loop (+ i 1))))
69: (unless (<= w 1)
70: (window (- w 1))))
71: ; (printf "Agenda:\n")
72: ; (for-each (lambda (x)
73: ; (printf "~a\n" x))
74: ; agenda)
75:
76: (if (member goal agenda)
77: #t ; if goal in agenda, success
78: (if (> (length agenda) 0) ; else
79: (buparse (car agenda) goal (cdr agenda)) ; if some path on agenda
80: #f)))) ; else fail
81:
82:
83:
84:
85:(load-grammar "grammar.txt")
86:; (hash-table-for-each rhs (lambda (key value) (printf "~a\t~a\n" key value)))
87:(if (< 0 (vector-length argv))
88: (if (buparse (map-in-order (lambda (x)
89: (string->symbol x))
90: (vector->list argv))
91: (list 'S)
92: '())
93: (printf "Success!\n")
94: (printf "Fail!\n")))
95:; (buparse (list 'John 'loves 'Mary) (list 'S) '())
96:
97:
98: