Remove multiple-return-type support

ml-proto/README.md

@@ -88,8 +88,6 @@ For most part, the language understood by the interpreter is based on Ben's V8 p
 
 * *Expression Language.* There is no distinction between statements and expressions, everything is an expression. Some have an empty return type. Consequently, there is no need for a comma operator or ternary operator.
 
-* *Multiple Values.* Functions can return multiple values. These can be destructured with a dedicated expression. They can also be returned from a caller (e.g. for tail-calls). Parameters and results are treated fully symmetrically.
-
 * *Simple Loops*. Like in Ben's prototype, there is only one sort of loop, the infinite one, which can only be terminated by an explicit `break`. In such a language, a `continue` statement actually is completely redundant, because it equivalent to a `break` to a label on the loop's *body*. So I dropped `continue`.
 
 * *Break with Arguments.* In the spirit of a true expression language, `break` can carry arguments, which then become the result of the labelled expression it cuts to.
@@ -119,12 +117,11 @@ type expr =
   | If of expr * expr * expr                (* conditional
   | Loop of expr                            (* infinite loop
   | Label of expr                           (* labelled expression
-  | Break of int * expr list                (* break to n-th surrounding label
+  | Break of int * expr option              (* break to n-th surrounding label
   | Switch of expr * arm list * expr        (* switch, latter expr is default
   | Call of var * expr list                 (* call function
   | CallIndirect of var * expr * expr list  (* call function through table
-  | Return of expr list                     (* return 0 to many value
-  | Destruct of var list * expr             (* destructure multi-value into locals
+  | Return of expr option                   (* return 0 to many value
   | GetParam of var                         (* read parameter
   | GetLocal of var                         (* read local variable
   | SetLocal of var * expr                  (* write local variable
@@ -143,8 +140,6 @@ and arm = {value : value; expr : expr; fallthru : bool}
 
 See the code for more details on the auxiliary types. It also contains ASTs for functions and modules.
 
-As currently implemented, multiple values can be *produced* by either `Call`/`Dispatch` or `Break`/`Label`, and *consumed* by `Destruct`, `Return` or `Call`/`Dispatch`. They pass through `Block`, `Loop`, `Label` and `Switch`. This may be considered too rich, or not rich enough.
-
 
 ## External Syntax
 
@@ -172,13 +167,12 @@ expr:
   ( if <expr> <expr> )                     ;; = (if <expr> <expr> (nop))
   ( loop <expr>* )                         ;; = (loop (block <expr>*))
   ( label <name>? <expr>* )                ;; = (label (block <expr>*))
-  ( break <var> <expr>* )
+  ( break <var> <expr>? )
   ( break )                                ;; = (break 0)
   ( <type>.switch <expr> <case>* <expr> )
   ( call <var> <expr>* )
   ( call_indirect <var> <expr> <expr>* )
-  ( return <expr>* )
-  ( destruct <var>* <expr> )
+  ( return <expr>? )
   ( get_local <var> )
   ( set_local <var> <expr> )
   ( load_global <var> )
@@ -195,9 +189,9 @@ case:
   ( case <value> <expr>* fallthrough? )  ;; = (case <int> (block <expr>*) fallthrough?)
   ( case <value> )                       ;; = (case <int> (nop) fallthrough)
 
-func:   ( func <name>? <param>* <result>* <local>* <expr>* )
+func:   ( func <name>? <param>* <result>? <local>* <expr>* )
 param:  ( param <type>* ) | ( param <name> <type> )
-result: ( result <type>* )
+result: ( result <type> )
 local:  ( local <type>* ) | ( local <name> <type> )
 
 module: ( module <func>* <global>* <export>* <table>* <memory>? <data>* )
@@ -233,7 +227,7 @@ script: <cmd>*
 cmd:
   <module>                                       ;; define, validate, and initialize module
   ( invoke <name> <expr>* )                      ;; invoke export and print result
-  ( asserteq (invoke <name> <expr>* ) <expr>* )  ;; assert expected results of invocation
+  ( asserteq (invoke <name> <expr>* ) <expr> )   ;; assert expected results of invocation
   ( assertinvalid <module> <failure> )           ;; assert invalid module with given failure string
 ```
 

ml-proto/src/host/lexer.mll

@@ -131,7 +131,6 @@ rule token = parse
   | "call" { CALL }
   | "call_indirect" { CALLINDIRECT }
   | "return" { RETURN }
-  | "destruct" { DESTRUCT }
 
   | "get_local" { GETLOCAL }
   | "set_local" { SETLOCAL }

ml-proto/src/host/parser.mly

@@ -95,7 +95,7 @@ let anon_label c = {c with labels = VarMap.map ((+) 1) c.labels}
 
 %token INT FLOAT TEXT VAR TYPE LPAR RPAR
 %token NOP BLOCK IF LOOP LABEL BREAK SWITCH CASE FALLTHROUGH
-%token CALL CALLINDIRECT RETURN DESTRUCT
+%token CALL CALLINDIRECT RETURN
 %token GETLOCAL SETLOCAL LOADGLOBAL STOREGLOBAL LOAD STORE
 %token CONST UNARY BINARY COMPARE CONVERT
 %token FUNC PARAM RESULT LOCAL MODULE MEMORY SEGMENT GLOBAL IMPORT EXPORT TABLE
@@ -164,17 +164,16 @@ oper :
   | LABEL expr_block { fun c -> Label ($2 (anon_label c)) }
   | LABEL bind_var expr_block  /* Sugar */
     { fun c -> Label ($3 (bind_label c $2)) }
-  | BREAK var expr_list { fun c -> Break ($2 c label, $3 c) }
-  | BREAK { let at = at() in fun c -> Break (0 @@ at, []) }  /* Sugar */
+  | BREAK var expr_opt { fun c -> Break ($2 c label, $3 c) }
+  | BREAK { let at = at() in fun c -> Break (0 @@ at, None) }  /* Sugar */
   | SWITCH expr arms
     { let at1 = ati 1 in
       fun c -> let x, y = $3 c in
         Switch ($1 @@ at1, $2 c, List.map (fun a -> a $1) x, y) }
   | CALL var expr_list { fun c -> Call ($2 c func, $3 c) }
   | CALLINDIRECT var expr expr_list
     { fun c -> CallIndirect ($2 c table, $3 c, $4 c) }
-  | RETURN expr_list { fun c -> Return ($2 c) }
-  | DESTRUCT var_list expr { fun c -> Destruct ($2 c local, $3 c) }
+  | RETURN expr_opt { fun c -> Return ($2 c) }
   | GETLOCAL var { fun c -> GetLocal ($2 c local) }
   | SETLOCAL var expr { fun c -> SetLocal ($2 c local, $3 c) }
   | LOADGLOBAL var { fun c -> LoadGlobal ($2 c global) }
@@ -187,6 +186,10 @@ oper :
   | COMPARE expr expr { fun c -> Compare ($1, $2 c, $3 c) }
   | CONVERT expr { fun c -> Convert ($1, $2 c) }
 ;
+expr_opt :
+  | /* empty */ { fun c -> None }
+  | expr { fun c -> Some ($1 c) }
+;
 expr_list :
   | /* empty */ { fun c -> [] }
   | expr expr_list { fun c -> $1 c :: $2 c }
@@ -222,18 +225,21 @@ arms :
 func_fields :
   | /* empty */  /* Sugar */
     { let at = at() in
-      fun c -> {params = []; results = []; locals = []; body = Nop @@ at} }
+      fun c -> {params = []; result = None; locals = []; body = Nop @@ at} }
   | expr_block
-    { fun c -> {params = []; results = []; locals = []; body = $1 c} }
+    { fun c -> {params = []; result = None; locals = []; body = $1 c} }
   | LPAR PARAM value_type_list RPAR func_fields
     { fun c -> anon_locals c $3; let f = $5 c in
       {f with params = $3 @ f.params} }
   | LPAR PARAM bind_var value_type RPAR func_fields  /* Sugar */
     { fun c -> bind_local c $3; let f = $6 c in
       {f with params = $4 :: f.params} }
-  | LPAR RESULT value_type_list RPAR func_fields
-    { fun c -> let f = $5 c in
-      {f with results = $3 @ f.results} }
+  | LPAR RESULT value_type RPAR func_fields
+    { let at = at() in
+      fun c -> let f = $5 c in
+        match f.result with
+        | Some _ -> Error.error at "more than one return type"
+        | None -> {f with result = Some $3} }
   | LPAR LOCAL value_type_list RPAR func_fields
     { fun c -> anon_locals c $3; let f = $5 c in
       {f with locals = $3 @ f.locals} }
@@ -313,7 +319,7 @@ cmd :
   | LPAR ASSERTINVALID modul TEXT RPAR { AssertInvalid ($3, $4) @@ at() }
   | LPAR INVOKE TEXT expr_list RPAR
     { Invoke ($3, $4 (c0 ())) @@ at() }
-  | LPAR ASSERTEQ LPAR INVOKE TEXT expr_list RPAR expr_list RPAR
+  | LPAR ASSERTEQ LPAR INVOKE TEXT expr_list RPAR expr RPAR
     { AssertEq ($5, $6 (c0 ()), $8 (c0 ())) @@ at() }
 ;
 cmd_list :

ml-proto/src/host/print.ml

@@ -12,8 +12,8 @@ open Printf
 open Types
 
 let func_type f =
-  let {Ast.params; results; _} = f.it in
-  {ins = List.map Source.it params; outs = List.map Source.it results}
+  let {Ast.params; result; _} = f.it in
+  {ins = List.map it params; out = Lib.Option.map it result}
 
 let string_of_table_type = function
   | None -> "()"
@@ -65,9 +65,14 @@ let print_module_sig m =
   flush_all ()
 
 
-let print_values vs =
-  let ts = List.map Values.type_of vs in
-  printf "%s : %s\n"
-    (Values.string_of_values vs) (Types.string_of_expr_type ts);
-  flush_all ()
+let print_value vo =
+  match vo with
+  | Some v ->
+      let t = Values.type_of v in
+      printf "%s : %s\n"
+        (Values.string_of_value v) (Types.string_of_value_type t);
+      flush_all ()
+  | None ->
+      printf "()";
+      flush_all ()
 

ml-proto/src/host/print.mli

@@ -4,5 +4,5 @@
 
 val print_module : Ast.modul -> unit
 val print_module_sig : Ast.modul -> unit
-val print_values : Values.value list -> unit
+val print_value : Values.value option -> unit
 

ml-proto/src/host/script.ml

@@ -11,7 +11,7 @@ and command' =
   | Define of Ast.modul
   | AssertInvalid of Ast.modul * string
   | Invoke of string * Ast.expr list
-  | AssertEq of string * Ast.expr list * Ast.expr list
+  | AssertEq of string * Ast.expr list * Ast.expr
 
 type script = command list
 
@@ -20,7 +20,14 @@ type script = command list
 
 let trace name = if !Flags.trace then print_endline ("-- " ^ name)
 
-let current_module : Eval.module_instance option ref = ref None
+let current_module : Eval.instance option ref = ref None
+
+let eval_args es at =
+  let evs = List.map Eval.eval es in
+  let reject_none = function
+    | Some v -> v
+    | None -> Error.error at "unexpected () value" in
+  List.map reject_none evs
 
 let run_command cmd =
   match cmd.it with
@@ -50,24 +57,24 @@ let run_command cmd =
       | Some m -> m
       | None -> Error.error cmd.at "no module defined to invoke"
     in
-    let vs = List.map Eval.eval es in
-    let vs' = Eval.invoke m name vs in
-    if vs' <> [] then Print.print_values vs'
+    let vs = eval_args es cmd.at in
+    let v = Eval.invoke m name vs in
+    if v <> None then Print.print_value v
 
-  | AssertEq (name, arg_es, expect_es) ->
+  | AssertEq (name, arg_es, expect_e) ->
     trace "Assert invoking...";
     let m = match !current_module with
       | Some m -> m
       | None -> Error.error cmd.at "no module defined to invoke"
     in
-    let arg_vs = List.map Eval.eval arg_es in
-    let got_vs = Eval.invoke m name arg_vs in
-    let expect_vs = List.map Eval.eval expect_es in
-    if got_vs <> expect_vs then begin
+    let arg_vs = eval_args arg_es cmd.at in
+    let got_v = Eval.invoke m name arg_vs in
+    let expect_v = Eval.eval expect_e in
+    if got_v <> expect_v then begin
       print_string "Result: ";
-      Print.print_values got_vs;
+      Print.print_value got_v;
       print_string "Expect: ";
-      Print.print_values expect_vs;
+      Print.print_value expect_v;
       Error.error cmd.at "assertion failed"
     end
 

ml-proto/src/host/script.mli

@@ -7,7 +7,7 @@ and command' =
   | Define of Ast.modul
   | AssertInvalid of Ast.modul * string
   | Invoke of string * Ast.expr list
-  | AssertEq of string * Ast.expr list * Ast.expr list
+  | AssertEq of string * Ast.expr list * Ast.expr
 
 type script = command list
 

ml-proto/src/spec/ast.ml

@@ -27,6 +27,7 @@ open Values
 (* Types *)
 
 type value_type = Types.value_type Source.phrase
+type expr_type = value_type option
 
 
 (* Operators *)
@@ -77,12 +78,11 @@ and expr' =
   | If of expr * expr * expr
   | Loop of expr
   | Label of expr
-  | Break of var * expr list
+  | Break of var * expr option
   | Switch of value_type * expr * arm list * expr
   | Call of var * expr list
   | CallIndirect of var * expr * expr list
-  | Return of expr list
-  | Destruct of var list * expr
+  | Return of expr option
   | GetLocal of var
   | SetLocal of var * expr
   | LoadGlobal of var
@@ -119,7 +119,7 @@ type func = func' Source.phrase
 and func' =
 {
   params : value_type list;
-  results : value_type list;
+  result : expr_type;
   locals : value_type list;
   body : expr
 }