-- -------------------------------------------------- Smalltalking by choice. Isn't it nice to have one! 'From Squeak2.8 of 13 June 2000 [latest update: #2348] on 2 August 2000 at 7:59:16 pm'! LCompiler subclass: #LindaCompiler instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Linda-Compiler'! Prolog subclass: #LindaEnvironment instanceVariableNames: 'eventTupleSpace ' classVariableNames: '' poolDictionaries: '' category: 'Linda-Compiler'! !LindaEnvironment commentStamp: 'rww 8/2/2000 07:00' prior: 0! This class and other related classes in this category were originally written by Mike Teng miket@objectshare.com, then at Digitalk, as part of the Prolog/V implementation distributed with Smalltalk V/286 in 1988. We gratefully acknowledge Mike's permission to port his code to Squeak. The port to Squeak is the work of Bolot Kerimbaev bolot@cc.gatech.edu, a summer intern at Walt Disney Imagineering. Success and Failure fail() Fail always. true() Succeed once always, i.e. fail during backtracking. Classifying Terms atom(aTerm) Succeed if aTerm is a Symbol. atomic(aTerm) Succeed if aTerm is a Symbol or is a kind of Integer. integer(aTerm) Succeed if aTerm is an Integer. nonvar(aTerm) Succeed if aTerm is not an unbound variable. var(aTerm) Succeed if aTerm is an unbound variable. Communicating with Smalltalk consult(aStructure, aSmalltalkExpression) Use the result of evaluating aSmalltalkExpression as the receiver and ask it to solve aStructure as a goal. Nonstandard. is(aTerm, aSmalltalkExpression) Evaluate aSmalltalkExpression and then unify its result with aTerm. This Smalltalk expression can be used to do graphics, windows, pattern matching, animation, dictionary lookup, file I/O, etc. Nonstandard. runtime(aTerm) Unify aTerm with the system time in milliseconds. Nonstandard. Creating and Accessing Structures arg(n, aStructure, x) Bind x to the n'th argument of aStructure. functor(aStructure, head, arguments) If aStructure is bound, unify its functor with head, and its number of components with arguments. If aStructure is unbound, unify it to a structure with head as its functor and arguments number of don't care variables as its components. univ(aStructure, aList) Convert aStructure to a list if aStructure is bound. Convert aList to a structure otherwise. This is equivalent to the standard Prolog '=..' operator. Affecting Backtracking !!!! The cut predicate succeeds always; exit the containing method during backtracking. exit() The exit predicate succeeds always; exit the entire Prolog query. Nonstandard. Creating Complex Goals structure1 , structure2 The comma predicate succeeds when structure1 and structure2 both succeed. and(structure1, structure2, ...) Succeed when all structure arguments succeed. Nonstandard. call(aStructure) Execute aStructure as a goal. not(aStructure) Succeed if the evaluation of aStructure as a goal fails and fail otherwise. or(structure1, structure2) Succeed if the evaluation of either structure1 or structure2 succeeds, fail when both succeed. This is equivalent to the standard Prolog ';' operator. repeat() Succeed always, even during backtracking. Comparing Terms eq(term1, term2) Succeed if the two terms can be unified. This is equivalent to the standard Prolog '=' operator. equiv(term1, term2) Succeed if the two terms are the same object. This is equivalent to the standard Prolog '==' operator. ne(term1, term2) Succeed if term1 is not equal to term2. This is equivalent to the standard Prolog '=' operator. notequiv(term1, term2) Succeed if the two terms are not the same object. This is equivalent to the standard Prolog '==' operator. ge(term1, term2) Succeed if term1 is greater than or equal to term2. This is equivalent to the standard Prolog '>=' operator. gt(term1, term2) Succeed if term1 is greater than term2. This is equivalent to the standard Prolog '>' operator. le(term1, term2) Succeed if term1 is less than or equal to term2. This is equivalent to the standard Prolog '<=' operator. lt(term1, term2) Succeed if term1 is less than term2. This is equivalent to the standard Prolog '<' operator. Database database(aStructure) Create a database which can hold facts to be asserted or extracted. The name of the database is taken from the functor of aStructure. The arguments of aStructure are ignored. purgeDatabase(aStructure) Purge a database identified by the functor of aStructure. The arguments of aStructure are ignored. asserta(aFact) Add aFact to the beginning of the database identified by the functor of the fact. The database must have been previously created by the 'database' predicate. assertz(aFact) Add aFact to the end of the database identified by the functor of the fact. The database must have been previously created by the 'database' predicate. retract(aStructure) Delete the first fact unified with aStructure from the database that has the same name as the functor of aStructure. Delete the next unified fact during backtrack. Input-Output nl() Write an end of line to Transcript. read(aTerm) A Smalltalk Prompter is invoked to evaluate a Smalltalk expression. The result is unified with aTerm. This can be used to read a symbol (beginning with #), a number (integer or real), a string (enclosed with single quotes), etc. Nonstandard. write(term1, term2, ...) Write all the arguments to Transcript. Debugging halt() Halt the execution. The Smalltalk debugger can be invoked at this point to examine the stacked method evaluations. To modify Prolog methods, you must use the Logic Browser window. The resume option on the walkback window can be used as a trace facility. Nonstandard. ! LParser subclass: #LindaParser instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Linda-Compiler'! !LindaCompiler class methodsFor: 'as yet unclassified' stamp: 'rww 8/2/2000 07:02'! parserClass "Return a parser class to use for parsing method headers." ^LindaParser! ! !LindaEnvironment class methodsFor: 'as yet unclassified' stamp: 'rww 8/2/2000 06:57'! compilerClass ^LindaCompiler! ! !LindaEnvironment class methodsFor: 'as yet unclassified' stamp: 'rww 8/2/2000 06:57'! evaluatorClass "Answer an evaluator class appropriate for evaluating expressions in the context of this class." ^LindaCompiler! ! !LindaEnvironment class methodsFor: 'as yet unclassified' stamp: 'rww 8/2/2000 07:00'! sourceCodeTemplate "Answer an expression to be edited and evaluated in order to define methods in this class." ^'message selector and argument names "comment stating purpose of message" | temporary variable names | statements'! ! !LindaParser methodsFor: 'expression types' stamp: 'rww 8/2/2000 19:53'! lindaMethod: doit context: ctxt | blk messageComment methodNode blockComment | prologMethodSelector _ (here, ':') asSymbol. typeTable at: $, asciiValue put: #comma. typeTable at: $!! asciiValue put: #exclamationMark. (prologMethodArgument _ encoder bindArg: #assoc) isArg: true. messageComment _ currentComment. currentComment _ nil. " self statements: #() innerBlock: doit. " parseNode _ BlockNode new arguments: #() statements: (self ruleSeries, self safeGuardReturnStatements) returns: doit from: encoder. blockComment _ currentComment. currentComment _ nil. parseNode comment: blockComment. blk _ parseNode. hereType == #doIt ifFalse: [^self expected: 'Nothing more']. methodNode _ MethodNode new comment: messageComment. ^methodNode selector: prologMethodSelector arguments: (OrderedCollection with: prologMethodArgument) precedence: 3 temporaries: temporaries block: blk encoder: encoder primitive: 0! ! !LindaParser methodsFor: 'expression types' stamp: 'rww 8/2/2000 19:52'! messagePart: level repeat: repeat "bolot 8/5/1999 18:14" "This is the same as Parser>>messagePart:repeat:" "with only ONE addition: support for #:? for calling Prolog stuff" | start receiver selector args precedence words keywordStart | [receiver _ parseNode. (hereType == #keyword and: [level >= 3]) ifTrue: [start _ self startOfNextToken. selector _ WriteStream on: (String new: 32). args _ OrderedCollection new. words _ OrderedCollection new. [hereType == #keyword] whileTrue: [keywordStart _ self startOfNextToken + requestorOffset. selector nextPutAll: self advance. words addLast: (keywordStart to: self endOfLastToken + requestorOffset). self primaryExpression ifFalse: [^self expected: 'Argument']. self messagePart: 2 repeat: true. args addLast: parseNode]. (Symbol hasInterned: selector contents ifTrue: [ :sym | selector _ sym]) ifFalse: [ selector _ self correctSelector: selector contents wordIntervals: words exprInterval: (start to: self endOfLastToken) ifAbort: [ ^ self fail ] ]. precedence _ 3] ifFalse: [((hereType == #binary or: [hereType == #verticalBar]) and: [level >= 2]) ifTrue: [start _ self startOfNextToken. selector _ self advance asSymbol. self primaryExpression ifFalse: [^self expected: 'Argument']. self messagePart: 1 repeat: true. args _ Array with: parseNode. precedence _ 2] ifFalse: [hereType == #word ifTrue: [start _ self startOfNextToken. selector _ self advance. args _ #(). words _ OrderedCollection with: (start + requestorOffset to: self endOfLastToken + requestorOffset). (Symbol hasInterned: selector ifTrue: [ :sym | selector _ sym]) ifFalse: [ selector _ self correctSelector: selector wordIntervals: words exprInterval: (start to: self endOfLastToken) ifAbort: [ ^ self fail ] ]. precedence _ 1] ifFalse: [(self match: #colonQuestion) ifTrue: [selector _ #inferSmalltalk:var:. "change typeTable for Prologging" typeTable at: $, asciiValue put: #comma; at: $!! asciiValue put: #exclamationMark. args _ Array with: (self goalSeries) with: (encoder encodeLiteral: #inka). "restore typeTable for Smalltalking" typeTable at: $, asciiValue put: (TypeTable at: $, asciiValue); at: $!! asciiValue put: (TypeTable at: $!! asciiValue). precedence _ 3 "TODO: pick right precedence"] ifFalse: [^args notNil]]]]. parseNode _ MessageNode new receiver: receiver selector: selector arguments: args precedence: precedence from: encoder sourceRange: (start to: self endOfLastToken). repeat] whileTrue: []. ^true! ! !LindaParser methodsFor: 'expression types' stamp: 'rww 8/2/2000 19:54'! method: doit context: ctxt | sap blk prim messageComment methodNode | "need temporaries/statements in doits - to enable unbounds" temporaries _ OrderedCollection new. statements _ OrderedCollection new. "may need to change (temporarily) for doits" typeTable _ typeTable copy. "check if it's a Prolog method definition" ((doit not and: [hereType == #word]) and: [tokenType == #leftParenthesis]) ifTrue: [^self lindaMethod: doit context: ctxt]. sap _ self pattern: doit inContext: ctxt. "sap={selector, arguments, precedence}" (sap at: 2) do: [:argNode | argNode isArg: true]. temporaries _ self temporaries asOrderedCollection. messageComment _ currentComment. currentComment _ nil. prim _ doit ifTrue: [0] ifFalse: [self primitive]. self statements: #() innerBlock: doit. parseNode statements: statements , parseNode statements. blk _ parseNode. doit ifTrue: [blk returnLast] ifFalse: [blk returnSelfIfNoOther]. hereType == #doIt ifFalse: [^self expected: 'Nothing more']. self interactive ifTrue: [self removeUnusedTemps]. methodNode _ MethodNode new comment: messageComment. ^methodNode selector: (sap at: 1) arguments: (sap at: 2) precedence: (sap at: 3) temporaries: temporaries block: blk encoder: encoder primitive: prim! ! !LindaParser methodsFor: 'expression types' stamp: 'rww 8/2/2000 19:54'! method: doit context: ctxt encoder: encoderToUse | sap blk prim messageComment methodNode | encoder _ encoderToUse. "need temporaries/statements in doits - to enable unbounds" temporaries _ OrderedCollection new. statements _ OrderedCollection new. "may need to change (temporarily) for doits" typeTable _ typeTable copy. "check if it's a Prolog method definition" ((doit not and: [hereType == #word]) and: [tokenType == #leftParenthesis]) ifTrue: [^self lindaMethod: doit context: ctxt]. sap _ self pattern: doit inContext: ctxt. "sap={selector, arguments, precedence}" (sap at: 2) do: [:argNode | argNode isArg: true]. temporaries _ self temporaries asOrderedCollection. messageComment _ currentComment. currentComment _ nil. prim _ doit ifTrue: [0] ifFalse: [self primitive]. self statements: #() innerBlock: doit. parseNode statements: statements , parseNode statements. blk _ parseNode. doit ifTrue: [blk returnLast] ifFalse: [blk returnSelfIfNoOther]. hereType == #doIt ifFalse: [^self expected: 'Nothing more']. self interactive ifTrue: [self removeUnusedTemps]. methodNode _ self newMethodNode comment: messageComment. ^methodNode selector: (sap at: 1) arguments: (sap at: 2) precedence: (sap at: 3) temporaries: temporaries block: blk encoder: encoder primitive: prim! ! !LindaParser reorganize! ('expression types' lindaMethod:context: messagePart:repeat: method:context: method:context:encoder:) !