Better is_circular function detection

analyze/aps-bind.c

@@ -1104,6 +1104,7 @@ static void *activate_pragmas(void *ignore, void *node) {
   }
   if (ABSTRACT_APS_tnode_phylum(node) == KEYDeclaration) {
     Declaration decl=(Declaration)node;
+    Declaration_info(decl)->is_circular = FALSE;  // set default value of is_circular
     switch (Declaration_KEY(decl)) {
     case KEYpragma_call:
       { Symbol pragma_sym = pragma_call_name(decl);

analyze/aps-fiber.h

@@ -101,6 +101,7 @@ extern Declaration shared_use_p(Expression);
 extern Declaration responsible_node_shared_info(void *,
 						struct analysis_state *);
 extern Declaration formal_in_case_p(Declaration);
+Declaration function_actual_formal(Declaration func, Expression actual, Expression call);
 
 
 

analyze/aps-info.h

@@ -43,6 +43,7 @@ struct Declaration_info {
   unsigned decl_flags;
   void * call_sites;
   void *analysis_state;
+  BOOL is_circular;     /* boolean indicating if decl is circular */
 #define DECL_LHS_FLAG 1
 #define DECL_RHS_FLAG 2
 #define DECL_OBJECT_FLAG 4

analyze/aps-type.c

@@ -441,6 +441,7 @@ static void* validate_canonicals(void* ignore, void*node) {
 
 static Declaration module_TYPE;
 static Declaration module_PHYLUM;
+Declaration module_lattice;
 
 static void* set_root_phylum(void *ignore, void *node)
 {
@@ -451,7 +452,7 @@ static void* set_root_phylum(void *ignore, void *node)
     Declaration d = (Declaration)node;
     switch (Declaration_KEY(d))
     {
-    case KEYmodule_decl:
+    case KEYsome_class_decl:
     {
       if (module_TYPE == 0 && streq(decl_name(d), "TYPE"))
       {
@@ -461,6 +462,10 @@ static void* set_root_phylum(void *ignore, void *node)
       {
         module_PHYLUM = d;
       }
+      else if (streq(decl_name(d), "LATTICE"))
+      {
+        module_lattice = d;
+      }
 
       return NULL;
     }

analyze/aps-type.h

@@ -1,6 +1,9 @@
 #ifndef APS_TYPE_H
 #define APS_TYPE_H
 
+// Lattice module declaration.
+extern Declaration module_lattice;
+
 extern Type function_type_return_type(Type);
 
 /* We use local type inference a la Turner and Pierce

analyze/canonical-signature.c

@@ -482,6 +482,17 @@ static CanonicalSignature* join_canonical_signature_actuals(CanonicalType *sourc
     struct Canonical_use_type *ctype_use = (struct Canonical_use_type *)source_ctype;
 
     Declaration tdecl = ctype_use->decl;
+    switch (Declaration_KEY(tdecl))
+    {
+    case KEYsome_type_decl:
+      break;
+    default:
+      // short-circuit.
+      // only when the source declaration of canonical type is some kind of
+      // type declaration then "join" (or simplifying) would be possible.
+      return canonical_sig;
+    }
+
     Declaration mdecl = USE_DECL(module_use_use(type_inst_module(some_type_decl_type(tdecl))));
 
     CanonicalType **substituted_actuals = (CanonicalType **)alloca(canonical_sig->num_actuals);
@@ -693,3 +704,41 @@ void initialize_canonical_signature(Declaration module_TYPE_decl, Declaration mo
 
   initialized = true;
 }
+
+/**
+ * Given a signature, it returns whether it contains module declaration
+ * @param sig signature
+ * @param module_or_class_decl module or class declaration
+ * @return boolean indicating if module is in the type hierarchy of signature
+ */
+bool signature_hierarchy_contains(Signature sig, Declaration module_or_class_decl)
+{
+  switch (Signature_KEY(sig))
+  {
+  case KEYsig_inst:
+    Declaration some_mdecl = USE_DECL(class_use_use(sig_inst_class(sig)));
+    return some_mdecl == module_or_class_decl ||
+           signature_hierarchy_contains(some_class_decl_parent(some_mdecl), module_or_class_decl);
+  case KEYmult_sig:
+    return signature_hierarchy_contains(mult_sig_sig1(sig), module_or_class_decl) ||
+           signature_hierarchy_contains(mult_sig_sig2(sig), module_or_class_decl);
+  case KEYsig_use:
+    return USE_DECL(sig_use_use(sig)) == module_or_class_decl;
+  case KEYno_sig:
+  case KEYfixed_sig:
+    return false;
+  }
+}
+
+/**
+ * Given a canonical signature, it returns whether it contains module declaration
+ * @param csig canonical signature
+ * @param module_or_class_decl module or class declaration
+ * @return boolean indicating if module is in the type hierarchy of signature
+ */
+bool canonical_signature_hierarchy_contains(CanonicalSignature* csig, Declaration module_or_class_decl)
+{
+  if (csig->source_class == module_or_class_decl) return true;
+
+  return signature_hierarchy_contains(some_class_decl_parent(csig->source_class), module_or_class_decl);
+}

analyze/canonical-signature.h

@@ -1,6 +1,9 @@
 #ifndef CANONICAL_SIGNATURE_H
 #define CANONICAL_SIGNATURE_H
 
+#include <stdbool.h>
+#include "canonical-type.h"
+
 struct CanonicalSignature_type
 {
   bool is_input;
@@ -42,4 +45,12 @@ void print_canonical_signature(void *untyped, FILE *f);
  */
 void print_canonical_signature_set(void *untyped, FILE *f);
 
+/**
+ * Given a canonical signature, it returns whether it contains module declaration
+ * @param csig canonical signature
+ * @param module_or_class_decl module or class declaration
+ * @return boolean indicating if module is in the type hierarchy of signature
+ */
+bool canonical_signature_hierarchy_contains(CanonicalSignature* csig, Declaration module_or_class_decl);
+
 #endif

analyze/canonical-type.c

@@ -371,6 +371,8 @@ static CanonicalType *canonical_type_use(Use use)
 
     case KEYfunction_type:
       return canonical_type(some_type_decl_type(td));
+    case KEYremote_type:
+      return canonical_type(remote_type_nodetype(some_type_decl_type(td)));
     default:
       fatal_error("Unknown type use_decl type key %d", (int)Type_KEY(some_type_decl_type(td)));
       return NULL;
@@ -514,6 +516,9 @@ CanonicalType *canonical_type(Type t)
   }
   case KEYfunction_type:
     return canonical_type_function(t);
+  case KEYno_type:
+    // canonical type representation of no-type is itself.
+    return (CanonicalType*)t;
   default:
     aps_error(t, "Case of type %d is not implemented in canonical_type()", (int)Type_KEY(t));
     return NULL;

examples/first.aps

@@ -67,11 +67,11 @@ module FIRST[T :: var GRAMMAR[]] extends T begin
 
   end;
 
-  var function contains_epsilon(s_set: Symbols) :Boolean begin
+  function contains_epsilon(s_set: Symbols) :Boolean begin
     result := Symbols$member(epsilon, s_set);
   end;
 
-  var function black_dot(s1 :Symbols; s2 :Symbols) : Symbols begin
+  function black_dot(s1 :SymbolLattice; s2 :SymbolLattice) : SymbolLattice begin
     if contains_epsilon(s1) then
       result := (s1 /\~ { epsilon }) \/ s2;
     else