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