aboutsummaryrefslogtreecommitdiff
path: root/src/interp
diff options
context:
space:
mode:
Diffstat (limited to 'src/interp')
-rw-r--r--src/interp/Makefile.in2
-rw-r--r--src/interp/c-doc.boot18
-rw-r--r--src/interp/define.boot7
-rw-r--r--src/interp/lisplib.boot46
-rw-r--r--src/interp/sys-globals.boot6
5 files changed, 37 insertions, 42 deletions
diff --git a/src/interp/Makefile.in b/src/interp/Makefile.in
index bac63c43..056fa8d5 100644
--- a/src/interp/Makefile.in
+++ b/src/interp/Makefile.in
@@ -317,7 +317,7 @@ newfort.$(FASLEXT): macros.$(FASLEXT)
lisplib.$(FASLEXT): nlib.$(FASLEXT) c-util.$(FASLEXT) debug.$(FASLEXT) \
daase.$(FASLEXT)
interop.$(FASLEXT): interop.boot c-util.$(FASLEXT) hashcode.$(FASLEXT)
-c-doc.$(FASLEXT): c-util.$(FASLEXT)
+c-doc.$(FASLEXT): c-util.$(FASLEXT) daase.$(FASLEXT)
server.$(FASLEXT): macros.$(FASLEXT)
##
diff --git a/src/interp/c-doc.boot b/src/interp/c-doc.boot
index e3842172..a77aab7c 100644
--- a/src/interp/c-doc.boot
+++ b/src/interp/c-doc.boot
@@ -33,6 +33,7 @@
import c_-util
+import daase
namespace BOOT
batchExecute() ==
@@ -132,7 +133,7 @@ collectAndDeleteAssoc x ==
y.rest := s
res
-finalizeDocumentation() ==
+finalizeDocumentation ctor ==
unusedCommentLineNumbers := [x for (x := [n,:r]) in $COMBLOCKLIST | r]
docList := substitute("$","%",transDocList($op,$docList))
if u := [sig for [sig,:doc] in docList | null doc] then
@@ -141,17 +142,16 @@ finalizeDocumentation() ==
y is [x,b] and b is ['attribute,:r] =>
attributes := [[x,:r],:attributes]
signatures := [y,:signatures]
- name := first $lisplibForm
if noHeading or signatures or attributes or unusedCommentLineNumbers then
sayKeyedMsg("S2CD0001",nil)
bigcnt := 1
if noHeading or signatures or attributes then
- sayKeyedMsg("S2CD0002",[strconc(STRINGIMAGE bigcnt,'"."),name])
+ sayKeyedMsg("S2CD0002",[strconc(STRINGIMAGE bigcnt,'"."),ctor])
bigcnt := bigcnt + 1
litcnt := 1
if noHeading then
sayKeyedMsg("S2CD0003",
- [strconc('"(",STRINGIMAGE litcnt,'")"),name])
+ [strconc('"(",STRINGIMAGE litcnt,'")"),ctor])
litcnt := litcnt + 1
if signatures then
sayKeyedMsg("S2CD0004",
@@ -172,15 +172,15 @@ finalizeDocumentation() ==
a isnt [.,:.] => ['%x9,a]
['%x9,:a]
if unusedCommentLineNumbers then
- sayKeyedMsg("S2CD0006",[strconc(STRINGIMAGE bigcnt,'"."),name])
+ sayKeyedMsg("S2CD0006",[strconc(STRINGIMAGE bigcnt,'"."),ctor])
for [n,r] in unusedCommentLineNumbers repeat
sayMSG ['" ",:bright n,'" ",r]
- hn [[:fn(sig,$e),:doc] for [sig,:doc] in docList] where
- fn(x,e) ==
+ form := dbConstructorForm constructorDB ctor
+ hn [[:fn(sig,$e,form.args),:doc] for [sig,:doc] in docList] where
+ fn(x,e,args) ==
x isnt [.,:.] => [x,nil]
if #x > 2 then x := TAKE(2,x)
- applySubst(pairList($lisplibForm.args,$FormalMapVariableList),
- macroExpand(x,e))
+ applySubst(pairList(args,$FormalMapVariableList),macroExpand(x,e))
hn u ==
-- ((op,sig,doc), ...) --> ((op ((sig doc) ...)) ...)
opList := removeDuplicates ASSOCLEFT u
diff --git a/src/interp/define.boot b/src/interp/define.boot
index aeeff45e..b7b1941a 100644
--- a/src/interp/define.boot
+++ b/src/interp/define.boot
@@ -75,7 +75,6 @@ $functorStats := nil
$lisplibCategory := nil
$lisplibAncestors := nil
-$lisplibAbbreviation := nil
$CheckVectorList := []
$pairlis := []
$functorTarget := nil
@@ -1051,13 +1050,11 @@ compDefineCategory2(form,signature,specialCases,body,m,e,
$domainShell := eval [op',:[MKQ f for f in sargl]]
$lisplibCategory:= formalBody
if $LISPLIB then
- $lisplibForm:= form
modemap:= [[parForm,:parSignature],[true,op']]
$lisplibModemap:= modemap
$lisplibParents :=
getParentsFor($op,$FormalMapVariableList,$lisplibCategory)
$lisplibAncestors := computeAncestorsOf($form,nil)
- $lisplibAbbreviation := getConstructorAbbreviationFromDB $op
form':=[op',:sargl]
augLisplibModemapsFromCategory(form',formalBody,signature')
[fun,$Category,e]
@@ -1077,6 +1074,7 @@ compDefineCategory(df,m,e,prefix,fal) ==
ctor := opOf lhs
kind := getConstructorKindFromDB ctor
kind ~= "category" => throwKeyedMsg("S2IC0016",[ctor,"category",kind])
+ dbConstructorForm(constructorDB ctor) := lhs
$insideFunctorIfTrue or $LISPLIB = nil or $compileDefaultsOnly =>
compDefineCategory1(df,m,e,prefix,fal)
dbNiladic?(constructorDB ctor) := lhs isnt [.,:.] or lhs.args = nil
@@ -1362,6 +1360,7 @@ compDefineFunctor1(df is ['DEF,form,signature,nils,body],
$genSDVar: local:= 0
originale:= $e
[$op,:argl]:= form
+ dbConstructorForm(constructorDB $op) := form
$formalArgList:= [:argl,:$formalArgList]
$pairlis: local := pairList(argl,$FormalMapVariableList)
$mutableDomain: local :=
@@ -1445,10 +1444,8 @@ compDefineFunctor1(df is ['DEF,form,signature,nils,body],
$lisplibParents :=
getParentsFor($op,$FormalMapVariableList,$lisplibCategory)
$lisplibAncestors := computeAncestorsOf($form,nil)
- $lisplibAbbreviation := getConstructorAbbreviationFromDB $op
$insideFunctorIfTrue:= false
if $LISPLIB then
- $lisplibForm:= form
if not $bootStrapMode then
$NRTslot1Info := NRTmakeSlot1Info()
$isOpPackageName: local := isCategoryPackageName $op
diff --git a/src/interp/lisplib.boot b/src/interp/lisplib.boot
index 1616a042..4fbf05db 100644
--- a/src/interp/lisplib.boot
+++ b/src/interp/lisplib.boot
@@ -437,8 +437,6 @@ compConLib1(fun,infileOrNil,outfileOrNil,auxOp,editFlag,traceFlag) ==
$LISPLIB: local := 'T
$lisplibAttributes: local := nil
$lisplibPredicates: local := nil
- $lisplibForm: local := nil
- $lisplibAbbreviation: local := nil
$lisplibParents: local := nil
$lisplibAncestors: local := nil
$lisplibModemap: local := nil
@@ -468,8 +466,6 @@ compDefineLisplib(df:=["DEF",[op,:.],:.],m,e,prefix,fal,fn) ==
$op: local := op
$lisplibAttributes: local := nil
$lisplibPredicates: local := nil -- set by makePredicateBitVector
- $lisplibForm: local := nil
- $lisplibAbbreviation: local := nil
$lisplibParents: local := nil
$lisplibAncestors: local := nil
$lisplibModemap: local := nil
@@ -486,7 +482,7 @@ compDefineLisplib(df:=["DEF",[op,:.],:.],m,e,prefix,fal,fn) ==
--will eventually become the "constructorCategory" property in lisplib
--set in compDefineCategory1 if category, otherwise in finalizeLisplib
libName := getConstructorAbbreviation op
- $compileDocumentation => compileDocumentation libName
+ $compileDocumentation => compileDocumentation(op,libName)
sayMSG ['" initializing ",$spadLibFT,:bright libName,
'"for",:bright op]
initializeLisplib libName
@@ -512,13 +508,11 @@ compDefineLisplib(df:=["DEF",[op,:.],:.],m,e,prefix,fal,fn) ==
$newConlist := [op, :$newConlist] ----------> bound in function "compiler"
res
-compileDocumentation libName ==
+compileDocumentation(ctor,libName) ==
filename := MAKE_-INPUT_-FILENAME(libName,$spadLibFT)
$FCOPY(filename,[libName,'DOCLB])
stream := RDEFIOSTREAM [['FILE,libName,'DOCLB],['MODE, :'O]]
- lisplibWrite('"documentation",finalizeDocumentation(),stream)
--- if $lisplibRelatedDomains then
--- lisplibWrite('"relatedDomains",$lisplibRelatedDomains,stream)
+ lisplibWrite('"documentation",finalizeDocumentation ctor,stream)
RSHUT(stream)
RPACKFILE([libName,'DOCLB])
$REPLACE([libName,$spadLibFT],[libName,'DOCLB])
@@ -550,9 +544,21 @@ writeInfo(ctor,info,key,prop,file) ==
LAM_,FILEACTQ(key,expandToVMForm insn)
lisplibWrite(symbolName key,info,file)
+writeKind(ctor,kind,file) ==
+ writeInfo(ctor,kind,'constructorKind,'dbConstructorKind,file)
+
+writeConstructorForm(ctor,form,file) ==
+ writeInfo(ctor,form,'constructorForm,'dbConstructorForm,file)
+
writeSuperDomain(ctor,domPred,file) ==
writeInfo(ctor,domPred,'superDomain,'dbSuperDomain,file)
+writeOperations(ctor,ops,file) ==
+ writeInfo(ctor,ops,'operationAlist,'dbOperations,file)
+
+writeConstructorModemap(ctor,mm,file) ==
+ writeInfo(ctor,mm,'constructorModemap,'dbConstructorModemap,file)
+
++ If compilation produces an error, issue inform user and
++ return to toplevel reader.
leaveIfErrors(libName,kind) ==
@@ -564,22 +570,20 @@ leaveIfErrors(libName,kind) ==
++ Finalize `libName' compilation; returns true if everything is OK.
finalizeLisplib(ctor,libName) ==
kind := dbConstructorKind constructorDB ctor
- lisplibWrite('"constructorForm",removeZeroOne $lisplibForm,$libFile)
- lisplibWrite('"constructorKind",kind,$libFile)
- lisplibWrite('"constructorModemap",removeZeroOne $lisplibModemap,$libFile)
- $lisplibCategory:= $lisplibCategory or $lisplibModemap.mmTarget
+ form := dbConstructorForm constructorDB ctor
+ writeConstructorForm(ctor,form,$libFile)
+ writeKind(ctor,kind,$libFile)
+ writeConstructorModemap(ctor,removeZeroOne $lisplibModemap,$libFile)
+ $lisplibCategory := $lisplibCategory or $lisplibModemap.mmTarget
-- set to target of modemap for package/domain constructors;
-- to the right-hand sides (the definition) for category constructors
lisplibWrite('"constructorCategory",$lisplibCategory,$libFile)
lisplibWrite('"sourceFile",namestring _/EDITFILE,$libFile)
lisplibWrite('"modemaps",removeZeroOne $lisplibModemapAlist,$libFile)
- opsAndAtts:= getConstructorOpsAndAtts(
- $lisplibForm,kind,$lisplibModemap)
- lisplibWrite('"operationAlist",removeZeroOne first opsAndAtts,$libFile)
- --lisplibWrite('"attributes",rest opsAndAtts,$libFile)
- --if kind='category then NRTgenInitialAttributeAlist rest opsAndAtts
+ opsAndAtts := getConstructorOpsAndAtts(form,kind,$lisplibModemap)
+ writeOperations(ctor,removeZeroOne first opsAndAtts,$libFile)
if kind='category then
- $pairlis : local := pairList($lisplibForm,$FormalMapVariableList)
+ $pairlis : local := pairList(form,$FormalMapVariableList)
$NRTslot1PredicateList : local := []
NRTgenInitialAttributeAlist rest opsAndAtts
writeSuperDomain(ctor,dbSuperDomain constructorDB ctor,$libFile)
@@ -588,10 +592,10 @@ finalizeLisplib(ctor,libName) ==
$lisplibVariableAlist),$libFile)
lisplibWrite('"attributes",removeZeroOne $lisplibAttributes,$libFile)
lisplibWrite('"predicates",removeZeroOne $lisplibPredicates,$libFile)
- lisplibWrite('"abbreviation",$lisplibAbbreviation,$libFile)
+ lisplibWrite('"abbreviation",dbAbbreviation constructorDB ctor,$libFile)
lisplibWrite('"parents",removeZeroOne $lisplibParents,$libFile)
lisplibWrite('"ancestors",removeZeroOne $lisplibAncestors,$libFile)
- lisplibWrite('"documentation",finalizeDocumentation(),$libFile)
+ lisplibWrite('"documentation",finalizeDocumentation ctor,$libFile)
lisplibWrite('"slot1Info",removeZeroOne $lisplibSlot1,$libFile)
if $profileCompiler then profileWrite()
leaveIfErrors(libName,kind)
diff --git a/src/interp/sys-globals.boot b/src/interp/sys-globals.boot
index 3f1c2ce1..e0ea10f5 100644
--- a/src/interp/sys-globals.boot
+++ b/src/interp/sys-globals.boot
@@ -167,12 +167,6 @@ $letAssoc := false
$libFile := nil
++
-$lisplibForm := nil
-
-++
-$lisplibKind := nil
-
-++
$lisplibModemapAlist := []
++
generated by cgit v1.2.3 (git 2.39.1) at 2024-06-29 11:51:59 +0000