(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