/[lisppaste]/lisppaste2/r5rs-lookup.lisp
ViewVC logotype

Contents of /lisppaste2/r5rs-lookup.lisp

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1.3 - (show annotations)
Tue Nov 30 19:16:12 2004 UTC (9 years, 4 months ago) by bmastenbrook
Branch: MAIN
CVS Tags: HEAD
Changes since 1.2: +3 -1 lines
MORE ROBUSTNESS
1 (defpackage :r5rs-lookup (:use :common-lisp)
2 (:export :populate-table :symbol-lookup))
3 (in-package :r5rs-lookup)
4
5 (defparameter *r5rs-root* "http://www.schemers.org/Documents/Standards/R5RS/HTML/")
6
7 (defparameter *r5rs-file*
8 (merge-pathnames "r5rs-symbols.lisp-expr"
9 (or #.*compile-file-truename* *default-pathname-defaults*)))
10
11 (defvar *table* nil)
12
13 (defvar *populated-p* nil)
14
15 (defun populate-table ()
16 (unless *populated-p*
17 (with-open-file (r *r5rs-file* :direction :input)
18 (setf *table* (make-hash-table :test #'equalp))
19 (let ((s (read r)))
20 (loop for i in s do (setf (gethash (car i) *table*) (cdr i))))
21 'done)
22 (setf *populated-p* t)))
23
24 (defun symbol-lookup (symbol)
25 (unless *populated-p*
26 (populate-table))
27 (multiple-value-bind (val found)
28 (gethash symbol *table*)
29 (if found
30 (concatenate 'string *r5rs-root*
31 val))))

  ViewVC Help
Powered by ViewVC 1.1.5