(FILECREATED " 2-SEP-77 14:26:28" <KRL1>OLDACCESSCOMP.;3 31482
previous date: " 1-SEP-77 14:20:42" <KRL1>OLDACCESSCOMP.;1)
(PRETTYCOMPRINT OLDACCESSCOMPCOMS)
(RPAQQ OLDACCESSCOMPCOMS [(* Contains both RunTime and Translation Time Functions For the access
Compiler)
(FILEDOC)
(PROP FuncTran KnownIdentity Identity LocalPost)
(PROP PerspTran Seek Match Describe)
(PROP CLISPWORD $)
(F: OLDACCESSCOMPFNS)
(DECLARE: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS
(ADDVARS (NLAMA)
(NLAML])
(* Contains both RunTime and Translation Time Functions For the
access Compiler)
(DECLARE: DONTCOPY (*
Externally available functions:
None
Externally available variables:
None
Masterscope database on file OLDACCESSCOMP.DATABASE
External functions called:
None
External variables used freely:
None
))
(InitDoc OLDACCESSCOMP NIL NIL NIL)
(PUTPROPS KnownIdentity FuncTran (SeekTran (args:1)
3PERSPECTIVE 3PERSPECTIVE))
(PUTPROPS Identity FuncTran (SeekTran (args:1)
3PERSPECTIVE 3PERSPECTIVE))
(PUTPROPS LocalPost FuncTran (SeekTran (args:1)
3PERSPECTIVE 3PERSPECTIVE))
(PUTPROPS Seek PerspTran (SeekTran (GetFillerFrom fillerPairs 'initialDescription)
(GetFillerFrom fillerPairs 'resultDescription)
(GetFillerFrom fillerPairs 'processDescription)
(CompositeDescTran (GetFillerFrom fillerPairs
'compositeDescription))))
(PUTPROPS Match PerspTran (MatchTran (GetFillerFrom fillerPairs 'datum)
(GetFillerFrom fillerPairs 'pattern)
(GetFillerFrom fillerPairs 'resultDescription)
(GetFillerFrom fillerPairs 'processDescription)
(GetFillerFrom fillerPairs 'descriptorTest)))
(PUTPROPS Describe PerspTran (DescribeTran (GetFillerFrom fillerPairs (QUOTE anchorDescription))
(GetFillerFrom fillerPairs (QUOTE newDescription))
(GetFillerFrom fillerPairs (QUOTE processDescription))
(GetFillerFrom fillerPairs (QUOTE triggerFlag))))
(PUTPROPS $ CLISPWORD (KrlTran . $))
(PRETTYCOMPRINT (F: OLDACCESSCOMPFNS))
(RPAQQ OLDACCESSCOMPFNS (Augment CompileDescribe CompileFunctionalMatch CompileFunctionalSeek
CompileImplicitAndMatch CompileImplicitAndSeek CompileLispPointerMatch CompileLispPointerSeek
CompileLispValueMatch CompileLispValueSeek CompileMatch CompileMatchDatum CompileMemberOfMatch
CompileMemberOfSeek CompileSeek CompileSeekInnerComposite CompileSeekOuterComposite CompileSeekResult
CompileSlotPointerMatch CompileSlotPointerSeek CompileSpecificationMatch CompileSpecificationSeek
CompileUniqueSeekResult CompositeDescTran ConfirmPrimary DescribeTran ElementalFor FetchMapAnchor
FuncTran GetFillerFrom GetSeekResultCoerceFn KrlTran ListToSequence ListToSet MapAnchor MapCollection
MatchTran PerspTran PrimaryFor Replace SeekTran Update))
(DEFINEQ
(Augment
[LAMBDA (anchor newDesc triggerFlg) (* ref: "11-MAY-77 13:56" posted: "11-MAY-77 13:58")
(* Run time function for Describe.
Add newDesc to the descriptor in anchor.
Fire WhenFilled triggers if triggerFlg is non-NIL.)
(HELP "Not yet written function" 'Augment])
(CompileDescribe
[LAMBDA (anchorDesc newDesc processDesc triggerFlg)
(* ref: "11-MAY-77 14:37")
(* Compiles Describes.)
<processDesc:perspPrototype
[if (Type? anchorDesc 'ANCHOR)
then <'QUOTE anchorDesc>
else (if (AND (Type? anchorDesc 'PERSPECTIVE)
anchorDesc:perspPrototype='Seek)
then (PerspTran anchorDesc:perspPrototype anchorDesc:fillerPairs)
else (if (Level3P anchorDesc)
then (SeekTran anchorDesc \An Anchor/(if triggerFlg
then \A TriggerAccessWithCoref/
else \An AccessWithCoref/))
else (HELP "Illegal anchor description given to Describe" (KrlType anchorDesc]
newDesc triggerFlg>])
(CompileFunctionalMatch
[LAMBDA NIL (* ref: " 5-MAY-77 12:13" posted: " 5-MAY-77 12:19")
(* Compile a Match with initial description a functional)
(SELECTQ (pattern:functionalName)
(MemberOf (CompileMemberOfMatch))
(CompileMatch datumCode
(create Specification slotSpec ←(
pattern:functionalName:FunctionalDefs:focusSlotName)
perspective ←(create
Perspective perspPrototype ←(
pattern:functionalName:FunctionalDefs:protoName)
fillerPairs ←(<!! pattern:FPairList
! (MakeFuncPairs
(
pattern:functionalName:FunctionalDefs:slotForms)
(pattern:functionalArgs)) >)))
resultDesc triggerAccessFlg corefAccessFlg descriptorTest])
(CompileFunctionalSeek
[LAMBDA NIL (* ref: " 5-MAY-77 12:13")
(* Compile a Seek with initial description a functional)
(SELECTQ (initialDesc:functionalName)
(MemberOf (CompileMemberOfSeek))
(CompileSeek (create Specification slotSpec ←
initialDesc:functionalName:functionalDefs:focusSlotName perspective
←(create Perspective perspPrototype ←
initialDesc:functionalName:functionalDefs:protoName
fillerPairs ←(<!! initialDesc:FPairList
! (MakeFuncPairs
initialDesc:functionalName:functionalDefs:slotForms
(initialDesc:functionalArgs)) >)))
resultDesc compositeDesc triggerAccessFlg corefAccessFlg])
(CompileImplicitAndMatch
[LAMBDA (patterns) (* ref: " 3-MAY-77 12:13")
(* Compile a Match with pattern a conjunction of
descriptors.)
<'PROG '($$MatchResult)
<'AND ! (for pat in patterns collect <'$$MatchResult← '<(CompileMatch datumCode pat resultDesc
triggerAccessFlg
corefAccessFlg
descriptorTest)
'! '$$MatchResult '> >) >
'(RETURN $$MatchResult)>])
(CompileImplicitAndSeek
[LAMBDA (descriptors) (* ref: " 5-MAY-77 10:32")
(* Compile a Seek with initial description an implicitAnd.)
(PROG ((coercer (GetSeekResultCoerceFn))
(resultCode (CompileSeekInnerComposite))
matchCode)
(RETURN (CompileSeekOuterComposite (for desc in descriptors
collect (matchCode←
<'$$SeekResult←(CompileMatch
'$$SeekResult
(create ImplicitAnd andSeq ←(REMOVE
desc descriptors))
\A TrueFalseIndicator/ triggerAccessFlg
corefAccessFlg)>)
(CompileSeek desc \An Anchor/
<'ApplyToAll
<'LAMBDA '($$SeekResult)
<'if (if coercer
then
<'AND matchCode
<'$$SeekResult←
<coercer
'$$SeekResult >>>
else matchCode)
'then ! resultCode>>>
triggerAccessFlg corefAccessFlg])
(CompileLispPointerMatch
[LAMBDA (pointer) (* ref: " 9-MAY-77 17:35")
(* Compile a Match with pattern a lisp pointer.)
<'(Type? $$MatchDatumDescriptor (QUOTE POINTERDESC))
'$$MatchDatumDescriptor:LispPointer= <'QUOTE pointer>>])
(CompileLispPointerSeek
[LAMBDA (pointer) (* ref: "31-MAR-77 16:08" posted: " 2-MAY-77 13:45")
(* Compile a Seek with initialDescription a LispPointer)
(SELECTQ (resultDesc:perspPrototype)
((Anchor PrimaryAnchor)
NIL)
((Post Elemental Primary)
(CompileUniqueSeekResult <'QUOTE pointer>))
(HELP "Unknown resultDescription to Seek" resultDesc])
(CompileLispValueMatch
[LAMBDA (sExpression) (* ref: " 3-MAY-77 11:50")
(* Compiles a Match with pattern a lisp value.)
<'EVAL <'CompileMatch datum sExpression resultDesc triggerAccessFlg corefAccessFlg
descriptorTest>>])
(CompileLispValueSeek
[LAMBDA (sExpression) (* ref: " 9-APR-77 11:01" posted: " 2-MAY-77 13:45")
(* Compile a Seek with initial description a Lisp value
pointer.)
(* This function can perhaps be made smarter later for simple
cases.)
<'EVAL <'CompileSeek sExpression resultDesc processDesc compositeDesc>>])
(CompileMatch
[LAMBDA (datumCode pattern resultDesc triggerAccessFlg corefAccessFlg descriptorTest)
(* ref: " 5-MAY-77 11:14")
(* Compiles Matches)
(SELECTQ (KrlType pattern)
(FUNCTIONAL (CompileFunctionalMatch))
(LISPVALUE (CompileLispValueMatch (pattern:dBody)))
(IMPAND (CompileImplicitAndMatch (pattern:andSeq)))
(PROGN descriptorTest←(if descriptorTest
then <'APPLY* descriptorTest '$$MatchDatumDescriptor >
else '$$MatchDatumDescriptor)
<'MapAnchor datumCode
<'FUNCTION <'LAMBDA '($$MatchDatumDescriptor)
<'AND
! (SELECTQ (KrlType pattern)
(SPECIFICATION
(CompileSpecificationMatch
(pattern:slotSpec)
(pattern:perspective:perspPrototype)
(pattern:perspective:fillerPairs)
(pattern:focus)))
(PERSPECTIVE (CompileSpecificationMatch
'self
(pattern:perspPrototype)
(pattern:fillerPairs)))
(SLOTPOINTER (CompileSlotPointerMatch
(pattern:SPUnit)
(pattern:SPSlotSpec)))
(UNITPOINTER (CompileSlotPointerMatch (pattern:dBody)
'self))
(LISPPOINTER (CompileLispPointerMatch (pattern:dBody))
)
(HELP
"Match compiler not written for this pattern type"
(KrlType pattern))) descriptorTest>>>
triggerAccessFlg corefAccessFlg>])
(CompileMatchDatum
[LAMBDA (datum) (* ref: " 9-MAY-77 17:40")
(* Compile coercion code for a Match's datum.)
(if (Level2P datum)
then <'QUOTE (if (Type? datum 'ANCHOR)
then datum
else (create Anchor descriptors ← datum))>
else (SELECTQ (KrlType datum)
(LISPVALUE <'EVAL <'CompileMatchDatum datum:dBody>>)
(SLOTPOINTER <'AnchorFor <'QUOTE datum:SPUnit> <'QUOTE datum:SPSlotSpec>>)
(UNITPOINTER <'AnchorFor <'QUOTE datum:dBody> '(QUOTE self)>)
(HELP "Match compiler not written for this datum type" (KrlType datum])
(CompileMemberOfMatch
[LAMBDA NIL (* ref: " 5-MAY-77 12:18" posted: " 5-MAY-77 12:20")
(* Compile a Match with pattern a MemberOf functional.)
(CompileSeek pattern \An Anchor/ <'ApplyToAll <'LAMBDA '($$SeekResult)>>])
(CompileMemberOfSeek
[LAMBDA NIL (* ref: " 2-MAY-77 14:23")
(* Compile a Seek with initial description a MemberOf
functional)
(PROG ((coercer (GetSeekResultCoerceFn))
(resultCode (CompileSeekInnerComposite)))
(RETURN (CompileSeekOuterComposite
<(CompileSeek (initialDesc:functionalArgs:1)
\A PrimaryAnchor/
<'ApplyToAll
<'LAMBDA '($$SeekAnchor)
<'MapAnchor '$$SeekAnchor
<'FUNCTION
<'LAMBDA '($$SeekDescriptor)
<'MapCollection '$$SeekDescriptor
<'FUNCTION
<'LAMBDA '($$SeekResult)
! (if coercer
then (<<'if '$$SeekResult←
<coercer '$$SeekResult > ' then
! resultCode>>)
else resultCode)>>>>>>>>
triggerAccessFlg corefAccessFlg)>])
(CompileSeek
[LAMBDA (initialDesc resultDesc compositeDesc triggerAccessFlg corefAccessFlg)
(* ref: " 9-MAY-77 17:41")
(* Compiles Seeks)
(SELECTQ (KrlType initialDesc)
(IMPLICITAND (CompileImplicitAndSeek initialDesc:andSeek))
(FUNCTIONAL (CompileFunctionalSeek))
(LISPPOINTER (CompileLispPointerSeek (initialDesc:dBody)))
(SLOTPOINTER (CompileSlotPointerSeek (initialDesc:SPUnit)
(initialDesc:SPSlotSpec)))
(UNITPOINTER (CompileSlotPointerSeek (initialDesc:dBody)
'self))
(LISPVALUE (CompileLispValueSeek (initialDesc:dBody)))
(SPECIFICATION (CompileSpecificationSeek (initialDesc:slotSpec)
(initialDesc:perspective:perspPrototype)
(initialDesc:perspective:fillerPairs)
(initialDesc:focus)))
(PERSPECTIVE (CompileSpecificationSeek 'self (initialDesc:perspPrototype)
(initialDesc:fillerPairs)))
(HELP "Seek compiler not written for this initial description type"
(KrlType initialDesc])
(CompileSeekInnerComposite
[LAMBDA NIL (* ref: " 4-MAY-77 17:02")
(* A compile time function for Seek. Returns a list containing code for producing the results of a Seek as specified
by trhe composite description.)
(SELECTQ (compositeDesc:1)
(NIL '($$SeekResult))
(ApplyToAll <<'APPLY* <'FUNCTION compositeDesc:2> '$$SeekResult >>)
(ResumeToAll '((RESUME $$SeekFromPtr $$SeekToPtr $$SeekResult)))
(Generator '((PRODUCE $$SeekResult)
NIL))
('(($$SeekVal←<$$SeekResult ! $$SeekVal>)
NIL])
(CompileSeekOuterComposite
[LAMBDA (seekCode) (* ref: "14-APR-77 16:26" posted: " 2-MAY-77 13:46")
(* Adds on code as required by the requested composite to Seek. seekCode is the compiled code that does the seek.
If the composite is (List) (Set) or (Sequence), the seek code is assumed to create a list of results as the value of
$$SeekVal. If the composite is (ResumeToAll) the seek code is assumed to do RESUMEs with each result using
$$SeekFromPtr and $$SeekToPtr.)
(SELECTQ (compositeDesc:1)
((ApplyToAll NIL)
(if (seekCode:2)
then <'OR ! seekCode>
else (seekCode:1)))
(Generator (if (seekCode:2)
then <'PROGN ! seekCode>
else (seekCode:1)))
(Sequence <'PROG '($$SeekVal) ! <!!
seekCode '(RETURN (ListToSequence $$SeekVal))>>)
(Set <'PROG '($$SeekVal) ! <!!
seekCode '(RETURN (ListToSet $$SeekVal))>>)
(List <'PROG '($$SeekVal) ! <!!
seekCode '(RETURN $$SeekVal)>>)
(ResumeToAll <'PROG '($$SeekFromPtr $$SeekToPtr)
<'COROUTINE '$$SeekFromPtr '$$SeekToPtr compositeDesc:2>
<'RETURN (if (seekCode:2)
then <'OR ! seekCode>
else (seekCode:1))>>)
(HELP "Unknown composite descriptor for Seek" compositeDesc])
(CompileSeekResult
[LAMBDA (anchorCode) (* ref: " 9-MAY-77 18:06" posted: " 9-MAY-77 18:06")
(* Compile code for extracting a result that matches the
Seek's resultDescription. anchorCode is compiled code that
finds an anchor matching the Seek's initialDescription.)
(PROG ((coercer (GetSeekResultCoerceFn)))
(RETURN (if coercer
then <coercer anchorCode>
else anchorCode])
(CompileSlotPointerMatch
[LAMBDA (unitName slotName) (* ref: " 9-MAY-77 17:43")
(* Compile a Match with pattern a slot or unit pointer.)
<'(Type? $$MatchDatumDescriptor (QUOTE COREFDESC))
'$$MatchDatumDescriptor:corefAnchor:label:anchorUnit= <'QUOTE unitName>
'$$MatchDatumDescriptor:corefAnchor:label:anchorSlot= <'QUOTE slotName>>])
(CompileSlotPointerSeek
[LAMBDA (unitName slotName) (* ref: " 9-MAY-77 18:00")
(* Compile a Seek with initialDescription a SlotPointer or
UnitPointer.)
(PROG ((seekCode (CompileSeekResult <'AnchorFor <'QUOTE unitName> <'QUOTE slotName>>)))
(RETURN (SELECTQ (compositeDesc:1)
(NIL seekCode)
(ResumeToAll
<'PROG <'$$SeekFromPtr '$$SeekToPtr <'$$SeekResult seekCode>>
<'RETURN <'if '$$SeekResult 'then
<'COROUTINE '$$SeekFromPtr '$$SeekToPtr
compositeDesc:2>
'(RESUME $$SeekFromPtr $$SeekToPtr $$SeekResult)>>>)
(<'PROG <<'$$SeekResult seekCode>>
<'RETURN
<'if '$$SeekResult 'then
(SELECTQ (compositeDesc : 1)
(List '(<$$SeekResult>))
(Set '(ListToSet <$$SeekResult>))
(Sequence '(ListToSequence <$$SeekResult>))
(Generator '(Produce $$SeekResult))
(ApplyToAll
<'APPLY* <'FUNCTION compositeDesc:2> '$$SeekResult
>)
(HELP "Unknown composite description to Seek"
compositeDesc))>>>])
(CompileSpecificationMatch
[LAMBDA (focusSlotName prototype fillerPairs selfSlotFiller)
(* ref: " 9-MAY-77 17:45")
(* Compile a Match with pattern a specification or a
perspective.)
(if selfSlotFiller
then fillerPairs← <(create FILLERPAIR pairName ←('self)
pairFiller ← selfSlotFiller)
! fillerPairs>)
<'(Type? $$MatchDatumDescriptor (QUOTE MAPDESC))
<'EQ <'QUOTE prototype> '$$MatchDatumDescriptor:prototype >
<'EQ <'QUOTE focusSlotName> '$$MatchDatumDescriptor:focusSlot >
! (for pair in fillerPairs collect (CompileMatch <'FetchMapAnchor '$$MatchDatumDescriptor
<'QUOTE (pair:pairName)>>
(pair:pairFiller)
resultDesc triggerAccessFlg corefAccessFlg))
>])
(CompileSpecificationSeek
[LAMBDA (focusSlotName prototype fillerPairs selfSlotFiller)
(* ref: " 3-MAY-77 14:46")
(* Compiles a Seek with initial description a specification.)
(PROG ((coercer (GetSeekResultCoerceFn))
(focusSlotFetch (<'FetchMapAnchor '$$MatchDescriptor <'QUOTE focusSlotName>>)))
(focusSlotFetch← <'LAMBDA '($$MatchDescriptor)
(if coercer
then <coercer focusSlotFetch>
else focusSlotFetch)>)
(if selfSlotFiller
then fillerPairs← <(create FILLERPAIR pairName ←('self)
pairFiller ← selfSlotFiller)
! fillerPairs>)
(RETURN (CompileSeekOuterComposite (for pair in fillerPairs
collect
(CompileSeek (pair:pairFiller)
\An Anchor/
<'ApplyToAll
<'LAMBDA
'($$SeekResult)
<'$$SeekResult←(CompileMatch
'$$SeekResult
(create Specification slotSpec
←(pair:pairName)
perspective ←(create
Perspective
perspPrototype ←
prototype fillerPairs
←(REMOVE pair
fillerPairs)))
\A TrueFalseIndicator/
triggerAccessFlg corefAccessFlg
focusSlotFetch)>
! (CompileSeekInnerComposite) >>
triggerAccessFlg corefAccessFlg])
(CompileUniqueSeekResult
[LAMBDA (seekCode) (* ref: " 2-MAY-77 16:50")
(* Given the compilation of a Seek that returns a unique
value, add on the code to produce the requested composite)
(SELECTQ (compositeDesc:1)
(NIL seekCode)
(List <'< seekCode '> >)
(Set <'ListToSet <'< seekCode '> >>)
(Sequence <'ListToSequence <'< seekCode '> >>)
(Generator <'PRODUCE seekCode>)
(ApplyToAll <'APPLY* <'FUNCTION compositeDesc:2> seekCode>)
(ResumeToAll <'PROG '($$SeekFromPtr $$SeekToPtr)
<'COROUTINE '$$SeekFromPtr '$$SeekToPtr compositeDesc:2>
<'RETURN <'RESUME '$$SeekFromPtr '$$SeekToPtr seekCode>>>)
(HELP "Unknown composite description to Seek" compositeDesc])
(CompositeDescTran
[LAMBDA (compositeDesc) (* ref: " 8-APR-77 13:50" posted: " 2-MAY-77 13:46")
(* Translate a Seek composite description into NIL or a list. If the description was a perspective, the list has a
single element, namely the perspective's prototype. If the description is a functional, then the list has the form
(functionalName functionalArg).)
(if compositeDesc
then (SELECTQ (KrlType compositeDesc)
(PERSPECTIVE <compositeDesc:perspPrototype>)
(FUNCTIONAL <compositeDesc:functionalName compositeDesc:functionalArgs:1:dBody>)
(HELP "Unknown composite description to Seek" compositeDesc])
(ConfirmPrimary
[LAMBDA (anchor) (* ref: " 2-MAY-77 14:19")
(* Confirm that anchor is primary. anchor is assumed to be primary unless it is described as nonprimary.
Return anchor if it is primary, NIL otherwise.)
(HELP "undefined function" 'ConfirmPrimary])
(DescribeTran
[LAMBDA (anchorDesc newDesc processDesc triggerFlg)
(* ref: "11-MAY-77 12:49" posted: "11-MAY-77 13:57")
(* Translates Matches)
(CompileDescribe anchorDesc newDesc processDesc triggerFlg='Fire])
(ElementalFor
[LAMBDA (anchor) (* ref: " 2-MAY-77 14:19")
(* Look for an elemental in anchor and return it if found.
Return NIL otherwise)
(HELP "unwritten function" 'ElementalFor])
(FetchMapAnchor
[LAMBDA (mapDescriptor pairName) (* ref: " 2-MAY-77 11:41" posted: " 2-MAY-77 14:04")
(* Fetch the anchor from mapDescriptor's filler pair with
name pairName.)
(HELP "Not yet written function" 'FetchMapAnchor])
(FuncTran
[LAMBDA (name args pairs) (* ref: " 2-MAY-77 14:20")
(* Translates Functionals for the interpreter)
(SELECTQ name
(KnownIdentity (SeekTran (args:1)
\A Primary/ \An AccessOnly/))
(Identity (SeekTran (args:1)
\A Primary/ \A TriggerAccess/))
(LocalPost (SeekTran (args:1)
\A Post/ \An AccessOnly/))
(HELP "$ functional conversion not done yet" <name args pairs>])
(GetFillerFrom
[LAMBDA (pairs name) (* ref: " 8-APR-77 15:22" posted: " 2-MAY-77 13:47")
(* Fetch the filler from the filler pair with the given name
from the given list of filler pairs.)
(for pair in pairs when name=pair:pairName do (RETURN (pair:pairFiller])
(GetSeekResultCoerceFn
[LAMBDA NIL (* ref: " 9-MAY-77 17:54" posted: " 9-MAY-77 17:54")
(* Get the name of the function that will coerce an anchor produced by Seek to comply with the Seek's result
description. Return NIL if no coercion is needed.)
(SELECTQ (resultDesc:perspPrototype)
((Post Anchor)
NIL)
((Primary PrimaryAnchor)
'PrimaryFor)
(Elemental 'ElementalFor)
(HELP "Unknown result description to Seek" (resultDesc:perspPrototype])
(KrlTran
[LAMBDA (form) (* dgb: "23-FEB-77 14:56:55" posted: " 2-MAY-77 13:47")
(* This function is the entry point for all access compiling)
(CLISPTRAN form (PROG ((KrlForm (form:2)))
(RETURN (SELECTQ (KrlForm:dT)
(PERSPECTIVE (PerspTran (KrlForm:perspPrototype)
(KrlForm:fillerPairs)))
(FUNCTIONAL (FuncTran (KrlForm:functionalName)
(KrlForm:functionalArgs)
(KrlForm:FPairList)))
(HELP "No Translation" KrlForm])
(ListToSequence
[LAMBDA (list) (* ref: " 8-APR-77 16:17" posted: " 2-MAY-77 13:48")
(* Given a list of level 2 objects, create a sequence
collection descriptor with those objects as the elements of
the sequence.)
(HELP "Not yet written function" 'ListToSequence])
(ListToSet
[LAMBDA (list) (* ref: " 8-APR-77 16:19" posted: " 2-MAY-77 13:48")
(* Given a list of level 2 objects, create a set collection
descriptor with those objects as the elements of the set.)
(HELP "Not yet written function" 'ListToSet])
(MapAnchor
[LAMBDA (anchor mapFn triggerAccessFlg corefAccessFlg)
(* ref: " 2-MAY-77 15:08")
(* Apply mapFn to each descriptor in anchor until mapFn returns a non-NIL value. Return the last value produced by
mapFn. If TriggerAccessFlg is non-NIL, use any procedures attached to the anchor to produce new descriptors.
If corefAccessFlg is non-NIL, also apply mapFn to the descriptors found in any anchor that is coreferenced in
anchor.)
(HELP "Not yet written function" 'MapAnchor])
(MapCollection
[LAMBDA (descriptor mapFn) (* ref: " 8-APR-77 16:12" posted: " 2-MAY-77 13:48")
(* If the descriptor is a collection descriptor then apply mapFn to each member anchor in descriptor until a non-NIL
value is returned. Return the last value returned by mapFn. Return NIL if descriptor is not a collection
descriptor.)
(HELP "Not yet written function" 'MapCollection])
(MatchTran
[LAMBDA (datum pattern resultDesc processDesc descriptorTest)
(* ref: " 3-MAY-77 11:19")
(* Translates Matches.)
datum←(CompileMatchDatum datum)
(SELECTQ (processDesc:perspPrototype)
(AccessOnly (CompileMatch datum pattern resultDesc NIL NIL descriptorTest))
(AccessWithCorefs (CompileMatch datum pattern resultDesc NIL T descriptorTest))
(TriggerAccess (CompileMatch datum pattern resultDesc T NIL descriptorTest))
(TriggerAccessWithCorefs (CompileMatch datum pattern resultDesc T T descriptorTest))
(<'OR (CompileMatch datum pattern resultDesc T T descriptorTest)
<'InterpretMatch datum pattern resultDesc processDesc>>])
(PerspTran
[LAMBDA (proto fillerPairs) (* ref: "11-MAY-77 11:24")
(* Each prototype is assumed to have its translator stored on its property list as an sExpression as the value of
property PerspTran %. These sExpressions can access the args to PerspTran.)
(* Translates Perspectives for the interporeter)
(PROG ((translator (GETPROP proto 'PerspTran)))
(RETURN (if translator
then (EVAL translator)
else (HELP "Translator not yet written" proto])
(PrimaryFor
[LAMBDA (anchor) (* ref: " 3-MAY-77 11:12")
(* Given an anchor, find a primary anchor or elemental. First check to see if anchor is described as primary.
If not, look at the descriptions in anchor for an elemental or a coreference. Return NIL if no primary is found)
(HELP "function not yet written" 'PrimaryFor])
(Replace
[LAMBDA (anchor newDesc triggerFlg) (* ref: "11-MAY-77 13:54" posted: "11-MAY-77 13:58")
(* Run time function for Describe.
Make newDesc the descriptor in anchor.
Fire WhenFilled triggers if triggerFlg is nonNIL.)
(HELP "Not yet written function" 'Replace])
(SeekTran
[LAMBDA (initialDesc resultDesc processDesc compositeDesc)
(* ref: " 2-MAY-77 15:14")
(* Translates Seeks)
(SELECTQ (processDesc:perspPrototype)
(AccessOnly (CompileSeek initialDesc resultDesc compositeDesc))
(TriggerAccess (CompileSeek initialDesc resultDesc compositeDesc T))
(AccessWithCoref (CompileSeek initialDesc resultDesc compositeDesc NIL T))
(TriggerAccessWithCoref (CompileSeek initialDesc resultDesc compositeDesc T T))
(<'OR (CompileSeek initialDesc resultDesc compositeDesc T T)
<'InterpretSeek initialDesc resultDesc processDesc compositeDesc>>])
(Update
[LAMBDA (anchor newDesc triggerFlg) (* ref: "11-MAY-77 13:57" posted: "11-MAY-77 13:58")
(* Run time function for Describe.
Replace any coreference or pointer descriptors in anchor by
newDesc. Fire WhenFilled triggers if triggerFlg is non-NIL.)
(HELP "Not yet written function" 'Update])
)
(DECLARE: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS
(ADDTOVAR NLAMA )
(ADDTOVAR NLAML )
)
(DECLARE: DONTCOPY
(FILEMAP (NIL (3012 31342 (Augment 3024 . 3422) (CompileDescribe 3426 . 4291) (CompileFunctionalMatch
4295 . 5157) (CompileFunctionalSeek 5161 . 6000) (CompileImplicitAndMatch 6004 . 6560) (
CompileImplicitAndSeek 6564 . 7683) (CompileLispPointerMatch 7687 . 8031) (CompileLispPointerSeek 8035 .
8531) (CompileLispValueMatch 8535 . 8871) (CompileLispValueSeek 8875 . 9385) (CompileMatch 9389 .
11002) (CompileMatchDatum 11006 . 11712) (CompileMemberOfMatch 11716 . 12054) (CompileMemberOfSeek
12058 . 13013) (CompileSeek 13017 . 14204) (CompileSeekInnerComposite 14208 . 14823) (
CompileSeekOuterComposite 14827 . 16211) (CompileSeekResult 16215 . 16775) (CompileSlotPointerMatch
16779 . 17225) (CompileSlotPointerSeek 17229 . 18431) (CompileSpecificationMatch 18435 . 19359) (
CompileSpecificationSeek 19363 . 20927) (CompileUniqueSeekResult 20931 . 21788) (CompositeDescTran
21792 . 22515) (ConfirmPrimary 22519 . 22857) (DescribeTran 22861 . 23205) (ElementalFor 23209 . 23520)
(FetchMapAnchor 23524 . 23865) (FuncTran 23869 . 24406) (GetFillerFrom 24410 . 24813) (
GetSeekResultCoerceFn 24817 . 25390) (KrlTran 25394 . 26002) (ListToSequence 26006 . 26421) (ListToSet
26425 . 26801) (MapAnchor 26805 . 27405) (MapCollection 27409 . 27868) (MatchTran 27872 . 28711) (
PerspTran 28715 . 29329) (PrimaryFor 29333 . 29739) (Replace 29743 . 30138) (SeekTran 30142 . 30910) (
Update 30914 . 31339)))))
STOP