-
Notifications
You must be signed in to change notification settings - Fork 0
/
preamble.lisp
91 lines (85 loc) · 3.31 KB
/
preamble.lisp
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
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
;;;; Test preamble
;;;
(in-package :org.tfeb.star/test)
(defvar *test-report-class* 'summary)
(defvar *test-individually* nil)
(define-test "org.tfeb.star")
(defun pessimize-maybe-wrapped-for-expression (maybe-wrapped-for-expression)
;; MAYBE-WRAPPED-FOR-EXPRESSION is either a for expression or of the
;; form (x ...) where any of the ...'s may be (FOR (...) ...). This
;; is not a code walker!
;;
;; Note: this transformation *doesn't* work for for*: in (for* ((a
;; <f1>) (b <f2>)) ...) you need to evaluate <f2> each time round
;; the outer loop, with a bound, so you can't raise it out of the
;; expression this way for those two reasons.
(flet ((pessimize (for-expression)
(destructuring-match for-expression
((for (&rest clauses) &body forms)
(:when (literals for))
(multiple-value-bind (bindings rewritten-clauses)
(with-collectors (binding clause)
(for ((clause (in-list clauses)))
(destructuring-match clause
((var/s iterator)
(with-names (<valid> <cursor>)
(binding `((,<valid> ,<cursor>) ,iterator))
(clause `(,var/s (values ,<valid> ,<cursor>)))))
(otherwise
(error "bad clause ~S" clause)))))
(iterate next-binding ((btail bindings))
(if (null btail)
`(for ,rewritten-clauses
,@forms)
`(multiple-value-bind ,@(first btail)
,(next-binding (rest btail)))))))
(otherwise
(error "not a for expression: ~S" for-expression)))))
(destructuring-match maybe-wrapped-for-expression
((for . _)
(:when (literals for))
(pessimize maybe-wrapped-for-expression))
((op &rest possibles)
(:when (symbolp op))
`(,op
,@(collecting
(for ((possible (in-list possibles)))
(destructuring-match possible
((for . _)
(:when (literals for))
(collect (pessimize possible)))
(otherwise
(collect possible))))))))))
(defmacro pessimizing-for (((p o &optional e) maybe-wrapped-for-expression) &body forms)
;; P & O will be functions corresponding to pessimal and optimal
;; versions of FOR-EXPRESSION in BODY respectively. E is the
;; expression itself for error reporting
(if e
`(let ((,e ',maybe-wrapped-for-expression))
(declare (ignorable e))
(flet ((,p ()
,(pessimize-maybe-wrapped-for-expression
maybe-wrapped-for-expression))
(,o ()
,maybe-wrapped-for-expression))
,@forms))
`(flet ((,p ()
,(pessimize-maybe-wrapped-for-expression
maybe-wrapped-for-expression))
(,o ()
,maybe-wrapped-for-expression))
,@forms)))
(defun repeat (n &key (error nil))
;; Used to ensure termination without using IN-RANGE
(let ((i 0))
(values
(lambda ()
(cond
((< i n)
t)
(error
(error "hit repeat limit"))
(t nil)))
(lambda ()
(prog1 i
(incf i))))))