diff options
-rw-r--r-- | src/ChangeLog | 5 | ||||
-rw-r--r-- | src/interp/br-data.boot | 41 | ||||
-rw-r--r-- | src/interp/define.boot | 20 |
3 files changed, 29 insertions, 37 deletions
diff --git a/src/ChangeLog b/src/ChangeLog index 8125b842..7e044d50 100644 --- a/src/ChangeLog +++ b/src/ChangeLog @@ -1,3 +1,8 @@ +2012-02-11 Gabriel Dos Reis <gdr@cse.tamu.edu> + + * interp/br-data.boot (getParentsFor): Move to define.boot. + (explodeIfs): Likewise. + 2012-02-09 Gabriel Dos Reis <gdr@cs.tamu.edu> * interp/define.boot (mkEvalableCategoryForm): Compile only diff --git a/src/interp/br-data.boot b/src/interp/br-data.boot index 54a8021e..0de38303 100644 --- a/src/interp/br-data.boot +++ b/src/interp/br-data.boot @@ -1,6 +1,6 @@ -- Copyright (c) 1991-2002, The Numerical Algorithms Group Ltd. -- All rights reserved. --- Copyright (C) 2007-2011, Gabriel Dos Reis. +-- Copyright (C) 2007-2012, Gabriel Dos Reis. -- All rights reserved. -- -- Redistribution and use in source and binary forms, with or without @@ -493,16 +493,6 @@ getImports conname == --called by mkUsersHashTable --============================================================================ -- Get Hierarchical Information --============================================================================ -getParentsFor(db,formalParams) == ---called by compDefineFunctor1 - acc := nil - formals := take(#formalParams,$TriangleVariableList) - constructorForm := dbConstructorForm db - for x in folks dbCategory db repeat - x := applySubst(pairList(formals,formalParams),x) - x := applySubst(pairList(formalParams,IFCDR constructorForm),x) - acc := [:explodeIfs x,:acc] - reverse! acc $parentsCache := nil @@ -516,7 +506,7 @@ parentsOf con == --called by kcpPage, ancestorsRecur parentsOfForm [op,:argl] == parents := parentsOf op - null argl or argl = (newArgl := rest getConstructorFormFromDB op) => + argl = nil or argl = (newArgl := getConstructorFormFromDB(op).args) => parents applySubst(pairList(newArgl,argl),parents) @@ -530,16 +520,6 @@ getParentsForDomain domname == --called by parentsOf acc := [:explodeIfs x,:acc] reverse! acc -explodeIfs x == main where --called by getParents, getParentsForDomain - main() == - x is ['IF,p,a,b] => fn(p,a,b) - [[x,:true]] - fn(p,a,b) == - [:"append"/[gn(p,y) for y in a],:"append"/[gn(['NOT,p],y) for y in b]] - gn(p,a) == - a is ['IF,q,b,:.] => fn(MKPF([p,q],'AND),b,nil) - [[a,:p]] - folks u == --called by getParents and getParentsForDomain u isnt [.,:.] => nil u is [op,:v] and op in '(Join PROGN) @@ -583,19 +563,6 @@ childArgCheck(argl, nargl) == isSharpVar y => i = symbolPosition(y,$FormalMapVariableList) false ---computeDescendantsOf cat == ---dynamically generates descendants --- hash := hashTable 'EQUAL --- for [child,:pred] in childrenOf cat repeat --- childForm := getConstructorForm child --- tableValue(hash,childForm) := pred --- for [form,:pred] in descendantsOf(childForm,nil) repeat --- newPred := --- oldPred := tableValue(hash,form) => quickOr(oldPred,pred) --- pred --- tableValue(hash,form) := newPred --- mySort [[key,:val] for [key,:val] in entries hash] - ancestorsOf(conform,domform) == --called by kcaPage, originsInOrder,... "category" = getConstructorKindFromDB(conname := opOf conform) => alist := getConstructorAncestorsFromDB conname @@ -604,7 +571,7 @@ ancestorsOf(conform,domform) == --called by kcaPage, originsInOrder,... left := sublisFormal(argl,a) right := sublisFormal(argl,b) if domform then right := simpHasPred right - null right => false + right = false => nil [left,:right] computeAncestorsOf(conform,domform) @@ -630,7 +597,7 @@ ancestorsRecur(conform,domform,pred,firstTime?) == --called by ancestorsOf if conform ~= originalConform then parents := applySubst(pairList(IFCDR originalConform,IFCDR conform),parents) for [newform,:p] in parents repeat - if domform and rest domform then + if domform and domform.args then newdomform := applySubst(pairList(conform.args,domform.args),newform) p := applySubst(pairList(conform.args,domform.args),p) newPred := quickAnd(pred,p) diff --git a/src/interp/define.boot b/src/interp/define.boot index 2b9470f2..1303e141 100644 --- a/src/interp/define.boot +++ b/src/interp/define.boot @@ -630,6 +630,26 @@ expandTypeArgs(u,template,domform) == u isnt [.,:.] => u expandType(u,template,domform) +explodeIfs x == main where --called by getParents, getParentsForDomain + main() == + x is ['IF,p,a,b] => fn(p,a,b) + [[x,:true]] + fn(p,a,b) == + [:"append"/[gn(p,y) for y in a],:"append"/[gn(['NOT,p],y) for y in b]] + gn(p,a) == + a is ['IF,q,b,:.] => fn(MKPF([p,q],'AND),b,nil) + [[a,:p]] + +getParentsFor(db,formalParams) == + acc := nil + formals := take(#formalParams,$TriangleVariableList) + constructorForm := dbConstructorForm db + for x in folks dbCategory db repeat + x := applySubst(pairList(formals,formalParams),x) + x := applySubst(pairList(formalParams,constructorForm.args),x) + acc := [:explodeIfs x,:acc] + reverse! acc + --% Subdomains ++ We are defining a functor with head given by `form', as a subdomain |