From 4e987026148fe65c323afbc93cd560c07bf06b3f Mon Sep 17 00:00:00 2001 From: Yale AI Dept Date: Wed, 14 Jul 1993 13:08:00 -0500 Subject: Import to github. --- util/annotation-utils.scm | 41 +++++++++++++++++++++++++++++++++++++++++ 1 file changed, 41 insertions(+) create mode 100644 util/annotation-utils.scm (limited to 'util/annotation-utils.scm') diff --git a/util/annotation-utils.scm b/util/annotation-utils.scm new file mode 100644 index 0000000..8e2baf2 --- /dev/null +++ b/util/annotation-utils.scm @@ -0,0 +1,41 @@ + +;;; Some general utilities for dealing with annotations + +;;; Lookup an annotation on a var + +(define (lookup-annotation var aname) + (lookup-annotation-1 (var-annotations var) aname)) + +(define (lookup-annotation-1 a aname) + (if (null? a) + '#f + (if (eq? aname (annotation-value-name (car a))) + (car a) + (lookup-annotation-1 (cdr a) aname)))) + +;;; This parses a string denoting a strictness property into a list +;;; of booleans. "S,N,S" -> (#t #f #t) + +(define (parse-strictness str) + (parse-strictness-1 str 0)) + +(define (parse-strictness-1 str i) + (if (>= i (string-length str)) + (signal-bad-strictness-annotation str) + (let* ((ch (char-downcase (string-ref str i))) + (s (cond ((char=? ch '#\s) + '#t) + ((char=? ch '#\n) + '#f) + (else + (signal-bad-strictness-annotation str))))) + (cond ((eqv? (1+ i) (string-length str)) + (list s)) + ((char=? (string-ref str (1+ i)) '#\,) + (cons s (parse-strictness-1 str (+ i 2)))) + (else + (signal-bad-strictness-annotation str)))))) + +(define (signal-bad-strictness-annotation str) + (fatal-error 'bad-strictness "Bad strictness annotation: ~A~%" str)) + -- cgit v1.2.3