aboutsummaryrefslogtreecommitdiff
path: root/src/interp
diff options
context:
space:
mode:
authordos-reis <gdr@axiomatics.org>2011-06-22 20:53:36 +0000
committerdos-reis <gdr@axiomatics.org>2011-06-22 20:53:36 +0000
commit5c371a307a201cf425f848d0a0b24631ff47978e (patch)
tree67c4846decafd03e19eb0cbad301c3363c02928a /src/interp
parenta6708e246ad91491dc54f3e6c1ae5f44f80b9fba (diff)
downloadopen-axiom-5c371a307a201cf425f848d0a0b24631ff47978e.tar.gz
* interp/br-con.boot: Remove reference to asharp constructors.
* interp/br-op2.boot: Likewise. * interp/br-saturn.boot: Likewise. * interp/br-util.boot: Likewise. * interp/c-util.boot: Likewise. * interp/cattable.boot: Likewise. * interp/database.boot: Likewise. * interp/lisplib.boot: Likewise. * interp/nrunfast.boot: Likewise.
Diffstat (limited to 'src/interp')
-rw-r--r--src/interp/br-con.boot111
-rw-r--r--src/interp/br-op2.boot2
-rw-r--r--src/interp/br-saturn.boot32
-rw-r--r--src/interp/br-util.boot7
-rw-r--r--src/interp/c-util.boot1
-rw-r--r--src/interp/cattable.boot3
-rw-r--r--src/interp/database.boot4
-rw-r--r--src/interp/lisplib.boot10
-rw-r--r--src/interp/nrunfast.boot10
9 files changed, 32 insertions, 148 deletions
diff --git a/src/interp/br-con.boot b/src/interp/br-con.boot
index fbfbc6bf..ce241655 100644
--- a/src/interp/br-con.boot
+++ b/src/interp/br-con.boot
@@ -93,65 +93,6 @@ conPageConEntry entry ==
--=======================================================================
-- Constructor Page
--=======================================================================
--- in br-saturn.boot now
---% kPage(line,:options) == --any cat, dom, package, default package
---% --constructors Cname\#\E\sig \args \abb \comments (C is C, D, P, X)
---% ------------------> BRANCH OUT FOR SATURN
---% true => kPageSaturn(line,options)
---% parts := dbXParts(line,7,1)
---% [kind,name,nargs,xflag,sig,args,abbrev,comments] := parts
---% form := IFCAR options
---% isFile := null kind
---% kind := kind or '"package"
---% parts.first := kind
---% conform := mkConform(kind,name,args)
---% conname := opOf conform
---% capitalKind := capitalize kind
---% signature := ncParseFromString sig
---% sourceFileName := dbSourceFile makeSymbol name
---% constrings :=
---% KDR form => dbConformGenUnder form
---% [strconc(name,args)]
---% emString := ['"{\sf ",:constrings,'"}"]
---% heading := [capitalKind,'" ",:emString]
---% if not isExposedConstructor conname then heading := ['"Unexposed ",:heading]
---% if name=abbrev then abbrev := asyAbbreviation(conname,nargs)
---% page := htInitPage(heading,nil)
---% htpSetProperty(page,'isFile,true)
---% htpSetProperty(page,'parts,parts)
---% htpSetProperty(page,'heading,heading)
---% htpSetProperty(page,'kind,kind)
---% if asharpConstructorName? conname then
---% htpSetProperty(page,'isAsharpConstructor,true)
---% htpSetProperty(page,'conform,conform)
---% htpSetProperty(page,'signature,signature)
---% kdPageInfo(name,abbrev,nargs,conform,signature,isFile)
---% htSayStandard '"\newline"
---% htBeginMenu(3)
---% htSayStandard '"\item "
---% htMakePage [['bcLinks,['"\menuitemstyle{Description}",
---% [['text,'"\tab{19}",'"General description"]],'kiPage,nil]]]
---% satBreak()
---% htMakePage [['bcLinks,['"\menuitemstyle{Operations}",
---% [['text,'"\tab{19}All exported operations"]],'koPage,'"operation"]]]
---% if not asharpConstructorName? conname then
---% satBreak()
---% htMakePage [['bcLinks,['"\menuitemstyle{Attributes}",
---% [['text,'"\tab{19}All exported attributes"]],'koPage,'"attribute"]]]
---% if kind ~= 'category and (pathname := dbHasExamplePage conname) then
---% satBreak()
---% htMakePage [['bcLinks,['"\menuitemstyle{Examples}",
---% [['text,'"\tab{19}Examples illustrating use"]],'kxPage,pathname]]]
---% satBreak()
---% htMakePage [['bcLinks,['"\menuitemstyle{Exports}",
---% [['text,'"\tab{19}Explicit categories and operations"]],'kePage,nil]]]
---% satBreak()
---% htMakePage [['bcLinks,['"\menuitemstyle{Cross Reference}",
---% [['text,'"\tab{19}Hierarchy and usage information"]],'kcPage,nil]]]
---% htEndMenu(3)
---% if kind ~= 'category and nargs > 0 then addParameterTemplates conform
---% htShowPage()
---%
conform2String u ==
x := form2String u
atom x => STRINGIMAGE x
@@ -450,27 +391,24 @@ kcPage(htPage,junk) ==
satBreak()
htMakePage [['bcLinks,['"\menuitemstyle{Descendants}",[['text,'"\tab{12}",
'"All categories which extend this category"]],'kcdPage,nil]]]
- if not asharpConstructorName? conname then
- satBreak()
- message := '"Constructors mentioning this as an argument type"
- htMakePage [['bcLinks,['"\menuitemstyle{Dependents}",
- [['text,'"\tab{12}",message]],'kcdePage,nil]]]
- if not asharpConstructorName? conname and kind ~= '"category" then
- satBreak()
- htMakePage [['bcLinks,['"\menuitemstyle{Lineage}",
- '"\tab{12}Constructor hierarchy used for operation lookup",'ksPage,nil]]]
- if not asharpConstructorName? conname then
- if kind = '"category" then
- satBreak()
- htMakePage [['bcLinks,['"\menuitemstyle{Domains}",[['text,'"\tab{12}",
- '"All domains which are of this category"]],'kcdoPage,nil]]]
- if kind ~= '"category" then
- satBreak()
- htMakePage [['bcLinks,['"\menuitemstyle{Clients}",'"\tab{12}Constructors",'kcuPage,nil]]]
- if tableValue($defaultPackageNamesHT,conname)
- then htSay('" which {\em may use} this default package")
+ satBreak()
+ message := '"Constructors mentioning this as an argument type"
+ htMakePage [['bcLinks,['"\menuitemstyle{Dependents}",
+ [['text,'"\tab{12}",message]],'kcdePage,nil]]]
+ satBreak()
+ htMakePage [['bcLinks,['"\menuitemstyle{Lineage}",
+ '"\tab{12}Constructor hierarchy used for operation lookup",'ksPage,nil]]]
+ if kind = '"category" then
+ satBreak()
+ htMakePage [['bcLinks,['"\menuitemstyle{Domains}",[['text,'"\tab{12}",
+ '"All domains which are of this category"]],'kcdoPage,nil]]]
+ if kind ~= '"category" then
+ satBreak()
+ htMakePage [['bcLinks,['"\menuitemstyle{Clients}",'"\tab{12}Constructors",'kcuPage,nil]]]
+ if tableValue($defaultPackageNamesHT,conname)
+ then htSay('" which {\em may use} this default package")
-- htMakePage [['bcLinks,['"files",'"",'kcuPage,true]]]
- else htSay('" which {\em use} this ",kind)
+ else htSay('" which {\em use} this ",kind)
if kind ~= '"category" or dbpHasDefaultCategory? xpart then
satBreak()
message :=
@@ -479,11 +417,10 @@ kcPage(htPage,junk) ==
htMakePage [['bcLinks,['"\menuitemstyle{Benefactors}",
[['text,'"\tab{12}",:message]],'kcnPage,nil]]]
--to remove "Capsule Information", comment out the next 5 lines
- if not asharpConstructorName? conname and hasNewInfoAlist conname then
- satBreak()
- message := ['"Cross reference for capsule implementation"]
- htMakePage [['bcLinks,['"\menuitemstyle{CapsuleInfo}",
- [['text,'"\tab{12}",:message]],'kciPage,nil]]]
+ satBreak()
+ message := ['"Cross reference for capsule implementation"]
+ htMakePage [['bcLinks,['"\menuitemstyle{CapsuleInfo}",
+ [['text,'"\tab{12}",:message]],'kciPage,nil]]]
htEndMenu(3)
htShowPage()
@@ -1144,17 +1081,13 @@ bcUnixTable(u) ==
if firstTime then firstTime := false
else htSaySaturn '"&"
htSay '"{"
- ft :=
- isAsharpFileName? x => '("AS")
- '("SPAD")
+ ft := '("SPAD")
filename := NAMESTRING $FINDFILE(STRINGIMAGE x, ft)
htMakePage [['text, '"\unixcommand{",PATHNAME_-NAME x, '"}{",
textEditor(), '" ", filename, '"} "]]
htSay '"}"
htEndTable()
-isAsharpFileName? con == false
-
--=======================================================================
-- Special Code for Union, Mapping, and Record
--=======================================================================
diff --git a/src/interp/br-op2.boot b/src/interp/br-op2.boot
index 625dc62c..0b30f52c 100644
--- a/src/interp/br-op2.boot
+++ b/src/interp/br-op2.boot
@@ -342,7 +342,6 @@ whoUsesMatch1?(signumList,sig,al) ==
koAttrs(conform,domname) ==
[conname,:args] := conform
---asharpConstructorName? conname => nil --assumed
"category" = getConstructorKindFromDB conname =>
koCatAttrs(conform,domname)
$infovec: local := dbInfovec conname or return nil
@@ -389,7 +388,6 @@ koOps(conform,domname,:options) == main where
u := koCatOps(conform,domname) => u
-- "category" = getConstructorKindFromDB conname =>
-- koCatOps(conform,domname)
- asharpConstructorName? opOf conform => nil
----------> new <------------------
$infovec: local := dbInfovec conname--------> removed 94/10/24
exposureTail :=
diff --git a/src/interp/br-saturn.boot b/src/interp/br-saturn.boot
index 9af0e238..3c697f46 100644
--- a/src/interp/br-saturn.boot
+++ b/src/interp/br-saturn.boot
@@ -642,8 +642,6 @@ kPage(line,:options) == --any cat, dom, package, default package
htpSetProperty(page,'parts,parts)
htpSetProperty(page,'heading,heading)
htpSetProperty(page,'kind,kind)
- if asharpConstructorName? conname then
- htpSetProperty(page,'isAsharpConstructor,true)
htpSetProperty(page,'conform,conform)
htpSetProperty(page,'signature,signature)
---what follows is stuff from kiPage with domain = nil
@@ -668,17 +666,14 @@ kPageContextMenu page ==
if kind = '"category" then
htSay '"}{"
htMakePage [['bcLinks,['Children,'"",'kccPage,nil]]]
- if not asharpConstructorName? conname then
- htSay '"}{"
- htMakePage [['bcLinks,['Dependents,'"",'kcdePage,nil]]]
+ htSay '"}{"
+ htMakePage [['bcLinks,['Dependents,'"",'kcdePage,nil]]]
if kind = '"category" then
htSay '"}{"
htMakePage [['bcLinks,['Descendents,'"",'kcdPage,nil]]]
if kind = '"category" then
htSay '"}{"
- if not asharpConstructorName? conname then
- htMakePage [['bcLinks,['Domains,'"",'kcdoPage,nil]]]
- else htSay '"{\em Domains}"
+ htMakePage [['bcLinks,['Domains,'"",'kcdoPage,nil]]]
htSay '"}{"
if kind ~= '"category" and (pathname := dbHasExamplePage conname)
then htMakePage [['bcLinks,['Examples,'"",'kxPage,pathname]]]
@@ -691,9 +686,7 @@ kPageContextMenu page ==
htMakePage [['bcLinks,['Parents,'"",'kcpPage,'"operation"]]]
if kind ~= '"category" then
htSay '"}{"
- if not asharpConstructorName? conname
- then htMakePage [['bcLinks,["Search Path",'"",'ksPage,nil]]]
- else htSay '"{\em Search Path}"
+ htMakePage [['bcLinks,["Search Path",'"",'ksPage,nil]]]
if kind ~= '"category" then
htSay '"}{"
htMakePage [['bcLinks,['Users,'"",'kcuPage,nil]]]
@@ -712,23 +705,18 @@ kPageContextMenuSaturn page ==
htMakePage [['bcLinks,['"Attri\&butes",'"",'koPage,'"attribute"]]]
if kind = '"category" then
htMakePage [['bcLinks,['"\&Children",'"",'kccPage,nil]]]
- if not asharpConstructorName? conname then
- htMakePage [['bcLinks,['"\&Dependents",'"",'kcdePage,nil]]]
+ htMakePage [['bcLinks,['"\&Dependents",'"",'kcdePage,nil]]]
if kind = '"category" then
htMakePage [['bcLinks,['"Desce\&ndents",'"",'kcdPage,nil]]]
if kind = '"category" then
- if not asharpConstructorName? conname then
- htMakePage [['bcLinks,['"Do\&mains",'"",'kcdoPage,nil]]]
- else htSayCold '"Do\&mains"
+ htMakePage [['bcLinks,['"Do\&mains",'"",'kcdoPage,nil]]]
if kind ~= '"category" and (name := saturnHasExamplePage conname)
then saturnExampleLink name
else htSayCold '"E\&xamples"
htMakePage [['bcLinks,['"\&Exports",'"",'kePage,nil]]]
htMakePage [['bcLinks,['"\&Operations",'"",'koPage,'"operation"]]]
htMakePage [['bcLinks,['"\&Parents",'"",'kcpPage,'"operation"]]]
- if not asharpConstructorName? conname
- then htMakePage [['bcLinks,['"Search O\&rder",'"",'ksPage,nil]]]
- else htSayCold '"Search Order"
+ htMakePage [['bcLinks,['"Search O\&rder",'"",'ksPage,nil]]]
if kind ~= '"category" or dbpHasDefaultCategory? xpart
then
htMakePage [['bcLinks,['"\&Users",'"",'kcuPage,nil]]]
@@ -1022,11 +1010,10 @@ dbGatherThenShow(htPage,opAlist,which,data,constructorIfTrue,word,fn) ==
dbPresentOps(htPage,which,:exclusions) ==
$saturn => dbPresentOpsSaturn(htPage,which,exclusions)
- asharp? := htpProperty(htPage,'isAsharpConstructor)
fromConPage? := (conname := opOf htpProperty(htPage,'conform))
usage? := nil
star? := not fromConPage? or which = '"package operation"
- implementation? := not asharp? and
+ implementation? :=
$UserLevel = 'development and $conformsAreDomains --and not $includeUnexposed?
rightmost? := star? or (implementation? and not $includeUnexposed?)
if integer? first exclusions then exclusions := ['documentation]
@@ -1093,11 +1080,10 @@ dbPresentOps(htPage,which,:exclusions) ==
dbPresentOpsSaturn(htPage,which,exclusions) ==
$htLineList : local := nil
$newPage : local := nil
- asharp? := htpProperty(htPage,'isAsharpConstructor)
fromConPage? := (conname := opOf htpProperty(htPage,'conform))
usage? := nil
star? := not fromConPage? or which = '"package operation"
- implementation? := not asharp? and
+ implementation? :=
$UserLevel = 'development and $conformsAreDomains --and not $includeUnexposed?
rightmost? := star? or (implementation? and not $includeUnexposed?)
if integer? first exclusions then exclusions := ['documentation]
diff --git a/src/interp/br-util.boot b/src/interp/br-util.boot
index 38de165d..0512cd45 100644
--- a/src/interp/br-util.boot
+++ b/src/interp/br-util.boot
@@ -362,13 +362,6 @@ dbSourceFile name ==
t := PATHNAME_-TYPE u
strconc(n,'".",t)
-asharpConstructorName? name ==
- u:= getConstructorSourceFileFromDB name
- u and PATHNAME_-TYPE u = '"as"
-
-asharpConstructors() ==
- [x for x in allConstructors() | not asharpConstructorName? x]
-
extractFileNameFromPath s == fn(s,0,#s) where
fn(s,i,m) ==
k := charPosition(char "/",s,i)
diff --git a/src/interp/c-util.boot b/src/interp/c-util.boot
index 7d45bede..7ee3f3f9 100644
--- a/src/interp/c-util.boot
+++ b/src/interp/c-util.boot
@@ -127,7 +127,6 @@ $SetCategory ==
dbInfovec name ==
getConstructorKindFromDB name is "category" => nil
- asharpConstructorFromDB name => nil
loadLibIfNotLoaded(name)
u := property(name,'infovec) => u
nil
diff --git a/src/interp/cattable.boot b/src/interp/cattable.boot
index d86290f4..947db52f 100644
--- a/src/interp/cattable.boot
+++ b/src/interp/cattable.boot
@@ -146,9 +146,6 @@ simpHasAttribute(pred,conform,attr) == --eval w/o loading
conname := conform.op
getConstructorKindFromDB conname is "category" =>
simpCatHasAttribute(conform,attr)
- asharpConstructorName? conname =>
- p := LASSOC(attr,getConstructorAttributesFromDB conname) =>
- simpHasPred sublisFormal(rest conform,p)
infovec := dbInfovec conname
k := LASSOC(attr,infovec.2) or return nil --if not listed then false
k = 0 => true
diff --git a/src/interp/database.boot b/src/interp/database.boot
index 8211fd04..a2cdd9f1 100644
--- a/src/interp/database.boot
+++ b/src/interp/database.boot
@@ -134,10 +134,6 @@ niladicConstructorFromDB: %Constructor -> %Boolean
niladicConstructorFromDB ctor ==
GETDATABASE(ctor,"NILADIC")
-asharpConstructorFromDB: %Constructor -> %Maybe %Symbol
-asharpConstructorFromDB ctor ==
- GETDATABASE(ctor,"ASHARP?")
-
constructorHasCategoryFromDB: %Pair(%Thing,%Thing) -> %List %Code
constructorHasCategoryFromDB p ==
GETDATABASE(p,"HASCATEGORY")
diff --git a/src/interp/lisplib.boot b/src/interp/lisplib.boot
index 06daed68..51210ea0 100644
--- a/src/interp/lisplib.boot
+++ b/src/interp/lisplib.boot
@@ -413,15 +413,7 @@ makeConstructorsAutoLoad() ==
systemDependentMkAutoload(getConstructorAbbreviationFromDB cnam,cnam)
systemDependentMkAutoload(fn,cnam) ==
- FBOUNDP(cnam) => "next"
- asharpName := asharpConstructorFromDB cnam =>
- kind := getConstructorKindFromDB cnam
- cosig := getDualSignatureFromDB cnam
- file := getConstructorModuleFromDB cnam
- SET_-LIB_-FILE_-GETTER(file, cnam)
- kind is 'category =>
- ASHARPMKAUTOLOADCATEGORY(file, cnam, asharpName, cosig)
- ASHARPMKAUTOLOADFUNCTOR(file, cnam, asharpName, cosig)
+ FBOUNDP cnam => "next"
symbolFunction(cnam) := mkAutoLoad(fn, cnam)
autoLoad(abb,cname) ==
diff --git a/src/interp/nrunfast.boot b/src/interp/nrunfast.boot
index 9fcdd17a..52cda675 100644
--- a/src/interp/nrunfast.boot
+++ b/src/interp/nrunfast.boot
@@ -628,16 +628,6 @@ newHasTest(domform,catOrAtt) ==
catOrAtt is '(Type) => true
cons? domform and builtinFunctorName? domform.op =>
ofCategory(domform,catOrAtt)
- asharpConstructorFromDB opOf domform => fn(domform,catOrAtt) where
- -- atom (infovec := getInfovec opOf domform) => fn(domform,catOrAtt) where
- fn(a,b) ==
- categoryForm?(a) => assoc(b, ancestorsOf(a, nil))
- isPartialMode a => throwKeyedMsg("S2IS0025",nil)
- b is ["SIGNATURE",:opSig] =>
- HasSignature(evalDomain a,opSig)
- b is ["ATTRIBUTE",attr] => HasAttribute(evalDomain a,attr)
- hasCaty(a,b,nil) isnt 'failed
- HasCategory(evalDomain a,b) => true -- for asharp domains: must return Boolean
op := opOf catOrAtt
isAtom := atom catOrAtt
not isAtom and op is 'Join =>