Commit e611fb5d authored by Guy Watson's avatar Guy Watson
Browse files

Add global generation to generator

parent ace55cf3
......@@ -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)
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment