diff options
| author | dos-reis <gdr@axiomatics.org> | 2008-04-14 01:59:56 +0000 |
|---|---|---|
| committer | dos-reis <gdr@axiomatics.org> | 2008-04-14 01:59:56 +0000 |
| commit | 663089e7f95f4901a46939ef34c60982dd5aadda (patch) | |
| tree | 591d333d98a1eaf5b3c22d57e75ece8c56f9619b /src | |
| parent | c5659a8580de5b531891c6703465c84add9fbb1b (diff) | |
| download | open-axiom-663089e7f95f4901a46939ef34c60982dd5aadda.tar.gz | |
Various cleanups.
Diffstat (limited to 'src')
43 files changed, 436 insertions, 309 deletions
diff --git a/src/ChangeLog b/src/ChangeLog index 9f368b0c..05f44c64 100644 --- a/src/ChangeLog +++ b/src/ChangeLog @@ -1,5 +1,49 @@ 2008-04-13 Gabriel Dos Reis <gdr@cs.tamu.edu> + * interp/as.boot: Remove explicit use GETDATABASE. + * interp/br-con.boot: Likewise. + * interp/br-data.boot: Likewise. + * interp/br-op1.boot: Likewise. + * interp/br-op2.boot: Likewise. + * interp/br-prof.boot: Likewise. + * interp/br-saturn.boot: Likewise. + * interp/br-search.boot: Likewise. + * interp/br-util.boot: Likewise. + * interp/c-doc.boot: Likewise. + * interp/cattable.boot: Likewise. + * interp/clammed.boot: Likewise. + * interp/daase.lisp: Likewise. + * interp/database.boot: Likewise. + * interp/define.boot: Likewise. + * interp/format.boot: Likewise. + * interp/g-cndata.boot: Likewise. + * interp/g-util.boot: Likewise. + * interp/hashcode.boot: Likewise. + * interp/i-coerce.boot: Likewise. + * interp/i-eval.boot: Likewise. + * interp/i-funsel.boot: Likewise. + * interp/i-resolv.boot: Likewise. + * interp/interop.boot: Likewise. + * interp/lisplib.boot: Likewise. + * interp/mark.boot: Likewise. + * interp/modemap.boot: Likewise. + * interp/nruncomp.boot: Likewise. + * interp/nrunfast.boot: Likewise. + * interp/nrunopt.boot: Likewise. + * interp/parse.boot: Likewise. + * interp/postpar.boot: Likewise. + * interp/pspad1.boot: Likewise. + * interp/pspad2.boot: Likewise. + * interp/showimp.boot: Likewise. + * interp/template.boot: Likewise. + * interp/topics.boot: Likewise. + * interp/types.boot (%Atom): New. + * algebra/Makefile.pamphlet (axiom_algebra_layer_0): Tidy. + (axiom_algebra_layer_4): Likewise. + (axiom_algebra_layer_19): Likewise. + +2008-04-13 Gabriel Dos Reis <gdr@cs.tamu.edu> + * interp/apply.boot: Tidy signature declarations. * interp/as.boot: Use getConstructorKindFromDB throughout. * interp/br-con.boot: Likewise. diff --git a/src/algebra/Makefile.in b/src/algebra/Makefile.in index 0907ebad..ea22eb05 100644 --- a/src/algebra/Makefile.in +++ b/src/algebra/Makefile.in @@ -359,7 +359,7 @@ axiom_algebra_bootstrap_objects = \ axiom_algebra_layer_0 = \ AHYP ATTREG CFCAT ELTAB KOERCE KONVERT \ - MSYSCMD ODEIFTBL OM OMCONN OMDEV OUT \ + MSYSCMD OM OMCONN OMDEV OUT \ PRIMCAT PRINT PTRANFN SPFCAT TYPE UTYPE \ PROPLOG PROPERTY BASTYPE BASTYPE- CATEGORY LMODULE \ RMODULE FINITE STEP SGROUP SGROUP- ABELSG \ @@ -411,10 +411,10 @@ axiom_algebra_layer_3_objects = \ $(addsuffix .$(FASLEXT),$(axiom_algebra_layer_3))) axiom_algebra_layer_4 = \ ANON COLOR COMM COMPPROP ESCONT1 EXIT \ - FAMONC FORMULA1 IDPC NIPROB NONE NUMINT \ - ODECAT ODEPROB OMENC ONECOMP2 OPTCAT OPTPROB \ + FAMONC FORMULA1 IDPC NONE NUMINT \ + ODECAT OMENC ONECOMP2 OPTCAT \ PALETTE PARPCURV PARPC2 PARSCURV PARSC2 PARSURF \ - PARSU2 PATMAB PATRES2 PATTERN1 PDECAT PDEPROB \ + PARSU2 PATMAB PATRES2 PATTERN1 PDECAT \ REPSQ REPDB RFDIST RIDIST SPACEC SPLNODE \ SUCH TEX1 UDVO YSTREAM PAIR ENV \ ATRIG ATRIG- GROUP GROUP- LALG LALG- \ @@ -478,12 +478,14 @@ axiom_algebra_layer_8_objects = \ $(addprefix $(OUT)/, \ $(addsuffix .$(FASLEXT),$(axiom_algebra_layer_8))) axiom_algebra_layer_9 = \ - AMR AMR- DEGRED DLP EAB ESTOOLS1 \ - FAGROUP FAMONOID FLINEXP FLINEXP- FRETRCT FRETRCT- \ - FSERIES FT IDPAG IDPOAMS INFINITY LA \ - OMLO ORTHPOL PRODUCT PADICCT PMPRED PMASS \ - PTFUNC2 RADCAT RADCAT- RATRET RADUTIL UPXS2 \ - XFALG ZLINDEP BBTREE LSAGG LSAGG- SRAGG SRAGG- STRICAT + AMR AMR- DEGRED DLP EAB ESTOOLS1 \ + FAGROUP FAMONOID FLINEXP FLINEXP- FRETRCT FRETRCT- \ + FSERIES FT IDPAG IDPOAMS INFINITY LA \ + OMLO ORTHPOL PRODUCT PADICCT PMPRED PMASS \ + PTFUNC2 RADCAT RADCAT- RATRET RADUTIL UPXS2 \ + XFALG ZLINDEP BBTREE LSAGG LSAGG- SRAGG \ + SRAGG- STRICAT ODEIFTBL NIPROB ODEPROB OPTPROB \ + PDEPROB axiom_algebra_layer_9_nrlibs = \ @@ -696,9 +698,9 @@ axiom_algebra_layer_18_objects = \ $(addsuffix .$(FASLEXT),$(axiom_algebra_layer_18))) axiom_algebra_layer_19 = \ ACPLOT ANTISYM \ - ANY ASP12 ASP27 ASP28 \ - ASP33 ASP49 ASP55 ASP7 \ - ASP78 ASP8 ASP9 ATTRBUT \ + ANY ASP27 ASP28 \ + ASP33 ASP49 ASP7 \ + ASP78 ASP9 ATTRBUT \ BOP BOP1 COMMONOP COMPCAT \ COMPCAT- DRAW DRAWCFUN DROPT \ DROPT0 D01ANFA D01ASFA D03AGNT \ @@ -733,7 +735,7 @@ axiom_algebra_layer_19_objects = \ $(addprefix $(OUT)/, \ $(addsuffix .$(FASLEXT),$(axiom_algebra_layer_19))) axiom_algebra_layer_20 = \ - AF ALGFACT \ + AF ALGFACT ASP12 ASP55 ASP8 \ ALGFF ALGMANIP ALGMFACT ALGPKG \ ALGSC AN APPRULE ASP19 \ ASP20 ASP30 ASP31 ASP35 \ diff --git a/src/algebra/Makefile.pamphlet b/src/algebra/Makefile.pamphlet index 278c74a7..91499e2f 100644 --- a/src/algebra/Makefile.pamphlet +++ b/src/algebra/Makefile.pamphlet @@ -185,7 +185,7 @@ system.spad.pamphlet (MSYSCMD) axiom_algebra_layer_0 = \ AHYP ATTREG CFCAT ELTAB KOERCE KONVERT \ - MSYSCMD ODEIFTBL OM OMCONN OMDEV OUT \ + MSYSCMD OM OMCONN OMDEV OUT \ PRIMCAT PRINT PTRANFN SPFCAT TYPE UTYPE \ PROPLOG PROPERTY BASTYPE BASTYPE- CATEGORY LMODULE \ RMODULE FINITE STEP SGROUP SGROUP- ABELSG \ @@ -284,10 +284,10 @@ ystream.spad.pamphlet (YSTREAM) <<layer4>>= axiom_algebra_layer_4 = \ ANON COLOR COMM COMPPROP ESCONT1 EXIT \ - FAMONC FORMULA1 IDPC NIPROB NONE NUMINT \ - ODECAT ODEPROB OMENC ONECOMP2 OPTCAT OPTPROB \ + FAMONC FORMULA1 IDPC NONE NUMINT \ + ODECAT OMENC ONECOMP2 OPTCAT \ PALETTE PARPCURV PARPC2 PARSCURV PARSC2 PARSURF \ - PARSU2 PATMAB PATRES2 PATTERN1 PDECAT PDEPROB \ + PARSU2 PATMAB PATRES2 PATTERN1 PDECAT \ REPSQ REPDB RFDIST RIDIST SPACEC SPLNODE \ SUCH TEX1 UDVO YSTREAM PAIR ENV \ ATRIG ATRIG- GROUP GROUP- LALG LALG- \ @@ -405,12 +405,14 @@ sf.spad.pamphlet (REAL RADCAT RNS FPS DFLOAT) <<layer9>>= axiom_algebra_layer_9 = \ - AMR AMR- DEGRED DLP EAB ESTOOLS1 \ - FAGROUP FAMONOID FLINEXP FLINEXP- FRETRCT FRETRCT- \ - FSERIES FT IDPAG IDPOAMS INFINITY LA \ - OMLO ORTHPOL PRODUCT PADICCT PMPRED PMASS \ - PTFUNC2 RADCAT RADCAT- RATRET RADUTIL UPXS2 \ - XFALG ZLINDEP BBTREE LSAGG LSAGG- SRAGG SRAGG- STRICAT + AMR AMR- DEGRED DLP EAB ESTOOLS1 \ + FAGROUP FAMONOID FLINEXP FLINEXP- FRETRCT FRETRCT- \ + FSERIES FT IDPAG IDPOAMS INFINITY LA \ + OMLO ORTHPOL PRODUCT PADICCT PMPRED PMASS \ + PTFUNC2 RADCAT RADCAT- RATRET RADUTIL UPXS2 \ + XFALG ZLINDEP BBTREE LSAGG LSAGG- SRAGG \ + SRAGG- STRICAT ODEIFTBL NIPROB ODEPROB OPTPROB \ + PDEPROB axiom_algebra_layer_9_nrlibs = \ @@ -954,9 +956,9 @@ variable.spad.pamphlet (OVAR VARIABLE RULECOLD FUNCTION ANON) <<layer19>>= axiom_algebra_layer_19 = \ ACPLOT ANTISYM \ - ANY ASP12 ASP27 ASP28 \ - ASP33 ASP49 ASP55 ASP7 \ - ASP78 ASP8 ASP9 ATTRBUT \ + ANY ASP27 ASP28 \ + ASP33 ASP49 ASP7 \ + ASP78 ASP9 ATTRBUT \ BOP BOP1 COMMONOP COMPCAT \ COMPCAT- DRAW DRAWCFUN DROPT \ DROPT0 D01ANFA D01ASFA D03AGNT \ @@ -1071,7 +1073,7 @@ utsode.spad.pamphlet (UTSODE) <<layer20>>= axiom_algebra_layer_20 = \ - AF ALGFACT \ + AF ALGFACT ASP12 ASP55 ASP8 \ ALGFF ALGMANIP ALGMFACT ALGPKG \ ALGSC AN APPRULE ASP19 \ ASP20 ASP30 ASP31 ASP35 \ diff --git a/src/interp/as.boot b/src/interp/as.boot index 8ed116d9..6ab40d99 100644 --- a/src/interp/as.boot +++ b/src/interp/as.boot @@ -216,22 +216,22 @@ getAttributesFromCATEGORY catform == displayDatabase x == main where main() == for y in - '(CONSTRUCTORFORM CONSTRUCTORKIND _ - CONSTRUCTORMODEMAP _ - ABBREVIATION _ - CONSTRUCTORCATEGORY _ - PARENTS _ - ATTRIBUTES _ - ANCESTORS _ - SOURCEFILE _ - OPERATIONALIST _ - MODEMAPS _ - SOURCEFILE _ - DOCUMENTATION) repeat fn(x,y) + '(("form" . getConstructorFormFromDB) _ + ("kind" . getConstructorKindFromDB) _ + ("modemap" . getConstructorModemapFromDB) _ + ("abbreviation" . getConstructorAbbreviationFromDB) _ + ("category" . getConstructorCategoryFromDB) _ + ("parents" . getConstructorParentsFromDB) _ + ("attributes" . getConstructorAttributesFromDB) _ + ("ancestors" . getConstructorAncestorsFromDB) _ + ("source file" . getConstructorSourceFileFromDB) _ + ("all operations" . getConstructorOperationsFromDB) _ + ("operation modemap" . getOperationModemapsFromDB) _ + ("documentation" . getConstructorDocumentationFromDB)) repeat fn(x,y) where fn(x,y) == - sayBrightly ['"----------------- ",y,'" --------------------"] - pp GETDATABASE(x,y) + sayBrightly ['"----------------- ",first y,'" --------------------"] + pp FUNCALL(rest y, x) -- For some reason Dick has modified as.boot to convert the -- identifier |0| or |1| to an integer in the list of operations. @@ -392,7 +392,7 @@ asyAncestors x == atom x => x = '_% => '_$ MEMQ(x, $niladics) => [x] - GETDATABASE(x ,'NILADIC) => [x] + niladicConstructorFromDB x => [x] x asyAncestorList x @@ -759,9 +759,9 @@ createAbbreviation s == nil --============================================================================ --- extending getConstructorModemap Property +-- extending getConstructorModemapFromDB Property --============================================================================ ---Note: modemap property is built when getConstructorModemap is called +--Note: modemap property is built when getConstructorModemapFromDB is called asyConstructorModemap con == HGET($conHash,con) isnt [record,:.] => nil --not there diff --git a/src/interp/ax.boot b/src/interp/ax.boot index 8d7f4321..ab40f81e 100644 --- a/src/interp/ax.boot +++ b/src/interp/ax.boot @@ -60,7 +60,7 @@ makeAxFile(filename, constructors) == $literals := [] axForms := [modemapToAx(modemap) for cname in constructors | - (modemap:=getConstructorModemap cname) and + (modemap:=getConstructorModemapFromDB cname) and (not cname in '(Tuple Exit Type)) and not isDefaultPackageName cname] if $baseForms then @@ -80,7 +80,7 @@ makeAxExportForm(filename, constructors) == $literals := [] axForms := [modemapToAx(modemap) for cname in constructors | - (modemap:=getConstructorModemap cname) and + (modemap:=getConstructorModemapFromDB cname) and (not cname in '(Tuple Exit Type)) and not isDefaultPackageName cname] if $baseForms then @@ -106,7 +106,7 @@ modemapToAx(modemap) == argdecls:=['Comma, : [axFormatDecl(a,stripType t) for a in args for t in argtypes]] resultType := axFormatType stripType target categoryForm? constructor => - categoryInfo := GETDATABASE(constructor,'CONSTRUCTORCATEGORY) + categoryInfo := getConstructorCategoryFromDB constructor categoryInfo := SUBLISLIS($FormalMapVariableList, $TriangleVariableList, categoryInfo) NULL args => @@ -125,7 +125,7 @@ modemapToAx(modemap) == rtype := ['Apply, conscat, :args] -- if resultType is ['With,a,b] then -- if not(b is ['Sequence,:withseq]) then withseq := [b] --- cosigs := rest GETDATABASE(constructor, 'COSIG) +-- cosigs := rest getDualSignatureFromDB constructor -- exportargs := [['Export, [], arg, []] for arg in args for p in cosigs | p] -- resultType := ['With,a,['Sequence,:APPEND(exportargs, withseq)]] consdef := ['Define, @@ -141,7 +141,7 @@ modemapToAx(modemap) == ['Export, ['Declare, constructor, resultType],[],[]] -- if resultType is ['With,a,b] then -- if not(b is ['Sequence,:withseq]) then withseq := [b] --- cosigs := rest GETDATABASE(constructor, 'COSIG) +-- cosigs := rest getDualSignatureFromDB constructor -- exportargs := [['Export, [], arg, []] for arg in args for p in cosigs | p] -- resultType := ['With,a,['Sequence,:APPEND(exportargs, withseq)]] ['Export, ['Declare, constructor, ['Apply, "->", optcomma argdecls, resultType]],[],[]] @@ -226,13 +226,13 @@ axFormatType(typeform) == ['PretendTo, axFormatType CADDR typeform, 'SetCategory]] typeform is [op,:args] => $pretendFlag and constructor? op and - getConstructorModemap op is [[.,target,:argtypes],.] => + getConstructorModemapFromDB op is [[.,target,:argtypes],.] => ['Apply, op, :[['PretendTo, axFormatType a, axFormatType t] for a in args for t in argtypes]] MEMQ(op, '(SquareMatrix SquareMatrixCategory DirectProduct DirectProductCategory RadixExpansion)) and - getConstructorModemap op is [[.,target,arg1type,:restargs],.] => + getConstructorModemapFromDB op is [[.,target,arg1type,:restargs],.] => ['Apply, op, ['PretendTo, axFormatType first args, axFormatType arg1type], :[axFormatType a for a in rest args]] @@ -343,7 +343,7 @@ getDefaultingOps catname == while curIndex < stopIndex repeat curIndex := get1defaultOp(op,curIndex) $pretendFlag : local := true - catops := GETDATABASE(catname, 'OPERATIONALIST) + catops := getConstructorOperationsFromDB catname [axFormatDefaultOpSig(op,sig,catops) for opsig in $opList | opsig is [op,sig]] axFormatDefaultOpSig(op, sig, catops) == diff --git a/src/interp/br-con.boot b/src/interp/br-con.boot index 927e8256..18042be9 100644 --- a/src/interp/br-con.boot +++ b/src/interp/br-con.boot @@ -177,7 +177,7 @@ kdPageInfo(name,abbrev,nargs,conform,signature,file?) == htSayStandard '"\indentrel{-2}" if name.(#name-1) = char "&" then name := SUBSEQ(name, 0, #name-1) --sourceFileName := dbSourceFile INTERN name - sourceFileName := GETDATABASE(INTERN name,'SOURCEFILE) + sourceFileName := getConstructorSourceFileFromDB INTERN name filename := extractFileNameFromPath sourceFileName if filename ^= '"" then htSayStandard '"\newline{}" @@ -190,7 +190,7 @@ kdPageInfo(name,abbrev,nargs,conform,signature,file?) == kPageArgs([op,:args],[.,.,:source]) == ------------------> OBSELETE firstTime := true - coSig := rest GETDATABASE(op,'COSIG) + coSig := rest getDualSignatureFromDB op for x in args for t in source for pred in coSig repeat if not firstTime then htSay '", and" htSay('"\newline ") @@ -208,7 +208,7 @@ kArgPage(htPage,arg) == [op,:args] := conform := htpProperty(htPage,'conform) domname := htpProperty(htPage,'domname) heading := htpProperty(htPage,'heading) - source := CDDAR getConstructorModemap op + source := CDDAR getConstructorModemapFromDB op n := position(arg,args) typeForm := sublisFormal(args,source . n) domTypeForm := mkDomTypeForm(typeForm,conform,domname) @@ -405,7 +405,7 @@ dbSearchOrder(conform,domname,$domain) == --domain = nil or set to live domain u := $infovec.3 $predvec:= $domain => $domain . 3 - GETDATABASE(name,'PREDICATES) + getConstructorPredicatesFromDB name catpredvec := CAR u catinfo := CADR u catvec := CADDR u @@ -656,7 +656,7 @@ kDomainName(htPage,kind,name,nargs) == htpSetProperty(htPage,'inputAreaList,inputAreaList) conname := INTERN name args := [kArgumentCheck(domain?,x) or nil for x in inputAreaList - for domain? in rest GETDATABASE(conname,'COSIG)] + for domain? in rest getDualSignatureFromDB conname] or/[null x for x in args] => (n := +/[1 for x in args | x]) > 0 => ['error,nil,'"\centerline{You gave values for only {\em ",n,'" } of the {\em ",#args,'"}}",'"\centerline{parameters of {\sf ",name,'"}}\vspace{1}\centerline{Please enter either {\em all} or {\em none} of the type parameters}"] @@ -702,7 +702,7 @@ kisValidType typeForm == kCheckArgumentNumbers t == [conname,:args] := t - cosig := KDR GETDATABASE(conname,'COSIG) + cosig := KDR getDualSignatureFromDB conname #cosig ^= #args => false and/[foo for domain? in cosig for x in args] where foo() == domain? => kCheckArgumentNumbers x @@ -846,7 +846,7 @@ koaPageFilterByName(htPage,functionToCall) == dbConstructorDoc(conform,$op,$sig) == fn conform where fn (conform := [conname,:$args]) == - or/[gn y for y in GETDATABASE(conname,'DOCUMENTATION)] + or/[gn y for y in getConstructorDocumentationFromDB conname] gn([op,:alist]) == op = $op and "or"/[doc or '("") for [sig,:doc] in alist | hn sig] hn sig == @@ -876,7 +876,7 @@ dbAddDocTable conform == conname := opOf conform storedArgs := rest getConstructorForm conname for [op,:alist] in SUBLISLIS(["$",:rest conform], - ["%",:storedArgs],GETDATABASE(opOf conform,'DOCUMENTATION)) + ["%",:storedArgs],getConstructorDocumentationFromDB opOf conform) repeat op1 := op = '(Zero) => 0 @@ -1054,7 +1054,7 @@ dbShowCons1(htPage,cAlist,key) == key = 'files => flist := [y for con in conlist | - y := (fn := GETDATABASE(con,'SOURCEFILE))] + y := (fn := getConstructorSourceFileFromDB con)] bcUnixTable(listSort(function GLESSEQP,REMDUP flist)) key = 'documentation => dbShowConsDoc(page,conlist) if $exposedOnlyIfTrue then @@ -1139,7 +1139,7 @@ dbShowConsDoc1(htPage,conform,indexOrNil) == --NOTE that we pass conform is as "origin" getConstructorDocumentation conname == - LASSOC('constructor,GETDATABASE(conname,'DOCUMENTATION)) + LASSOC('constructor,getConstructorDocumentationFromDB conname) is [[nil,line,:.],:.] and line or '"" dbSelectCon(htPage,which,index) == diff --git a/src/interp/br-data.boot b/src/interp/br-data.boot index 06b24ba7..95e275c7 100644 --- a/src/interp/br-data.boot +++ b/src/interp/br-data.boot @@ -98,18 +98,18 @@ buildLibdb(:options) == --called by buildDatabase (database.boot) deleteFile '"temp.text" buildLibdbConEntry conname == - null getConstructorModemap conname => nil - abb:=GETDATABASE(conname,'ABBREVIATION) + null getConstructorModemapFromDB conname => nil + abb:= getConstructorAbbreviationFromDB conname $conname := conname - conform := GETDATABASE(conname,'CONSTRUCTORFORM) or [conname] --hack for Category,.. + conform := getConstructorFormFromDB conname or [conname] --hack for Category,.. $conform := dbMkForm SUBST('T,"T$",conform) null $conform => nil $exposed? := (isExposedConstructor conname => '"x"; '"n") - $doc := GETDATABASE(conname, 'DOCUMENTATION) + $doc := getConstructorDocumentationFromDB conname pname := PNAME conname kind := getConstructorKindFromDB conname if kind = 'domain - and getConstructorModemap conname is [[.,t,:.],:.] + and getConstructorModemapFromDB conname is [[.,t,:.],:.] and t is ['CATEGORY,'package,:.] then kind := 'package $kind := pname.(MAXINDEX pname) = char '_& => 'x @@ -129,7 +129,7 @@ buildLibdbString [x,:u] == STRCONC(STRINGIMAGE x,"STRCONC"/[STRCONC('"`",STRINGIMAGE y) for y in u]) libConstructorSig [conname,:argl] == - [[.,:sig],:.] := getConstructorModemap conname + [[.,:sig],:.] := getConstructorModemapFromDB conname formals := TAKE(#argl,$FormalMapVariableList) sig := SUBLISLIS(formals,$TriangleVariableList,sig) keys := [g(f,sig,i) for f in formals for i in 1..] where @@ -237,7 +237,7 @@ dbAugmentConstructorDataTable() == RPLACD(CDR entry,PUTALIST(CDDR entry,'dbLineNumber,fp)) -- if xname := constructorHasExamplePage entry then -- RPLACD(CDR entry,PUTALIST(CDDR entry,'dbExampleFile,xname)) - args := IFCDR GETDATABASE(name,'CONSTRUCTORFORM) + args := IFCDR getConstructorFormFromDB name if args then RPLACD(CDR entry,PUTALIST(CDDR entry,'constructorArgs,args)) 'done @@ -456,7 +456,7 @@ mkDependentsHashTable() == --called by buildDatabase (database.boot) $depTb getArgumentConstructors con == --called by mkDependentsHashTable - argtypes := IFCDR IFCAR getConstructorModemap con or return nil + argtypes := IFCDR IFCAR getConstructorModemapFromDB con or return nil fn argtypes where fn(u) == "union"/[gn x for x in u] gn(x) == @@ -467,7 +467,7 @@ getArgumentConstructors con == --called by mkDependentsHashTable fn rest x getImports conname == --called by mkUsersHashTable - conform := GETDATABASE(conname,'CONSTRUCTORFORM) + conform := getConstructorFormFromDB conname infovec := dbInfovec conname or return nil template := infovec.0 u := [doImport(i,template) @@ -504,7 +504,7 @@ getParentsFor(cname,formalParams,constructorCategory) == --called by compDefineFunctor1 acc := nil formals := TAKE(#formalParams,$TriangleVariableList) - constructorForm := GETDATABASE(cname, 'CONSTRUCTORFORM) + constructorForm := getConstructorFormFromDB cname for x in folks constructorCategory repeat x := SUBLISLIS(formalParams,formals,x) x := SUBLISLIS(IFCDR constructorForm,formalParams,x) @@ -521,13 +521,13 @@ parentsOf con == --called by kcpPage, ancestorsRecur parentsOfForm [op,:argl] == parents := parentsOf op - null argl or argl = (newArgl := rest GETDATABASE(op,'CONSTRUCTORFORM)) => + null argl or argl = (newArgl := rest getConstructorFormFromDB op) => parents SUBLISLIS(argl, newArgl, parents) getParentsForDomain domname == --called by parentsOf acc := nil - for x in folks GETDATABASE(domname,'CONSTRUCTORCATEGORY) repeat + for x in folks getConstructorCategoryFromDB domname repeat x := getConstructorKindFromDB domname = "category" => sublisFormal(IFCDR getConstructorForm domname,x,$TriangleVariableList) @@ -565,7 +565,7 @@ descendantsOf(conform,domform) == --called by kcdPage "category" = getConstructorKindFromDB(conname := opOf conform) => cats := catsOf(conform,domform) [op,:argl] := conform - null argl or argl = (newArgl := rest (GETDATABASE(op,'CONSTRUCTORFORM))) + null argl or argl = (newArgl := rest getConstructorFormFromDB op) => cats SUBLISLIS(argl, newArgl, cats) 'notAvailable @@ -659,7 +659,7 @@ domainsOf(conform,domname,:options) == --u is list of pairs (a . b) where b() = conname --we sort u then replace each b by the predicate for which this is true s := listSort(function GLESSEQP,COPY u) - s := [[CAR pair,:GETDATABASE(pair,'HASCATEGORY)] for pair in s] + s := [[CAR pair,:constructorHasCategoryFromDB pair] for pair in s] transKCatAlist(conform,domname,listSort(function GLESSEQP,s)) catsOf(conform,domname,:options) == diff --git a/src/interp/br-op1.boot b/src/interp/br-op1.boot index 8ffd824a..5ba992a9 100644 --- a/src/interp/br-op1.boot +++ b/src/interp/br-op1.boot @@ -292,7 +292,7 @@ fromHeading htPage == upOp := PNAME opOf updomain ['" {\em from} ",:dbConformGen dnForm,'" {\em under} \ops{",upOp,'"}{",:$pn,:upFence,'"}"] domname := htpProperty(htPage,'domname) - numberOfUnderlyingDomains := #[x for x in rest GETDATABASE(opOf domname,'COSIG) | x] + numberOfUnderlyingDomains := #[x for x in rest getDualSignatureFromDB(opOf domname) | x] -- numberOfUnderlyingDomains = 1 and -- KDR domname and (dn := dbExtractUnderlyingDomain domname) => -- ['" {\em from} ",:pickitForm(domname,dn)] @@ -315,10 +315,10 @@ conform2StringList(form,opFn,argFn,exception) == special := MEMQ(op,'(Union Record Mapping)) cosig := special => ['T for x in args] - rest GETDATABASE(op,'COSIG) + rest getDualSignatureFromDB op atypes := special => cosig - rest CDAR getConstructorModemap op + rest CDAR getConstructorModemapFromDB op sargl := [fn for x in args for atype in atypes for pred in cosig] where fn() == keyword := x is [":",y,t] => @@ -361,8 +361,8 @@ dbOuttran form == else op := form args := nil - cosig := rest GETDATABASE(op,'COSIG) - atypes := rest CDAR getConstructorModemap op + cosig := rest getDualSignatureFromDB op + atypes := rest CDAR getConstructorModemapFromDB op argl := [fn for x in args for atype in atypes for pred in cosig] where fn() == pred => x typ := sublisFormal(args,atype) @@ -497,7 +497,7 @@ dbGatherDataImplementation(htPage,opAlist) == dom := EVAL domainForm which := '"operation" [nam,:$domainArgs] := domainForm - $predicateList: local := GETDATABASE(nam,'PREDICATES) + $predicateList: local := getConstructorPredicatesFromDB nam predVector := dom.3 u := getDomainOpTable(dom,true,ASSOCLEFT opAlist) --u has form ((op,sig,:implementor)...) @@ -640,7 +640,7 @@ dbShowOpAllDomains(htPage,opAlist,which) == for pair in u repeat [dom,:cat] := pair LASSQ(cat,catOriginAlist) = 'etc => RPLACD(pair,'etc) - RPLACD(pair,simpOrDumb(GETDATABASE(pair,'HASCATEGORY),true)) + RPLACD(pair,simpOrDumb(constructorHasCategoryFromDB pair,true)) --now add all of the domains for [dom,:pred] in domOriginAlist repeat u := insertAlist(dom,simpOrDumb(pred,LASSQ(dom,u) or true),u) @@ -1011,7 +1011,7 @@ dbExpandOpAlistIfNecessary(htPage,opAlist,which,needOrigins?,condition?) == 'done getRegistry(op,sig) == - u := GETDATABASE('AttributeRegistry,'DOCUMENTATION) + u := getConstructorDocumentationFromDB "AttributeRegistry" v := LASSOC(op,u) match := or/[y for y in v | y is [['attribute,: =sig],:.]] => CADR match '"" @@ -1019,7 +1019,7 @@ getRegistry(op,sig) == evalableConstructor2HtString domform == if VECP domform then domform := devaluate domform conname := first domform - coSig := rest GETDATABASE(conname,'COSIG) + coSig := rest getDualSignatureFromDB conname --entries are T for arguments which are domains; NIL for computational objects and/[x for x in coSig] => form2HtString(domform,nil,true) arglist := [unquote x for x in rest domform] where @@ -1028,7 +1028,7 @@ evalableConstructor2HtString domform == f = 'QUOTE => first args [f,:[unquote x for x in args]] arg - fargtypes:=CDDAR getConstructorModemap conname + fargtypes:=CDDAR getConstructorModemapFromDB conname --argtypes:= sublisFormal(arglist,fargtypes) form2HtString([conname,:[fn for arg in arglist for x in coSig for ftype in fargtypes]],nil,true) where diff --git a/src/interp/br-op2.boot b/src/interp/br-op2.boot index 02832a49..d6f499bb 100644 --- a/src/interp/br-op2.boot +++ b/src/interp/br-op2.boot @@ -80,7 +80,7 @@ displayDomainOp(htPage,which,origin,op,sig,predicate, htSaySaturn ops htSaySaturn '"}" htSayStandard(ops) - predicate='ASCONST or GETDATABASE(op,'NILADIC) or member(op,'(0 1)) => 'skip + predicate='ASCONST or niladicConstructorFromDB op or member(op,'(0 1)) => 'skip which = '"attribute" and null args => 'skip htSay('"(") if IFCAR args then htSay('"{\em ",quickForm2HtString IFCAR args,'"}") @@ -97,7 +97,7 @@ displayDomainOp(htPage,which,origin,op,sig,predicate, if which = '"operation" then $signature : local := MEMQ(conname,$Primitives) => nil - CDAR getConstructorModemap conname + CDAR getConstructorModemapFromDB conname --RDJ: this next line is necessary until compiler bug is fixed --that forgets to substitute #variables for t#variables; --check the signature for SegmentExpansionCategory, e.g. @@ -495,7 +495,7 @@ koAttrs(conform,domname) == $infovec: local := dbInfovec conname or return nil $predvec: local := $domain => $domain . 3 - GETDATABASE(conname,'PREDICATES) + getConstructorPredicatesFromDB conname u := [[a,:pred] for [a,:i] in $infovec . 2 | a ^= 'nil and (pred := sublisFormal(args,kTestPred i))] --------- CHECK for a = nil listSort(function GLESSEQP,fn u) where fn u == @@ -576,7 +576,7 @@ kFormatSlotDomain x == fn formatSlotDomain x where fn x == koCatOps(conform,domname) == conname := opOf conform - oplist := REVERSE GETDATABASE(conname,'OPERATIONALIST) + oplist := REVERSE getConstructorOperationsFromDB conname oplist := sublisFormal(IFCDR domname or IFCDR conform ,oplist) --check below for INTEGERP key to avoid subsumed signatures [[zeroOneConvert op,:nalist] for [op,:alist] in oplist | nalist := koCatOps1(alist)] diff --git a/src/interp/br-prof.boot b/src/interp/br-prof.boot index bbb36293..7d916543 100644 --- a/src/interp/br-prof.boot +++ b/src/interp/br-prof.boot @@ -80,7 +80,7 @@ dbShowInfoOp(htPage,op,sig,alist) == kind = 'category => [INTERN STRCONC(PNAME conname,'"&"),"$",:CDR conform] conform - faTypes := CDDAR getConstructorModemap conname + faTypes := CDDAR getConstructorModemapFromDB conname conArgTypes := SUBLISLIS(IFCDR conform,TAKE(#faTypes,$FormalMapVariableList),faTypes) @@ -262,7 +262,7 @@ getInfoAlist conname == return nil alist := mySort READ inStream if cat? then - [.,dollarName,:.] := GETDATABASE(conname,'CONSTRUCTORFORM) + [.,dollarName,:.] := getConstructorFormFromDB conname alist := SUBST("$",dollarName,alist) alist diff --git a/src/interp/br-saturn.boot b/src/interp/br-saturn.boot index bfa95d0d..3df47a86 100644 --- a/src/interp/br-saturn.boot +++ b/src/interp/br-saturn.boot @@ -979,7 +979,7 @@ addParameterTemplates(page, conform) == kPageArgs([op,:args],[.,.,:source]) == htSaySaturn '"\begin{tabular}{p{.25in}lp{0in}}" firstTime := true - coSig := rest GETDATABASE(op,'COSIG) + coSig := rest getDualSignatureFromDB op for x in args for t in source for pred in coSig repeat if firstTime then firstTime := false else @@ -1243,7 +1243,7 @@ displayDomainOp(htPage,which,origin,op,sig,predicate, if unexposed? and $includeUnexposed? then htSayUnexposed() htSay(ops) - predicate='ASCONST or GETDATABASE(op,'NILADIC) or member(op,'(0 1)) => 'skip + predicate='ASCONST or niladicConstructorFromDB op or member(op,'(0 1)) => 'skip which = '"attribute" and null args => 'skip htSay('"(") if IFCAR args then htSay('"{\em ",quickForm2HtString IFCAR args,'"}") @@ -1261,7 +1261,7 @@ displayDomainOp(htPage,which,origin,op,sig,predicate, if which = '"operation" then $signature : local := MEMQ(conname,$Primitives) => nil - CDAR getConstructorModemap conname + CDAR getConstructorModemapFromDB conname --RDJ: this next line is necessary until compiler bug is fixed --that forgets to substitute #variables for t#variables; --check the signature for SegmentExpansionCategory, e.g. @@ -1283,7 +1283,7 @@ displayDomainOp(htPage,which,origin,op,sig,predicate, htSaySaturn '"{\em Arguments:}" htSaySaturnAmpersand() firstTime := true - coSig := KDR GETDATABASE(op,'COSIG) --check if op is constructor + coSig := KDR getDualSignatureFromDB op --check if op is constructor for a in args for t in rest $sig repeat if not firstTime then htSaySaturn '"\\ " @@ -1380,7 +1380,7 @@ displayDomainOp(htPage,which,origin,op,sig,predicate, htSayIndentRel(-15) --------> print abbr and source file for constructors <--------- if which = '"constructor" then - if (abbr := GETDATABASE(conname,'ABBREVIATION)) then + if (abbr := getConstructorAbbreviationFromDB conname) then htSaySaturn '"\\" htSaySaturn '"{\em Abbreviation:}" htSaySaturnAmpersand() @@ -1414,7 +1414,7 @@ displayDomainOp(htPage,which,origin,op,sig,predicate, htSaySaturn '"\end{tabular}" htSaySourceFile conname == - sourceFileName := (GETDATABASE(conname,'SOURCEFILE) or '"none") + sourceFileName := (getConstructorSourceFileFromDB conname or '"none") filename := extractFileNameFromPath sourceFileName htMakePage [['text,'"\unixcommand{",filename,'"}{_\$AXIOM/lib/SPADEDIT ", sourceFileName, '" ", conname, '"}"]] diff --git a/src/interp/br-search.boot b/src/interp/br-search.boot index 3c7089d3..07c8f876 100644 --- a/src/interp/br-search.boot +++ b/src/interp/br-search.boot @@ -96,10 +96,10 @@ grepForAbbrev(s,key) == UPPER_-CASE_-P c => someUpperCaseChar := true someLowerCaseChar or not someUpperCaseChar => false pattern := DOWNCASE s - ['Abbreviations ,:[GETDATABASE(x,'CONSTRUCTORFORM) + ['Abbreviations ,:[getConstructorFormFromDB x for x in allConstructors() | test]] where test() == not $includeUnexposed? and not isExposedConstructor x => false - a := GETDATABASE(x,'ABBREVIATION) + a := getConstructorAbbreviationFromDB x match?(pattern,PNAME a) and not HGET($defaultPackageNamesHT,x) applyGrep(x,filename) == --OBSELETE with $saturn--> see applyGrepSaturn @@ -312,8 +312,8 @@ mkGrepPattern1(x,:options) == --called by mkGrepPattern (and grepConstructName?) conform2OutputForm(form) == [op,:args] := form null args => form - cosig := rest GETDATABASE(op,'COSIG) - atypes := rest CDAR getConstructorModemap op + cosig := rest getDualSignatureFromDB op + atypes := rest CDAR getConstructorModemapFromDB op sargl := [fn for x in args for atype in atypes for pred in cosig] where fn() == pp [x,atype,pred] pred => conform2OutputForm x diff --git a/src/interp/br-util.boot b/src/interp/br-util.boot index cc28cb4d..c7244c40 100644 --- a/src/interp/br-util.boot +++ b/src/interp/br-util.boot @@ -264,7 +264,7 @@ args2LispString x == STRCONC('",",form2LispString first x,fnTailTail rest x) dbConstructorKind x == - target := CADAR getConstructorModemap x + target := CADAR getConstructorModemapFromDB x target = '(Category) => 'category target is ['CATEGORY,'package,:.] => 'package HGET($defaultPackageNamesHT,x) => 'default_ package @@ -276,7 +276,7 @@ getConstructorForm name == name = 'Record => '(Record (_: a A) (_: b B)) name = 'Mapping => '(Mapping T S) name = 'Enumeration => '(Enumeration a b) - GETDATABASE(name,'CONSTRUCTORFORM) + getConstructorFormFromDB name getConstructorArgs conname == CDR getConstructorForm conname @@ -425,14 +425,14 @@ bcStarConform form == bcConform form dbSourceFile name == - u:= GETDATABASE(name,'SOURCEFILE) + u:= getConstructorSourceFileFromDB name null u => '"" n := PATHNAME_-NAME u t := PATHNAME_-TYPE u STRCONC(n,'".",t) asharpConstructorName? name == - u:= GETDATABASE(name,'SOURCEFILE) + u:= getConstructorSourceFileFromDB name u and PATHNAME_-TYPE u = '"as" asharpConstructors() == @@ -584,7 +584,7 @@ htCopyProplist htPage == [[x,:y] for [x,:y] in htpPropertyList htPage] dbInfovec name == "category" = getConstructorKindFromDB name => nil - GETDATABASE(name, 'ASHARP?) => nil + asharpConstructorFromDB name => nil loadLibIfNotLoaded(name) u := GETL(name,'infovec) => u diff --git a/src/interp/c-doc.boot b/src/interp/c-doc.boot index e04fb69a..b343b13d 100644 --- a/src/interp/c-doc.boot +++ b/src/interp/c-doc.boot @@ -74,7 +74,7 @@ getDocForDomain(name,op,sig) == ++ `op' and given signature `sigPart'. The operator `op' is assumed ++ to have been defined in the domain or catagory `abb'. getOpDoc(abb,op,:sigPart) == - u := LASSOC(op,GETDATABASE(abb,'DOCUMENTATION)) + u := LASSOC(op,getConstructorDocumentationFromDB abb) $argList : local := $FormalMapVariableList _$: local := '_$ sigPart is [sig] => or/[d for [s,:d] in u | sig = s] @@ -417,7 +417,7 @@ removeBackslashes s == checkNumOfArgs conform == conname := opOf conform constructor? conname or (conname := abbreviation? conname) => - #GETDATABASE(conname,'CONSTRUCTORARGS) + #getConstructorArgsFromDB conname nil --signals error ++ returns ok if correct, form if wrong number of arguments, nil if unknown @@ -428,7 +428,7 @@ checkIsValidType form == main where [op,:args] := form conname := (constructor? op => op; abbreviation? op) null conname => nil - fn(form,GETDATABASE(conname,'COSIG)) + fn(form,getDualSignatureFromDB conname) fn(form,coSig) == #form ^= #coSig => form or/[null checkIsValidType x for x in rest form for flag in rest coSig | flag] @@ -1233,7 +1233,7 @@ setOutStream nam == whoOwns(con) == null $exposeFlag => nil --con=constructor name (id beginning with a capital), returns owner as a string - filename := GETDATABASE(con,'SOURCEFILE) + filename := getConstructorSourceFileFromDB con quoteChar := char '_" OBEY STRCONC('"awk '$2 == ",quoteChar,filename,quoteChar,'" {print $1}' whofiles > /tmp/temp") instream := MAKE_-INSTREAM '"/tmp/temp" @@ -1270,7 +1270,7 @@ checkDocError u == ++ Augment `u' with information about the owner of the source file ++ containing the current functor definition being processed. checkDocMessage u == - sourcefile := GETDATABASE($constructorName,'SOURCEFILE) + sourcefile := getConstructorSourceFileFromDB $constructorName person := whoOwns $constructorName or '"---" middle := BOUNDP '$x => ['"(",$x,'"): "] diff --git a/src/interp/cattable.boot b/src/interp/cattable.boot index b9c95bcb..27cdebd5 100644 --- a/src/interp/cattable.boot +++ b/src/interp/cattable.boot @@ -38,7 +38,7 @@ import '"g-util" hasCat(domainOrCatName,catName) == catName='Object or catName='Type -- every domain is a Type (Object) - or GETDATABASE([domainOrCatName,:catName],'HASCATEGORY) + or constructorHasCategoryFromDB [domainOrCatName,:catName] showCategoryTable con == [[b,:val] for (key :=[a,:b]) in HKEYS _*HASCATEGORY_-HASH_* @@ -61,7 +61,7 @@ genCategoryTable() == [con for con in allConstructors() | getConstructorKindFromDB con = "domain"] domainTable:= [addDomainToTable(con,getConstrCat catl) for con - in domainList | catl := GETDATABASE(con,'CONSTRUCTORCATEGORY)] + in domainList | catl := getConstructorCategoryFromDB con] -- $nonLisplibDomains, $noCategoryDomains are set in BUILDOM BOOT specialDs := SETDIFFERENCE($nonLisplibDomains,$noCategoryDomains) domainTable:= [:[addDomainToTable(id, getConstrCat (eval [id]).3) @@ -135,7 +135,7 @@ simpHasSignature(pred,conform,op,sig) == --eval w/o loading IDENTP conform => pred [conname,:args] := conform n := #sig - u := LASSOC(op,GETDATABASE(conname,'OPERATIONALIST)) + u := LASSOC(op,getConstructorOperationsFromDB conname) candidates := [x for (x := [sig1,:.]) in u | #sig1 = #sig] or return false match := or/[x for (x := [sig1,:.]) in candidates | sig = sublisFormal(args,sig1)] or return false @@ -147,14 +147,14 @@ simpHasAttribute(pred,conform,attr) == --eval w/o loading getConstructorKindFromDB conname = "category" => simpCatHasAttribute(conform,attr) asharpConstructorName? conname => - p := LASSOC(attr,GETDATABASE(conname,'attributes)) => + 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 $domain => kTestPred k --from koOps predvec := $predvec or sublisFormal(rest conform, - GETDATABASE(conname,'PREDICATES)) + getConstructorPredicatesFromDB conname) simpHasPred predvec.(k - 1) simpCatHasAttribute(domform,attr) == @@ -205,7 +205,7 @@ genTempCategoryTable() == addToCategoryTable con == -- adds an entry to $tempCategoryTable with key=con and alist entries - u := CAAR getConstructorModemap con --domain + u := CAAR getConstructorModemapFromDB con --domain alist := getCategoryExtensionAlist u HPUT(_*ANCESTORS_-HASH_*,first u,alist) alist @@ -368,7 +368,7 @@ makeCatPred(zz, cats, thePred) == cats getConstructorExports(conform,:options) == categoryParts(conform, - GETDATABASE(opOf conform,'CONSTRUCTORCATEGORY),IFCAR options) + getConstructorCategoryFromDB opOf conform,IFCAR options) categoryParts(conform,category,:options) == main where main() == @@ -459,11 +459,11 @@ updateCategoryTable(cname,kind) == kind = 'package => nil kind = 'category => updateCategoryTableForCategory(cname) updateCategoryTableForDomain(cname,getConstrCat( - GETDATABASE(cname,'CONSTRUCTORCATEGORY))) + getConstructorCategoryFromDB cname)) --+ kind = 'domain => updateCategoryTableForDomain(cname,getConstrCat( - GETDATABASE(cname,'CONSTRUCTORCATEGORY))) + getConstructorCategoryFromDB cname)) updateCategoryTableForCategory(cname) == clearTempCategoryTable([[cname,'category]]) diff --git a/src/interp/clammed.boot b/src/interp/clammed.boot index 14c98e85..cd7cb165 100644 --- a/src/interp/clammed.boot +++ b/src/interp/clammed.boot @@ -107,11 +107,11 @@ isValidType form == form is ['Expression, ['Kernel, . ]] => NIL form is [op,:argl] => null constructor? op => nil - cosig := GETDATABASE(op, 'COSIG) + cosig := getDualSignatureFromDB op cosig and null rest cosig => -- niladic constructor null argl => true false - null (sig := getConstructorSignature form) => nil + null (sig := getConstructorSignature op) => nil [.,:cl] := sig -- following line is needed to deal with mutable domains if # cl ^= # argl and GENSYMP last argl then argl:= DROP(-1,argl) @@ -167,11 +167,11 @@ isLegitimateMode(t,hasPolyMode,polyVarList) == ATOM t => false badDoubles := CONS($QuotientField, '(Gaussian Complex Polynomial Expression)) - t is [T1, [T2, :.]] and T1 = T2 and member(T1, badDoubles) => NIL + t is [T1, [T2, :.]] and T1 = T2 and member(T1, badDoubles) => false t is [=$QuotientField,D] and not isPartialMode(D) and - ofCategory(D,'(Field)) => NIL - t = '(Complex (AlgebraicNumber)) => NIL + ofCategory(D,'(Field)) => false + t = '(Complex (AlgebraicNumber)) => false t := equiType t vl := isPolynomialMode t => @@ -184,23 +184,23 @@ isLegitimateMode(t,hasPolyMode,polyVarList) == poly? := (con = 'Polynomial or con = 'Expression) isLegitimateMode(underDomainOf t,poly?,polyVarList) - constructor? first t => + IDENTP(op := first t) and constructor? op => isLegitimateMode(underDomainOf t,hasPolyMode,polyVarList) => t t is ['Mapping,:ml] => - null ml => NIL + null ml => false -- first arg is target, which can be Void - null isLegitimateMode(first ml,nil,nil) => NIL + null isLegitimateMode(first ml,nil,nil) => false for m in rest ml repeat m = $Void => - return NIL - null isLegitimateMode(m,nil,nil) => return NIL + return false + null isLegitimateMode(m,nil,nil) => return false true t is ['Union,:ml] => -- check for tagged union ml and first ml is [":",:.] => isLegitimateRecordOrTaggedUnion ml - null (and/[isLegitimateMode(m,nil,nil) for m in ml]) => NIL + null (and/[isLegitimateMode(m,nil,nil) for m in ml]) => false ((# ml) = (# REMDUP ml)) => true - NIL + false t is ['Record,:r] => isLegitimateRecordOrTaggedUnion r t is ['Enumeration,:r] => null (and/[IDENTP x for x in r]) => false diff --git a/src/interp/daase.lisp b/src/interp/daase.lisp index f01aac3e..a550539a 100644 --- a/src/interp/daase.lisp +++ b/src/interp/daase.lisp @@ -388,7 +388,7 @@ (|Symbol| . |ConvertibleTo|) (|Variable| . |CoercibleTo|))) (dolist (pair hascategory) - (getdatabase pair 'hascategory)) + (|constructorHasCategoryFromDB| pair)) (setq constructormodemapAndoperationalist '(|BasicOperator| |Boolean| @@ -431,14 +431,14 @@ |Variable| |Vector|)) (dolist (con constructormodemapAndoperationalist) - (|getConstructorModemap| con) - (getdatabase con 'operationalist)) + (|getConstructorModemapFromDB| con) + (|getConstructorOperationsFromDB| con)) (setq operation '(|+| |-| |*| |/| |**| |coerce| |convert| |elt| |equation| |float| |sin| |cos| |map| |SEGMENT|)) (dolist (op operation) - (getdatabase op 'operation)) + (|getOperationFromDB| op)) (setq constr '( ;these are sorted least-to-most freq. delete early ones first |Factored| @@ -526,7 +526,8 @@ |List| |OutputForm|)) (dolist (con constr) - (let ((c (|getSystemModulePath| (string (getdatabase con 'abbreviation))))) + (let ((c (|getSystemModulePath| + (string (|getConstructorAbbreviationFromDB| con))))) (format t " preloading ~a.." c) (if (probe-file c) (progn @@ -675,60 +676,60 @@ (dolist (map oldmaps) ; out with the old (let (oldop op) (setq op (car map)) - (setq oldop (getdatabase op 'operation)) + (setq oldop (|getOperationFromDB| op)) (setq oldop (delete (cdr map) oldop :test #'equal)) (setf (gethash op *operation-hash*) oldop))) - (dolist (map (getdatabase constructor 'modemaps)) ; in with the new + (dolist (map (|getOperationModemapsFromDB| constructor)) ; in with the new (let (op newmap) (setq op (car map)) - (setq newmap (getdatabase op 'operation)) + (setq newmap (|getOperationFromDB| op)) (setf (gethash op *operation-hash*) (cons (cdr map) newmap))))) (defun showdatabase (constructor) (format t "~&~a: ~a~%" 'constructorkind - (getdatabase constructor 'constructorkind)) + (|getConstructorKindFromDB| constructor)) (format t "~a: ~a~%" 'cosig - (getdatabase constructor 'cosig)) + (|getDualSignatureFromDB| constructor)) (format t "~a: ~a~%" 'operation - (getdatabase constructor 'operation)) + (|getOperationFromDB| constructor)) (format t "~a: ~%" 'constructormodemap) - (pprint (|getConstructorModemap| constructor)) + (pprint (|getConstructorModemapFromDB| constructor)) (format t "~&~a: ~%" 'constructorcategory) - (pprint (getdatabase constructor 'constructorcategory)) + (pprint (|getConstructorCategoryFromDB| constructor)) (format t "~&~a: ~%" 'operationalist) - (pprint (getdatabase constructor 'operationalist)) + (pprint (|getConstructorOperationsFromDB| constructor)) (format t "~&~a: ~%" 'modemaps) - (pprint (getdatabase constructor 'modemaps)) + (pprint (|getOperationModemapsFromDB| constructor)) (format t "~a: ~a~%" 'hascategory - (getdatabase constructor 'hascategory)) + (|constructorHasCategoryFromDB| constructor)) (format t "~a: ~a~%" 'object - (getdatabase constructor 'object)) + (|getConstructorModuleFromDB| constructor)) (format t "~a: ~a~%" 'niladic - (getdatabase constructor 'niladic)) + (|niladicConstructorFromDB| constructor)) (format t "~a: ~a~%" 'abbreviation - (getdatabase constructor 'abbreviation)) + (|getConstructorAbbreviationFromDB| constructor)) (format t "~a: ~a~%" 'constructor? - (getdatabase constructor 'constructor?)) + (|getConstructorOperationsFromDB| constructor)) (format t "~a: ~a~%" 'constructor - (getdatabase constructor 'constructor)) + (|getConstructorFullNameFromDB| constructor)) (format t "~a: ~a~%" 'defaultdomain - (getdatabase constructor 'defaultdomain)) + (|getConstructorDefaultFromDB| constructor)) (format t "~a: ~a~%" 'ancestors - (getdatabase constructor 'ancestors)) + (|getConstructorAncestorsFromDB| constructor)) (format t "~a: ~a~%" 'sourcefile - (getdatabase constructor 'sourcefile)) + (|getConstructorSourceFileFromDB| constructor)) (format t "~a: ~a~%" 'constructorform - (getdatabase constructor 'constructorform)) + (|getConstructorFormFromDB| constructor)) (format t "~a: ~a~%" 'constructorargs - (getdatabase constructor 'constructorargs)) + (|getConstructorArgsFromDB| constructor)) (format t "~a: ~a~%" 'attributes - (getdatabase constructor 'attributes)) + (|getConstructorAttributesFromDB| constructor)) (format t "~a: ~%" 'predicates) - (pprint (getdatabase constructor 'predicates)) + (pprint (|getConstructorPredicatesFromDB| constructor)) (format t "~a: ~a~%" 'documentation - (getdatabase constructor 'documentation)) + (|getConstructorDocumentationFromDB| constructor)) (format t "~a: ~a~%" 'parents - (getdatabase constructor 'parents))) + (|getConstructorParentsFromDB| constructor))) (defun setdatabase (constructor key value) (let (struct) @@ -785,7 +786,7 @@ (when (setq struct (get constructor 'database)) (setq data (database-constructorcategory struct)) (when (null data) ;domain or package then subfield of constructormodemap - (setq data (cadar (|getConstructorModemap| constructor)))))) + (setq data (cadar (|getConstructorModemapFromDB| constructor)))))) (operationalist (setq stream *interp-stream*) (when (setq struct (get constructor 'database)) @@ -811,8 +812,7 @@ (when (setq struct (get constructor 'database)) (setq data (database-niladic struct)))) (constructor? - (when (setq struct (get constructor 'database)) - (setq data (when (database-operationalist struct) t)))) + (|fatalError| "GETDATABASE called with CONSTRUCTOR?")) (superdomain ; only 2 superdomains in the world (case constructor (|NonNegativeInteger| @@ -836,7 +836,7 @@ (when (setq struct (get constructor 'database)) (setq data (database-constructorform struct)))) (constructorargs - (setq data (cdr (getdatabase constructor 'constructorform)))) + (setq data (cdr (|getConstructorFormFromDB| constructor)))) (attributes (setq stream *browse-stream*) (when (setq struct (get constructor 'database)) @@ -1066,14 +1066,14 @@ (if (< (length alist) 4) ;we have a naked function object (let ((opname key) (modemap (car (LASSOC '|modemaps| alist))) ) - (setq oldmaps (getdatabase opname 'operation)) + (setq oldmaps (|getOperationFromDB| opname)) (setf (gethash opname *operation-hash*) (adjoin (subst asharp-name opname (cdr modemap)) oldmaps :test #'equal)) (asharpMkAutoloadFunction object asharp-name)) (when (if (null only) (not (eq key '%%)) (member key only)) (setq *allOperations* nil) ; force this to recompute - (setq oldmaps (getdatabase key 'modemaps)) + (setq oldmaps (|getOperationModemapsFromDB| key)) (setq dbstruct (make-database)) (setf (get key 'database) dbstruct) (setq *allconstructors* (adjoin key *allconstructors*)) @@ -1150,7 +1150,7 @@ (file-position in pos) (setq constructorform (read in)) (setq key (car constructorform)) - (setq oldmaps (getdatabase key 'modemaps)) + (setq oldmaps (|getOperationModemapsFromDB| key)) (setq dbstruct (make-database)) (setq *allconstructors* (adjoin key *allconstructors*)) (setf (get key 'database) dbstruct) ; store the struct, side-effect it... @@ -1613,7 +1613,7 @@ (defun create-initializers () ;; since libaxiom is now built with -name=axiom following unnecessary ;; (dolist (con (|allConstructors|)) -;; (let ((sourcefile (getdatabase con 'sourcefile))) +;; (let ((sourcefile (|getConstructorSourceFileFromDB| con))) ;; (if sourcefile ;; (set (foam::axiomxl-file-init-name (pathname-name sourcefile)) ;; NOPfuncall)))) @@ -1825,7 +1825,7 @@ (defun init-lib-file-getter (env) (let* ((getter-name (car env)) (cname (cdr env)) - (filename (getdatabase cname 'object))) + (filename (|getConstructorModuleFromDB| cname))) #-:CCL (load filename) #+:CCL @@ -1845,7 +1845,7 @@ (unless (or (not (numberp hcode)) (zerop hcode) (boundp asharpname)) (when (|constructor?| bootname) (setf (symbol-value asharpname) - (if (getdatabase bootname 'niladic) + (if (|niladicConstructorFromDB| bootname) (|makeLazyOldAxiomDispatchDomain| (list bootname)) (cons '|runOldAxiomFunctor| bootname)))) (when (|attribute?| bootname) diff --git a/src/interp/database.boot b/src/interp/database.boot index 2d25edb4..07d67515 100644 --- a/src/interp/database.boot +++ b/src/interp/database.boot @@ -50,7 +50,7 @@ getConstructorAbbreviationFromDB ctor == getConstructorCategoryFromDB: %Symbol -> %Form getConstructorCategoryFromDB ctor == - GETDATABASE(ctor,"CONSTRCTORCATEGORY") + GETDATABASE(ctor,"CONSTRUCTORCATEGORY") getConstructorKindFromDB: %Symbol -> %Maybe %ConstructorKind getConstructorKindFromDB ctor == @@ -60,10 +60,86 @@ getConstructorAncestorsFromDB: %Symbol -> %List getConstructorAncestorsFromDB ctor == GETDATABASE(ctor,"ANCESTORS") -getConstructorSourceFile: %Symbol -> %Maybe %String -getConstructorSourceFile ctor == +++ return the modemap of the constructor or the instantiation +++ of the constructor `form'. +getConstructorModemapFromDB: %Symbol -> %Maybe %Symbol +getConstructorModemapFromDB form == + GETDATABASE(opOf form, 'CONSTRUCTORMODEMAP) + +getConstructorFormFromDB: %Symbol -> %Form +getConstructorFormFromDB ctor == + GETDATABASE(ctor,"CONSTRUCTORFORM") + +getConstructorSourceFileFromDB: %Symbol -> %Maybe %String +getConstructorSourceFileFromDB ctor == GETDATABASE(ctor,"SOURCEFILE") +getConstructorModuleFromDB: %Symbol -> %Maybe %String +getConstructorModuleFromDB ctor == + GETDATABASE(ctor,"OBJECT") + +getConstructorDocumentationFromDB: %Symbol -> %List +getConstructorDocumentationFromDB ctor == + GETDATABASE(ctor,"DOCUMENTATION") + +getConstructorOperationsFromDB: %Symbol -> %List +getConstructorOperationsFromDB ctor == + GETDATABASE(ctor,"OPERATIONALIST") + +getConstructorFullNameFromDB: %Symbol -> %Symbol +getConstructorFullNameFromDB ctor == + GETDATABASE(ctor,"CONSTRUCTOR") + +getConstructorArgsFromDB: %Symbol -> %List +getConstructorArgsFromDB ctor == + GETDATABASE(ctor,"CONSTRUCTORARGS") + +++ returns a list of Boolean values indicating whether the +++ parameter type at the corresponding position is a category. +getDualSignatureFromDB: %Symbol -> %Form +getDualSignatureFromDB ctor == + GETDATABASE(ctor,"COSIG") + +getConstructorPredicatesFromDB: %Symbol -> %Thing +getConstructorPredicatesFromDB ctor == + GETDATABASE(ctor,"PREDICATES") + +getConstructorParentsFromDB: %Symbol -> %List +getConstructorParentsFromDB ctor == + GETDATABASE(ctor,"PARENTS") + +getSuperDomainFromDB: %Symbol -> %Form +getSuperDomainFromDB ctor == + GETDATABASE(ctor,"SUPERDOMAIN") + +getConstructorAttributesFromDB: %Symbol -> %Form +getConstructorAttributesFromDB ctor == + GETDATABASE(ctor,"ATTRIBUTES") + +niladicConstructorFromDB: %Symbol -> %Boolean +niladicConstructorFromDB ctor == + GETDATABASE(ctor,"NILADIC") + +asharpConstructorFromDB: %Symbol -> %Maybe %Symbol +asharpConstructorFromDB ctor == + GETDATABASE(ctor,"ASHARP?") + +constructorHasCategoryFromDB: %Pair -> %Thing +constructorHasCategoryFromDB p == + GETDATABASE(p,"HASCATEGORY") + +getConstructorDefaultFromDB: %Symbol -> %Maybe %Symbol +getConstructorDefaultFromDB ctor == + GETDATABASE(ctor,"DEFAULTDOMAIN") + +getOperationFromDB: %Symbol -> %List +getOperationFromDB op == + GETDATABASE(op,"OPERATION") + +getOperationModemapsFromDB: %Symbol -> %List +getOperationModemapsFromDB op == + GETDATABASE(op,"MODEMAPS") + --% Functions for manipulating MODEMAP DATABASE augLisplibModemapsFromCategory(form is [op,:argl],body,signature) == @@ -470,7 +546,7 @@ getModemapsFromDatabase(op,nargs) == ans getSystemModemaps(op,nargs) == - mml:= GETDATABASE(op,'OPERATION) => + mml:= getOperationFromDB op => mms := NIL for (x := [[.,:sig],.]) in mml repeat (NUMBERP nargs) and (nargs ^= #QCDR sig) => 'iterate diff --git a/src/interp/define.boot b/src/interp/define.boot index d99cc278..a9f37559 100644 --- a/src/interp/define.boot +++ b/src/interp/define.boot @@ -191,7 +191,7 @@ macroExpand(x,e) == --not worked out yet macroExpandList(l,e) == -- macros should override niladic props - (l is [name]) and IDENTP name and GETDATABASE(name, 'NILADIC) and + (l is [name]) and IDENTP name and niladicConstructorFromDB name and (u := get(name, 'macro, e)) => macroExpand(u,e) [macroExpand(x,e) for x in l] @@ -229,7 +229,7 @@ makeCategoryPredicates(form,u) == --+ the following function mkCategoryPackage(form is [op,:argl],cat,def) == packageName:= INTERN(STRCONC(PNAME op,'"&")) - packageAbb := INTERN(STRCONC(GETDATABASE(op,'ABBREVIATION),'"-")) + packageAbb := INTERN(STRCONC(getConstructorAbbreviationFromDB op,'"-")) $options:local := [] -- This stops the next line from becoming confused abbreviationsSpad2Cmd ['domain,packageAbb,packageName] @@ -530,7 +530,7 @@ compDefineFunctor1(df is ['DEF,form,signature,$functorSpecialCases,body], $lisplibFunctionLocations := SUBLIS($pairlis,$functionLocations) $lisplibCategoriesExtended := SUBLIS($pairlis,$lisplibCategoriesExtended) -- see NRTsetVector4 for initial setting of $lisplibCategoriesExtended - libFn := GETDATABASE(op','ABBREVIATION) + libFn := getConstructorAbbreviationFromDB op' $lookupFunction: local := NRTgetLookupFunction($functorForm,CADAR $lisplibModemap,$NRTaddForm) --either lookupComplete (for forgetful guys) or lookupIncomplete diff --git a/src/interp/format.boot b/src/interp/format.boot index 52bfbdd8..f42f7255 100644 --- a/src/interp/format.boot +++ b/src/interp/format.boot @@ -392,11 +392,11 @@ form2String1 u == op := CAR u argl := CDR u op='Join or op= 'mkCategory => formJoin1(op,argl) - $InteractiveMode and (u:= constructor? op) => + $InteractiveMode and IDENTP op and (u:= constructor? op) => null argl => app2StringWrap(formWrapId constructorName op, u1) op = "NTuple" => [ form2String1 first argl, "*"] op = "Map" => ["(",:formatSignature0 [argl.1,argl.0],")"] - op = 'Record => record2String(argl) + op = "Record" => record2String(argl) null (conSig := getConstructorSignature op) => application2String(constructorName op,[form2String1(a) for a in argl], u1) ml := rest conSig @@ -409,7 +409,7 @@ form2String1 u == application2String(constructorName op,argl, u1) op = "Mapping" => ["(",:formatSignature argl,")"] op = "Record" => record2String(argl) - op = 'Union => + op = "Union" => application2String(op,[form2String1 x for x in argl], u1) op = ":" => null argl => [ '":" ] diff --git a/src/interp/g-cndata.boot b/src/interp/g-cndata.boot index d6ad6b1c..373abac0 100644 --- a/src/interp/g-cndata.boot +++ b/src/interp/g-cndata.boot @@ -48,7 +48,7 @@ mkLowerCaseConTable() == $lowerCaseConTb augmentLowerCaseConTable x == - y:=GETDATABASE(x,'ABBREVIATION) + y:=getConstructorAbbreviationFromDB x item:=[x,y,nil] HPUT($lowerCaseConTb,x,item) HPUT($lowerCaseConTb,DOWNCASE x,item) @@ -73,11 +73,11 @@ attribute? name == abbreviation? abb == -- if it is an abbreviation, return the corresponding name - GETDATABASE(abb,'CONSTRUCTOR) + getConstructorFullNameFromDB abb constructor? name == -- if it is a constructor name, return the abbreviation - GETDATABASE(name,'ABBREVIATION) + getConstructorAbbreviationFromDB name domainForm?: %Form -> %Boolean domainForm? d == @@ -95,17 +95,18 @@ categoryForm? c == false getImmediateSuperDomain(d) == - IFCAR GETDATABASE(opOf d, 'SUPERDOMAIN) + IFCAR getSuperDomainFromDB opOf d maximalSuperType d == - d' := GETDATABASE(opOf d, 'SUPERDOMAIN) => maximalSuperType first d' + d' := getSuperDomainFromDB opOf d => maximalSuperType first d' d -- probably will switch over to 'libName soon getLisplibName(c) == getConstructorAbbreviation(c) +getConstructorAbbreviation: %Symbol -> %Symbol getConstructorAbbreviation op == - constructor?(op) or throwKeyedMsg("S2IL0015",[op]) + getConstructorAbbreviationFromDB op or throwKeyedMsg("S2IL0015",[op]) getConstructorUnabbreviation op == abbreviation?(op) or throwKeyedMsg("S2IL0019",[op]) @@ -119,13 +120,13 @@ mkUserConstructorAbbreviation(c,a,type) == setAutoLoadProperty(c) abbQuery(x) == - abb := GETDATABASE(x,'ABBREVIATION) => + abb := getConstructorAbbreviation x => sayKeyedMsg("S2IZ0001",[abb,getConstructorKindFromDB x,x]) sayKeyedMsg("S2IZ0003",[x]) installConstructor(cname,type) == (entry := getCDTEntry(cname,true)) => entry - item := [cname,GETDATABASE(cname,'ABBREVIATION),nil] + item := [cname,getConstructorAbbreviationFromDB cname,nil] if BOUNDP '$lowerCaseConTb and $lowerCaseConTb then HPUT($lowerCaseConTb,cname,item) HPUT($lowerCaseConTb,DOWNCASE cname,item) @@ -141,8 +142,8 @@ constructorAbbreviationErrorCheck(c,a,typ,errmess) == then throwKeyedErrorMsg('precompilation,"S2IL0021",NIL) if siz > 8 then throwKeyedErrorMsg('precompilation,"S2IL0006",NIL) if s ^= UPCASE s then throwKeyedMsg("S2IL0006",NIL) - abb := GETDATABASE(c,'ABBREVIATION) - name:= GETDATABASE(a,'CONSTRUCTOR) + abb := getConstructorAbbreviationFromDB c + name:= getConstructorFullNameFromDB a type := getConstructorKindFromDB c a=abb and c^=name => lisplibError(c,a,typ,abb,name,type,'duplicateAbb) a=name and c^=name => lisplibError(c,a,typ,abb,name,type,'abbIsName) @@ -181,16 +182,17 @@ isNameOfType x == unabbrev1(u,modeIfTrue) == atom u => + not IDENTP u => u -- surely not constructor abbrev modeIfTrue => d:= isDomainValuedVariable u => u a := abbreviation? u => - GETDATABASE(a,'NILADIC) => [a] + niladicConstructorFromDB a => [a] largs := ['_$EmptyMode for arg in getPartialConstructorModemapSig(a)] unabbrev1([u,:largs],modeIfTrue) u a:= abbreviation?(u) or u - GETDATABASE(a,'NILADIC) => [a] + niladicConstructorFromDB a => [a] a [op,:arglist] := u op = 'Join => ['Join, :[unabbrev1(x, modeIfTrue) for x in arglist]] diff --git a/src/interp/g-util.boot b/src/interp/g-util.boot index 3bcb22da..f8e53dc7 100644 --- a/src/interp/g-util.boot +++ b/src/interp/g-util.boot @@ -64,7 +64,7 @@ get(x,prop,e) == get1(x,prop,e) get0(x,prop,e) == - null atom x => get(QCAR x,prop,e) + not atom x => get(QCAR x,prop,e) u:= QLASSQ(x,CAR QCAR e) => QLASSQ(prop,u) (tail:= CDR QCAR e) and (u:= fastSearchCurrentEnv(x,tail)) => QLASSQ(prop,u) @@ -72,15 +72,15 @@ get0(x,prop,e) == get1(x,prop,e) == --this is the old get - null atom x => get(QCAR x,prop,e) + not atom x => get(QCAR x,prop,e) prop="modemap" and $insideCapsuleFunctionIfTrue=true => LASSOC("modemap",getProplist(x,$CapsuleModemapFrame)) or get2(x,prop,e) LASSOC(prop,getProplist(x,e)) or get2(x,prop,e) get2(x,prop,e) == - prop="modemap" and constructor? x => - (u := getConstructorModemap(x)) => [u] + prop="modemap" and IDENTP x and constructor? x => + (u := getConstructorModemapFromDB x) => [u] nil nil diff --git a/src/interp/hashcode.boot b/src/interp/hashcode.boot index ba6fb58f..d52781c0 100644 --- a/src/interp/hashcode.boot +++ b/src/interp/hashcode.boot @@ -74,8 +74,8 @@ hashType(type, percentHash) == hash := hashCombine(hashType(arg, percentHash), hash) hash - cmm := CDDAR getConstructorModemap(op) - cosig := CDR GETDATABASE(op, 'COSIG) + cmm := CDDAR getConstructorModemapFromDB op + cosig := rest getDualSignatureFromDB op for arg in args for c in cosig for ct in cmm repeat if c then hash := hashCombine(hashType(arg, percentHash), hash) diff --git a/src/interp/i-coerce.boot b/src/interp/i-coerce.boot index 2f7c8db3..aab49da6 100644 --- a/src/interp/i-coerce.boot +++ b/src/interp/i-coerce.boot @@ -926,7 +926,7 @@ coerceInt1(triple,t2) == coerceSubDomain(val, tSuper, tSub) == -- Try to coerce from a sub domain to a super domain val = '_$fromCoerceable_$ => nil - super := GETDATABASE(first tSub, 'SUPERDOMAIN) + super := getSuperDomainFromDB first tSub superDomain := first super superDomain = tSuper => coerceImmediateSubDomain(val, tSuper, tSub, CADR super) @@ -1091,20 +1091,20 @@ coerceIntByMapInner(arg,[u1,:u2]) == coerceOrThrowFailure(arg,u1,u2) valueArgsEqual?(t1, t2) == -- returns true if the object-valued arguments to t1 and t2 are the same -- under coercion - coSig := CDR GETDATABASE(CAR t1, 'COSIG) - constrSig := CDR getConstructorSignature CAR t1 + coSig := rest getDualSignatureFromDB first t1 + constrSig := rest getConstructorSignature first t1 tl1 := replaceSharps(constrSig, t1) tl2 := replaceSharps(constrSig, t2) not MEMQ(NIL, coSig) => true done := false value := true - for a1 in CDR t1 for a2 in CDR t2 for cs in coSig + for a1 in rest t1 for a2 in rest t2 for cs in coSig for m1 in tl1 for m2 in tl2 while not done repeat - ^cs => + not cs => trip := objNewWrap(a1, m1) newVal := coerceInt(trip, m2) null newVal => (done := true; value := false) - ^algEqual(a2, objValUnwrap newVal, m2) => + not algEqual(a2, objValUnwrap newVal, m2) => (done := true; value := false) value diff --git a/src/interp/i-eval.boot b/src/interp/i-eval.boot index 6d31ceb8..6fc95c1f 100644 --- a/src/interp/i-eval.boot +++ b/src/interp/i-eval.boot @@ -56,10 +56,10 @@ mkEvalable form == op="Enumeration" => form loadIfNecessary op kind:= getConstructorKindFromDB op - cosig := GETDATABASE(op, 'COSIG) => + cosig := getDualSignatureFromDB op => [op,:[val for x in argl for typeFlag in rest cosig]] where val() == typeFlag => - kind = 'category => MKQ x + kind = "category" => MKQ x VECP x => MKQ x loadIfNecessary x mkEvalable x @@ -170,7 +170,7 @@ evaluateFormAsType form == ++ evaluates the arguments passed to the constructor `op'. ++ Note: only constructor instantiations go here. evaluateType1 (form is [op,:argl]) == - null (sig := getConstructorSignature form) => + null (sig := getConstructorSignature op) => throwEvalTypeMsg("S2IE0005",[form]) [.,:ml] := sig ml := replaceSharps(ml,form) diff --git a/src/interp/i-funsel.boot b/src/interp/i-funsel.boot index 0857b4a4..bce242f8 100644 --- a/src/interp/i-funsel.boot +++ b/src/interp/i-funsel.boot @@ -1248,12 +1248,12 @@ coerceTypeArgs(t1, t2, SL) == -- if needed. t1 isnt [con1, :args1] or t2 isnt [con2, :args2] => t2 con1 ^= con2 => t2 - coSig := CDR GETDATABASE(CAR t1, 'COSIG) + coSig := rest getDualSignatureFromDB first t1 and/coSig => t2 csub1 := constructSubst t1 csub2 := constructSubst t2 - cs1 := CDR getConstructorSignature con1 - cs2 := CDR getConstructorSignature con2 + cs1 := rest getConstructorSignature con1 + cs2 := rest getConstructorSignature con2 [con1, : [makeConstrArg(arg1, arg2, constrArg(c1,csub1,SL), constrArg(c2,csub2,SL), cs) @@ -1601,7 +1601,7 @@ hasAtt(dom,att,SL) == -- needs S0 similar to hasSig above ?? $domPvar: local := nil fun:= CAR dom => - atts:= subCopy(GETDATABASE(fun,'ATTRIBUTES),constructSubst dom) => + atts:= subCopy(getConstructorAttributesFromDB fun,constructSubst dom) => PAIRP (u := getInfovec CAR dom) => --UGH! New world has attributes stored as pairs not as lists!! for [x,:cond] in atts until not (S='failed) repeat @@ -1746,7 +1746,7 @@ defaultTypeForCategory(cat, SL) == -- calls this and should possibly fail in some cases. cat := subCopy(cat, SL) c := CAR cat - d := GETDATABASE(c, 'DEFAULTDOMAIN) + d := getConstructorDefaultFromDB c d => [d, :CDR cat] cat is [c] => c = 'Field => $RationalNumber diff --git a/src/interp/i-resolv.boot b/src/interp/i-resolv.boot index 037b83c7..7ba536ae 100644 --- a/src/interp/i-resolv.boot +++ b/src/interp/i-resolv.boot @@ -340,7 +340,7 @@ resolveTTRed3(t) == (and/[member(x,a) for x in b] and "and"/[member(x,b) for x in a]) and a [( atom x and x ) or ((not cs and x and not interpOp? x and x) or resolveTTRed3 x) or return NIL - for x in t for cs in GETDATABASE(CAR t, 'COSIG) ] + for x in t for cs in getDualSignatureFromDB first t ] interpOp?(op) == PAIRP(op) and @@ -412,7 +412,7 @@ getConditionsForCategoryOnType(t,cat) == getConditionalCategoryOfType(t,conditions,match) == if PAIRP t then t := first t t in '(Union Mapping Record) => NIL - conCat := GETDATABASE(t,'CONSTRUCTORCATEGORY) + conCat := getConstructorCategoryFromDB t REMDUP CDR getConditionalCategoryOfType1(conCat,conditions,match,[NIL]) getConditionalCategoryOfType1(cat,conditions,match,seen) == @@ -429,7 +429,7 @@ getConditionalCategoryOfType1(cat,conditions,match,seen) == cat is [catName,:.] and (getConstructorKindFromDB catName = "category") => cat in CDR seen => conditions RPLACD(seen,[cat,:CDR seen]) - subCat := GETDATABASE(catName,'CONSTRUCTORCATEGORY) + subCat := getConstructorCategoryFromDB catName -- substitute vars of cat into category for v in rest cat for vv in $TriangleVariableList repeat subCat := SUBST(v,vv,subCat) @@ -729,8 +729,8 @@ getUnderModeOf d == deconstructT(t) == -- M is a type, which may contain type variables -- results in a pair (type constructor . mode arguments) - KDR t and constructor? CAR t => - dt := destructT CAR t + KDR t and (op := first t) and IDENTP op and constructor? op => + dt := destructT op args := [ x for d in dt for y in t | ( x := d and y ) ] c := [ x for d in dt for y in t | ( x := not d and y ) ] CONS(c,args) @@ -755,7 +755,7 @@ replaceLast(A,t) == destructT(functor)== -- provides a list of booleans, which indicate whether the arguments -- to the functor are category forms or not - GETDATABASE(opOf functor,'COSIG) + getDualSignatureFromDB opOf functor constructTowerT(t,TL) == -- t is a type, TL a list of constructors and argument lists diff --git a/src/interp/i-syscmd.boot b/src/interp/i-syscmd.boot index 06ce2db5..47f03680 100644 --- a/src/interp/i-syscmd.boot +++ b/src/interp/i-syscmd.boot @@ -2131,8 +2131,8 @@ loadSpad2Cmd args == -- justWondering => -- GETL(lib,'LOADED) => sayKeyedMsg("S2IZ0028",[lib]) -- sayKeyedMsg("S2IZ0029",[lib]) --- null GETDATABASE(lib,'OBJECT) and --- null (lib := GETDATABASE(lib,'CONSTRUCTOR)) => +-- null getConstructorModuleFromDB lib and +-- null (lib := getConstructorFullNameFromDB lib) => -- sayKeyedMsg("S2IL0020", [namestring [lib,$spadLibFT,"*"]]) -- null FUNCALL(loadfun,lib) => -- sayKeyedMsg("S2IZ0029",[lib]) @@ -2339,8 +2339,8 @@ reportOpsFromUnitDirectly unitForm == sayBrightly concat('%b,formatOpType unitForm, '%d,'"is a",'%b,kind,'%d, '"constructor.") if not isRecordOrUnion then - abb := GETDATABASE(top,'ABBREVIATION) - sourceFile := GETDATABASE(top,'SOURCEFILE) + abb := getConstructorAbbreviatiomFronDB top + sourceFile := getConstructorSourceFileFromDB top sayBrightly ['" Abbreviation for",:bright top,'"is",:bright abb] verb := isExposedConstructor top => '"is" @@ -2391,7 +2391,7 @@ reportOpsFromLisplib(op,u) == NIL typ:= getConstructorKindFromDB op nArgs:= #argml - argList:= KDR GETDATABASE(op,'CONSTRUCTORFORM) + argList:= KDR getConstructorFormFromDB op functorForm:= [op,:argList] argml:= EQSUBSTLIST(argList,$FormalMapVariableList,argml) functorFormWithDecl:= [op,:[[":",a,m] for a in argList for m in argml]] @@ -2403,7 +2403,7 @@ reportOpsFromLisplib(op,u) == '"is not" sayBrightly ['" This constructor",:bright verb, '"exposed in this frame."] - sourceFile := GETDATABASE(op,'SOURCEFILE) + sourceFile := getConstructorSourceFileFromDB op sayBrightly ['" Issue",:bright STRCONC('")edit ", namestring sourceFile), '"to see algebra source code for",:bright fn,'%l] @@ -2418,7 +2418,7 @@ reportOpsFromLisplib(op,u) == centerAndHighlight('"Attributes",$LINELENGTH,specialChar 'hbar) sayBrightly '"" attList:= REMDUP MSORT [x for [x,:.] in - GETDATABASE(op,'ATTRIBUTES)] + getConstructorAttributesFromDB op] null attList => sayBrightly concat('%b,form2String functorForm,'%d,"has no attributes.",'%l) say2PerLine [formatAttribute x for x in attList] @@ -2430,7 +2430,7 @@ displayOperationsFromLisplib form == [name,:argl] := form kind := getConstructorKindFromDB name centerAndHighlight('"Operations",$LINELENGTH,specialChar 'hbar) - opList:= GETDATABASE(name,'OPERATIONALIST) + opList:= getConstructorOperationsFromDB name null opList => centerAndHighlight('"No exported operations",$LINELENGTH) opl:=REMDUP MSORT EQSUBSTLIST(argl,$FormalMapVariableList,opList) @@ -2748,7 +2748,7 @@ filterAndFormatConstructors(constrType,label,patterns) == whatConstructors constrType == -- here constrType should be one of 'category, 'domain, 'package - MSORT [CONS(GETDATABASE(con,'ABBREVIATION), STRING(con)) + MSORT [CONS(getConstructorAbbreviatiomFronDB con, STRING(con)) for con in allConstructors() | getConstructorKindFromDB con = constrType] diff --git a/src/interp/interop.boot b/src/interp/interop.boot index a2cc3301..b17ba754 100644 --- a/src/interp/interop.boot +++ b/src/interp/interop.boot @@ -101,7 +101,7 @@ SExprToDName(sexpr, cosigVal) == CAR sexpr = 'Union or CAR sexpr = 'Record => [DNameApplyID, name0, [DNameTupleID,: [ SExprToDName(sx,true) for sx in CDR sexpr]]] - newCosig := CDR GETDATABASE(CAR sexpr, QUOTE COSIG) + newCosig := rest getDualSignatureFromDB first sexpr [DNameApplyID, name0, : MAPCAR(function SExprToDName, CDR sexpr, newCosig)] @@ -184,9 +184,9 @@ oldAxiomCategoryDevaluate([[op,:args],:.], env) == SExprToDName([op,:devaluateList args], true) oldAxiomPreCategoryParents(catform,dom) == - vars := ["$",:rest GETDATABASE(opOf catform, 'CONSTRUCTORFORM)] + vars := ["$",:rest getConstructorFormFromDB opOf catform] vals := [dom,:rest catform] - -- parents := GETDATABASE(opOf catform, 'PARENTS) + -- parents := getConstructorParentsFromDB opOf catform parents := parentsOf opOf catform PROGV(vars, vals, LIST2VEC diff --git a/src/interp/lisplib.boot b/src/interp/lisplib.boot index 39952bf0..562d22ed 100644 --- a/src/interp/lisplib.boot +++ b/src/interp/lisplib.boot @@ -131,8 +131,9 @@ isNestedInstantiation(form,deps) == ++ Return a path to the loadable module that contains the ++ definition of the constructor indicated by `cname'. ++ Error if the file container of the module does not exist. +findModule: %Symbol -> %Maybe %String findModule cname == - m := GETDATABASE(cname,'OBJECT) or return nil + m := getConstructorModuleFromDB cname or return nil existingFile? m => m strap := algebraBootstrapDir() => m := CONCAT(strap,PATHNAME_-NAME m,'".",$faslType) @@ -161,7 +162,7 @@ loadLib cname == clearConstructorCache cname updateDatabase(cname,cname,systemdir?) installConstructor(cname,kind) - u := getConstructorModemap cname + u := getConstructorModemapFromDB cname updateCategoryTable(cname,kind) coSig := u => @@ -170,7 +171,7 @@ loadLib cname == NIL -- in following, add property value false or NIL to possibly clear -- old value - if null CDR GETDATABASE(cname,'CONSTRUCTORFORM) then + if null rest getConstructorFormFromDB cname then MAKEPROP(cname,'NILADIC,'T) else REMPROP(cname,'NILADIC) @@ -226,15 +227,15 @@ convertOpAlist2compilerInfo(opalist) == [[op, typelist], pred, [impl, '$, slot]] updateCategoryFrameForConstructor(constructor) == - opAlist := GETDATABASE(constructor, 'OPERATIONALIST) - [[dc,:sig],[pred,impl]] := getConstructorModemap constructor + opAlist := getConstructorOperationsFromDB constructor + [[dc,:sig],[pred,impl]] := getConstructorModemapFromDB constructor $CategoryFrame := put(constructor,'isFunctor, convertOpAlist2compilerInfo(opAlist), addModemap(constructor, dc, sig, pred, impl, put(constructor, 'mode, ['Mapping,:sig], $CategoryFrame))) updateCategoryFrameForCategory(category) == - [[dc,:sig],[pred,impl]] := getConstructorModemap category + [[dc,:sig],[pred,impl]] := getConstructorModemapFromDB category $CategoryFrame := put(category, 'isCategory, 'T, addModemap(category, dc, sig, pred, impl, $CategoryFrame)) @@ -248,18 +249,18 @@ makeConstructorsAutoLoad() == for cnam in allConstructors() repeat cnam in $CategoryNames => nil REMPROP(cnam,'LOADED) --- fn:=GETDATABASE(cnam,'ABBREVIATION) - if GETDATABASE(cnam,'NILADIC) +-- fn:=getConstructorAbbreviationFromDB cnam + if niladicConstructorFromDB cnam then PUT(cnam,'NILADIC,'T) else REMPROP(cnam,'NILADIC) systemDependentMkAutoload(constructor? cnam,cnam) systemDependentMkAutoload(fn,cnam) == FBOUNDP(cnam) => "next" - asharpName := GETDATABASE(cnam, 'ASHARP?) => + asharpName := asharpConstructorFromDB cnam => kind := getConstructorKindFromDB cnam - cosig := GETDATABASE(cnam, 'COSIG) - file := GETDATABASE(cnam, 'OBJECT) + cosig := getDualSignatureFromDB cnam + file := getConstructorModuleFromDB cnam SET_-LIB_-FILE_-GETTER(file, cnam) kind = 'category => ASHARPMKAUTOLOADCATEGORY(file, cnam, asharpName, cosig) @@ -374,7 +375,7 @@ compDefineLisplib(df:=["DEF",[op,:.],:.],m,e,prefix,fal,fn) == FRESH_-LINE $algebraOutputStream sayMSG fillerSpaces(72,'"-") unloadOneConstructor(op,libName) - LOCALDATABASE(LIST SYMBOL_-NAME GETDATABASE(op,'ABBREVIATION),NIL) + LOCALDATABASE(LIST SYMBOL_-NAME getConstructorAbbreviationFromDB op,NIL) $newConlist := [op, :$newConlist] ----------> bound in function "compiler" if $lisplibKind = 'category then updateCategoryFrameForCategory op @@ -598,7 +599,7 @@ getSlotNumberFromOperationAlist(domainForm,op,sig) == constructorName:= CAR domainForm constructorArglist:= CDR domainForm operationAlist:= - GETDATABASE(constructorName, 'OPERATIONALIST) or + getConstructorOperationsFromDB constructorName or keyedSystemError("S2IL0026",[constructorName]) entryList:= QLASSQ(op,operationAlist) or return nil tail:= or/[r for [sig1,:r] in entryList | sigsMatch(sig,sig1,domainForm)] => @@ -627,16 +628,12 @@ findDomainSlotNumber(domain,op,sig) == --using slot 1 of the domain systemErrorHere '"findDomainSlotNumber" -++ return the modemap of the constructor or the instantiation -++ of the constructor `form'. -getConstructorModemap form == - GETDATABASE(opOf form, 'CONSTRUCTORMODEMAP) - -getConstructorSignature form == - (mm := getConstructorModemap form) => +getConstructorSignature: %Symbol -> %Form +getConstructorSignature ctor == + (mm := getConstructorModemapFromDB ctor) => [[.,:sig],:.] := mm sig - NIL + nil --% from MODEMAP BOOT diff --git a/src/interp/mark.boot b/src/interp/mark.boot index 4f40971d..addbd96a 100644 --- a/src/interp/mark.boot +++ b/src/interp/mark.boot @@ -1248,7 +1248,7 @@ changeToEqualEqual lines == word := INTERN SUBSTRING(x, n + 4, m - n - 4) expandedWord := macroExpand(word,$e) not (MEMQ(word, '(Record Union Mapping)) - or GETDATABASE(opOf expandedWord,'CONSTRUCTORFORM)) => nil + or getConstructorFormFromDB opOf expandedWord) => nil sayMessage '"Converting input line:" sayMessage ['"WAS: ", x] x . (n + 1) := char '_= ; @@ -1339,7 +1339,7 @@ markConstructorForm name == --------> same as getConstructorForm name = 'UntaggedUnion => '(Union A B) name = 'Record => '(Record (_: a A) (_: b B)) name = 'Mapping => '(Mapping T S) - GETDATABASE(name,'CONSTRUCTORFORM) + getConstructorFromDB name --====================================================================== -- new path functions diff --git a/src/interp/modemap.boot b/src/interp/modemap.boot index f80df408..b211d3bc 100644 --- a/src/interp/modemap.boot +++ b/src/interp/modemap.boot @@ -233,7 +233,7 @@ augModemapsFromDomain(name,functorForm,e) == member(KAR name or name,$DummyFunctorNames) => e name=$Category or isCategoryForm(name,e) => e member(name,curDomainsInScope:= getDomainsInScope e) => e - if u:= GETDATABASE(opOf functorForm,'SUPERDOMAIN) then + if u:= getSuperDomainFromDB opOf functorForm then e:= addNewDomain(first u,e) --need code to handle parameterized SuperDomains if innerDom:= listOrVectorElementMode name then e:= addDomain(innerDom,e) @@ -317,7 +317,7 @@ evalAndSub(domainName,viewName,functorForm,form,$e) == [substAlist,$e] getOperationAlist(name,functorForm,form) == - if atom name and GETDATABASE(name,'NILADIC) then functorForm:= [functorForm] + if atom name and niladicConstructorFromDB name then functorForm:= [functorForm] -- (null isConstructorForm functorForm) and (u:= isFunctor functorForm) (u:= isFunctor functorForm) and not ($insideFunctorIfTrue and first functorForm=first $functorForm) => u diff --git a/src/interp/nruncomp.boot b/src/interp/nruncomp.boot index 3203c699..a595c075 100644 --- a/src/interp/nruncomp.boot +++ b/src/interp/nruncomp.boot @@ -116,19 +116,20 @@ NRTencode(x,y) == encode(x,y,true) where encode(x,compForm,firstTime) == not firstTime and (k:= NRTassocIndex x) => k VECP x => systemErrorHere '"NRTencode" PAIRP x => - QCAR x='Record or x is ['Union,['_:,a,b],:.] => - [QCAR x,:[['_:,a,encode(b,c,false)] - for [.,a,b] in QCDR x for [.,=a,c] in CDR compForm]] + op := first x + op = "Record" or x is ['Union,['_:,a,b],:.] => + [op,:[['_:,a,encode(b,c,false)] + for [.,a,b] in rest x for [.,=a,c] in rest compForm]] (x' := isQuasiquote x) => quasiquote encode(x',isQuasiquote compForm,false) - constructor? QCAR x or MEMQ(QCAR x,'(Union Mapping)) => - [QCAR x,:[encode(y,z,false) for y in QCDR x for z in CDR compForm]] - ['NRTEVAL,NRTreplaceAllLocalReferences COPY_-TREE lispize compForm] + IDENTP op and (constructor? op or MEMQ(op,'(Union Mapping))) => + [op,:[encode(y,z,false) for y in rest x for z in rest compForm]] + ["NRTEVAL",NRTreplaceAllLocalReferences COPY_-TREE lispize compForm] MEMQ(x,$formalArgList) => v := $FormalMapVariableList.(POSN1(x,$formalArgList)) firstTime => ["local",v] v - x = '$ => x + x = "$" => x x = "$$" => x ['QUOTE,x] @@ -232,13 +233,13 @@ NRTgetLocalIndex item == NRTgetLocalIndex1(item,false) NRTgetLocalIndex1(item,killBindingIfTrue) == k := NRTassocIndex item => k item = $NRTaddForm => 5 - item = '$ => 0 - item = '_$_$ => 2 + item = "$" => 0 + item = "$$" => 2 value:= - MEMQ(item,$formalArgList) => item + atom item => + MEMQ(item,$formalArgList) => item nil - atom item and null MEMQ(item,'($ _$_$)) - and null value => --give slots to atoms + atom item and null value => --give slots to atoms $NRTdeltaList:= [['domain,NRTaddInner item,:value],:$NRTdeltaList] $NRTdeltaListComp:=[item,:$NRTdeltaListComp] $NRTdeltaLength := $NRTdeltaLength+1 @@ -246,8 +247,7 @@ NRTgetLocalIndex1(item,killBindingIfTrue) == -- when assigning slot to flag values, we don't really want to -- compile them. Rather, we want to record them as if they were atoms. flag := isQuasiquote item - $NRTdeltaList:= [['domain, NRTaddInner item,:value], - :$NRTdeltaList] + $NRTdeltaList:= [['domain, NRTaddInner item,:value], :$NRTdeltaList] saveNRTdeltaListComp:= $NRTdeltaListComp:=[nil,:$NRTdeltaListComp] saveIndex := $NRTbase + $NRTdeltaLength $NRTdeltaLength := $NRTdeltaLength+1 diff --git a/src/interp/nrunfast.boot b/src/interp/nrunfast.boot index e35ab522..2e7f293e 100644 --- a/src/interp/nrunfast.boot +++ b/src/interp/nrunfast.boot @@ -430,8 +430,8 @@ lazyMatch(source,lazyt,dollar,domain) == for [.,stag,s] in sargl for [.,atag,a] in argl] MEMQ(op,'(Union Mapping _[_|_|_] QUOTE)) => and/[lazyMatchArg(s,a,dollar,domain) for s in sargl for a in argl] - coSig := GETDATABASE(op,'COSIG) - NULL coSig => error ["bad Constructor op", op] + coSig := getDualSignatureFromDB op + null coSig => error ["bad Constructor op", op] and/[lazyMatchArg2(s,a,dollar,domain,flag) for s in sargl for a in argl for flag in rest coSig] STRINGP source and lazyt is ['QUOTE,=source] => true @@ -447,7 +447,7 @@ lazyMatch(source,lazyt,dollar,domain) == lazyMatchArgDollarCheck(s,d,dollarName,domainName) == #s ^= #d => nil - scoSig := GETDATABASE(opOf s,'COSIG) or return nil + scoSig := getDualSignatureFromDB opOf s or return nil if MEMQ(opOf s, '(Union Mapping Record)) then scoSig := [true for x in s] and/[fn for x in rest s for arg in rest d for xt in rest scoSig] where @@ -513,8 +513,8 @@ newExpandLocalTypeForm([functorName,:argl],dollar,domain) == MEMQ(functorName, '(Union Mapping _[_|_|_])) => [functorName,:[newExpandLocalTypeArgs(a,dollar,domain,true) for a in argl]] functorName = "QUOTE" => [functorName,:argl] - coSig := GETDATABASE(functorName,'COSIG) - NULL coSig => error ["bad functorName", functorName] + coSig := getDualSignatureFromDB functorName + null coSig => error ["bad functorName", functorName] [functorName,:[newExpandLocalTypeArgs(a,dollar,domain,flag) for a in argl for flag in rest coSig]] @@ -574,7 +574,7 @@ newHasTest(domform,catOrAtt) == domform is [dom,:.] and dom in '(Union Record Mapping Enumeration) => ofCategory(domform, catOrAtt) catOrAtt = '(Type) => true - GETDATABASE(opOf domform, 'ASHARP?) => fn(domform,catOrAtt) where + 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)) @@ -593,7 +593,7 @@ newHasTest(domform,catOrAtt) == -- on second thoughts we won't! getConstructorKindFromDB opOf domform = "category" => domform = catOrAtt => 'T - for [aCat,:cond] in [:ancestorsOf(domform,NIL),:SUBLISLIS (rest domform,$FormalMapVariableList,GETDATABASE(opOf domform,'ATTRIBUTES))] | aCat = catOrAtt repeat + for [aCat,:cond] in [:ancestorsOf(domform,NIL),:SUBLISLIS (rest domform,$FormalMapVariableList,getConstructorAttributesFromDB(opOf domform))] | aCat = catOrAtt repeat return evalCond cond where evalCond x == ATOM x => x diff --git a/src/interp/nrunopt.boot b/src/interp/nrunopt.boot index b15c6722..12a6bb7f 100644 --- a/src/interp/nrunopt.boot +++ b/src/interp/nrunopt.boot @@ -489,7 +489,7 @@ dcOpLatchPrint(op,index) == getInfovec name == u := GETL(name,'infovec) => u GETL(name,'LOADED) => nil - fullLibName := GETDATABASE(name,'OBJECT) or return nil + fullLibName := getConstructorModuleFromDB name or return nil startTimingProcess 'load loadLibNoUpdate(name, name, fullLibName) GETL(name,'infovec) @@ -522,7 +522,7 @@ dcOpTable con == name := abbreviation? con or con $infovec: local := getInfovec name template := $infovec.0 - $predvec: local := GETDATABASE(con,'PREDICATES) + $predvec: local := getConstructorPredicatesFromDB con opTable := $infovec.1 for i in 0..MAXINDEX opTable repeat op := opTable.i @@ -563,7 +563,7 @@ dcSig(numvec,index,numOfArgs) == dcPreds con == name := abbreviation? con or con $infovec: local := getInfovec name - $predvec:= GETDATABASE(con,'PREDICATES) + $predvec:= getConstructorPredicatesFromDB con for i in 0..MAXINDEX $predvec repeat sayBrightlyNT bright (i + 1) sayBrightly pred2English $predvec.i @@ -571,7 +571,7 @@ dcPreds con == dcAtts con == name := abbreviation? con or con $infovec: local := getInfovec name - $predvec:= GETDATABASE(con,'PREDICATES) + $predvec:= getConstructorPredicatesFromDB con attList := $infovec.2 for [a,:predNumber] in attList for i in 0.. repeat sayBrightlyNT bright i @@ -585,7 +585,7 @@ dcCats con == $infovec: local := getInfovec name u := $infovec.3 VECP CDDR u => dcCats1 con --old style slot4 - $predvec:= GETDATABASE(con,'PREDICATES) + $predvec:= getConstructorPredicatesFromDB con catpredvec := CAR u catinfo := CADR u catvec := CADDR u @@ -603,7 +603,7 @@ dcCats con == sayBrightly concat(form2String formatSlotDomain form,suffix,extra) dcCats1 con == - $predvec:= GETDATABASE(con,'PREDICATES) + $predvec:= getConstructorPredicatesFromDB con u := $infovec.3 catvec := CADR u catinfo := CAR u @@ -810,7 +810,7 @@ getExportCategory form == [op,:argl] := form op = 'Record => ['RecordCategory,:argl] op = 'Union => ['UnionCategory,:argl] - functorModemap := getConstructorModemap op + functorModemap := getConstructorModemapFromDB op [[.,target,:tl],:.] := functorModemap EQSUBSTLIST(argl,$FormalMapVariableList,target) diff --git a/src/interp/parse.boot b/src/interp/parse.boot index 91273ced..fe466ac2 100644 --- a/src/interp/parse.boot +++ b/src/interp/parse.boot @@ -165,7 +165,7 @@ parseTypeEvaluate form == cmm := fn := constructor? op => p := pathname [fn,$spadLibFT,'"*"] => - isExistingFile p => getConstructorModemap(abbreviation? fn) + isExistingFile p => getConstructorModemapFromDB abbreviation? fn nil nil cmm is [[.,.,:argml],:.] => [op,:parseTypeEvaluateArgs(argl,argml)] diff --git a/src/interp/postpar.boot b/src/interp/postpar.boot index fc59b59f..33602a10 100644 --- a/src/interp/postpar.boot +++ b/src/interp/postpar.boot @@ -152,7 +152,7 @@ postAtom x == x=0 => '(Zero) x=1 => '(One) EQ(x,'T) => 'T_$ -- rename T in spad code to T$ - IDENTP x and GETDATABASE(x,'NILADIC) => LIST x + IDENTP x and niladicConstructorFromDB x => LIST x x postBlock ["Block",:l,x] == diff --git a/src/interp/pspad1.boot b/src/interp/pspad1.boot index 889d3e73..f97b4396 100644 --- a/src/interp/pspad1.boot +++ b/src/interp/pspad1.boot @@ -587,7 +587,7 @@ formatDEF0(["DEF",form,tlist,sclist,body],$DEFdepth) == form is [":",a,:.] => a form con := opOf $form - $comments: local := SUBST('_$,'_%,GETDATABASE(con,'DOCUMENTATION)) + $comments: local := SUBST('_$,'_%,getConstructorDocumentationFromDB con) $abb :local := constructor? opOf $form if $DEFdepth < 2 then condoc := (u := LASSOC('constructor,$comments)) and KDR KAR u or ['""] diff --git a/src/interp/pspad2.boot b/src/interp/pspad2.boot index 92c84b2a..bd514f50 100644 --- a/src/interp/pspad2.boot +++ b/src/interp/pspad2.boot @@ -209,7 +209,7 @@ formatCategory ['Category] == format " " and format "Category" formatCATEGORY cat == con := opOf $form - $comments: local := SUBST('_$,'_%,GETDATABASE(con,'DOCUMENTATION)) + $comments: local := SUBST('_$,'_%,getConstructorDocumentationFromDB con) $insideEXPORTS : local := true format ["with",formatDeftranCategory cat] @@ -290,7 +290,7 @@ formatColon [":",a,b] == formatColonWith(form,a,b) == con := opOf $form - $comments: local := SUBST('_$,'_%,GETDATABASE(con,'DOCUMENTATION)) + $comments: local := SUBST('_$,'_%,getConstructorDocumentationFromDB con) $insideEXPORTS : local := true $pilesAreOkHere: local := true $insideTypeExpression : local := false diff --git a/src/interp/showimp.boot b/src/interp/showimp.boot index a3ff694e..f6cea219 100644 --- a/src/interp/showimp.boot +++ b/src/interp/showimp.boot @@ -51,7 +51,7 @@ showImp(dom,:options) == missingOnlyFlag := KAR options domainForm := devaluate dom [nam,:$domainArgs] := domainForm - $predicateList: local := GETDATABASE(nam,'PREDICATES) + $predicateList: local := getConstructorPredicatesFromDB nam predVector := dom.3 u := getDomainOpTable(dom,true) --sort into 4 groups: domain exports, unexports, default exports, others @@ -99,7 +99,7 @@ showFrom(D,:option) == alist := nil domainForm := devaluate D [nam,:.] := domainForm - $predicateList: local := GETDATABASE(nam,'PREDICATES) + $predicateList: local := getConstructorPredicatesFromDB nam for (opSig := [op,sig]) in getDomainSigs1(D,ops) repeat u := from?(D,op,sig) x := ASSOC(u,alist) => RPLACD(x,[opSig,:rest x]) @@ -114,13 +114,13 @@ showFrom(D,:option) == getDomainOps D == domname := D.0 conname := CAR domname - $predicateList: local := GETDATABASE(conname,'PREDICATES) + $predicateList: local := getConstructorPredicatesFromDB conname REMDUP listSort(function GLESSEQP,ASSOCLEFT getDomainOpTable(D,nil)) getDomainSigs(D,:option) == domname := D.0 conname := CAR domname - $predicateList: local := GETDATABASE(conname,'PREDICATES) + $predicateList: local := getConstructorPredicatesFromDB conname getDomainSigs1(D,first option) getDomainSigs1(D,ops) == listSort(function GLESSEQP,u) where @@ -129,7 +129,7 @@ getDomainSigs1(D,ops) == listSort(function GLESSEQP,u) where getDomainDocs(D,:option) == domname := D.0 conname := CAR domname - $predicateList: local := GETDATABASE(conname,'PREDICATES) + $predicateList: local := getConstructorPredicatesFromDB conname ops := KAR option [[op,sig,:getInheritanceByDoc(D,op,sig)] for [op,sig] in getDomainSigs1(D,ops)] @@ -180,7 +180,7 @@ getInheritanceByDoc(D,op,sig,:options) == where fn() == getDocDomainForOpSig(op,sig,substDomainArgs(D,x),D) getDocDomainForOpSig(op,sig,dollar,D) == - (u := LASSOC(op,GETDATABASE(CAR dollar,'DOCUMENTATION))) + (u := LASSOC(op,getConstructorDocumentationFromDB CAR dollar)) and (doc := or/[[d,dollar] for [s,:d] in u | compareSig(sig,s,D,dollar)]) --======================================================================= @@ -209,7 +209,7 @@ showPredicates dom == sayBrightly '"--------------------Predicate summary-------------------" conname := CAR dom.0 predvector := dom.3 - predicateList := GETDATABASE(conname,'PREDICATES) + predicateList := getConstructorPredicateFromDB conname for i in 1.. for p in predicateList repeat prefix := testBitVector(predvector,i) => '"true : " diff --git a/src/interp/template.boot b/src/interp/template.boot index 42913388..c0739a63 100644 --- a/src/interp/template.boot +++ b/src/interp/template.boot @@ -37,11 +37,11 @@ import '"c-util" getOperationAlistFromLisplib x == -- used to be in clammed.boot. Moved on 1/24/94 --+ --- newType? x => GETDATABASE(x, 'OPERATIONALIST) +-- newType? x => getConstructorOperationsFromDB x NRTgetOperationAlistFromLisplib x NRTgetOperationAlistFromLisplib x == - u := GETDATABASE(x, 'OPERATIONALIST) + u := getConstructorOperationsFromDB x -- u := removeZeroOneDestructively u null u => u -- this can happen for Object CAAR u = '_$unique => rest u @@ -101,7 +101,7 @@ evalSlotDomain(u,dollar) == y is ['SETELT,:.] => eval y--lazy domains need to marked; this is dangerous? y is [v,:.] => VECP v => lazyDomainSet(y,dollar,u) --old style has [$,code,:lazyt] - constructor? v or MEMQ(v,'(Record Union Mapping)) => + IDENTP v and constructor? v or MEMQ(v,'(Record Union Mapping)) => lazyDomainSet(y,dollar,u) --new style has lazyt y y @@ -203,7 +203,7 @@ mkSigPredVectors() == $predVector:= newShell 100 for nam in allConstructors() | getConstuctorKindFromDB nam ^= "package" repeat - for [op,:sigList] in GETDATABASE(nam,'OPERATIONALIST) repeat + for [op,:sigList] in getConstructorOperationsFromDB nam repeat for [sig,:r] in sigList repeat addConsDB sig r is [.,pred,:.] => putPredHash addConsDB pred @@ -283,7 +283,7 @@ NRTaddInner x == y is [":",.,z] => NRTinnerGetLocalIndex z NRTinnerGetLocalIndex y x is ['SubDomain,y,:.] => NRTinnerGetLocalIndex y - getConstructorSignature x is [.,:ml] => + getConstructorSignature first x is [.,:ml] => for y in rest x for m in ml | not (y = '$) repeat isCategoryForm(m,$CategoryFrame) => NRTinnerGetLocalIndex y keyedSystemError("S2NR0003",[x]) @@ -294,8 +294,9 @@ NRTaddInner x == NRTinnerGetLocalIndex x == atom x => x -- following test should skip Unions, Records, Mapping - MEMQ(opOf x,'(Union Record Mapping _[_|_|_])) => NRTgetLocalIndex x - constructor?(x) => NRTgetLocalIndex x + op := first x + MEMQ(op,'(Union Record Mapping _[_|_|_])) => NRTgetLocalIndex x + constructor? op => NRTgetLocalIndex x NRTaddInner x assignSlotToPred cond == diff --git a/src/interp/topics.boot b/src/interp/topics.boot index 09bbc030..aee5e275 100644 --- a/src/interp/topics.boot +++ b/src/interp/topics.boot @@ -181,7 +181,7 @@ td con == tdAdd(con,hash) == v := HGET($conTopicHash,con) u := addTopic2Documentation(con,v) ---u := GETDATABASE(con,'DOCUMENTATION) +--u := getConstructorDocumentationFromDB con for pair in u | FIXP (code := myLastAtom pair) and (op := CAR pair) ^= 'construct repeat for x in (names := code2Classes code) repeat HPUT(hash,x,insert(op,HGET(hash,x))) @@ -221,7 +221,7 @@ transferClassCodes(conform,opAlist) == transferCodeCon(CAAR x,opAlist) transferCodeCon(con,opAlist) == - for pair in GETDATABASE(con,'DOCUMENTATION) + for pair in getConstructorDocumentationFromDB con | FIXP (code := myLastAtom pair) repeat u := ASSOC(QCAR pair,opAlist) => RPLACD(LASTNODE u,code) @@ -235,7 +235,7 @@ filterByTopic(opAlist,topic) == | FIXP (code := myLastAtom x) and LOGBITP(bitNumber,code)] listOfTopics(conname) == - doc := GETDATABASE(conname,'DOCUMENTATION) + doc := getConstructorDocumentationFromDB conname u := ASSOC('constructor,doc) or return nil code := myLastAtom u --null FIXP code => nil diff --git a/src/interp/types.boot b/src/interp/types.boot index 0a7898a6..2f680568 100644 --- a/src/interp/types.boot +++ b/src/interp/types.boot @@ -41,11 +41,14 @@ import '"boot-pkg" %Integer <=> BIGNUM %Symbol <=> SYMBOL %String <=> STRING +%Atom <=> atom %List <=> LIST %Vector <=> VECTOR %Thing <=> true %Sequence <=> SEQUENCE +%Pair <=> cons + %Maybe a <=> null or a --% Data structures for the compiler |