-
Notifications
You must be signed in to change notification settings - Fork 0
/
aoc.rkt
112 lines (96 loc) · 3.15 KB
/
aoc.rkt
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
#lang racket
(provide (all-from-out racket)
tests
define-task
debug:
#%app
~nl
~bl
for/max
for/min)
(require syntax/parse/define
rackunit
fancy-app
(for-syntax racket/syntax))
(define-simple-macro (tests {~optional {~seq #:name s:str}} xs ...)
(module+ test ({~? {~@ test-case s} test-begin} (tests+ xs ...))))
(begin-for-syntax
(define-splicing-syntax-class check-clause
(pattern
{~seq left:expr {~and op {~datum is}} right:expr}
#:with result (syntax/loc #'left (check-equal? left right))
#:with residue #'(op right))
(pattern
{~seq left:expr {~and op {~datum satisfies}} right:expr}
#:with result (syntax/loc #'left (check-pred right left))
#:with residue #'(op right))
(pattern
{~seq left:expr {~and op {~datum does-not-satisfies}} right:expr}
#:with result (syntax/loc #'left (check-pred (negate right) left))
#:with residue #'(op right))))
(define-syntax-parser tests+
[(_ #:input e:expr {~seq #:on c:check-clause} ... xs ...)
#:with v (generate-temporary 'v)
#:with (left ...) (map (λ (e) (quasisyntax/loc e (#,e v)))
(attribute c.left))
#`(begin
(let ([v e]) (tests+ {~@ #:>> left . c.residue}) ...)
(tests+ xs ...))]
[(_ #:>> :check-clause xs ...) #`(begin result (tests+ xs ...))]
[(_ #:let var:id e:expr xs ...) #'(let ([var e]) (tests+ xs ...))]
[(_ #:do e:expr xs ...) #'(begin e (tests+ xs ...))]
[(_ e:expr xs ...) #`(begin e (tests+ xs ...))]
[(_) #'(begin)])
(tests
#:input "abc"
#:on string-length is 3
#:on identity satisfies non-empty-string?
#:>> (add1 1) is 2
#:>> (add1 0) satisfies positive?
#:input 5
#:on add1 is 6
#:on sub1 is 4
#:let hello (- 2 1)
#:>> hello is (+ 0 1))
(begin-for-syntax
(define-splicing-syntax-class task-name
(pattern {~seq name:id #:name subname:id}
#:with the-name (format-id #'name "~a:~a" #'name #'subname))
(pattern {~seq name:id} #:with the-name #'name)))
(define-simple-macro (define-task :task-name xs ...)
(begin
(provide the-name)
(define (the-name s)
(with-input-from-string s (thunk xs ...)))))
(define-simple-macro (debug: e)
(debug:core 'e e))
(define (debug:core repr v)
(fprintf (current-error-port) "~a:\n" repr)
(for ([line (in-list (string-split (pretty-format v) "\n"))])
(fprintf (current-error-port) " ~a\n" line))
(fprintf (current-error-port) "\n")
v)
(define ~nl string-trim)
(define ~bl (string-replace _ "\n" ""))
(define-syntax-parser for/max
[(_ clauses body ... tail-expr)
#:with orig this-syntax
#'(for/fold/derived original
([current-max -inf.0])
clauses
body ...
(define maybe-new-max tail-expr)
(if (> maybe-new-max current-max)
maybe-new-max
current-max))])
(define-syntax-parser for/min
[(_ clauses body ... tail-expr)
#:with orig this-syntax
#'(for/fold/derived original
([current-min -inf.0])
clauses
body ...
(define maybe-new-min tail-expr)
(if (> maybe-new-min current-min)
maybe-new-min
current-min))])