Commit dc32fbdc authored by Camil Staps's avatar Camil Staps 🍃

Interpreter generator: move general WebAssembly stuff to separate module

parent f650fc7b
Pipeline #23959 failed with stages
in 13 minutes and 4 seconds
......@@ -3,8 +3,7 @@ definition module target
import StdEnv
import StdMaybe
import interpretergen
:: Type
from wasm import :: Type
class wasm_type a :: !a -> Type
......
This diff is collapsed.
definition module wasm
from StdOverloaded import class ==, class toString
:: Label :== String
:: Locality :== Bool
:: Variable = Variable !Locality !Label
Local v :== Variable True v
Global v :== Variable False v
:: Type = I8 | I16 | I32 | I64 | F32 | F64
:: Signedness :== Bool; Signed :== True; Unsigned :== False; DontCare :== False
instance == Type
instance toString Type
type_width :: !Type -> Int
type_width_shift :: !Type -> Int
class wasm_literal a
where
wasm_repr :: !a -> String
is_zero :: !a -> Bool
instance wasm_literal Int, Char
:: Ex
// Actual wasm instructions:
= Eunreachable
| Ereturn !Ex
| Eblock
| Eloop
| Ebr !Label
| Ebr_local !Int
| Ebr_if !Int !Ex
| Eend
| Eif !Ex
| Ethen
| Eelse
| Ecall !Label ![Ex]
| Eselect !Ex !Ex !Ex
| Etee !Variable !Ex
| Eset !Variable !Ex
| Eget !Variable
| Eload !Type /*target*/ !Type /*source*/ !Signedness !Int /*offset*/ !Ex
| Estore !Type /*target*/ !Type /*source*/ !Int /*offset*/ !Ex !Ex
| E.a: Econst !Type !a & wasm_literal a
| Eadd !Type !Ex !Ex
| Esub !Type !Ex !Ex
| Emul !Type !Ex !Ex
| Ediv !Type !Signedness !Ex !Ex
| Erem !Type !Signedness !Ex !Ex
| Eeq !Type !Ex !Ex
| Ene !Type !Ex !Ex
| Elt !Type !Signedness !Ex !Ex
| Egt !Type !Signedness !Ex !Ex
| Ele !Type !Signedness !Ex !Ex
| Ege !Type !Signedness !Ex !Ex
| Eeqz !Type !Ex
| Eand !Type !Ex !Ex
| Eor !Type !Ex !Ex
| Exor !Type !Ex !Ex
| Eshl !Type !Ex !Ex
| Eshr !Type !Signedness !Ex !Ex
| Eabs !Type !Ex
| Efloor !Type !Ex
| Eneg !Type !Ex
| Esqrt !Type !Ex
| Ewrap !Type /*target*/ !Type /*source*/ !Ex
| Eextend !Type /*target*/ !Type /*source*/ !Ex
| Ereinterpret !Type /*target*/ !Type /*source*/ !Ex
| Etrunc !Type /*target*/ !Type /*source*/ !Ex
| Econvert !Type /*target*/ !Type /*source*/ !Ex
// Meta-instructions used internally:
| Ivar !Variable
| Iref !Type !Type !Int !Ex // load or store
class type a :: !a -> Type
type2 :: !a !a -> Type | type a
instance type Ex, Variable
instance toString Ex
implementation module wasm
import StdEnv
instance == Type
where
== a b = case a of
I8 -> b=:I8
I16 -> b=:I16
I32 -> b=:I32
I64 -> b=:I64
F32 -> b=:F32
F64 -> b=:F64
instance toString Type
where
toString t = case t of
I32 -> "i32"
I64 -> "i64"
F32 -> "f32"
F64 -> "f64"
I8 -> "i8"
I16 -> "i16"
type_width :: !Type -> Int
type_width t = case t of
I64 -> 8
I32 -> 4
F64 -> 8
F32 -> 4
I16 -> 2
I8 -> 1
type_width_shift :: !Type -> Int
type_width_shift t = case t of
I64 -> 3
I32 -> 2
F64 -> 3
F32 -> 2
I16 -> 1
I8 -> 0
instance wasm_literal Int
where
wasm_repr i = toString i
is_zero i = i == 0
instance wasm_literal Char
where
wasm_repr c = toString (toInt c)
is_zero c = c == '\0'
instance type Ex
where
type e = case e of
Eselect a b _ -> type2 a b
Etee _ e -> type e
Eget v -> type v
Eload t _ _ _ _ -> t
Econst t _ -> t
Eadd t _ _ -> t
Esub t _ _ -> t
Emul t _ _ -> t
Ediv t _ _ _ -> t
Erem t _ _ _ -> t
Eeq _ _ _ -> I32
Ene _ _ _ -> I32
Elt _ _ _ _ -> I32
Egt _ _ _ _ -> I32
Ele _ _ _ _ -> I32
Ege _ _ _ _ -> I32
Eeqz _ _ -> I32
Eand t _ _ -> t
Eor t _ _ -> t
Exor t _ _ -> t
Eshl t _ _ -> t
Eshr t _ _ _ -> t
Eabs t _ -> t
Efloor t _ -> t
Eneg t _ -> t
Esqrt t _ -> t
Ewrap t _ _ -> t
Eextend t _ _ -> t
Ereinterpret t _ _ -> t
Etrunc t _ _ -> t
Econvert t _ _ -> t
Ivar v -> type v
Iref t _ _ _ -> t
_ -> abort e
where
abort :: !.a -> .b
abort _ = code {
print "missing case in type:\n"
.d 1 0
jsr _print_graph
.o 0 0
halt
}
instance type Variable
where
type (Variable _ v)
| v.[0]=='v' = case v.[1] of
'w' -> I32
'q' -> I64
'd' -> F64
| v=="pc" = I32
| v=="asp" = I32
| v=="bsp" = I32
| v=="csp" = I32
| v=="hp" = I32
| v=="hp-free" = I32
| v=="hp-size" = I32
| otherwise = abort ("unknown variable "+++v+++"\n")
type2 :: !a !a -> Type | type a
type2 a b = let ta = type a in if (ta == type b) ta (abort "type mismatch\n")
instance toString Ex
where
toString e = case e of
Eunreachable -> "(unreachable)"
Ereturn e -> "(return "+++toString e+++")"
Eblock -> "(block"
Eloop -> "(loop"
Ebr l -> "(br $"+++l+++")"
Ebr_local i -> "(br "+++toString i+++")"
Ebr_if i c -> "(br_if "+++toString i+++" "+++toString c+++")"
Eend -> ")"
Eif e -> "(if "+++toString e
Ethen -> "(then"
Eelse -> "(else"
Ecall l args -> "(call $"+++foldl (+++) l [" "+++toString a \\ a <- args]+++")"
Eselect a b c -> "(select "+++toString a+++toString b+++toString c+++")"
Etee (Variable True v) e -> "(local.tee $" +++v+++" "+++toString e+++")"
Eset (Variable True v) e -> "(local.set $" +++v+++" "+++toString e+++")"
Eset (Variable False v) e -> "(global.set $"+++v+++" "+++toString e+++")"
Eget (Variable True v) -> "(local.get $" +++v+++")"
Eget (Variable False v) -> "(global.get $" +++v+++")"
Eload loctype srctype signed offset addr
-> "("+++toString loctype+++".load"+++srctype`+++offset`+++toString addr+++")"
with
srctype` = case srctype of
I8 -> "8" +++signed_extension
I16 -> "16"+++signed_extension
I32 -> if (loctype=:I32) "" ("32"+++signed_extension)
_ -> ""
signed_extension = if signed "_s" "_u"
offset` = if (offset==0) " " (" offset="+++toString offset+++" ")
Estore loctype srctype offset addr e
-> "("+++toString loctype+++".store"+++srctype`+++offset`+++toString addr+++toString e+++")"
with
srctype` = case srctype of
I8 -> "8"
I16 -> "16"
I32 -> if (loctype=:I32) "" "32"
_ -> ""
offset` = if (offset==0) " " (" offset="+++toString offset+++" ")
Econst t x -> "("+++toString t+++".const "+++wasm_repr x+++")"
Eadd t a b -> "("+++toString t+++".add "+++toString a+++toString b+++")"
Esub t a b -> "("+++toString t+++".sub "+++toString a+++toString b+++")"
Emul t a b -> "("+++toString t+++".mul "+++toString a+++toString b+++")"
Ediv t signed a b -> "("+++toString t+++signed_op t signed "div"+++toString a+++toString b+++")"
Erem t signed a b -> "("+++toString t+++if signed ".rem_s " ".rem_u "+++toString a+++toString b+++")"
Eeq t a b -> "("+++toString t+++".eq "+++toString a+++toString b+++")"
Ene t a b -> "("+++toString t+++".ne "+++toString a+++toString b+++")"
Elt t signed a b -> "("+++toString t+++signed_op t signed "lt"+++toString a+++toString b+++")"
Egt t signed a b -> "("+++toString t+++signed_op t signed "gt"+++toString a+++toString b+++")"
Ele t signed a b -> "("+++toString t+++signed_op t signed "le"+++toString a+++toString b+++")"
Ege t signed a b -> "("+++toString t+++signed_op t signed "ge"+++toString a+++toString b+++")"
Eeqz t e -> "("+++toString t+++".eqz "+++toString e+++")"
Eand t a b -> "("+++toString t+++".and "+++toString a+++toString b+++")"
Eor t a b -> "("+++toString t+++".or " +++toString a+++toString b+++")"
Exor t a b -> "("+++toString t+++".xor "+++toString a+++toString b+++")"
Eshl t a b -> "("+++toString t+++".shl "+++toString a+++toString b+++")"
Eshr t signed a b -> "("+++toString t+++if signed ".shr_s " ".shr_u "+++toString a+++toString b+++")"
Eabs t e -> "("+++toString t+++".abs "+++toString e+++")"
Efloor t e -> "("+++toString t+++".floor "+++toString e+++")"
Eneg t e -> "("+++toString t+++".neg "+++toString e+++")"
Esqrt t e -> "("+++toString t+++".sqrt "+++toString e+++")"
Ewrap totype frtype e -> "("+++toString totype+++".wrap_" +++toString frtype+++" "+++toString e+++")"
Eextend totype frtype e -> "("+++toString totype+++".extend_" +++toString frtype+++"_s "+++toString e+++")"
Ereinterpret totype frtype e -> "("+++toString totype+++".reinterpret_"+++toString frtype+++" "+++toString e+++")"
Etrunc totype frtype e -> "("+++toString totype+++".trunc_" +++toString frtype+++"_s "+++toString e+++")"
Econvert totype frtype e -> "("+++toString totype+++".convert_" +++toString frtype+++"_s "+++toString e+++")"
Ivar v -> toString (Eget v)
Iref loctype srctype offset addr -> toString (Eload loctype srctype Signed offset addr)
where
signed_op t sig op = case t of
F64 -> "."+++op+++" "
_ -> "."+++op+++if sig "_s" "_u"
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