Add global generation to generator

wasmlike/wasmlike.rkt

@@ -43,7 +43,7 @@
 (add-to-grammar
  wasm-like
  [Program #f (Func
-              [globals : GlobalDeclaration * = 5])]
+              [globals : GlobalDeclaration *])]
  [Func #f ([root : Expr]
            [localcount = (random 1 10)])]
  [Expr #f ()
@@ -91,16 +91,16 @@
                  [expr : Expr])]
  [GlobalDeclaration #f ([name]
                         [type]
-                        [initialexpression])
+                        [initialvalue : LiteralInt])
                     #:prop binder-info (name type definition)]
  [GlobalGet Expr ([name])
-            #:prop reference-info (write name #:unifies type)
-            #:prop choice-weight 30] ;;todo : What do I do about unification here?
+            #:prop reference-info (read name)
+            #:prop choice-weight 30] 
  [GlobalSet Expr ([val : Expr]
                   [name]
                   [expr : Expr])
-            #:prop reference-info (write name #:unifies type)
-            #:prop choice-weight 300]
+            #:prop reference-info (write name #:unifies val)
+            #:prop choice-weight 30]
  )
 
 (add-prop
@@ -112,8 +112,20 @@
               (hash 'targetindex index 'targetnode node))]
   [LocalGet (hash 'index (choose-local-target (current-hole)))]
   [LocalSet (hash 'index (choose-local-target (current-hole)))]
-  [GlobalGet (hash 'name (fresh-var-name "$global_"))]
-  [GlobalSet (hash 'name (fresh-var-name "$global_"))]
+  #;[GlobalSet (λ (d)
+                (let* ([type (hash-ref d 'type [(fresh-type-variable)])]
+                       [binders (ast-child 'globals (top-ancestor-node (current-hole)))]
+                       [fresh-node (make-fresh-node 'GlobalDeclaration
+                                                    (hash 'type type))])
+                  (begin 
+                    (append binders (make-fresh-node 'GlobalDeclaration
+                                                     (hash 'type type)))
+                    (hash 'type type
+                          'name (ast-child 'name fresh-node)))))]
+
+
+  #;[GlobalGet (hash 'name (fresh-var-name "$global_"))]
+  #;[GlobalSet (hash 'name (fresh-var-name "$global_"))]
 )
 
 (add-att-rule
@@ -134,7 +146,7 @@
                     (λ (n t) 
                        (hash 'Func (fresh-type-variable)
                              'globals (λ (cn) (fresh-type-variable))))]]
-          [GlobalDeclaration [int (no-child-types)]]
+          [GlobalDeclaration [int (λ (n t) (hash 'initialvalue int))]]
           [Func [(fresh-type-variable) 
                   (λ (n t)
                      (hash 'root (fresh-type-variable)))]]
@@ -246,9 +258,9 @@
                     (import "env" "__memory_base" (global $mem_base i32))
                     ,(begin0
                        (map (λ (global)
-                               `(global ,(string->symbol (ast-child 'name global)) (mut i32)))
-                            (ast-children (ast-child 'globals n)))
-                       (printf (format "globals: ~a" (ast-children (ast-child 'globals n)))))
+                    ,@(map (λ (global)
+                             `(global ,(string->symbol (format "$~a" (ast-child 'name global))) (mut i32)))
+                        (reverse (ast-children (ast-child 'globals n))))
                     ,(render-node (ast-child 'Func n))
                     (global $mem_base_internal (mut i32) (i32.const 0))
                     (global $mem_max_internal (mut i32) (i32.const 0))
@@ -259,10 +271,12 @@
                           i32.const 5242880
                           i32.add
                           global.set $mem_max_internal)
-                    #;(func (export "crc_globals")
-                          ,(map (λ (global)
-                                   `(global ,(string->symbol (ast-child 'name global)) (mut i32)))
-                                (ast-children (ast-child 'globals n))))))]
+                    (func (export "crc_globals")
+                       ,@(flatten (map (λ (global) (append
+                                                    '(global.get)
+                                                    (list (string->symbol (format "$~a" (ast-child 'name global))))
+                                                    '(call $addToCrc)))
+                              (reverse (ast-children (ast-child 'globals n))))))))]
  [Func (λ (n) `(func (export "_func") (result i32)
                       (local ,@(make-list (ast-child 'localcount n) 'i32))
                      ,@(render-node (ast-child 'root n))))]
@@ -339,7 +353,9 @@
 ;; This line defines `webassembly-generate-ast`.
 (assemble-spec-components webassembly wasm-like)
  
-(xsmith-command-line (λ () (webassembly-generate-ast 'Program))
+(xsmith-command-line (λ () (parameterize ([current-xsmith-type-constructor-thunks
+                                           (list (λ () int))])
+                             (webassembly-generate-ast 'Program)))
                      #:comment-wrap (λ (lines)
                                       (string-join
                                        (map (λ (x) (format ";; ~a" x)) lines)