|
Mike defines, designs, and implements an object-oriented language that you can wrap around your code.
November 01, 1990
URL:http://www.drdobbs.com/cpp/roll-your-own-object-oriented-language/184408439
Mike is a technical editor at DDJ and can be reached directly at DDJ, on CompuServe at 76703, 4057, or on MCI MAIL as MFLOYD.
A special relationship exists between developing software and writing music. Among other things, the two disciplines share precise languages containing symbols that, unlike English, carry very specific meanings. Yet, these symbols can be combined in countless ways to orchestrate something that can only be termed "harmonious." More often than not, the unexpected becomes the norm, and more to the point of this article, what could be more unexpected than object-oriented extensions to the Prolog language? The extensions, which I call "Object Prolog," involve an inheritance mechanism and message-passing facility that, when included in a Prolog program, allow you to add objects to your programs. I'll also provide a preprocessor that allows you to define your own object definition language and spits out Object Prolog code.
"But," you say, "I'm no logic programmer." Well, I'm no Brahms either, but you should know that Prolog's unique abilities allow it to serve as a sort of "executable specification," meaning that you can easily rewrite the code presented here in your favorite language. In addition, the parser presented in this article provides a code generator that can be modified to output source in your favorite language.
I should mention that I'm using PDC Prolog (formerly Turbo Prolog) from the Prolog Development Center. The code generated by the preprocessor, however, should run under any Prolog compiler with only slight modifications.
Object Prolog is a small language set that I've defined to wrap around your code. When written correctly, that code will exhibit inheritance, encapsulation, abstraction, polymorphism, and persistence. Object Prolog treats everything in the system as an object and, as such, there are no formal classes. As defined here, only single inheritance is supported, although support for multiple inheritance can be added.
Object Prolog uses four predefined predicates (equivalent to a Pascal procedure) which are defined in OOP.PRO (see Listing One, page 102). The method( ) predicate is used to define methods in the program and takes an object type and the method name as its two arguments. There is nothing unusual about method( ) except that it is invoked by the inheritance mechanism. A method( ), like any Prolog predicate may call any other predicate in the system, including other methods.
The msg( ) predicate is used to send messages to objects by taking an object identifier and a message identifier as its arguments and passing the message through the inheritance mechanism to invoke the appropriate method.
The is_a( ) predicate is a database predicate that simulates a table defining the parent/child relationships in the system. is_a( ) is generally used only by the inheritance mechanism, although it can be called directly anywhere in the program. One common use for is_a( ) outside of the inheritance mechanism is to look up the hierarchy for a specific attribute of the parent object. You'll see this action in the discussion of Listing Two.
Finally, the has( ) predicate is a data structure that represents the dynamic portion of the objects in your program. It has the effect of an instance variable and stores the data associated with an object. has( ) is a database predicate so that instances of objects can be passed around in memory. The structure for has( ) consists of an object identifier and a list (similar to a linked-list) of slots which describe the named object. Slots are recursively defined and consist of an identifier and a value. For instance, a slot could be a variable name and the contents of that variable. A value, however, can also contain lists made up from the basic data types, another slot, or a list of slots.
If you are a Turbo Pascal or Turbo C++ programmer, you're familiar with Borland's "Figures" example which is used in the Borland documentation to get budding object-oriented programmers up to speed. The example defines a base object type (or class) called point that is used to derive a circle, and later an arc. I'll use that same example, both as a litmus test for Object Prolog and as a common ground for understanding.
Listing Two (page 102) presents FIGURES.PRO, which defines four shapes: point, circle, rectangle, and solid rectangle. The Clauses section (similar to procedure definitions) first defines the methods for those shapes. Because PDC Prolog supports the Borland Graphics Interface (BGI) library, I'll use the BGI to draw the various shapes on the screen. The bide and show methods for point, for instance, use BGI's putpixel( ) routine to display or hide a point on the screen. BGI.PRO (Listing Three, page 104) provides the BGI initialization support.
Point is the base object from which all other shapes will inherit. As such, point demonstrates the use of abstraction in Object Prolog. In other words, point's purpose is to act as a template for all other shapes that inherit from it rather than to draw points on the screen (although there would be no problem in doing so). point's init and done methods represent a constructor and destructor, respectively, using assert and retract to create and destroy objects in memory.
I mentioned earlier that is_a( ) could be called directly in an Object Prolog program. method(circle, drag), for instance, uses is_a( )to send a message to method(point,drag). Note that there is no explicit circle.drag method in the Turbo Pascal or Turbo C++ counterparts to Figures. These bindings are handled by a Virtual Method Table (VMT). Object Prolog, however, does not setup a VMT so the lookup is done explicitly by method(circle.drag). This is a dynamic lookup, so nothing is lost in the way of polymorphism, although it does require a little more work.
The Figures example winds up with arc, a new object type. arc is defined as a child of point and therefore reaps the same benefits as circle. Note that arc is not a stand-alone object file; rather, it is included at the end of Listing Two. The reason is that PDC Prolog requires that all predicates be grouped together. Therefore, arc must consult the database and assert the appropriate is_a and has clauses. There will be more to say about this in the "Encore" section.
One of the beauties of Prolog is its ability to quickly model an algorithm. This is apparent in the instrument that orchestrates the symphony -- the inheritance mechanism. (The code for the inheritance mechanism in Listing One, for example, is a paltry 11 lines long.)
The inherit( ) rules are actually quite powerful and can act in a number of ways. inherit can take an object identifier and return its associated value. Given the Figures example, for instance, if Object is instantiated to point, the first inherit clause will call description to look for a matching has fact in the database. In this case, description will return a list of slots containing the values for the x and y coordinates of point.
In the case of circle, however, no explicit fact exists. So, a call to inherit with Object instantiated to circle will invoke the second inherit clause, which uses is_a to look up the hierarchy until a fact is found. In this case, inherit will return the x and y coordinates with no explicit has reference to circle.
The second description clause comes into play when a has clause cannot be found. The assumption is that if it's not an instance variable, it must be a method. If you're concerned about performance here, don't worry. Prolog (like all languages) looks at the data structure before attempting to bind variables, so the instance variables are quickly ruled out.
A point for C programmers to note here is that you can call PDC Prolog from C (both Turbo and Microsoft). You can then get a cheap inheritance mechanism by linking OOP.PRO with your C code and calling inherit directly!
Object structures, as represented by has( ), can be quite complex, especially if an object slot contains lists of slots within slots, and so on. I decided to build a simple preprocessor that allows you to design objects at a higher level, using what I call an "object definition language" (ODL). The preprocessor defines a syntax similar to Turbo Pascal's, parses the code, and generates Object Prolog source code.
FIGURES.OOP (see Listing Four, page 104) presents an example of the ODL that I've defined. You'll note that this program looks more like the Figures example in the Turbo Pascal OOP Guide than Listing Two, with the exception that I've borrowed the style for variable declarations from C. (Note, for instance, the int declaration at the beginning of point.) Of course, there is no virtual keyword for the reasons discussed above.
Turbo Pascal has a nifty style for describing objects. In particular, I like the syntactic style used in defining inheritance relationships: The ancestor is named in the argument to object( ). Introducing an inherit keyword as defined in "true" Object Pascal works, but is clumsy, and in my opinion, less eloquent. Otherwise, the program is straightforward: Methods are encapsulated directly in the object and support predicates are contained after the object definitions. As with Object Pascal, the end statement is used to terminate the object definition and must be followed by a period.
PARSER.PRO in Listing Five (page 105) presents the ODL parser; a top-down parser that operates in a recursive-descent fashion. Because the parser need generate only Object Prolog code, construction of a state machine is not necessary. In fact, much of the defined syntax is a reordering of the Object Prolog syntax so that encapsulation is more natural. Of course, the parser must also create data structures for objects, insert inheritance relationships, and bind static variables.
The algorithm for the parser is implemented in the scan predicate. As with many parsers, scan does not actually construct a parse tree, but mirrors the tree through predicate calls. The parser takes its input, one line at a time, and passes the line to the lexical analyzer via tokl for tokenization. scan first looks for the object definition, and then for any variable declarations. The object definition is stored in the database via insert _isa for later insertion into the is_a table, and the object identifier is recorded in objectname. Init_vars then scans the variable string and asserts their tokenized counterparts into the database as slots. Later, in the code generation phase, these slots will be referenced to set up the appropriate has clauses.
scan_methods then scans the method identifier and asserts the tokenized method into the database for reference by the code generator. The code generator inserts the object name to create the method clause. Also note that methods may span several lines so GetMethEnd is used to search for the end of a method, which is designated by a period (as are traditional Prolog clauses). scan_methods continues recursively scanning methods until an end statement is reached.
Finally, the code generation phase takes over. Code is generated for one object at a time; then scan is called again to parse more objects. generate_code begins the code generation phase by grabbing the current object identifier from the database and calling generate_ancestors to setup the is_a table. Next, generate_methods is called to insert the object identifier and write any methods stored in memory. generate_vars then grabs individual slots and reasserts them as a list of slots, stored as vars. Finally, generate_code retrieves the vars from the database and writes out the has clauses.
Because PDC Prolog requires that like clauses be grouped together, has, is_a, and method clauses are stored in separate temporary files and merged at the end of the code generation phase. It probably makes sense to store has and is_a clauses in a separate consult file. In fact, this is a prerequisite for dynamic objects and is required to support object persistence.
As mentioned earlier, the lexical analyzer shown in Listing Six (page 108) is called by the parser via tokl to scan and tokenize lexemes. tokl uses the built-in fronttoken predicate to strip the first lexeme from the input stream, then calls scan_next to scan the rest of the stream. scan_next also uses fronttoken to assert "lookahead" lexemes in the database in the form of a stack. tokl next calls tokenize to tokenize the string. tokenize pulls a lexeme from the input stream and passes the lexeme to str_tok, which takes a string and returns its tokenized representation. In most cases, this is a simple lookup. For instance, str_tok("(", X) will return the lpartoken in X. But a lookahead is necessary in the case of variable declarations, so str_tok("int", X) must pop lexemes off the lookahead stack to get to the variable identifiers. These identifiers are stored in the database as they are popped off the stack.
One other notable point is that str_tok suffixes an underscore character to lexemes that coincide with built-in PDC Prolog keywords. For instance, str_tokwill return if_for the iflexeme. This is done to resolve conflicts between the object definition language and PDC Prolog language elements.
The parser makes a good stepping stone for designing and developing Object Prolog code, but is by no means complete or bulletproof. Indeed, the parser is bare bones at the moment and is crying for improvements. So, if you plan to use the extended language and preprocessor to develop Object Prolog code, you'll probably want to make some additions to the parser and scanner. The first step is to add some error handlers to both the parser and lexical analyzer. And you'll want to add support for any built-in predicates that you need.
As mentioned earlier on in this article, the Figure example included arc, rather than linking it as a separate object file. Not only is this a deterrent to polymorphism, but it restricts the size of your object-oriented system. Another problem lies in the fact that every clause in the system (except support clauses) is a method( ). Although I'm not certain of the limit, there is a maximum number of clauses allowed for a given predicate. Undoubtedly, someone is going to hit that limit at some point. This is where a method table would come in handy.
My next project will be to build a hierarchy browser to scan the is_a relationships and present a tree diagram of the hierarchy. The Prolog Development Center provides window and menu tools, and includes a tree menu predicate that can be cannibalized (most of the toolbox, including tree menu, comes with full source code) to aid in this effort.
In any case, I invite you to pick up the baton and have a go at it. Who knows what melody lurks in the wings, waiting to be played.
_ROLL YOUR OWN OBJECT-ORIENTED LANGUAGE_ by Michael Floyd
[LISTING ONE]
/* File : OOP.PRO -- Include file that adds inheritance mechanism
and message passing facility. This file also declares the
object-oriented predicates msg(), method(), has(), and is_a().
Objects are implemented using a technique known as frames;
the inheritance mechanism is based on the article "Suitable for
Framing" by Michael Floyd (Turbo Technix, April/May '87).
Michael Floyd -- DDJ -- 8/28/90 -- CIS: [76703,4057] or MCI Mail: MFLOYD
*/
DOMAINS
object = object(string,slots) % not actually used in examples
objects = object*
slot = slot(string,value)
slots = slot*
value = int(integer) ; ints(integers) ;
real_(real) ; reals(reals) ;
str(string) ; strs(strings) ;
object(string,slots,parents) ; objects(objects)
parents = string*
integers = integer*
reals = real*
strings = string*
% --- OOP preds to be used by the programmer ---
DATABASE
has(string,slots) % storage for instance vars
is_a(string,string) % hierarchy relationships
PREDICATES
msg(string,string) % send a message to an object
method(string, string) % define a method
% --- Internal Predicates not called ditrectly by the programmer ---
inherit(string,slot) % inheritance mechanism
description(string,slot) % search for matching clauses
member(slot,slots) % look for object in a list
CLAUSES
/* Inheritance Mechanism */
inherit(Object,Value):-
description(Object,Value),!.
inherit(Object,Value):-
is_a(Object,Object1),
inherit(Object1,Value),
description(Object1,_).
description(Object,Value):-
has(Object,Description),
member(Value,Description).
description(Object,slot(method,str(Value))):-
method(Object,Value).
/* Simple message processor */
msg(Object,Message):-
inherit(Object,slot(method,str(Message))).
/* Support Clauses */
member(X,[X|_]):-!. % Find specified member in a list
member(X,[_|L]):-member(X,L).
[LISTING TWO]
/* File: FIGURES.PRO -- Object Prolog example that models FIGURES example in
Turbo C++ and Turbo Pascal documentation
Michael Floyd -- DDJ -- 8/28/90
*/
include "bgi.pro"
include "OOP.PRO"
domains
key = escape; up_arrow; down_arrow; left_arrow; right_arrow; other
database - SHAPES
anyShape(string)
PREDICATES % Support predicates
horiz(integer, integer, string)
vert(integer, integer, integer)
readkey(integer, integer, integer)
key_code(key, integer, integer, integer)
key_code2(key, integer, integer, integer)
repeat
main
CLAUSES
/* Methods */
/* point is an example of an Abstract object. Note that variables passed
through the database must be explicitly called by the child
method (i.e. variables are not inherited). */
method(point, init):-
assert(has(point,[slot(x_coord,int(150)),
slot(y_coord,int(150))])).
method(point, done):-
retractall(has(point,_)).
method(point,show):-!,
has(point,[slot(x_coord,int(X)),
slot(y_coord,int(Y))]),
putpixel(X,Y,blue).
method(point,hide):-!,
has(point,[slot(x_coord,int(X)),
slot(y_coord,int(Y))]),
putpixel(X,Y,black).
/* Example of a virtual method */
method(point,moveTo):-!,
anyShape(Object),
msg(Object,hide),
retract(has(point,[slot(x_coord,int(DeltaX)),
slot(y_coord,int(DeltaY))])),
msg(Object,show).
method(point,drag):-
has(point,[slot(x_coord,int(X)),
slot(y_coord,int(Y))]),
anyShape(Shape),!,
msg(Shape,show),
repeat,
readkey(Key, DeltaX, DeltaY),
assertz(has(point,[slot(x_coord,int(DeltaX)),
slot(y_coord,int(DeltaY))])),
msg(point,moveTo),
Key = 27.
/* Circle Methods */
method(circle, init):-!,
method(point, init),
assert(anyShape(circle)).
method(circle, done):-!,
retract(anyShape(circle)),
method(point, done).
method(circle, show):-!,
has(point,[slot(x_coord,int(X)),
slot(y_coord,int(Y))]),
setcolor(white),
circle(X,Y,50).
method(circle, hide):-!,
has(point,[slot(x_coord,int(X)),
slot(y_coord,int(Y))]),
setcolor(black),
circle(X,Y,50).
method(circle, drag):-
msg(circle, hide),
is_a(circle, Ancestor),
msg(Ancestor, drag),
msg(circle, show).
/* arc Methods */
method(arc, init):-!,
assert(anyShape(arc)),
assert(has(point,[slot(x_coord,int(150)),
slot(y_coord,int(150))])),
assert(has(arc,[slot(radius,int(50)),
slot(startAngle,int(25)),
slot(endAngle,int(90))])).
method(arc, done):-
retract(anyShape(arc)),!,
retractall(has(arc,_)),
method(point, init).
method(arc, show):-
has(point,[slot(x_coord,int(X)),
slot(y_coord,int(Y))]),
has(arc,[slot(radius,int(Radius)),
slot(startAngle,int(Start)),
slot(endAngle,int(End))]),!,
setcolor(white),
arc(X, Y, Start, End, Radius).
method(arc, hide):-
has(point,[slot(x_coord,int(X)),
slot(y_coord,int(Y))]),
has(arc,[slot(radius,int(Radius)),
slot(startAngle,int(Start)),
slot(endAngle,int(End))]),!,
setcolor(black),
arc(X, Y, Start, End, Radius).
method(arc,drag):-
msg(arc, hide),
is_a(arc,Ancestor),!,
msg(Ancestor,drag),
msg(arc, show).
/* rectangle Methods */
method(rectangle,init):-
has(rectangle,[slot(length,int(L)),
slot(width,int(W))]),!.
method(rectangle,init):-!,
write("Enter Length of rectangle: "),
readint(L),nl,
write("Enter Width of rectangle: "),
readint(W),nl,
assert(has(rectangle,[slot(length,int(L)),
slot(width,int(W))])).
method(rectangle,done):-
retract(has(rectangle,[slot(length,int(L)),
slot(width,int(W))])),!.
method(rectangle,draw):-!,
has(rectangle,[slot(length,int(L)),
slot(width,int(W))]),
write("Z"),
horiz(1,L,"D"),
write("?"),nl,
vert(1,W,L),
write("@"),
horiz(1,L,"D"),
write("Y").
method(rectangle,draw):-
write("Cannot draw rectangle"),nl.
/* Support Methods */
horiz(I,L,Chr):-
I <= L,!,
TempI = I + 1,
write(Chr),
horiz(TempI,L,Chr).
horiz(I,L,Chr):-!.
vert(I,W,L):-
I <= W,!,
TempI = I + 1,
write("3"),
horiz(1,L," "),
write("3"),nl,
vert(TempI,W,L).
vert(I,W,L):-!.
/* Ancestor/Child relationships - should be stored in consult() file */
is_a(circle,point).
is_a(arc,point).
is_a(triangle,shape).
is_a(rectangle,shape).
is_a(solid_rectangle,rectangle).
/* Generic clause to read cursor keys - used by the Drag method */
readkey(Val, NewX, NewY) :-
readchar(T),
char_int(T, Val),
key_code(Key, Val, NewX, NewY).
key_code(escape, 27, 0, 0) :- !.
key_code(Key, 0, NewX, NewY) :- !,
readchar(T),
char_int(T, Val),
key_code2(Key, Val, NewX, NewY).
key_code2(up_arrow, 72, NewX, NewY) :- !,
has(point,[slot(x_coord,int(X)),
slot(y_coord,int(Y))]),
NewX = X,
NewY = Y - 5.
key_code2(left_arrow, 75, NewX, NewY):- !,
has(point,[slot(x_coord,int(X)),
slot(y_coord,int(Y))]),
NewX = X - 5,
NewY = Y.
key_code2(right_arrow, 77, NewX, NewY) :- !,
has(point,[slot(x_coord,int(X)),
slot(y_coord,int(Y))]),
NewX = X + 5,
NewY = Y.
key_code2(down_arrow, 80, NewX, NewY) :- !,
has(point,[slot(x_coord,int(X)),
slot(y_coord,int(Y))]),
NewX = X,
NewY = Y + 5.
key_code2(other, _,0,0).
/* Supports the repeat/fail loop */
repeat.
repeat:- repeat.
main:-
nl,
initialize, % init BGI graphics
makewindow(1,7,0,"",0,0,25,80),
msg(circle, init), % create and manipulate a circle
msg(circle, show),
msg(circle, drag),
msg(circle, done),
clearwindow,
msg(arc, init), % create and manipulate an arc
msg(arc, show),
msg(arc, drag),
msg(arc, done),
closegraph, % return to text mode
makewindow(2,2,3,"",0,0,25,80),
msg(rectangle, init), % create a rectangle in text mode
msg(rectangle, draw),
msg(rectangle, done).
goal
main.
[LISTING THREE]
/* File: BGI.PRO -- Minimum required to detect graphics hardware an initialize
system in graphics mode using BGI. BGI.PRE is included with PDC Prolog.
Michael Floyd -- DDJ -- 8/28/90
*/
include "D:\\prolog\\include\\BGI.PRE"
CONSTANTS
bgi_Path = "D:\\prolog\\bgi"
PREDICATES
Initialize
CLAUSES
Initialize:-
DetectGraph(G_Driver, G_Mode),
InitGraph(G_Driver,G_Mode, _, _, bgi_Path),!.
[LISTING FOUR]
include "bgi.pro"
include "support.pro"
database - figures
anyShape(string)
point = object
int XCoord YCoord
method(init) if XCoord = 150, YCoord = 150.
method(done) if retract(has(point,_)).
method(show) if putpixel(XCoord,YCoord,blue).
method(hide) if putpixel(XCoord,YCoord,black).
method(moveTo) if
anyShape(Object),
msg(Object, hide),
retract(has(point,_)),
msg(Object, show).
method(drag) if
anyShape(Shape),
msg(Shape,show),
repeat,
readkey(Key, DeltaX, DeltaY),
XCoord = DeltaX,
YCoord = DeltaY,
msg(point,moveTo),
Key = 27.
end.
circle = object(point)
int XCoord YCoord
method(init) if
XCoord = 200, YCoord = 200,
assert(anyShape(circle)).
method(done) if
retract(anyShape(circle)),
msg(point,done).
method(show) if
setcolor(white),
circle(XCoord, YCoord, 50).
method(hide) if
setcolor(black),
circle(XCoord, YCoord, 50).
method(drag) if
msg(circle,hide),
is_a(circle, Ancestor),
msg(Ancestor,drag),
msg(circle,show).
end.
arc = object(point)
int XCoord YCoord Radius StartAngle EndAngle
method(init) if
Radius = 50, StartAngle = 25, EndAngle = 90,
msg(point, init).
method(done) if
retract(anyShape(arc)),
retractall(has(arc,_)),
msg(point, done).
method(show) if
setcolor(white),
arc(XCoord,YCoord,StartAngle,EndAngle,Radius).
method(hide) if
setcolor(black),
arc(XCoord,YCoord,StartAngle,EndAngle,Radius).
method(drag) if
msg(arc,hide),
is_a(arc,Ancestor),
msg(Ancestor,drag),
msg(arc,show).
end.
[LISTING FIVE]
/* File: PARSER.PRO -- Implements parser to translate ODL to Object Prolog
code. Top-down parser; simulates parse tree through predicate calls.
Michael Floyd -- DDJ -- 8/28/90
*/
include "lex.pro"
DOMAINS
file = infile; outfile; tmpfile
PREDICATES
main
repeat
gen(tokl)
scan
scan_object(tokl,string)
findAncestor(tokl)
init_vars
scan_methods(string)
getMethEnd(string,string)
write_includes
generate_code
generate_methods
generate_ancestor(string)
generate_vars
fixVar(tokl)
insert_isa(tokl)
bindvars(tokl,tokl)
addVarRef(tokl)
assert_temp(strings,tokl)
construct_has(tokl)
empty(tokl)
isvar(tokl,tokl)
is_op(tok)
value(tok, integer)
search_ch(CHAR,STRING,INTEGER,INTEGER)
process(string)
read(string)
datatype(string)
headbody(tokl,tokl,tokl)
search_msg(tokl,tokl,tokl)
constVar(string,tok)
writeSlotVars
write_seperator(tokl)
write_comma
append(tokl,tokl,tokl)
CLAUSES
repeat.
repeat:- repeat.
/**** Parser ****/
scan:-
readln(ObjectStr),
ObjectStr <> "",
tokl(ObjectStr,ObjList),
scan_object(ObjList,Object),
init_vars,
scan_methods(Object),!,
generate_code.
scan:- scan.
scan_object([H|List],S):-
member(object,List),
str_tok(S,H),
assert(objectname(S)),
findAncestor(List).
scan_object(List,_):-
openappend(tmpfile,"headers.$$$"),
writedevice(tmpfile),
gen(List),nl,
writedevice(screen),
closefile(tmpfile),trace(off),
fail.
findAncestor(List):-
member(lpar,List),
insert_isa(List).
findancestor(_).
insert_isa([H|List]):-
str_tok(S,H),
S <> "(",
insert_isa(List).
insert_isa([H1,H2|List]):-
str_tok(Ancestor,H2),
assert(ancestor(Ancestor)).
init_vars:-
readln(VarStr),
process(VarStr).
process(VarStr):-
fronttoken(VarStr,Token, RestStr),
datatype(Token),
tokl(VarStr,VarList),!. % tokenize/init variables
process(VarStr):-
assert(unread(VarStr)).
datatype(int). % datatypes supported
datatype(real).
constVar(int,int(_)). % convert tok to string
constVar(real,real_(_)).
read(Str):-
retract(unread(Str)),!.
read(Str):-
readln(Str).
scan_methods(MethodId):-
readln(FirstLn),
getMethEnd(FirstLn,Method),
search_ch('(',Method,0,N), % Find lpar and insert MethodId
N1 = N+1, % and add comma
fronttoken(MComma,MethodId,","),
frontstr(N1,Method,Str,OUT1),!,
fronttoken(Method1,MComma,Out1),
fronttoken(Method2,Str,Method1),
tokl(Method2,MList), % Now Tokenize the method
not(member(end,MList)), % Check for End statement
assert(methods(MList)), % Store method list
scan_methods(MethodId). % Look for more methods
scan_methods(_):- !.
getMethEnd(Line1,ReturnLn):-
search_ch('.',Line1,0,N),
N <> 0,!,
ReturnLn = Line1.
getMethEnd(Line1,ReturnLn):-
readln(Line2),
fronttoken(AppendLn,Line1,Line2),
getMethEnd(AppendLn,ReturnLn).
/**** Entry point into the code generator ****/
generate_code:-
objectname(Object),
generate_ancestor(Object),
openappend(tmpfile,"methods.$$$"),
writedevice(tmpfile),
generate_methods,
generate_vars,
vars(VarList),!,
openappend(tmpfile,"has.$$$"),
writedevice(tmpfile),
write("has(",Object,",",VarList),
write(")."),nl,
writedevice(screen),
closefile(tmpfile),
retract(objectname(Object)).
generate_vars:-
findall(Var,var(Var),VarList), % retrieve vars
retractall(var(_)), % cleanup database
fixVar(VarList),
findall(X,var(X),Slots), % retrieve new vars
retractall(var(_)), % cleanup database
assert(vars(Slots)). % store vars as list of slots
generate_vars:- !.
fixVar([]):- !.
fixVar([slot(UpToken,Const)|Rest]):-
upper_lower(UpToken,Token),
assert(var(slot(Token,Const))),
fixVar(Rest).
generate_ancestor(Object):-
openappend(tmpfile,"isa.$$$"), % open temp file for is_a
writedevice(tmpfile), % stdout to tmpfile
objectname(Obj), % get current object id
retract(ancestor(Parent)), % get parent in hierarchy
write("is_a(",Obj,",",Parent,")."), % write is_a clause
nl,
writedevice(screen), % stdout to screen
closefile(tmpfile). % close temp file
generate_ancestor(_):- % always succeed
writedevice(screen), % stdout to screen
closefile(tmpfile). % close temp file
generate_methods:-
retract(methods(Method)),!,
headBody(Method,Head,Body),
bindvars(Body,NewBody),
gen(Head),
write(":-"), nl,
addVarRef(NewBody),
gen(NewBody),nl,
generate_methods.
generate_methods:-
writedevice(screen),
closefile(tmpfile).
/* Binding of variable names in for has() lookups */
addVarRef(Body):-
findall(Variable, var(slot(Variable,_)), VList),
findall(X, var(slot(_,X)), XList),
assert_temp(VList, XList),
construct_has(Body).
addVarRef(Body).
assert_temp([],[]):- !.
assert_temp([V|VList],[X|XList]):-
constVar(Type,X),
assert(tempvar(V)),
assert(temptype(Type)),
assert_temp(VList,XList).
construct_has(Body):-
objectname(Object),
write(" has(",Object,",","["),
writeSlotVars,
write(")"),
write_seperator(Body),nl.
write_seperator([]):-
write(".").
write_seperator(_):-
write(",").
writeSlotVars:-
retract(tempVar(Var)),
retract(temptype(Type)),
upper_lower(Var,VarId),
write("slot(",VarId,", ",Type,"(",Var,"))"),
write_comma,
writeSlotVars.
writeSlotVars:- !,
write("]").
write_comma:-
tempvar(_),
write(",").
write_comma:- !.
/* Append two lists */
append([], List, List).
append([H|List1], List2, [H|List3]):-
append(List1, List2, List3).
search_msg([H,H2|Body],[],Body):-
H = msg,
H2 = lpar.
search_msg([H|Method], [H|Head], Body):-
search_msg(Method,Head,Body).
search_ch(CH,STR,N,N):- % Search for char in string
frontchar(STR,CH,_),!. % and return its position
search_ch(CH,STR,N,N1):-
frontchar(STR,_,S1),
N2 = N + 1,
search_ch(CH,S1,N2,N1).
headbody([H|Body],[],Body):-
str_tok("if",H).
headBody([H|Method], [H|Head], Body):-
headBody(Method,Head,Body).
bindvars(Method,NewMethod):-
is_op(Op), % supports any operator
member(Op,Method), % defined by is_op()
isvar(Method,[H|RestMethod]), % locate variable in method
bindvars(RestMethod,NewMethod). % look for more vars
bindvars(NewMethod,NewMethod):- !. % return Method w/out vars
empty([]). % simple test for empty list
isvar([],[]):-!.
isvar([id(X),H2,H3|RestMethod],RestMethod):-
is_op(H2),
value(H3,Value),
objectname(ObjId),
retract(var(slot(X,_))),!, % add "var not decl." error here
assert(var(slot(X,H3))).
isvar([H|Method],NewMethod):-
isvar(Method,NewMethod).
is_op(equals).
is_op(plus).
value(int(X),X).
gen([]):- !.
gen([H|List]):-
str_tok(S,H),
write(S),
gen(List).
write_includes:-
write("include \"oop.pro\""),nl.
main:-
/**** Reads file (e.g, FIGURES.ODL) specified on command line. First order of
business is to add error handling for command line processsor. ****/
comline(Filename),
openread(infile, Filename),
readdevice(infile),
repeat,
scan,
eof(infile),
readdevice(keyboard),
openwrite(outfile,"newfig.pro"),
writedevice(outfile),
write_includes,nl,
file_str("headers.$$$",Headers),
write(Headers),nl,
write("clauses\n"),
file_str("methods.$$$",Methods),
write(Methods),nl,nl,
file_str("isa.$$$",Isa),
write(Isa),nl,nl,
file_str("has.$$$",Has),
write(Has),
writedevice(screen),
closefile(outfile),
closefile(infile),
deletefile("headers.$$$"),
deletefile("methods.$$$"),
deletefile("isa.$$$"),
deletefile("has.$$$"),
write("done").
goal
main.
[LISTING SIX]
/* File: LEX.PRO -- Implements scanner which tokenizes ODL. To modify, add
appropriate DOMAIN declarations and str_tok definitions.
Michael Floyd -- DDJ -- 8/28/90
*/
DOMAINS
tok = id(string);
int(integer); real_(real) ;
plus; minus;
mult; div;
lpar; rpar;
comma; colon;
semicolon; period;
object; method;
msg; end;
ancestor; var(string);
equals; if_;
slash; bslash;
slot(string,tok); dummy
tokl = tok*
strings = string*
DATABASE
nextTok(string) % Token lookahead
objectname(string) % current Object ID
vars(tokl) % variables list
methods(tokl) % methods list
var(tok) % individual var
ancestor(string) % tracks Object's ancestor
unread(string)
tempVar(string)
temptype(string)
PREDICATES
tokl(string, tokl) % entry point into the scanner
tokenize(string,tokl) % tokenize a string
str_tok(string, tok) % return individual token
member(tok, tokl) % verify member is in list
scan_next(string) % setup lookahead stack
clauses
str_tok("int",slot(Token,int(0))):-
retract(nextTok(Token)),!,
assert(var(slot(Token,int(0)))),
str_tok("int",_).
str_tok("int",slot(dummy,int(0))):- !,
assert(nextTok(dummy)).
str_tok("real",slot(Token,real_(0))):-
retract(nextTok(Token)),!,
assert(var(slot(Token,real_(0)))),
str_tok("real",_).
str_tok("real",slot(dummy,real_(0))):- !.
str_tok("(", lpar):- !.
str_tok(")", rpar):- !.
str_tok("=", equals):- !.
str_tok("+", plus):- !.
str_tok("-", minus):- !.
str_tok("*", mult):- !.
str_tok("/", div):- !.
str_tok("\"",bslash):- !.
str_tok(",", comma):- !.
str_tok(":", colon):- !.
str_tok(";", semicolon):- !.
str_tok(".", period):- !.
str_tok("if", if_):- !.
str_tok("object", object):- !.
str_tok("method", method):- !.
str_tok("msg", msg):- !.
str_tok("end", end):-!.
/* str_tok(Var, var(Var)):-
frontchar(Var,X,_),
X >= 'A', X <= 'Z'.*/
str_tok(ID, id(ID)):-
isname(ID),!.
str_tok(IntStr,int(Int)):-
str_int(Intstr,Int).
/* Entry point into the scanner */
tokl(Str, Tokl):-
fronttoken(Str, Token, RestStr),
scan_next(RestStr),
tokenize(Str,Tokl).
tokenize("",[]):- !, retractall(nexttok(_)).
tokenize(Str, [Tok|Tokl]):-
fronttoken(Str, Token, RestStr),
str_tok(Token, Tok),
tokenize(RestStr, Tokl).
scan_next("").
scan_next(RestStr):-
fronttoken(RestStr, NextToken, MoreStr),
assert(nexttok(NextToken)),
scan_next(MoreStr).
member(X,[X|_]):-!.
member(X,[_|L]):-member(X,L).