From 441149f835b87fa1d6780585b961a65cde1f9e4f Mon Sep 17 00:00:00 2001 From: johnvg Date: Fri, 12 Oct 2001 15:32:18 +0000 Subject: add list cons symbols with arity<2 (for strict lists) git-svn-id: https://svn.cs.ru.nl/repos/clean-compiler/trunk@848 1f8540f1-abd5-4d5b-9d24-4c5ce8603e2d --- backendC/CleanCompilerSources/sa.c | 113 ++++++++++++++++++++++++------------- 1 file changed, 73 insertions(+), 40 deletions(-) diff --git a/backendC/CleanCompilerSources/sa.c b/backendC/CleanCompilerSources/sa.c index 1bbc0c4..4a75d97 100644 --- a/backendC/CleanCompilerSources/sa.c +++ b/backendC/CleanCompilerSources/sa.c @@ -119,7 +119,7 @@ static Fun # ifndef _DB_ static # endif -Fun *strict_cons_sym,*tail_strict_cons_sym,*strict_tail_strict_cons_sym; +Fun *lazy_cons_sym0,*strict_cons_sym0,*tail_strict_cons_sym0,*strict_tail_strict_cons_sym0; #endif static ExpRepr top; @@ -2194,15 +2194,18 @@ static Exp ConvertNode (Node node, NodeId nid) case cons_symb: #if STRICT_LISTS if (node->node_symbol->symb_head_strictness>1){ - e->e_fun = node->node_symbol->symb_tail_strictness ? strict_tail_strict_cons_sym : strict_cons_sym; + e->e_fun = (node->node_symbol->symb_tail_strictness ? strict_tail_strict_cons_sym0 : strict_cons_sym0)+arity; break; } else if (node->node_symbol->symb_tail_strictness){ - e->e_fun = tail_strict_cons_sym; + e->e_fun = tail_strict_cons_sym0+arity; break; } -#endif + e->e_hnf = True; + e->e_fun = lazy_cons_sym0+arity; +#else e->e_hnf = True; e->e_fun = conssym; +#endif break; case nil_symb: e->e_hnf = True; @@ -2517,15 +2520,18 @@ static Exp convert_pattern (SymbolP symbol_p,int arity,NodeIdListElementP node_i case cons_symb: #if STRICT_LISTS if (symbol_p->symb_head_strictness>1){ - e->e_fun = symbol_p->symb_tail_strictness ? strict_tail_strict_cons_sym : strict_cons_sym; + e->e_fun = (symbol_p->symb_tail_strictness ? strict_tail_strict_cons_sym0 : strict_cons_sym0)+arity; break; } else if (symbol_p->symb_tail_strictness){ - e->e_fun = tail_strict_cons_sym; + e->e_fun = tail_strict_cons_sym0+arity; break; } -#endif + e->e_hnf = True; + e->e_fun = lazy_cons_sym0+arity; +#else e->e_hnf = True; e->e_fun = conssym; +#endif break; case nil_symb: e->e_hnf = True; @@ -3050,7 +3056,8 @@ static void init_predefined_symbols (void) */ nr_funs = MaxNodeArity + MaxNodeArity + MaxNrAnnots + 2 + 4 + 1 #if STRICT_LISTS - +3 + /* +3 */ + +11 #endif ; if (StrictDoLists) @@ -3117,6 +3124,7 @@ static void init_predefined_symbols (void) InitStrictResult (& f->fun_strictresult); f++; +#if !STRICT_LISTS conssym = f; f->fun_symbol = Null; f->fun_arity = 2; @@ -3125,38 +3133,59 @@ static void init_predefined_symbols (void) f->fun_single = False; InitStrictResult (& f->fun_strictresult); f++; +#else + lazy_cons_sym0 = f; -#if STRICT_LISTS - strict_cons_sym = f; - f->fun_symbol = NULL; - f->fun_arity = 2; - f->fun_kind = Constructor; - f->fun_strictargs = InitNewStrictInfos (2,NotStrict);; - f->fun_single = False; - InitStrictInfo (f->fun_strictargs,HnfStrict); - InitStrictResult (&f->fun_strictresult); - ++f; - - tail_strict_cons_sym = f; - f->fun_symbol = NULL; - f->fun_arity = 2; - f->fun_kind = Constructor; - f->fun_strictargs = InitNewStrictInfos (2,NotStrict);; - f->fun_single = False; - InitStrictInfo (&f->fun_strictargs[1],HnfStrict); - InitStrictResult (&f->fun_strictresult); - ++f; - - strict_tail_strict_cons_sym = f; - f->fun_symbol = NULL; - f->fun_arity = 2; - f->fun_kind = Constructor; - f->fun_strictargs = InitNewStrictInfos (2,NotStrict);; - f->fun_single = False; - InitStrictInfo (f->fun_strictargs,HnfStrict); - InitStrictInfo (&f->fun_strictargs[1],HnfStrict); - InitStrictResult (&f->fun_strictresult); - ++f; + for (i=0; i<=2; ++i){ + f->fun_symbol = Null; + f->fun_arity = i; + f->fun_kind = Constructor; + f->fun_strictargs = Null; + f->fun_single = False; + InitStrictResult (& f->fun_strictresult); + f++; + } + + strict_cons_sym0 = f; + + for (i=0; i<=2; ++i){ + f->fun_symbol = NULL; + f->fun_arity = i; + f->fun_kind = Constructor; + f->fun_strictargs = InitNewStrictInfos (2,NotStrict);; + f->fun_single = False; + InitStrictInfo (f->fun_strictargs,HnfStrict); + InitStrictResult (&f->fun_strictresult); + ++f; + } + + tail_strict_cons_sym0 = f; + + for (i=0; i<=2; ++i){ + f->fun_symbol = NULL; + f->fun_arity = i; + f->fun_kind = Constructor; + f->fun_strictargs = InitNewStrictInfos (2,NotStrict);; + f->fun_single = False; + InitStrictInfo (&f->fun_strictargs[1],HnfStrict); + InitStrictResult (&f->fun_strictresult); + ++f; + } + + strict_tail_strict_cons_sym0 = f; + for (i=0; i<=2; ++i){ + f->fun_symbol = NULL; + f->fun_arity = i; + f->fun_kind = Constructor; + f->fun_strictargs = InitNewStrictInfos (2,NotStrict);; + f->fun_single = False; + InitStrictInfo (f->fun_strictargs,HnfStrict); + InitStrictInfo (&f->fun_strictargs[1],HnfStrict); + InitStrictResult (&f->fun_strictresult); + ++f; + } + + conssym = lazy_cons_sym0+2; #endif if_sym = f; @@ -3522,7 +3551,7 @@ static Path AddToPath (Exp e, Path p) return p; if (! StrictDoAllPaths && p && p->p_exp->e_kind == Value && p->p_exp->e_fun->fun_symbol && - p->p_exp->e_fun->fun_symbol->sdef_ancestor != e->e_fun->fun_symbol->sdef_ancestor) + p->p_exp->e_fun->fun_symbol->sdef_ancestor != e->e_fun->fun_symbol->sdef_ancestor) return p; new = SAllocType (PathRepr); @@ -5148,6 +5177,10 @@ static void FindStrictPropertiesOfFunction (Fun *f) max_time_reached = False; CurrentName = f->fun_symbol->sdef_ident->ident_name; +#if 0 + printf ("%s\n",CurrentName); +#endif + #ifdef _DB_ DBPrinting = 1; /* strcmp ("catenate", CurrentName) == 0; */ #endif -- cgit v1.2.3