forked from google/lisp-koans
-
Notifications
You must be signed in to change notification settings - Fork 0
/
contemplate.lsp
215 lines (176 loc) · 7.84 KB
/
contemplate.lsp
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
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
;; Copyright 2013 Google Inc.
;;
;; Licensed under the Apache License, Version 2.0 (the "License");
;; you may not use this file except in compliance with the License.
;; You may obtain a copy of the License at
;;
;; http://www.apache.org/licenses/LICENSE-2.0
;;
;; Unless required by applicable law or agreed to in writing, software
;; distributed under the License is distributed on an "AS IS" BASIS,
;; WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
;; See the License for the specific language governing permissions and
;; limitations under the License.
(in-package :cl-user)
;; Though Clozure / CCL runs lisp-koans on the command line using
;; "ccl -l contemplate.lsp", the following lines are needed to
;; meditate on the koans within the CCL IDE.
;; (The :hemlock is used to distiguish between ccl commandline and the IDE)
#+(and :ccl :hemlock)
(setf *default-pathname-defaults* (directory-namestring *load-pathname*))
;; lisp-unit defines the modules for loading / executing koans
(load "lisp-unit.lsp")
(defpackage :lisp-koans
(:use :common-lisp)
(:use :lisp-unit)
#+sbcl (:use :sb-ext))
(in-package :lisp-koans)
;; .koans file controls which files in *koan-dir-name* are loaded as
;; koans to complete
(defvar *koan-dir-name* "koans")
(with-open-file (in #P".koans")
(with-standard-io-syntax
(defvar *all-koans-groups* (read in))))
;; set *print-koan-progress* to t to list all completed koans before summary
(defvar *print-koan-progress* t)
;; debug-print directives
(defvar *dp-loading* nil)
;; Global state used to hold results of loading and processing koans
(defvar *n-total-koans* 0)
(defvar *collected-results* nil)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Functions for loading koans ;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun load-koan-group-named (koan-group-name)
;; Creates a package for the koan-group based on koan-group-name.
;; Loads a lisp file at *koan-dir-name* / koan-group-name .lsp
;; Adds all the koans from that file to the package.
(let ((koan-file-name (concatenate 'string (string-downcase (string koan-group-name)) ".lsp")))
(if *dp-loading* (format t "start loading ~A ~%" koan-file-name))
(in-package :lisp-koans)
(unless (find-package koan-group-name)
(make-package koan-group-name
:use '(:common-lisp :lisp-unit #+sbcl :sb-ext)))
(setf *package* (find-package koan-group-name))
(load (concatenate 'string *koan-dir-name* "/" koan-file-name))
(incf *n-total-koans* (length (list-tests)))
(in-package :lisp-koans)
(if *dp-loading* (format t "done loading ~A ~%" koan-file-name))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Functions for executing koans ;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun run-koan-group-named (koan-group-name)
;; Executes the koan group, using run-koans defined in lisp-unit
;; returning a test-results object.
(if *dp-loading* (format t "start running ~A ~%" koan-group-name))
(run-koans koan-group-name))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Functions for printing progress ;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun print-one-koan-status (k-result)
(let ((koan-name (first k-result))
(all-pass-p (every
#'(lambda (x) (equalp :pass x))
(second k-result))))
(if all-pass-p
(format t "[32m~A has expanded your awareness.~%[0m" koan-name)
(format t "[31m~A requires more meditation.~%[0m" koan-name))))
(defun print-koan-group-progress (kg-name kg-results)
(format t "~%Thinking about ~A~%" kg-name)
(dolist (k-result (reverse kg-results))
(format t " ")
(print-one-koan-status k-result))
(format t "~%"))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Functions for processing results ;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun any-assert-non-pass-p ()
(dolist (k-group-result *collected-results*)
(dolist (koan-result (second k-group-result))
(dolist (one-assert (second koan-result))
(if (not (equal one-assert :pass))
(return-from any-assert-non-pass-p one-assert)))))
nil)
(defun get-error-filename (collected-results)
(first (first (last collected-results))))
(defun get-error-koan-name (collected-results)
(first (first (second (first (last (last collected-results)))))))
(defun get-error-koan-status (collected-results)
(second (first (second (first (last (last collected-results)))))))
(defun koan-status-message (koan-status)
(if (find :incomplete koan-status)
(return-from koan-status-message
" [1m[33mA koan is incomplete.~%[0m"))
(if (find :fail koan-status)
(return-from koan-status-message
" [1m[31mA koan is incorrect.~%[0m"))
(if (find :error koan-status)
(return-from koan-status-message
" A koan threw an error.~%"))
(format t " last koan status: ~A~%" koan-status)
"")
(defun print-next-suggestion-message ()
(let ((filename (get-error-filename *collected-results*))
(koan-name (get-error-koan-name *collected-results*))
(koan-status (get-error-koan-status *collected-results*)))
(format t "You have not yet reached enlightenment ...~%")
(format t (koan-status-message koan-status))
(format t "~%")
(format t "[1mPlease meditate on the following code:~%[0m")
(format t " File \"~A/~A.lsp\"~%" *koan-dir-name* (string-downcase filename))
(format t " Koan \"~A\"~%" koan-name)
(format t " Current koan assert status is \"~A\"~%" (reverse koan-status))))
(defun print-completion-message ()
(format t "**********************************************************~%")
(format t "That was the last one, well done! ENLIGHTENMENT IS YOURS!~%")
(format t "**********************************************************~%~%")
(format t "If you demand greater challenge, take a look at extra-credit.lsp~%")
(format t "Or, let the student become the teacher:~%")
(format t " Write and submit your own improvements to github.com/google/lisp-koans!~%"))
(defun n-completed-koans (collected-results)
(loop for kg in collected-results
sum (length (second kg)) into partial-sum
finally (return partial-sum)))
(defun all-asserts-passed-in-koan-p (koan-result)
(equal
(length (second koan-result))
(count :pass (second koan-result))))
(defun n-passed-koans-in-group (kg)
(loop for k in (second kg)
counting (all-asserts-passed-in-koan-p k) into partial-sum
finally (return partial-sum)))
(defun n-passed-koans-overall (collected-results)
(loop for kg in collected-results
sum (n-passed-koans-in-group kg) into partial-sum
finally (return partial-sum)))
(defun print-progress-message ()
(format t "You are now ~A/~A koans and ~A/~A lessons closer to reaching enlightenment~%~%"
(n-passed-koans-overall *collected-results*)
*n-total-koans*
(- (length *collected-results*) 1)
(length *all-koans-groups*)))
;;;;;;;;;;
;; Main ;;
;;;;;;;;;;
;; Load all the koans before testing any, and
;; count how many total koans there are.
(loop for koan-group-name in *all-koans-groups*
do
(load-koan-group-named koan-group-name))
;; Run through the koans until reaching the end condition.
;; Store the results in *collected-results*
(setf *collected-results*
(loop for koan-group-name in *all-koans-groups*
for kg-results = (run-koan-group-named koan-group-name)
collect (list koan-group-name kg-results)
do (if *print-koan-progress*
(print-koan-group-progress koan-group-name kg-results))
;; *proceed-after-failure* is defined in lisp-unit
until (and (not *proceed-after-failure*) (any-non-pass-p kg-results))))
;; Output advice to the learner
(if (any-assert-non-pass-p)
(progn
(print-next-suggestion-message)
(format t "~%")
(print-progress-message))
(print-completion-message))