Skip to content
Draft
Show file tree
Hide file tree
Changes from all commits
Commits
File filter

Filter by extension

Filter by extension

Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
2 changes: 1 addition & 1 deletion interpreter/exec/eval.ml
Original file line number Diff line number Diff line change
Expand Up @@ -78,7 +78,7 @@ and admin_instr' =
and ctxt = code -> code
and handle_table = (tag_inst * idx) list * tag_inst list

type cont = int32 * ctxt (* TODO: represent type properly *)
type cont = ctxt Cont.t
type ref_ += ContRef of cont option ref

let () =
Expand Down
36 changes: 36 additions & 0 deletions interpreter/exec/eval.mli
Original file line number Diff line number Diff line change
@@ -1,5 +1,7 @@
open Value
open Instance
open Source
open Ast

exception Link of Source.region * string
exception Trap of Source.region * string
Expand All @@ -10,3 +12,37 @@ exception Crash of Source.region * string

val init : Ast.module_ -> extern list -> module_inst (* raises Link, Trap *)
val invoke : func_inst -> value list -> value list (* raises Trap *)



type 'a stack = 'a list

type frame =
{
inst : module_inst;
locals : value option ref list;
}

type code = value stack * admin_instr list

and admin_instr = admin_instr' phrase
and admin_instr' =
| Plain of instr'
| Refer of ref_
| Invoke of func_inst
| Breaking of int32 * value stack
| Returning of value stack
| ReturningInvoke of value stack * func_inst
| Throwing of Tag.t * value stack
| Trapping of string
| Label of int * instr list * code
| Frame of int * frame * code
| Handler of int * catch list * code
| Prompt of handle_table * code
| Suspending of tag_inst * value stack * (int32 * ref_) option * ctxt

and ctxt = code -> code
and handle_table = (tag_inst * idx) list * tag_inst list
Comment on lines +18 to +45
Copy link
Copy Markdown
Member

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

Is there a reason you want to expose all this? If you need type ctxt in the interface to define cont below, it suffices to export it abstractly (justtype ctxt), and then all the other types don't need to be here.

Copy link
Copy Markdown
Member Author

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

No reason, this is just copied out of the .ml file and I didn't know it could be shortened. Will give it a shot.


type cont = ctxt Cont.t
type ref_ += ContRef of cont option ref
7 changes: 7 additions & 0 deletions interpreter/runtime/cont.ml
Original file line number Diff line number Diff line change
@@ -0,0 +1,7 @@
(*
open Types
open Value
*)

type 'ctxt t = 'ctxt cont
and 'ctxt cont = int32 * 'ctxt (* TODO: represent type properly *)
Comment on lines +6 to +7
Copy link
Copy Markdown
Member

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

Nit: these don't need to be recursive, just put cont first.

5 changes: 5 additions & 0 deletions interpreter/runtime/cont.mli
Original file line number Diff line number Diff line change
@@ -0,0 +1,5 @@
(* open Types *)
(* open Value *)

type 'ctxt t = 'ctxt cont
and 'ctxt cont = int32 * 'ctxt (* TODO: represent type properly *)
1 change: 0 additions & 1 deletion interpreter/runtime/global.ml
Original file line number Diff line number Diff line change
Expand Up @@ -9,7 +9,6 @@ exception NotMutable

let alloc (GlobalT (_mut, t) as ty) v =
assert Free.((val_type t).types = Set.empty);
if not (Match.match_val_type [] (type_of_value v) t) then raise Type;
Copy link
Copy Markdown
Member

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

Why remove this check?

Copy link
Copy Markdown
Member Author

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

This was causing allocation of globals with defined continuation types to fail because type_of_value rerurns the top cont type for continuation values.

{ty; content = v}

let type_of glob =
Expand Down
8 changes: 5 additions & 3 deletions interpreter/script/run.ml
Original file line number Diff line number Diff line change
@@ -1,5 +1,6 @@
open Script
open Source
open Eval


(* Errors & Tracing *)
Expand Down Expand Up @@ -344,7 +345,7 @@ let rec run_definition def : Ast.module_ * Custom.section list =

let run_action act : Value.t list =
match act.it with
| Invoke (x_opt, name, vs) ->
| (Invoke (x_opt, name, vs): Wasm.Script.action') ->
Copy link
Copy Markdown
Member

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

The complaint about the module recursion must be because this refers back to module Wasm. Just drop the prefix.

trace ("Invoking function \"" ^ Types.string_of_name name ^ "\"...");
let inst = lookup_instance x_opt act.at in
(match Instance.export inst name with
Expand Down Expand Up @@ -412,10 +413,11 @@ let assert_ref_pat r p =
| RefTypePat Types.EqHT, (I31.I31Ref _ | Aggr.StructRef _ | Aggr.ArrayRef _)
| RefTypePat Types.I31HT, I31.I31Ref _
| RefTypePat Types.StructHT, Aggr.StructRef _
| RefTypePat Types.ArrayHT, Aggr.ArrayRef _ -> true
| RefTypePat Types.ArrayHT, Aggr.ArrayRef _
| RefTypePat Types.FuncHT, Instance.FuncRef _
| RefTypePat Types.ContHT, Eval.ContRef _
| RefTypePat Types.ExnHT, Exn.ExnRef _
| RefTypePat Types.ExternHT, _ -> true
| RefTypePat Types.ExternHT, _
| NullPat, Value.NullRef _ -> true
| _ -> false

Expand Down
1 change: 1 addition & 0 deletions interpreter/text/lexer.mll
Original file line number Diff line number Diff line change
Expand Up @@ -341,6 +341,7 @@ rule token = parse
| "ref.func" -> REF_FUNC
| "ref.struct" -> REF_STRUCT
| "ref.array" -> REF_ARRAY
| "ref.cont" -> REF_CONT
| "ref.exn" -> REF_EXN
| "ref.extern" -> REF_EXTERN
| "ref.host" -> REF_HOST
Expand Down
3 changes: 2 additions & 1 deletion interpreter/text/parser.mly
Original file line number Diff line number Diff line change
Expand Up @@ -319,7 +319,7 @@ let parse_annots (m : module_) : Custom.section list =
%token<string> OFFSET_EQ_NAT ALIGN_EQ_NAT
%token<string Source.phrase -> Ast.instr' * Value.num> CONST
%token<Ast.instr'> UNARY BINARY TEST COMPARE CONVERT
%token REF_NULL REF_FUNC REF_I31 REF_STRUCT REF_ARRAY REF_EXN REF_EXTERN REF_HOST
%token REF_NULL REF_FUNC REF_I31 REF_STRUCT REF_ARRAY REF_CONT REF_EXN REF_EXTERN REF_HOST
%token REF_EQ REF_IS_NULL REF_AS_NON_NULL REF_TEST REF_CAST
%token<Ast.instr'> I31_GET
%token<Ast.idx -> Ast.instr'> STRUCT_NEW ARRAY_NEW ARRAY_GET
Expand Down Expand Up @@ -1626,6 +1626,7 @@ result :
| LPAR REF_STRUCT RPAR { RefResult (RefTypePat StructHT) @@ $sloc }
| LPAR REF_ARRAY RPAR { RefResult (RefTypePat ArrayHT) @@ $sloc }
| LPAR REF_FUNC RPAR { RefResult (RefTypePat FuncHT) @@ $sloc }
| LPAR REF_CONT RPAR { RefResult (RefTypePat ContHT) @@ $sloc }
| LPAR REF_EXN RPAR { RefResult (RefTypePat ExnHT) @@ $sloc }
| LPAR REF_EXTERN RPAR { RefResult (RefTypePat ExternHT) @@ $sloc }
| LPAR REF_NULL RPAR { RefResult NullPat @@ $sloc }
Expand Down
4 changes: 2 additions & 2 deletions interpreter/valid/valid.ml
Original file line number Diff line number Diff line change
Expand Up @@ -1147,8 +1147,8 @@ let is_const (c : context) (e : instr) =
| Const _ | VecConst _
| Binary (Value.I32 I32Op.(Add | Sub | Mul))
| Binary (Value.I64 I64Op.(Add | Sub | Mul))
| RefNull _ | RefFunc _
| RefI31 | StructNew _ | ArrayNew _ | ArrayNewFixed _ -> true
| RefNull _ | RefFunc _ | RefI31
| StructNew _ | ArrayNew _ | ArrayNewFixed _ | ContNew _ -> true
| GlobalGet x -> let GlobalT (mut, _t) = global c x in mut = Cons
| _ -> false

Expand Down
Loading
Loading