Skip to content
Open
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
31 changes: 27 additions & 4 deletions interpreter/binary/decode.ml
Original file line number Diff line number Diff line change
Expand Up @@ -1028,14 +1028,37 @@ let type_section s =

(* Import section *)

let import s =
let imports s =
let left = pos s in
let module_name = name s in
let item_name = name s in
let xt = externtype s in
Import (module_name, item_name, xt)
if item_name = [] then
match peek s with
| Some 0x7f ->
skip 1 s;
vec (fun s ->
let l = pos s in
let nm = name s in
let xt = externtype s in
Import (module_name, nm, xt) @@ region s l (pos s)
) s
| Some 0x7e ->
skip 1 s;
let xt = externtype s in
vec (fun s ->
let l = pos s in
let nm = name s in
Import (module_name, nm, xt) @@ region s l (pos s)
) s
| _ ->
let xt = externtype s in
[Import (module_name, item_name, xt) @@ region s left (pos s)]
else
let xt = externtype s in
[Import (module_name, item_name, xt) @@ region s left (pos s)]
Comment on lines +1057 to +1058
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.

You can avoid duplicating this case by replacing the outer if with guards on the cases, like

    match peek s with
    | Some 0x7f when item_name = [] -> ...
    | Some 0x7e when item_name = [] -> ...
    | _ -> ...


let import_section s =
section Custom.Import (vec (at import)) [] s
section Custom.Import (fun s -> List.concat (vec imports s)) [] s


(* Function section *)
Expand Down
85 changes: 60 additions & 25 deletions interpreter/text/parser.mly
Original file line number Diff line number Diff line change
Expand Up @@ -1227,32 +1227,67 @@ table_fields :
/* Imports & Exports */

externtype :
| LPAR FUNC bindidx_opt typeuse RPAR
{ fun c -> ignore ($3 c anon_func bind_func);
fun () -> ExternFuncT (Idx ($4 c).it) }
| LPAR TAG bindidx_opt typeuse RPAR
{ fun c -> ignore ($3 c anon_tag bind_tag);
fun () -> ExternTagT (TagT (Idx ($4 c).it)) }
| LPAR TAG bindidx_opt functype RPAR /* Sugar */
{ fun c -> ignore ($3 c anon_tag bind_tag);
fun () -> ExternTagT (TagT (Idx (inline_functype c ($4 c) $loc($4)).it)) }
| LPAR GLOBAL bindidx_opt globaltype RPAR
{ fun c -> ignore ($3 c anon_global bind_global);
fun () -> ExternGlobalT ($4 c) }
| LPAR MEMORY bindidx_opt memorytype RPAR
{ fun c -> ignore ($3 c anon_memory bind_memory);
fun () -> ExternMemoryT ($4 c) }
| LPAR TABLE bindidx_opt tabletype RPAR
{ fun c -> ignore ($3 c anon_table bind_table);
fun () -> ExternTableT ($4 c) }
| LPAR FUNC bindidx_opt functype RPAR /* Sugar */
{ fun c -> ignore ($3 c anon_func bind_func);
fun () -> ExternFuncT (Idx (inline_functype c ($4 c) $loc($4)).it) }
| LPAR FUNC option(bindidx) typeuse RPAR
{ fun c -> ($3, anon_func, bind_func,
fun () -> ExternFuncT (Idx ($4 c).it)) }
Comment on lines +1231 to +1232
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.

Perhaps this somewhat complicated deferred application and checking can be avoided by passing in a Boolean attribute b that controls whether an id is allowed. Like:

    { fun c b -> ignore ($3 c b anon_func (bind_if b bind_func));
      fun () -> ExternFuncT (Idx ($4 c).it) }

where

let bind_if b f = if b then f else fun _c x -> error x.at "identifier not allowed"

| LPAR TAG option(bindidx) typeuse RPAR
{ fun c -> ($3, anon_tag, bind_tag,
fun () -> ExternTagT (TagT (Idx ($4 c).it))) }
| LPAR TAG option(bindidx) functype RPAR /* Sugar */
{ fun c -> ($3, anon_tag, bind_tag,
fun () -> ExternTagT (TagT (Idx (inline_functype c ($4 c) $loc($4)).it))) }
| LPAR GLOBAL option(bindidx) globaltype RPAR
{ fun c -> ($3, anon_global, bind_global,
fun () -> ExternGlobalT ($4 c)) }
| LPAR MEMORY option(bindidx) memorytype RPAR
{ fun c -> ($3, anon_memory, bind_memory,
fun () -> ExternMemoryT ($4 c)) }
| LPAR TABLE option(bindidx) tabletype RPAR
{ fun c -> ($3, anon_table, bind_table,
fun () -> ExternTableT ($4 c)) }
| LPAR FUNC option(bindidx) functype RPAR /* Sugar */
{ fun c -> ($3, anon_func, bind_func,
fun () -> ExternFuncT (Idx (inline_functype c ($4 c) $loc($4)).it)) }

compact_item1 :
| LPAR ITEM name externtype RPAR
{ fun c -> let (id, anon, bind, df) = $4 c in
ignore (match id with None -> anon c $loc($4) | Some x -> bind c x);
fun () -> ($3, df ()) }

compact_item1_list :
| compact_item1
{ fun c -> let f = $1 c in
fun () -> [f ()] }
| compact_item1 compact_item1_list
{ fun c -> let f = $1 c in let fs = $2 c in
fun () -> f () :: fs () }

compact_item2_list :
| LPAR ITEM name RPAR compact_item2_list
{ let (items, xt_fn) = $5 in ($3 :: items, xt_fn) }
| externtype
{ ([], $1) }

import :
| LPAR IMPORT name name externtype RPAR
{ fun c -> let df = $5 c in
fun () -> Import ($3, $4, df ()) @@ $sloc }
{ fun c -> let (id, anon, bind, df) = $5 c in
ignore (match id with None -> anon c $loc($5) | Some x -> bind c x);
fun () -> [Import ($3, $4, df ()) @@ $sloc] }
| LPAR IMPORT name compact_item1_list RPAR
{ fun c -> let items = $4 c in
fun () ->
List.map (fun (item_name, xt) -> Import ($3, item_name, xt) @@ $sloc)
(items ()) }
| LPAR IMPORT name compact_item2_list RPAR
{ fun c ->
let (items, xt_fn) = $4 in
let (id, anon, _bind, df) = xt_fn c in
(match id with Some x -> error x.at "identifier not allowed" | None -> ());
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.

Suggested change
(match id with Some x -> error x.at "identifier not allowed" | None -> ());
Option.iter (fun x -> error x.at "identifier not allowed") id;

List.iter (fun _ -> ignore (anon c $sloc)) items;
fun () ->
let xt = df () in
List.map (fun item_name -> Import ($3, item_name, xt) @@ $sloc) items }

inline_import :
| LPAR IMPORT name name RPAR { $3, $4 }
Expand Down Expand Up @@ -1377,8 +1412,8 @@ module_fields1 :
| import module_fields
{ fun c -> let imf = $1 c in let mff = $2 c in
fun () -> let mf = mff () in
fun () -> let im = imf () in let m = mf () in
{m with imports = im :: m.imports} }
fun () -> let ims = imf () in let m = mf () in
{m with imports = ims @ m.imports} }
| export module_fields
{ fun c -> let mff = $2 c in
fun () -> let mf = mff () in
Expand Down
Loading