From cdd33524e33154ebe7c2c26d85328a2a8ca18210 Mon Sep 17 00:00:00 2001
From: zweije
Date: Tue, 10 Jul 2001 11:16:22 +0000
Subject: This commit was generated by cvs2svn to compensate for changes in
 r525, which included commits to RCS files with non-trunk default branches.

git-svn-id: https://svn.cs.ru.nl/repos/clean-compiler/trunk@526 1f8540f1-abd5-4d5b-9d24-4c5ce8603e2d
---
 sucl/strat.dcl | 31 +++++++++++++++++++++----------
 sucl/strat.icl | 56 ++++++++++++++++++++++++++++++++++++++++----------------
 2 files changed, 61 insertions(+), 26 deletions(-)

diff --git a/sucl/strat.dcl b/sucl/strat.dcl
index 341b550..d65972d 100644
--- a/sucl/strat.dcl
+++ b/sucl/strat.dcl
@@ -56,6 +56,17 @@ STRATEGY TRANSFORMERS
 The funcions below tranform (simpler) strategies into more complicated ones
 ------------------------------------------------------------------------ */
 
+// A strategy transformer that checks for partial applications
+checkarity
+ :: !(sym -> Int)                         // Arity of function symbol
+    (Strategy sym var .pvar .result)      // Default strategy
+    (Substrategy sym var .pvar .result)   // Substrategy
+    .(Graph sym var)                      // Subject graph
+    ((Subspine sym var .pvar) -> .result) // Spine continuation
+    .result                               // RNF continuation
+    !.(Node sym var)                      // Subject node
+ -> .result
+
 // A strategy transformer that checks for constructor applications
 checkconstr
  :: (sym->.Bool)
@@ -106,16 +117,16 @@ checkrules
  &  == var
  &  == pvar
 
-// A strategy transformer that checks a type rule
-// for curried applications and strict arguments
-checktype
- :: !(sym -> (Rule .tsym tvar,[.Bool]))
-    (Strategy sym var .pvar .result)
-    (Substrategy sym var .pvar .result)
-    .(Graph sym var)
-    ((Subspine sym var .pvar) -> .result)
-    .result
-    !.(Node sym var)
+// A strategy transformer that checks a function application
+// for strict arguments
+checkstricts
+ :: !(sym -> [.Bool])                     // Strict arguments of function
+    (Strategy sym var .pvar .result)      // Default strategy
+    (Substrategy sym var .pvar .result)   // Substrategy
+    .(Graph sym var)                      // Subject graph
+    ((Subspine sym var .pvar) -> .result) // Spine continuation
+    .result                               // RNF continuation
+    !.(Node sym var)                      // Subject node
  -> .result
 
 /* ------------------------------------------------------------------------
diff --git a/sucl/strat.icl b/sucl/strat.icl
index a3c8396..cc49256 100644
--- a/sucl/strat.icl
+++ b/sucl/strat.icl
@@ -361,27 +361,51 @@ checkinstance (graph,node) history defaultstrategy
           where hgraph = rgraphgraph hrgraph; hroot = rgraphroot hrgraph
 
 
-// Check a type rule for curried applications and strict arguments
-
-checktype
- :: !(sym -> (Rule .tsym tvar,[.Bool]))
-    (Strategy sym var .pvar .result)
-    (Substrategy sym var .pvar .result)
-    .(Graph sym var)
-    ((Subspine sym var .pvar) -> .result)
-    .result
-    !.(Node sym var)
+// Check for curried applications
+
+checkarity
+ :: !(sym -> Int)                         // Arity of function symbol
+    (Strategy sym var .pvar .result)      // Default strategy
+    (Substrategy sym var .pvar .result)   // Substrategy
+    .(Graph sym var)                      // Subject graph
+    ((Subspine sym var .pvar) -> .result) // Spine continuation
+    .result                               // RNF continuation
+    !.(Node sym var)                      // Subject node
  -> .result
 
-checktype typeinfo defaultstrategy substrat subject found rnf (ssym,sargs)
-| shorter targs sargs
+checkarity funarity defaultstrategy substrat subject found rnf (ssym,sargs)
+| shortern arity sargs
 = rnf
-| eqlen targs sargs
-= forcenodes substrat found rnf` strictnodes
+| eqlenn arity sargs
+= defaultstrategy substrat subject found rnf (ssym,sargs)
 = abort "checktype: symbol occurrence with arity greater than its type"
+  where arity = funarity ssym
+
+shortern n _      | n<=0 = False
+shortern _ []            = True
+shortern n [x:xs]        = shortern (n-1) xs
+
+eqlenn n _      | n<0 = False
+eqlenn 0 []           = True
+eqlenn n [x:xs]       = eqlenn (n-1) xs
+
+
+// Check for strict arguments
+
+checkstricts
+ :: !(sym -> [.Bool])                     // Strict arguments of function
+    (Strategy sym var .pvar .result)      // Default strategy
+    (Substrategy sym var .pvar .result)   // Substrategy
+    .(Graph sym var)                      // Subject graph
+    ((Subspine sym var .pvar) -> .result) // Spine continuation
+    .result                               // RNF continuation
+    !.(Node sym var)                      // Subject node
+ -> .result
+
+checkstricts funstricts defaultstrategy substrat subject found rnf (ssym,sargs)
+= forcenodes substrat found rnf` strictnodes
   where rnf` = defaultstrategy substrat subject found rnf (ssym,sargs)
-        (trule,tstricts) = typeinfo ssym
-        targs = arguments trule
+        tstricts = funstricts ssym
         strictnodes = [sarg\\(True,sarg)<-zip2 tstricts sargs]
 
 
-- 
cgit v1.2.3