blob: 8e2baf2b94c3c5e843708c8766cdfceeb4668a57 (
about) (
plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
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))
|
