[Q] Does anyone have a radixsearchtrieSmalltalkimplementation?

Rob Withers slosher2 at home.com
Thu Aug 3 03:11:29 UTC 2000


Mark Guzdial wrote:
> 
> >
> >Thanks, Mark.  I'll dig into it.  Perhaps there will be something about
> >unification.  I've never heard of that term before.
> 
> I'll attempt a definition: Unification is the process of mapping two
> forms (e.g., equations) onto one another such that variables (in the
> form) are set to appropriate values and constraints are maintained.
> The process may involve backtracking, and can also end in failure (if
> no match is possible).
> 
> I did some web-hunting and this page seems like a reasonable intro to
> unification:
> 
> http://www.ccs.neu.edu/home/arthur/unif.html
> 
> I first learned about it reading Patrick Winston's first book on Lisp
> -- I remember typing in the code and poking at it forever trying to
> figure out how it was working.  I think that the best description of
> the algorithm, though, is in Brian Harvey's "Computer Science Logo
> Style" series (Volume 3, I think).  (In general, next to "Structure
> and Interpretation of Computer Programs," Harvey's books are my
> favorite CS texts.)
> 
> Mark
> 
> --------------------------
> Mark Guzdial : Georgia Tech : College of Computing : Atlanta, GA 30332-0280
> Associate Professor - Learning Sciences & Technologies.
> Collaborative Software Lab - http://coweb.cc.gatech.edu/csl/
> (404) 894-5618 : Fax (404) 894-0673 : guzdial at cc.gatech.edu
> http://www.cc.gatech.edu/gvu/people/Faculty/Mark.Guzdial.html


Thank you Mark and all the great responses.  I have a bunch of material
to read and it is starting to sink in.  Here is the start of a
LindaCompiler, LindaParser, and a LindaEnvironment.  I am thinking that
an environment is the TupleSpace that has the unification collection and
allows logical queries to be made.  We compile expressions into
bytecodes to run within an environment.  These expressions can be in any
language, including Smalltalk, so I am subclassing all of the Prolog,
LCompiler and LParser to pick up the logic behavior, but I will modify
things back to the Smalltalk syntax.  The (objects, bindings,
expressions) of Smalltalk correspond to the (values, ?patterns, rules)
of Prolog.

I haven't implemented the unify algorithm correctly yet, so I haven't
even tried running this yet.  Is this the right direction?

Again, thanks to everyone for their help.  I will be out of touch for
several days to take a break from coding.

cheers,
Rob


-- 
--------------------------------------------------
Smalltalking by choice.  Isn't it nice to have one!
-------------- next part --------------
'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 at 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 at 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:)
!



More information about the Squeak-dev mailing list