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.
@@ -124,7 +122,6 @@ type expr =
   | 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
   | GetParam of var                         (* read parameter
   | GetLocal of var                         (* read local variable
   | SetLocal of var * expr                  (* write local variable
@@ -178,7 +175,6 @@ expr:
   ( call <var> <expr>* )
   ( call_indirect <var> <expr> <expr>* )
   ( return <expr>* )
-  ( destruct <var>* <expr> )
   ( get_local <var> )
   ( set_local <var> <expr> )
   ( load_global <var> )

ml-proto/src/given/source.ml

@@ -34,5 +34,6 @@ let (@@) phrase' region = {at = region; it = phrase'}
 let (@@@) phrase' regions = phrase'@@(span regions)
 
 let it phrase = phrase.it
+let ito o = match o with Some phrase -> (Some phrase.it) | None -> None
 let at phrase = phrase.at
 let ats phrases = span (List.map at phrases)

ml-proto/src/given/source.mli

@@ -20,5 +20,6 @@ val (@@) : 'a -> region -> 'a phrase
 val (@@@) : 'a -> region list -> 'a phrase
 
 val it : 'a phrase -> 'a
+val ito : 'a phrase option -> 'a option
 val at : 'a phrase -> region
 val ats : 'a phrase list -> region

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,18 @@ 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 { fun c -> Break ($2 c label, Some ($3 c)) }
+  | BREAK var { fun c -> Break ($2 c label, None) }
+  | BREAK { let at = at() in fun c -> Break (0 @@ at, None) }
   | 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 { fun c -> Return (Some ($2 c)) }
+  | RETURN { fun c -> Return None }
   | 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) }
@@ -222,18 +223,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 +317,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 Source.it params; out = ito 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
 
@@ -22,6 +22,13 @@ let trace name = if !Flags.trace then print_endline ("-- " ^ name)
 
 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
   | Define m ->
@@ -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
 }