diff options
| author | Gabriel Dos Reis <gdr@axiomatics.org> | 2015-12-26 21:37:15 -0800 |
|---|---|---|
| committer | Gabriel Dos Reis <gdr@axiomatics.org> | 2015-12-26 21:37:15 -0800 |
| commit | eac54a0152579f2de3fadadfd3f142d895c4b704 (patch) | |
| tree | 18068c33a0cde580b77a172f0b6bb970e045f12d /src | |
| parent | ba0eeb3c591ebb8e51a5ea2679749e4ceca95e08 (diff) | |
| download | open-axiom-eac54a0152579f2de3fadadfd3f142d895c4b704.tar.gz | |
Extract two helper functions out of DescendCode.
Diffstat (limited to 'src')
| -rw-r--r-- | src/ChangeLog | 5 | ||||
| -rw-r--r-- | src/interp/functor.boot | 29 |
2 files changed, 22 insertions, 12 deletions
diff --git a/src/ChangeLog b/src/ChangeLog index d13e7b4e..3b124755 100644 --- a/src/ChangeLog +++ b/src/ChangeLog @@ -1,5 +1,10 @@ 2015-12-26 Gabriel Dos Reis <gdr@axiomatics.org> + * interp/functor.boot (addConditionToGuard): New. Split out of + DescendCode. + (viewsUnderCondition): Likewise. + +2015-12-26 Gabriel Dos Reis <gdr@axiomatics.org> * interp/vmlisp.lisp (LASTELEM): Remove as unused. 2015-12-26 Gabriel Dos Reis <gdr@axiomatics.org> diff --git a/src/interp/functor.boot b/src/interp/functor.boot index 78864f8a..b068f9e2 100644 --- a/src/interp/functor.boot +++ b/src/interp/functor.boot @@ -1,6 +1,6 @@ -- Copyright (c) 1991-2002, The Numerical Algorithms Group Ltd. -- All rights reserved. --- Copyright (C) 2007-2013, Gabriel Dos Reis. +-- Copyright (C) 2007-2015, Gabriel Dos Reis. -- All rights reserved. -- -- Redistribution and use in source and binary forms, with or without @@ -421,6 +421,19 @@ DescendCodeAdd1(db,base,flag,target,formalArgs,formalArgModes) == code:=[v,:code] [["%LET",instantiatedBase,base],:code] +++ In a conditional branch, 'cond' is the new condition guarding +++ a branch; return an updated predicate taking into account the +++ logical combination of preceding guards and an updated +++ 'continuation predicate reflecting the new condition. +addConditionToGuard(cond,existing) == + TruthP cond => [existing,:existing] + TruthP existing => [cond,:['NOT,cond]] + [['AND,existing,cond],:['AND,existing,['NOT,cond]]] + +viewsUnderCondition(views,cond) == + cond is ['HasCategory,dom,cat] => [[dom,:cat],:views] + views + DescendCode(db,code,flag,viewAssoc,e) == -- flag = true if we are walking down code always executed; -- otherwise set to conditions in which @@ -440,17 +453,9 @@ DescendCode(db,code,flag,viewAssoc,e) == code is ['%when,:condlist] => c:= [[u2:= ProcessCond(db,first u,e),:q] for u in condlist] where q() == null u2 => nil - f:= - TruthP u2 => flag; - TruthP flag => - flag := ['NOT,u2] - u2 - flag := ['AND,flag,['NOT,u2]]; - ['AND,flag,u2] - [DescendCode(db,v, f, - if first u is ['HasCategory,dom,cat] - then [[dom,:cat],:viewAssoc] - else viewAssoc,e) for v in rest u] + [f,:flag] := addConditionToGuard(u2,flag) + [DescendCode(db,v,f,viewsUnderCondition(viewAssoc,first u),e) + for v in rest u] TruthP CAAR c => ['%seq,:CDAR c] while (c and (last c is [c1] or last c is [c1,[]]) and (c1 = '%true or c1 is ['HasAttribute,:.])) repeat |