summaryrefslogtreecommitdiff
path: root/util/annotation-utils.scm
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))