Channels ▼
RSS

C/C++

Roll Your Own Object-Oriented Language

Source Code Accompanies This Article. Download It Now.


NOV90: ROLL YOUR OWN OBJECT-ORIENTED LANGUAGE

Striking a chord with Object Prolog

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

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.

Striking Up the Band

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.

A Bow from the Director

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!

Objects in C Minor

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.

Parsing the ODL

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.

An Encore

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]

<a name="0235_000b">

/* 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).



<a name="0235_000c"><a name="0235_000c">
<a name="0235_000d">
[LISTING TWO]
<a name="0235_000d">

/* 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.



<a name="0235_000e"><a name="0235_000e">
<a name="0235_000f">
[LISTING THREE]
<a name="0235_000f">

/* 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),!.



<a name="0235_0010"><a name="0235_0010">
<a name="0235_0011">
[LISTING FOUR]
<a name="0235_0011">

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.



<a name="0235_0012"><a name="0235_0012">
<a name="0235_0013">
[LISTING FIVE]
<a name="0235_0013">

/* 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.




<a name="0235_0014"><a name="0235_0014">
<a name="0235_0015">
[LISTING SIX]
<a name="0235_0015">

/* 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).












Related Reading


More Insights






Currently we allow the following HTML tags in comments:

Single tags

These tags can be used alone and don't need an ending tag.

<br> Defines a single line break

<hr> Defines a horizontal line

Matching tags

These require an ending tag - e.g. <i>italic text</i>

<a> Defines an anchor

<b> Defines bold text

<big> Defines big text

<blockquote> Defines a long quotation

<caption> Defines a table caption

<cite> Defines a citation

<code> Defines computer code text

<em> Defines emphasized text

<fieldset> Defines a border around elements in a form

<h1> This is heading 1

<h2> This is heading 2

<h3> This is heading 3

<h4> This is heading 4

<h5> This is heading 5

<h6> This is heading 6

<i> Defines italic text

<p> Defines a paragraph

<pre> Defines preformatted text

<q> Defines a short quotation

<samp> Defines sample computer code text

<small> Defines small text

<span> Defines a section in a document

<s> Defines strikethrough text

<strike> Defines strikethrough text

<strong> Defines strong text

<sub> Defines subscripted text

<sup> Defines superscripted text

<u> Defines underlined text

Dr. Dobb's encourages readers to engage in spirited, healthy debate, including taking us to task. However, Dr. Dobb's moderates all comments posted to our site, and reserves the right to modify or remove any content that it determines to be derogatory, offensive, inflammatory, vulgar, irrelevant/off-topic, racist or obvious marketing or spam. Dr. Dobb's further reserves the right to disable the profile of any commenter participating in said activities.

 
Disqus Tips To upload an avatar photo, first complete your Disqus profile. | View the list of supported HTML tags you can use to style comments. | Please read our commenting policy.
 

Video