Skip to content
GitLab
Projects
Groups
Snippets
/
Help
Help
Support
Community forum
Keyboard shortcuts
?
Submit feedback
Contribute to GitLab
Sign in / Register
Toggle navigation
Menu
Open sidebar
xsmith
WebAssembly Sandbox
Commits
e611fb5d
Commit
e611fb5d
authored
Mar 10, 2020
by
Guy Watson
Browse files
Add global generation to generator
parent
ace55cf3
Changes
1
Hide whitespace changes
Inline
Side-by-side
wasmlike/wasmlike.rkt
View file @
e611fb5d
...
...
@@ -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
]
[
initial
expression
])
[
initial
value
:
LiteralInt
])
#:prop
binder-info
(
name
type
definition
)]
[
GlobalGet
Expr
([
name
])
#:prop
reference-info
(
write
name
#:unifies
typ
e
)
#:prop
choice-weight
30
]
;;todo : What do I do about unification here?
#:prop
reference-info
(
read
nam
e
)
#:prop
choice-weight
30
]
[
GlobalSet
Expr
([
val
:
Expr
]
[
name
]
[
expr
:
Expr
])
#:prop
reference-info
(
write
name
#:unifies
type
)
#:prop
choice-weight
30
0
]
#: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
'global
s
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
)
...
...
Write
Preview
Supports
Markdown
0%
Try again
or
attach a new file
.
Cancel
You are about to add
0
people
to the discussion. Proceed with caution.
Finish editing this message first!
Cancel
Please
register
or
sign in
to comment