wasmlike.rkt 24 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
  xsmith/app
35
  racr
36
  racket/class
37
38
  racket/pretty
  racket/string
39
  racket/match
40
  (except-in racket/list empty))
41
 
42
(define-spec-component wasm-like)
43
44
45

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

144
145
146
147
148
149
150
151
152
153
154
155
156
 ;; Type conversions
 [TypeConversion Expr ([expr : Expr])
                 #:prop choice-weight 20
                 #:prop may-be-generated #f]
 [Truncate TypeConversion ([sign = (< (random) 0.5)])]  ;; float -> int
 [Convert TypeConversion ([sign = (< (random) 0.5)])]   ;; int -> float
 [Wrap TypeConversion ()]                               ;; i64 -> i32
 [Extend TypeConversion ([sign = (< (random) 0.5)])]    ;; i32 -> i64
 [Demote TypeConversion ()]                             ;; f64 -> f32
 [Promote TypeConversion ()]                            ;; f32 -> f64
 [Reinterpret TypeConversion ()] ;; float -> int, or int -> float, but only with the same bit-width


157
158
159
160
 ;; 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
161
162
                [loop : Loop])
          #:prop choice-weight 30]
163
 
164
165
166
167
168
 )

(add-prop
  wasm-like
  fresh
Guy Watson's avatar
Guy Watson committed
169
170
171
172
173
174
175
176
177
178
179
  [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))]
180
181
  [LocalGet (hash 'index (choose-local-target (current-hole)))]
  [LocalSet (hash 'index (choose-local-target (current-hole)))]
Guy Watson's avatar
Guy Watson committed
182
  [LocalTee (hash 'index (choose-local-target (current-hole)))]
183
184
185

  #;[GlobalGet (hash 'name (fresh-var-name "$global_"))]
  #;[GlobalSet (hash 'name (fresh-var-name "$global_"))]
186
187
188
189
  ;;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
190
191
  [ForLoop (let* ([loopvar-name (binding-name (send this xsmith_get-reference-for-child! int #t))]
                  [loopvar (make-fresh-node 'GlobalSet
192
                                            (hash 'val (make-fresh-node 'LiteralIntThirtyTwo)
Guy Watson's avatar
Guy Watson committed
193
                                                  'name loopvar-name
194
195
                                                  'expr (make-fresh-node 'LiteralIntThirtyTwo)))] ;;dummy leaf node
                  [zero (make-fresh-node 'LiteralIntThirtyTwo
196
                                         (hash 'v 0))]
197
                  [one (make-fresh-node 'LiteralIntThirtyTwo
198
                                        (hash 'v 1))]
199
200
201
202
203
204
205
206
207
208
                  [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))]
209
                  [branch (make-fresh-node 'BranchIf
210
                                           (hash 'cond comparison
Guy Watson's avatar
Guy Watson committed
211
212
213
214
215
216
217
218
219
                                                 '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
220
                                         (hash 'expr loop-body))])                                     
Guy Watson's avatar
Guy Watson committed
221
222
             (hash 'loopvar loopvar
                   'loop loop))]
223
224
225
226
227
228
229
230
231
232
233
234
235
236
)

(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))))]
  )

237
238
239
240
241
242
243
244
245
246
247
248
249
250
251

;; ints and floats
;; Use these with (fresh-subtype-of ___)
;; For 32 and 64 bit types, use (fresh-type-variable i32 f32)
(define int (base-type 'int))
(define float (base-type 'float))
;; All the base types of WebAssembly, with supertypes of int and float
(define i32 (base-type 'i32 int))
(define i64 (base-type 'i64 int))
(define f32 (base-type 'f32 float))
(define f64 (base-type 'f64 float))

(define (no-child-types)
  (λ (n t) (hash))) 

252
253
(add-prop
 wasm-like type-info
254
          [Program [i32
255
                    (λ (n t) 
256
257
258
259
260
261
                       (hash 'Func i32
                             'globals (fresh-type-variable)))]] 
                            ;;todo I want the globals to possibly have different types
                             ;;'globals (λ (child-node) (fresh-type-variable))))]]
          [GlobalDeclaration [(fresh-type-variable)
                               (λ (n t) (hash 'initialvalue t))]]
262
263
          [Func [(fresh-type-variable) 
                  (λ (n t)
264
265
266
267
268
269
270
271
272
273
274
                     (hash 'root t))]]
          [LiteralIntThirtyTwo [i32
                    (no-child-types)]]
          [LiteralIntSixtyFour [i64
                    (no-child-types)]]
          [LiteralFloatThirtyTwo [f32
                    (no-child-types)]]
          [LiteralFloatSixtyFour [f64
                    (no-child-types)]]
          [Noop [(fresh-type-variable) (λ (n t) (hash 'expr t))]] ;;todo This is wierd....
          [Binop [(fresh-type-variable) 
275
276
277
                  (λ (n t) 
                     (hash 'l t 
                           'r t))]]
278
          [Unop [(fresh-type-variable)
279
                 (λ (n t)
280
                    (hash 'expr t))]]
281
          [IfElse [(fresh-type-variable)
282
                    (λ (n t)
283
284
285
286
                     (hash 'cond i32
                           'then t
                           'else t))]]
          [If [(fresh-type-variable)
287
                (λ (n t)
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
                   (hash 'cond i32
                         'then t))]]
          [Block [(fresh-type-variable) (λ (n t) (hash 'expr t))]]
          [Loop [(fresh-type-variable) (λ (n t) (hash 'expr t))]]
          [ForLoop [(fresh-type-variable) (λ (n t) (hash 'loopvar i32
                                                        'loop t))]]
          [Branch [(fresh-type-variable) (λ (n t) (hash 'val t))]] ;;todo triple check branch interactions here
          [BranchIf [(fresh-type-variable) 
                     (λ (n t) (hash 'cond i32
                                    'val t))]]
          [MemStore [(fresh-type-variable)
                     (λ (n t) (hash 'address i32 
                                    'value t
                                    'expr t))]]
          [MemLoad [(fresh-type-variable) (λ (n t) (hash 'address i32))]]
          [LocalGet [i32 (no-child-types)]]
          [LocalSet [i32 (λ (n t) (hash 'val i32
                                        'expr i32))]]
          [LocalTee [i32 (λ (n t) (hash 'val i32))]]
          [GlobalGet [(fresh-type-variable) (no-child-types)]]
          [GlobalSet [(fresh-type-variable) (λ (n t) (hash 'val t
                                                           'expr t))]]
          ;;Type conversions
          [Truncate [(fresh-subtype-of int) 
                     (λ (n t) 
                        (hash 'expr (fresh-subtype-of float)))]]
          [Convert [(fresh-subtype-of float) 
                    (λ (n t) 
                       (hash 'expr (fresh-subtype-of int)))]]
          [Wrap [i32 (λ (n t) 
                        (hash 'expr i64))]]
          [Extend [i64 (λ (n t)
                          (hash 'expr i32))]]
          [Demote [f32 (λ (n t)
                          (hash 'expr f64))]]
          [Promote [f64 (λ (n t)
                          (hash 'expr f32))]]
          [Reinterpret [(fresh-type-variable i32 i64 f32 f64) ;;constrain to concrete types
                        (λ (n t) ;; int to float or float to int, but only in the same bitwidth
                           (begin
                             (printf (format "node: ~a, type: ~a" n t))
                             (case t
                               [(i32) (hash 'expr f32)]
                               [(f32) (hash 'expr i32)]
                               [(i64) (hash 'expr f64)]
                               [(f64) (hash 'expr i64)])))]]
Guy Watson's avatar
Guy Watson committed
334
)
335

336
;; Define structured control instruction property
Guy Watson's avatar
Guy Watson committed
337
(define-non-inheriting-rule-property
338
339
  structured-control-instruction
  att-rule
340
  #:default (λ (n) #f)
341
  )
342

Guy Watson's avatar
Guy Watson committed
343
(add-prop
344
345
 wasm-like
 structured-control-instruction
346
347
 [Func (λ (n) #t)]
 [IfElse (λ (n) #t)]
348
349
 [If (λ (n) #t)]
 [Block (λ (n) #t)]
350
 [Loop (λ (n) #t)])
351

352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
(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))

371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
(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)))]
386
387
  [If (λ (n c)
         (not (eq? (ast-child 'cond n) c)))]
388
389
  [ForLoop (λ (n c)
              (not (eq? (ast-child 'loopvar n) c)))]
390
  )
391

Guy Watson's avatar
Guy Watson committed
392
393
394
395
396

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

399
400
401
402
403
404
(define (get-func-node n)
  (if (eq? (node-type n) 'Func)
    n
    (get-func-node (parent-node n))))

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

Guy Watson's avatar
Guy Watson committed
407

Guy Watson's avatar
Guy Watson committed
408
409
410
(add-prop
 wasm-like
 render-node-info
411
 [Program (λ (n) `(module
412
413
                    (import "env" "memory" (memory $mem 1))
                    (import "env" "addToCrc" (func $addToCrc (param i32)))
414
                    (import "env" "__memory_base" (global $mem_base i32))
415
                    ,@(map (λ (global)
416
417
                             `(global ,(string->symbol (format "$~a" (ast-child 'name global))) 
                                      (mut i32) 
418
                                      ,($xsmith_render-node (ast-child 'initialvalue global))))
419
                        (reverse (ast-children (ast-child 'globals n))))
420
                    ,($xsmith_render-node (ast-child 'Func n))
421
422
                    (global $mem_base_internal (mut i32) (i32.const 0))
                    (global $mem_max_internal (mut i32) (i32.const 0))
423
                    (func (export "__post_instantiate")
424
425
426
                          global.get $mem_base
                          global.set $mem_base_internal
                          global.get $mem_base_internal
427
428
                          i32.const 5242880
                          i32.add
429
                          global.set $mem_max_internal)
Guy Watson's avatar
Guy Watson committed
430
                    (func (export "_crc_globals")
431
432
433
434
435
                       ,@(flatten (map (λ (global) (append
                                                    '(global.get)
                                                    (list (string->symbol (format "$~a" (ast-child 'name global))))
                                                    '(call $addToCrc)))
                              (reverse (ast-children (ast-child 'globals n))))))))]
436
 [Func (λ (n) `(func (export "_func") (result i32)
437
                      (local ,@(make-list (ast-child 'localcount n) 'i32))
438
                     ,@($xsmith_render-node (ast-child 'root n))))]
439
440
441
442
 [LiteralIntThirtyTwo (λ (n) (list 'FIXMEEEE (ast-child 'v n)))] ;; todo fix
 [LiteralIntSixtyFour (λ (n) (list 'FIXMEEEE (ast-child 'v n)))] ;; todo fix
 [LiteralFloatThirtyTwo (λ (n) (list 'FIXMEEEE (ast-child 'v n)))] ;; todo fix
 [LiteralFloatSixtyFour (λ (n) (list 'FIXMEEEE (ast-child 'v n)))] ;; todo fix
Guy Watson's avatar
Guy Watson committed
443
444
 [Noop (λ (n) (append
                 '(nop)
445
                 ($xsmith_render-node (ast-child 'expr n))))]
446
 [Binop (λ (n) (append 
447
448
                  ($xsmith_render-node (ast-child 'l n))
                  ($xsmith_render-node (ast-child 'r n))
449
                  (list (att-value 'math-op n))))]
450
 [Unop (λ (n) (append
451
                 ($xsmith_render-node (ast-child 'expr n))
452
                 (list (att-value 'math-op n))))]
Guy Watson's avatar
Guy Watson committed
453
 [IfElse (λ (n)           
454
           (append
455
                ($xsmith_render-node (ast-child 'cond n))
456
                '(if (result i32))
457
                ($xsmith_render-node (ast-child 'then n))
458
                '(else)
459
                ($xsmith_render-node (ast-child 'else n))
460
                '(end)))]
461
462
 [If (λ (n)
        (append
463
          ($xsmith_render-node (ast-child 'cond n))
464
          '(if (result i32))
465
          ($xsmith_render-node (ast-child 'then n))
466
467
468
469
          '(end)))]
 [Block (λ (n)
           (append
             '(block (result i32))
470
             ($xsmith_render-node (ast-child 'expr n))
471
472
473
474
             '(end)))]
 [Loop (λ (n)
          (append
            '(loop (result i32))
475
            ($xsmith_render-node (ast-child 'expr n))
476
            '(end)))]
477
478
 [ForLoop (λ (n)
             (append
479
                 ($xsmith_render-node (ast-child 'val (ast-child 'loopvar n)))
480
                 `(global.set ,(string->symbol (format "$~a" (ast-child 'name (ast-child 'loopvar n)))))
481
                 ($xsmith_render-node (ast-child 'loop n))))]
Guy Watson's avatar
Guy Watson committed
482
483
 [Branch (λ (n)
            (append
484
              ($xsmith_render-node (ast-child 'val n))
Guy Watson's avatar
Guy Watson committed
485
              `(br ,(ast-child 'targetindex n))))]
Guy Watson's avatar
Guy Watson committed
486
487
 [BranchIf (λ (n)
              (append
488
489
                ($xsmith_render-node (ast-child 'val n))
                ($xsmith_render-node (ast-child 'cond n))
Guy Watson's avatar
Guy Watson committed
490
                `(br_if ,(ast-child 'targetindex n))))]
491
492
 [MemStore (λ (n)
              (append
493
494
                ($xsmith_render-node (ast-child 'address n))
                ($xsmith_render-node (ast-child 'value n))
495
496
                `(i32.store ,(string->symbol (format "offset=~a" (ast-child 'offset n))) 
                            ,(string->symbol (format "align=~a" (expt 2 (ast-child 'alignment n)))))
497
                ($xsmith_render-node (ast-child 'expr n))))]
498
499
 [MemLoad (λ (n)
             (append
500
               ($xsmith_render-node (ast-child 'address n))
501
502
               `(i32.load ,(string->symbol (format "offset=~a" (ast-child 'offset n))) 
                          ,(string->symbol (format "align=~a" (expt 2 (ast-child 'alignment n)))))))]
503
504
505
506
507
 [LocalGet (λ (n)
              (append
                `(local.get ,(ast-child 'index n))))]
 [LocalSet (λ (n)
              (append
508
                ($xsmith_render-node (ast-child 'val n))
509
                `(local.set ,(ast-child 'index n))
510
                ($xsmith_render-node (ast-child 'expr n))))]
Guy Watson's avatar
Guy Watson committed
511
512
 [LocalTee (λ (n)
              (append
513
                ($xsmith_render-node (ast-child 'val n))
Guy Watson's avatar
Guy Watson committed
514
                `(local.tee ,(ast-child 'index n))))]
515
516
 [GlobalGet (λ (n)
               (append
517
                 `(global.get ,(string->symbol (format "$~a" (ast-child 'name n))))))]
518
519
 [GlobalSet (λ (n)
               (append
520
                 ($xsmith_render-node (ast-child 'val n))
521
                 `(global.set ,(string->symbol (format "$~a" (ast-child 'name n))))
522
                 ($xsmith_render-node (ast-child 'expr n))))]
523
524
525
526
527
528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
 [Truncate (λ (n)
              (append
                '(FIXME)))]
 [Convert (λ (n)
              (append
                '(FIXME)))]
 [Wrap (λ (n)
              (append
                '(FIXME)))]
 [Extend (λ (n)
              (append
                '(FIXME)))]
 [Demote (λ (n)
              (append
                '(FIXME)))]
 [Promote (λ (n)
              (append
                '(FIXME)))]
 [Reinterpret (λ (n)
              (append
                '(FIXME)))]
544
)
Guy Watson's avatar
Guy Watson committed
545

Guy Watson's avatar
Guy Watson committed
546

Guy Watson's avatar
Guy Watson committed
547
548
549
(add-prop
 wasm-like
 render-hole-info
550
551
552
 [#f (λ (n)
        (append 
          `(hole!!! <,(ast-node-type n)>)))])
Guy Watson's avatar
Guy Watson committed
553

Guy Watson's avatar
Guy Watson committed
554
(add-att-rule
555
  wasm-like math-op
556
557
558
  [Equal (λ (n) 'i32.eq)]
  [NotEqual (λ (n) 'i32.ne)]
  [EqualZero (λ (n) 'i32.eqz)]
Guy Watson's avatar
Guy Watson committed
559
560
561
562
563
  [Addition (λ (n) 'i32.add)]
  [Subtraction (λ (n) 'i32.sub)]
  [Multiplication (λ (n) 'i32.mul)]
  [DivisionSigned (λ (n) 'i32.div_s)]
  [DivisionUnsigned (λ (n) 'i32.div_u)]
564
565
566
567
568
569
570
571
  [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)]
572
573
  [CountLeadingZero (λ (n) 'i32.clz)]
  [CountTrailingZero (λ (n) 'i32.ctz)]
574
  [NonZeroBits (λ (n) 'i32.popcnt)]
575
576
  [RemainderSigned (λ (n) 'i32.rem_s)]
  [RemainderUnsigned (λ (n) 'i32.rem_u)]
577
578
579
  [And (λ (n) 'i32.and)]
  [Or (λ (n) 'i32.or)]
  [Xor (λ (n) 'i32.xor)]
580
581
  [ShiftLeft (λ (n) 'i32.shl)]
  [ShiftRightSigned (λ (n) 'i32.shr_s)]
582
  [ShiftRightUnsigned (λ (n) 'i32.shr_u)]
583
584
  [RotateLeft (λ (n) 'i32.rotl)]
  [RotateRight (λ (n) 'i32.rotr)]
585

Guy Watson's avatar
Guy Watson committed
586
)
587
 
588
;; This line defines `webassembly-generate-ast`.
Guy Watson's avatar
Guy Watson committed
589
(assemble-spec-components webassembly wasm-like)
590
 
591
(xsmith-command-line (λ () (parameterize ([current-xsmith-type-constructor-thunks
592
                                           (list (λ () i32))])
593
                             (webassembly-generate-ast 'Program)))
594
595
596
                     #:comment-wrap (λ (lines)
                                      (string-join
                                       (map (λ (x) (format ";; ~a" x)) lines)
Guy Watson's avatar
Guy Watson committed
597
598
                                       "\n"))
                     #:format-render (λ (s-exp)
Guy Watson's avatar
Guy Watson committed
599
600
601
                                      (substring
                                        (pretty-format s-exp)
                                        1)))
602
603


Guy Watson's avatar
Guy Watson committed
604
605
606
607
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

;; End of file.