From 0b7eba84586ee81d1288ceec0a421d5152d600d3 Mon Sep 17 00:00:00 2001
From: Timothy Bourke <tim@tbrk.org>
Date: Tue, 26 Apr 2016 10:07:21 +0200
Subject: [PATCH] Add error for non-stateful decls. in pervasives

Attempts to compile a pervasives.epi containing functions with multiple
outputs or nodes now fail with an informative error message.

* The following files demonstrate the problem:

  pervasives.epi:
    type bool = true | false
    external val node test(bool;bool) returns bool

  broken.ept:
    node broken() returns (y : bool)
    let
      y = test(false, false);
    tel

  Running:
    heptc -nopervasives pervasives.epi
    heptc -stdlib . -target c broken.ept

  Fails with:

    ---------
    Internal compiler error
    Passe : Static evaluation failed of the pervasive operator test
    ----------
    Fatal error: exception Misc.Assert_false

* A different error occurs for nodes that return multiple outputs:

  pervasives.epi:
    type bool = true | false
    external val node test(bool;bool) returns (bool;bool)

  broken.ept:
    node broken() returns (y : bool)
    var l1 : bool;
    let
      (y,l1) = test(false, false);
    tel

  Running:
    heptc -nopervasives pervasives.epi
    heptc -stdlib . broken.ept

  Gives:
    Inconsistent clock annotation for exp test(false, false).
    File "broken.ept", line 4, characters 11-29:
    >  (y,l1) = test(false, false);
    >           ^^^^^^^^^^^^^^^^^^
    Clock Clash: this expression has clock 'a3,
    but is expected to have clock ('a4 * 'a5).

  The name "test" is parsed as an Eextvalue (rather than an Eapp), and there
  is an implicit assumption in compiler/minils/analysis/clocking.ml that such
  values have a simple clock.
---
 compiler/heptagon/analysis/typing.ml | 9 ++++++++-
 1 file changed, 8 insertions(+), 1 deletion(-)

diff --git a/compiler/heptagon/analysis/typing.ml b/compiler/heptagon/analysis/typing.ml
index 4fbec5a..09f6bfc 100644
--- a/compiler/heptagon/analysis/typing.ml
+++ b/compiler/heptagon/analysis/typing.ml
@@ -57,6 +57,7 @@ type error =
   | Enon_exaustive
   | Epartial_switch of name
   | Etoo_many_outputs
+  | Ebad_pervasives
   | Esome_fields_are_missing
   | Esubscripted_value_not_an_array of ty
   | Earray_subscript_should_be_const
@@ -149,7 +150,10 @@ let message loc kind =
           print_location loc
           s
     | Etoo_many_outputs ->
-        eprintf "%aA function may only returns a basic value.@."
+        eprintf "%aA function may only return a basic value.@."
+          print_location loc
+    | Ebad_pervasives ->
+        eprintf "%aNo nodes or multiple return values allowed in Pervasives.@."
           print_location loc
     | Esome_fields_are_missing ->
         eprintf "%aSome fields are missing.@."
@@ -1287,6 +1291,9 @@ let typing_typedec td =
 
 let typing_signature s =
   let typed_params, cenv = build_node_params QualEnv.empty s.sig_params in
+  if Modules.current () = Pervasives
+       && (s.sig_stateful || List.length s.sig_outputs > 1)
+    then message s.sig_loc Ebad_pervasives;
   { s with sig_params = typed_params;
     sig_inputs = List.map (typing_arg cenv) s.sig_inputs;
     sig_outputs = List.map (typing_arg cenv) s.sig_outputs; }