wasmlike.rkt 19.8 KB
Newer Older
Guy Watson's avatar
Guy Watson committed
1
#lang xsmith/private/base 
Guy Watson's avatar
Guy Watson committed
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
;; -*- mode: Racket -*-
;;
;; Copyright (c) 2019 The University of Utah
;; All rights reserved.
;;
;; Redistribution and use in source and binary forms, with or without
;; modification, are permitted provided that the following conditions are met:
;;
;;   * Redistributions of source code must retain the above copyright notice,
;;     this list of conditions and the following disclaimer.
;;
;;   * Redistributions in binary form must reproduce the above copyright
;;     notice, this list of conditions and the following disclaimer in the
;;     documentation and/or other materials provided with the distribution.
;;
;; THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
;; AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
;; IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
;; ARE DISCLAIMED.  IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
;; LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
;; CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
;; SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
;; INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
;; CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
;; ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
;; POSSIBILITY OF SUCH DAMAGE.

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

31
32
(require
  xsmith
33
  xsmith/racr-convenience
34
  racr
35
  racket/class
36
37
  racket/pretty
  racket/string
38
  racket/match
39
  (except-in racket/list empty))
40
 
41
(define-spec-component wasm-like)
42
43
44

;; This defines the layout of the grammar.
(add-to-grammar
45
 wasm-like
46
 [Program #f (Func
47
              [globals : GlobalDeclaration *])]
48
49
 [Func #f ([root : Expr]
           [localcount = (random 1 10)])]
50
51
 [Expr #f ()
       #:prop may-be-generated #f]
52
 [LiteralInt Expr ([v = (random 10000)])
53
             #:prop choice-weight 3]
54
 [Noop Expr ([expr : Expr])]
Guy Watson's avatar
Guy Watson committed
55
 [Binop Expr ([l : Expr] [r : Expr]) ;; use l and r here
Guy Watson's avatar
Guy Watson committed
56
57
           #:prop choice-weight 30 ;; default is 10
           #:prop may-be-generated #f]
Guy Watson's avatar
Guy Watson committed
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
 [Equal Binop ()]
 [NotEqual Binop ()]
 [Addition Binop ()]
 [Subtraction Binop ()]
 [Multiplication Binop ()]
 [DivisionSigned Binop ()]
 [DivisionUnsigned Binop ()]
 [LessThanSigned Binop ()]
 [LessThanUnsigned Binop ()]
 [GreaterThanSigned Binop ()]
 [GreaterThanUnsigned Binop ()]
 [LessThanOrEqualSigned Binop ()]
 [LessThanOrEqualUnsigned Binop ()]
 [GreaterThanOrEqualSigned Binop ()]
 [GreaterThanOrEqualUnsigned Binop ()]
 [RemainderSigned Binop ()]
 [RemainderUnsigned Binop ()]
 [And Binop ()]
 [Or Binop ()]
 [Xor Binop ()]
78
 [Unop Expr ([expr : Expr])
79
80
       #:prop choice-weight 20
       #:prop may-be-generated #f]
Guy Watson's avatar
Guy Watson committed
81
82
83
84
85
86
87
88
89
 [EqualZero Unop ()]
 [CountLeadingZero Unop ()]   
 [CountTrailingZero Unop ()]
 [NonZeroBits Unop ()]
 [ShiftLeft Unop ()]
 [ShiftRightSigned Unop ()]
 [ShiftRightUnsigned Unop ()]
 [RotateLeft Unop ()]
 [RotateRight Unop ()]
Guy Watson's avatar
Guy Watson committed
90
91
92
 [IfElse Expr ([cond : Expr]
               [then : Expr]
               [else : Expr])
93
         #:prop choice-weight 10]
94
95
 [If Expr ([cond : Expr]
           [then : Expr])]
96
97
 [Block Expr ([expr : Expr])]
 [Loop Expr ([expr : Expr])]
98
99
100
 [Branch Expr ([val : Expr]
               [targetnode]
               [targetindex]) ;; a number depth
Guy Watson's avatar
Guy Watson committed
101
         ;; todo: the type of val should be unified with the target node
102
         #:prop choice-weight 10]
Guy Watson's avatar
Guy Watson committed
103
104
105
106
 [BranchIf Expr ([cond : Expr]
                 [val : Expr]
                 [targetnode]
                 [targetindex])
107
           #:prop choice-weight 10]
108
109
110
111
112
 [MemStore Expr ([address : LiteralInt]
                 [value : Expr]
                 [offset = (abs (- (random 20000) 10000))] ;; This probably has some bias towards 0
                 [alignment = (random 4)]
                 [expr : Expr])
113
           #:prop choice-weight 3]
114
115
116
 [MemLoad Expr ([address : LiteralInt]
                [offset = (abs (- (random 20000) 10000))]
                [alignment = (random 4)])
117
118
           #:prop choice-weight 3]
 [LocalGet Expr ([index])] ;; Change these over to the xsmith reference system once random reference increases are implemented by William
119
 [LocalSet Expr ([val : Expr]
120
121
                 [index]
                 [expr : Expr])]
Guy Watson's avatar
Guy Watson committed
122
123
 [LocalTee Expr ([val : Expr]
                 [index])]
124
125
 [GlobalDeclaration #f ([name]
                        [type]
126
                        [initialvalue : LiteralInt])
127
128
                    #:prop binder-info (name type definition)]
 [GlobalGet Expr ([name])
129
            #:prop reference-info (read name)
130
            #:prop choice-weight 4] 
131
132
133
 [GlobalSet Expr ([val : Expr]
                  [name]
                  [expr : Expr])
134
            #:prop reference-info (write name #:unifies val)
135
            #:prop choice-weight 4]
136
137
138
139
140

 ;; Idiomatic Generation
 [ForLoop Expr ([loopvar : GlobalSet] ;; This will be the inital value set before entering the loop
                                      ;; Rendering for this node is restricted: it will not produce
                                      ;; a value for use by children
Guy Watson's avatar
Guy Watson committed
141
142
                [loop : Loop])
          #:prop choice-weight 30]
143
 
144
145
146
147
148
 )

(add-prop
  wasm-like
  fresh
Guy Watson's avatar
Guy Watson committed
149
150
151
152
153
154
155
156
157
158
159
  [Branch (if (ast-has-parent? current-hole) ;; Only check for targets if we are attached to the tree
                                             ;; For example: generating a branch instruction for the
                                             ;; for loop below while not connected to the tree. We
                                             ;; must manually specify the target
            (match-let ([(cons index node) (choose-br-target (current-hole))])
              (hash 'targetindex index 'targettype (node-type node)))
            (hash))]
  [BranchIf (if (ast-has-parent? current-hole)
              (match-let ([(cons index node) (choose-br-target (current-hole))])
                (hash 'targetindex index 'targettype (node-type node)))
              (hash))]
160
161
  [LocalGet (hash 'index (choose-local-target (current-hole)))]
  [LocalSet (hash 'index (choose-local-target (current-hole)))]
Guy Watson's avatar
Guy Watson committed
162
  [LocalTee (hash 'index (choose-local-target (current-hole)))]
163
164
165

  #;[GlobalGet (hash 'name (fresh-var-name "$global_"))]
  #;[GlobalSet (hash 'name (fresh-var-name "$global_"))]
166
167
168
169
  ;;todo Implement these with the upcoming custom name changes  
 

  ;; The problem here is that I can't seem to make-fresh-node inside of fresh
Guy Watson's avatar
Guy Watson committed
170
171
172
173
174
  [ForLoop (let* ([loopvar-name (binding-name (send this xsmith_get-reference-for-child! int #t))]
                  [loopvar (make-fresh-node 'GlobalSet
                                            (hash 'val (make-fresh-node 'LiteralInt)
                                                  'name loopvar-name
                                                  'expr (make-fresh-node 'LiteralInt)))] ;;dummy leaf node
175
176
177
178
                  [zero (make-fresh-node 'LiteralInt
                                         (hash 'v 0))]
                  [one (make-fresh-node 'LiteralInt
                                        (hash 'v 1))]
179
180
181
182
183
184
185
186
187
188
                  [loopvar-get1 (make-fresh-node 'GlobalGet
                                                 (hash 'name loopvar-name))]
                  [loopvar-get2 (make-fresh-node 'GlobalGet
                                                 (hash 'name loopvar-name))]
                  [subtraction (make-fresh-node 'Subtraction
                                                (hash 'l loopvar-get1
                                                      'r one))]
                  [comparison (make-fresh-node 'GreaterThanSigned
                                               (hash 'l loopvar-get2
                                                     'r zero))]
189
                  [branch (make-fresh-node 'BranchIf
190
                                           (hash 'cond comparison
Guy Watson's avatar
Guy Watson committed
191
192
193
194
195
196
197
198
199
                                                 'targetindex 0 ;; Target the loop in order to loop
                                                 ;; Specify the type manually to avoid cyclic dependenices
                                                 'targettype 'Loop))]
                                                 ;; 'val is the (randomly generated) loop body
                  [loop-body (make-fresh-node 'GlobalSet
                                              (hash 'val subtraction
                                                    'name loopvar-name
                                                    'expr branch))]
                  [loop (make-fresh-node 'Loop
200
                                         (hash 'expr loop-body))])                                     
Guy Watson's avatar
Guy Watson committed
201
202
             (hash 'loopvar loopvar
                   'loop loop))]
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
)

(add-att-rule
  wasm-like
  nesting-level
  [Program (λ (n c) 0)]
  [IfElse (λ (n c)
             (let ([depth (att-value 'nesting-level (ast-parent n) n)])
               (if (eq? c (ast-child 'cond n))
                   (+ 0 depth)
                   (+ 1 depth))))]
  [Func (λ (n c) (+ 1 (att-value 'nesting-level (ast-parent n))))]
  )

(add-prop
 wasm-like type-info
          [Program [(fresh-type-variable) 
                    (λ (n t) 
                       (hash 'Func (fresh-type-variable)
                             'globals (λ (cn) (fresh-type-variable))))]]
223
          [GlobalDeclaration [int (λ (n t) (hash 'initialvalue int))]]
224
225
226
227
          [Func [(fresh-type-variable) 
                  (λ (n t)
                     (hash 'root (fresh-type-variable)))]]
          [LiteralInt [int (no-child-types)]]
228
          [Noop [int (λ (n t) (hash 'expr int))]]
229
230
231
232
          [Binop [(fresh-type-variable int #|float|#) 
                  (λ (n t) 
                     (hash 'l t 
                           'r t))]]
233
234
          [Unop [(fresh-type-variable int)
                 (λ (n t)
235
                    (hash 'expr t))]]
236
237
238
239
240
          [IfElse [int
                    (λ (n t)
                     (hash 'cond int
                           'then int
                           'else int))]]
241
242
243
244
          [If [int
                (λ (n t)
                   (hash 'cond int
                         'then int))]]
245
246
          [Block [int (λ (n t) (hash 'expr int))]]
          [Loop [int (λ (n t) (hash 'expr int))]]
247
          [ForLoop [int (λ (n t) (hash 'loopvar int
Guy Watson's avatar
Guy Watson committed
248
                                       'loop int))]]
249
250
251
252
253
254
255
          [Branch [int (λ (n t) (hash 'val int))]]
          [BranchIf [int (λ (n t) (hash 'cond int
                                        'val int))]]
          [MemStore [int (λ (n t) (hash 'address int
                                        'value int
                                        'expr int))]]
          [MemLoad [int (λ (n t) (hash 'address int))]]
Guy Watson's avatar
Guy Watson committed
256
          [LocalGet [int (no-child-types)]]
257
258
          [LocalSet [int (λ (n t) (hash 'val int
                                        'expr int))]]
Guy Watson's avatar
Guy Watson committed
259
          [LocalTee [int (λ (n t) (hash 'val int))]]
260
261
262
          [GlobalGet [int (no-child-types)]]
          [GlobalSet [int (λ (n t) (hash 'val int
                                         'expr int))]]
Guy Watson's avatar
Guy Watson committed
263
)
264

265
;; Define structured control instruction property
Guy Watson's avatar
Guy Watson committed
266
(define-non-inheriting-rule-property
267
268
  structured-control-instruction
  att-rule
269
  #:default (λ (n) #f)
270
  )
271

Guy Watson's avatar
Guy Watson committed
272
(add-prop
273
274
 wasm-like
 structured-control-instruction
275
276
 [Func (λ (n) #t)]
 [IfElse (λ (n) #t)]
277
278
279
 [If (λ (n) #t)]
 [Block (λ (n) #t)]
 [Loop (λ (n) #t)]
Guy Watson's avatar
Guy Watson committed
280
 ;;[ForLoop (λ (n) #t)]
281
 )
282

283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
(define (get-nesting-types node)
  (let ([type (node-type node)])
    (if (eq? type 'Func)
      (list type)
      (if (att-value 'structured-control-instruction node)
        (cons type (get-nesting-types (parent-node node)))
        (get-nesting-types (parent-node node))))))

;; gets an ancestry trace up the tree
(define (get-parents n)
  (if (parent-node n)
    (cons n (get-parents (parent-node n)))
    (list n)))

;; converts a list of nodes into a list of their names (for debugging)
(define (node-names l)
  (map (λ (n) (node-type n))
       l))

302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
(define (valid-br-targets ns)
  (filter values
          (for/list ([child ns]
                     [parent (rest ns)])
            (if (and (att-value 'structured-control-instruction parent)
                     (att-value 'control-valid? parent child))
              parent
              #f))))

(add-att-rule
  wasm-like
  control-valid?
  [#f (λ (n c) #t)]
  [IfElse (λ (n c)
             (not (eq? (ast-child 'cond n) c)))]
317
318
  [If (λ (n c)
         (not (eq? (ast-child 'cond n) c)))]
319
320
  [ForLoop (λ (n c)
              (not (eq? (ast-child 'loopvar n) c)))]
321
  )
322

Guy Watson's avatar
Guy Watson committed
323
324
325
326
327

(define (choose-br-target n)
  (let* ([parents (get-parents n)]
         [targets (valid-br-targets parents)]
         [index (random (length targets))])
328
    (cons index (list-ref targets index))))
Guy Watson's avatar
Guy Watson committed
329

330
331
332
333
334
335
(define (get-func-node n)
  (if (eq? (node-type n) 'Func)
    n
    (get-func-node (parent-node n))))

(define (choose-local-target n)
336
  (random (ast-child 'localcount (get-func-node n))))
337

Guy Watson's avatar
Guy Watson committed
338

339
340
341
;; This creates a base type, like a leaf of a grammar
(define int (base-type 'int))

Guy Watson's avatar
Guy Watson committed
342
343
344
(define (no-child-types)
  (λ (n t) (hash))) 

345

Guy Watson's avatar
Guy Watson committed
346
347
348
(add-prop
 wasm-like
 render-node-info
349
 [Program (λ (n) `(module
350
351
                    (import "env" "memory" (memory $mem 1))
                    (import "env" "addToCrc" (func $addToCrc (param i32)))
352
                    (import "env" "__memory_base" (global $mem_base i32))
353
                    ,@(map (λ (global)
354
355
356
                             `(global ,(string->symbol (format "$~a" (ast-child 'name global))) 
                                      (mut i32) 
                                      ,(render-node (ast-child 'initialvalue global))))
357
                        (reverse (ast-children (ast-child 'globals n))))
Guy Watson's avatar
Guy Watson committed
358
                    ,(render-node (ast-child 'Func n))
359
360
                    (global $mem_base_internal (mut i32) (i32.const 0))
                    (global $mem_max_internal (mut i32) (i32.const 0))
361
                    (func (export "__post_instantiate")
362
363
364
                          global.get $mem_base
                          global.set $mem_base_internal
                          global.get $mem_base_internal
365
366
                          i32.const 5242880
                          i32.add
367
                          global.set $mem_max_internal)
Guy Watson's avatar
Guy Watson committed
368
                    (func (export "_crc_globals")
369
370
371
372
373
                       ,@(flatten (map (λ (global) (append
                                                    '(global.get)
                                                    (list (string->symbol (format "$~a" (ast-child 'name global))))
                                                    '(call $addToCrc)))
                              (reverse (ast-children (ast-child 'globals n))))))))]
374
 [Func (λ (n) `(func (export "_func") (result i32)
375
                      (local ,@(make-list (ast-child 'localcount n) 'i32))
376
                     ,@(render-node (ast-child 'root n))))]
377
 [LiteralInt (λ (n) (list 'i32.const (ast-child 'v n)))]
Guy Watson's avatar
Guy Watson committed
378
379
 [Noop (λ (n) (append
                 '(nop)
380
                 (render-node (ast-child 'expr n))))]
381
 [Binop (λ (n) (append 
Guy Watson's avatar
Guy Watson committed
382
383
                  (render-node (ast-child 'l n))
                  (render-node (ast-child 'r n))
384
                  (list (att-value 'math-op n))))]
385
 [Unop (λ (n) (append
386
                 (render-node (ast-child 'expr n))
387
                 (list (att-value 'math-op n))))]
Guy Watson's avatar
Guy Watson committed
388
 [IfElse (λ (n)           
389
           (append
Guy Watson's avatar
Guy Watson committed
390
                (render-node (ast-child 'cond n))
391
                '(if (result i32))
Guy Watson's avatar
Guy Watson committed
392
                (render-node (ast-child 'then n))
393
                '(else)
Guy Watson's avatar
Guy Watson committed
394
                (render-node (ast-child 'else n))
395
                '(end)))]
396
397
398
399
400
401
402
403
404
 [If (λ (n)
        (append
          (render-node (ast-child 'cond n))
          '(if (result i32))
          (render-node (ast-child 'then n))
          '(end)))]
 [Block (λ (n)
           (append
             '(block (result i32))
405
             (render-node (ast-child 'expr n))
406
407
408
409
             '(end)))]
 [Loop (λ (n)
          (append
            '(loop (result i32))
410
            (render-node (ast-child 'expr n))
411
            '(end)))]
412
413
414
415
 [ForLoop (λ (n)
             (append
                 (render-node (ast-child 'val (ast-child 'loopvar n)))
                 `(global.set ,(string->symbol (format "$~a" (ast-child 'name (ast-child 'loopvar n)))))
Guy Watson's avatar
Guy Watson committed
416
                 (render-node (ast-child 'loop n))))]
Guy Watson's avatar
Guy Watson committed
417
418
419
420
 [Branch (λ (n)
            (append
              (render-node (ast-child 'val n))
              `(br ,(ast-child 'targetindex n))))]
Guy Watson's avatar
Guy Watson committed
421
422
423
424
425
 [BranchIf (λ (n)
              (append
                (render-node (ast-child 'val n))
                (render-node (ast-child 'cond n))
                `(br_if ,(ast-child 'targetindex n))))]
426
427
428
429
 [MemStore (λ (n)
              (append
                (render-node (ast-child 'address n))
                (render-node (ast-child 'value n))
430
431
432
                `(i32.store ,(string->symbol (format "offset=~a" (ast-child 'offset n))) 
                            ,(string->symbol (format "align=~a" (expt 2 (ast-child 'alignment n)))))
                (render-node (ast-child 'expr n))))]
433
434
435
 [MemLoad (λ (n)
             (append
               (render-node (ast-child 'address n))
436
437
               `(i32.load ,(string->symbol (format "offset=~a" (ast-child 'offset n))) 
                          ,(string->symbol (format "align=~a" (expt 2 (ast-child 'alignment n)))))))]
438
439
440
441
442
443
 [LocalGet (λ (n)
              (append
                `(local.get ,(ast-child 'index n))))]
 [LocalSet (λ (n)
              (append
                (render-node (ast-child 'val n))
444
445
                `(local.set ,(ast-child 'index n))
                (render-node (ast-child 'expr n))))]
Guy Watson's avatar
Guy Watson committed
446
447
448
449
 [LocalTee (λ (n)
              (append
                (render-node (ast-child 'val n))
                `(local.tee ,(ast-child 'index n))))]
450
451
 [GlobalGet (λ (n)
               (append
452
                 `(global.get ,(string->symbol (format "$~a" (ast-child 'name n))))))]
453
454
455
 [GlobalSet (λ (n)
               (append
                 (render-node (ast-child 'val n))
456
                 `(global.set ,(string->symbol (format "$~a" (ast-child 'name n))))
457
458
                 (render-node (ast-child 'expr n))))]
)
Guy Watson's avatar
Guy Watson committed
459

Guy Watson's avatar
Guy Watson committed
460

Guy Watson's avatar
Guy Watson committed
461
462
463
464
465
(add-prop
 wasm-like
 render-hole-info
 [#f (λ (hole) `(hole!!! <,(ast-node-type hole)>))])

Guy Watson's avatar
Guy Watson committed
466
(add-att-rule
467
  wasm-like math-op
468
469
470
  [Equal (λ (n) 'i32.eq)]
  [NotEqual (λ (n) 'i32.ne)]
  [EqualZero (λ (n) 'i32.eqz)]
Guy Watson's avatar
Guy Watson committed
471
472
473
474
475
  [Addition (λ (n) 'i32.add)]
  [Subtraction (λ (n) 'i32.sub)]
  [Multiplication (λ (n) 'i32.mul)]
  [DivisionSigned (λ (n) 'i32.div_s)]
  [DivisionUnsigned (λ (n) 'i32.div_u)]
476
477
478
479
480
481
482
483
  [LessThanSigned (λ (n) 'i32.lt_s)]
  [LessThanUnsigned (λ (n) 'i32.lt_u)]
  [GreaterThanSigned (λ (n) 'i32.gt_s)]
  [GreaterThanUnsigned (λ (n) 'i32.gt_u)]
  [LessThanOrEqualSigned (λ (n) 'i32.le_s)]
  [LessThanOrEqualUnsigned (λ (n) 'i32.le_u)]
  [GreaterThanOrEqualSigned (λ (n) 'i32.gt_s)]
  [GreaterThanOrEqualUnsigned (λ (n) 'i32.gt_u)]
484
485
  [CountLeadingZero (λ (n) 'i32.clz)]
  [CountTrailingZero (λ (n) 'i32.ctz)]
486
  [NonZeroBits (λ (n) 'i32.popcnt)]
487
488
  [RemainderSigned (λ (n) 'i32.rem_s)]
  [RemainderUnsigned (λ (n) 'i32.rem_u)]
489
490
491
  [And (λ (n) 'i32.and)]
  [Or (λ (n) 'i32.or)]
  [Xor (λ (n) 'i32.xor)]
492
493
  [ShiftLeft (λ (n) 'i32.shl)]
  [ShiftRightSigned (λ (n) 'i32.shr_s)]
494
  [ShiftRightUnsigned (λ (n) 'i32.shr_u)]
495
496
  [RotateLeft (λ (n) 'i32.rotl)]
  [RotateRight (λ (n) 'i32.rotr)]
497

Guy Watson's avatar
Guy Watson committed
498
)
499
 
500
;; This line defines `webassembly-generate-ast`.
Guy Watson's avatar
Guy Watson committed
501
(assemble-spec-components webassembly wasm-like)
502
 
503
504
505
(xsmith-command-line (λ () (parameterize ([current-xsmith-type-constructor-thunks
                                           (list (λ () int))])
                             (webassembly-generate-ast 'Program)))
506
507
508
                     #:comment-wrap (λ (lines)
                                      (string-join
                                       (map (λ (x) (format ";; ~a" x)) lines)
Guy Watson's avatar
Guy Watson committed
509
510
                                       "\n"))
                     #:format-render (λ (s-exp)
Guy Watson's avatar
Guy Watson committed
511
512
513
                                      (substring
                                        (pretty-format s-exp)
                                        1)))
514
515


Guy Watson's avatar
Guy Watson committed
516
517
518
519
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

;; End of file.