home *** CD-ROM | disk | FTP | other *** search
/ Power-Programmierung / CD1.mdf / magazine / drdobbs / 1990 / 11 / m_floyd.asc < prev    next >
Encoding:
Text File  |  1990-10-12  |  23.4 KB  |  819 lines
  1. _ROLL YOUR OWN OBJECT-ORIENTED LANGUAGE_
  2. by Michael Floyd
  3.  
  4. [LISTING ONE]
  5.  
  6. /* File : OOP.PRO -- Include file that adds inheritance mechanism 
  7.    and message passing facility. This file also declares the 
  8.    object-oriented predicates msg(), method(), has(), and is_a().
  9.    Objects are implemented using a technique known as frames; 
  10.    the inheritance mechanism is based on the article "Suitable for 
  11.    Framing" by Michael Floyd (Turbo Technix, April/May '87).
  12.    Michael Floyd -- DDJ -- 8/28/90 -- CIS: [76703,4057]  or MCI Mail: MFLOYD
  13. */
  14.    
  15. DOMAINS
  16.    object    = object(string,slots)          % not actually used in examples
  17.    objects   = object*
  18.  
  19.    slot     = slot(string,value)
  20.    slots    = slot*
  21.  
  22.    value    = int(integer) ; ints(integers) ;
  23.               real_(real) ; reals(reals) ;
  24.               str(string) ; strs(strings) ;
  25.               object(string,slots,parents) ; objects(objects)
  26.    parents  = string*
  27.    integers = integer*
  28.    reals    = real*
  29.    strings  = string*
  30.  
  31. % --- OOP preds to be used by the programmer ---
  32. DATABASE
  33.    has(string,slots)            % storage for instance vars 
  34.    is_a(string,string)              % hierarchy relationships
  35. PREDICATES
  36.    msg(string,string)                   % send a message to an object
  37.    method(string, string)               % define a method
  38.  
  39. % --- Internal Predicates not called ditrectly by the programmer ---
  40.    inherit(string,slot)                 % inheritance mechanism
  41.    description(string,slot)             % search for matching clauses
  42.    member(slot,slots)                   % look for object in a list 
  43. CLAUSES
  44.  
  45. /* Inheritance Mechanism */
  46.    inherit(Object,Value):-
  47.       description(Object,Value),!.
  48.    inherit(Object,Value):-
  49.       is_a(Object,Object1),
  50.       inherit(Object1,Value),
  51.       description(Object1,_).
  52.    description(Object,Value):-
  53.       has(Object,Description),
  54.       member(Value,Description).
  55.    description(Object,slot(method,str(Value))):-
  56.       method(Object,Value).
  57.  
  58. /* Simple message processor */         
  59.    msg(Object,Message):-         
  60.      inherit(Object,slot(method,str(Message))).
  61.  
  62. /* Support Clauses  */
  63.     member(X,[X|_]):-!.                   % Find specified member in a list
  64.     member(X,[_|L]):-member(X,L).
  65.  
  66.  
  67. [LISTING TWO]
  68.  
  69. /* File: FIGURES.PRO -- Object Prolog example that models FIGURES example in 
  70.    Turbo C++ and Turbo Pascal documentation
  71.    Michael Floyd -- DDJ -- 8/28/90
  72. */
  73.    
  74. include "bgi.pro"
  75. include "OOP.PRO"
  76.  
  77. domains
  78.    key = escape; up_arrow; down_arrow; left_arrow; right_arrow; other
  79. database - SHAPES
  80.    anyShape(string)   
  81.    
  82. PREDICATES                                     % Support predicates
  83.    horiz(integer, integer, string)
  84.    vert(integer, integer, integer)
  85.    readkey(integer, integer, integer)
  86.    key_code(key, integer, integer, integer)
  87.    key_code2(key, integer, integer, integer)
  88.    repeat
  89.    main
  90.  
  91. CLAUSES
  92. /* Methods */   
  93.  
  94. /* point is an example of an Abstract object. Note that variables passed 
  95.    through the database must be explicitly called by the child 
  96.    method (i.e. variables are not inherited). */
  97.  
  98.    method(point, init):-
  99.       assert(has(point,[slot(x_coord,int(150)),
  100.                  slot(y_coord,int(150))])).
  101.    method(point, done):-
  102.       retractall(has(point,_)).
  103.    method(point,show):-!,
  104.       has(point,[slot(x_coord,int(X)),
  105.                  slot(y_coord,int(Y))]),
  106.       putpixel(X,Y,blue).
  107.    method(point,hide):-!,
  108.       has(point,[slot(x_coord,int(X)),
  109.                  slot(y_coord,int(Y))]),
  110.       putpixel(X,Y,black).
  111.  
  112. /* Example of a virtual method */
  113.    method(point,moveTo):-!,
  114.       anyShape(Object),
  115.       msg(Object,hide),
  116.       retract(has(point,[slot(x_coord,int(DeltaX)),
  117.                            slot(y_coord,int(DeltaY))])),
  118.       msg(Object,show).
  119.    method(point,drag):-
  120.       has(point,[slot(x_coord,int(X)),
  121.                  slot(y_coord,int(Y))]),         
  122.       anyShape(Shape),!,
  123.       msg(Shape,show),
  124.       repeat,
  125.          readkey(Key, DeltaX, DeltaY),
  126.          assertz(has(point,[slot(x_coord,int(DeltaX)),
  127.                            slot(y_coord,int(DeltaY))])),
  128.          msg(point,moveTo),
  129.       Key = 27.
  130.        
  131.  /* Circle Methods */
  132.    method(circle, init):-!,
  133.       method(point, init),
  134.       assert(anyShape(circle)).
  135.    method(circle, done):-!,
  136.       retract(anyShape(circle)),
  137.       method(point, done).
  138.    method(circle, show):-!,
  139.       has(point,[slot(x_coord,int(X)),
  140.                  slot(y_coord,int(Y))]),
  141.       setcolor(white),
  142.       circle(X,Y,50).
  143.    method(circle, hide):-!,
  144.       has(point,[slot(x_coord,int(X)),
  145.                  slot(y_coord,int(Y))]),
  146.       setcolor(black),
  147.       circle(X,Y,50).
  148.    method(circle, drag):-
  149.       msg(circle, hide),
  150.       is_a(circle, Ancestor),
  151.       msg(Ancestor, drag),
  152.       msg(circle, show).
  153.  
  154. /* arc Methods */
  155.    method(arc, init):-!,
  156.       assert(anyShape(arc)),
  157.       assert(has(point,[slot(x_coord,int(150)),
  158.                  slot(y_coord,int(150))])),
  159.       assert(has(arc,[slot(radius,int(50)),
  160.                       slot(startAngle,int(25)),
  161.                       slot(endAngle,int(90))])).
  162.    method(arc, done):-
  163.       retract(anyShape(arc)),!,
  164.       retractall(has(arc,_)),
  165.       method(point, init).
  166.    method(arc, show):-
  167.       has(point,[slot(x_coord,int(X)),
  168.                  slot(y_coord,int(Y))]),
  169.       has(arc,[slot(radius,int(Radius)),
  170.                       slot(startAngle,int(Start)),
  171.                       slot(endAngle,int(End))]),!,
  172.       setcolor(white),
  173.       arc(X, Y, Start, End, Radius).
  174.    method(arc, hide):-
  175.       has(point,[slot(x_coord,int(X)),
  176.                  slot(y_coord,int(Y))]),
  177.       has(arc,[slot(radius,int(Radius)),
  178.                       slot(startAngle,int(Start)),
  179.                       slot(endAngle,int(End))]),!,
  180.       setcolor(black),
  181.       arc(X, Y, Start, End, Radius).
  182.    method(arc,drag):-
  183.       msg(arc, hide),
  184.       is_a(arc,Ancestor),!,
  185.       msg(Ancestor,drag),
  186.       msg(arc, show).
  187.  
  188. /* rectangle Methods */
  189.    method(rectangle,init):-
  190.       has(rectangle,[slot(length,int(L)),
  191.                      slot(width,int(W))]),!.
  192.    method(rectangle,init):-!,
  193.       write("Enter Length of rectangle: "),
  194.       readint(L),nl,
  195.       write("Enter Width of rectangle: "),
  196.       readint(W),nl,
  197.       assert(has(rectangle,[slot(length,int(L)),
  198.                      slot(width,int(W))])).
  199.    method(rectangle,done):-
  200.       retract(has(rectangle,[slot(length,int(L)),
  201.                      slot(width,int(W))])),!.
  202.    method(rectangle,draw):-!,
  203.       has(rectangle,[slot(length,int(L)),
  204.                      slot(width,int(W))]),
  205.       write("Z"),
  206.       horiz(1,L,"D"),
  207.       write("?"),nl,
  208.       vert(1,W,L),
  209.       write("@"),
  210.       horiz(1,L,"D"),
  211.       write("Y"). 
  212.    method(rectangle,draw):-
  213.       write("Cannot draw rectangle"),nl.
  214.  
  215. /* Support Methods */
  216.   horiz(I,L,Chr):-
  217.      I <= L,!,
  218.      TempI = I + 1,
  219.      write(Chr),
  220.      horiz(TempI,L,Chr).
  221.   horiz(I,L,Chr):-!.
  222.      
  223.   vert(I,W,L):-
  224.      I <= W,!,
  225.      TempI = I + 1,
  226.      write("3"),
  227.      horiz(1,L," "),
  228.      write("3"),nl,
  229.      vert(TempI,W,L).
  230.   vert(I,W,L):-!.
  231.  
  232. /* Ancestor/Child relationships - should be stored in consult() file */
  233.    is_a(circle,point).
  234.    is_a(arc,point).
  235.    is_a(triangle,shape).
  236.    is_a(rectangle,shape).
  237.    is_a(solid_rectangle,rectangle).
  238.  
  239. /* Generic clause to read cursor keys - used by the Drag method */
  240.    readkey(Val, NewX, NewY) :- 
  241.       readchar(T), 
  242.       char_int(T, Val),  
  243.       key_code(Key, Val, NewX, NewY).
  244.    key_code(escape, 27, 0, 0) :- !.   
  245.    key_code(Key, 0, NewX, NewY) :- !, 
  246.       readchar(T), 
  247.       char_int(T, Val), 
  248.       key_code2(Key, Val, NewX, NewY).
  249.    key_code2(up_arrow, 72, NewX, NewY) :- !,
  250.       has(point,[slot(x_coord,int(X)),
  251.                          slot(y_coord,int(Y))]),
  252.               NewX = X,
  253.               NewY = Y - 5.
  254.    key_code2(left_arrow, 75, NewX, NewY):- !,
  255.       has(point,[slot(x_coord,int(X)),
  256.                          slot(y_coord,int(Y))]),
  257.               NewX = X - 5,
  258.               NewY = Y.
  259.    key_code2(right_arrow, 77, NewX, NewY) :- !,
  260.       has(point,[slot(x_coord,int(X)),
  261.                          slot(y_coord,int(Y))]),
  262.               NewX = X + 5,
  263.               NewY = Y.
  264.    key_code2(down_arrow, 80, NewX, NewY) :- !,  
  265.       has(point,[slot(x_coord,int(X)),
  266.                          slot(y_coord,int(Y))]),
  267.               NewX = X,
  268.               NewY = Y + 5.
  269.               
  270.    key_code2(other, _,0,0).
  271.  
  272. /* Supports the repeat/fail loop */
  273.    repeat.
  274.    repeat:- repeat.
  275.  
  276. main:-
  277.   nl,
  278.   initialize,                            % init BGI graphics
  279.   makewindow(1,7,0,"",0,0,25,80),
  280.   msg(circle, init),                     % create and manipulate a circle
  281.   msg(circle, show),
  282.   msg(circle, drag),
  283.   msg(circle, done),
  284.   clearwindow,
  285.   msg(arc, init),                        % create and manipulate an arc
  286.   msg(arc, show),
  287.   msg(arc, drag),
  288.   msg(arc, done),
  289.   closegraph,                            % return to text mode
  290.  
  291.   makewindow(2,2,3,"",0,0,25,80),
  292.   msg(rectangle, init),                  % create a rectangle in text mode
  293.   msg(rectangle, draw),
  294.   msg(rectangle, done).
  295.  
  296. goal
  297.    main.
  298.  
  299.  
  300. [LISTING THREE]
  301.  
  302. /* File: BGI.PRO -- Minimum required to detect graphics hardware an initialize
  303.    system in graphics mode using BGI. BGI.PRE is included with PDC Prolog.
  304.    Michael Floyd -- DDJ -- 8/28/90
  305. */   
  306. include    "D:\\prolog\\include\\BGI.PRE"
  307.  
  308. CONSTANTS    
  309.   bgi_Path = "D:\\prolog\\bgi"
  310.  
  311. PREDICATES
  312.   Initialize
  313.  
  314. CLAUSES
  315.   Initialize:-
  316.      DetectGraph(G_Driver, G_Mode),
  317.      InitGraph(G_Driver,G_Mode, _, _, bgi_Path),!.
  318.  
  319. [LISTING FOUR]
  320.  
  321. include "bgi.pro"
  322. include "support.pro"
  323. database - figures
  324.    anyShape(string)
  325.    
  326. point = object
  327.    int XCoord YCoord
  328.    method(init) if XCoord = 150, YCoord = 150.
  329.    method(done) if retract(has(point,_)).
  330.    method(show) if putpixel(XCoord,YCoord,blue).
  331.    method(hide) if putpixel(XCoord,YCoord,black).
  332.    method(moveTo) if
  333.       anyShape(Object),
  334.       msg(Object, hide),
  335.       retract(has(point,_)),
  336.       msg(Object, show).
  337.    method(drag) if 
  338.       anyShape(Shape),
  339.       msg(Shape,show),
  340.       repeat,
  341.          readkey(Key, DeltaX, DeltaY),
  342.          XCoord = DeltaX,
  343.          YCoord = DeltaY,
  344.          msg(point,moveTo),
  345.       Key = 27.
  346. end.
  347.  
  348. circle = object(point)
  349.    int XCoord YCoord
  350.    method(init) if 
  351.       XCoord = 200, YCoord = 200,
  352.       assert(anyShape(circle)).
  353.    method(done) if 
  354.       retract(anyShape(circle)),
  355.       msg(point,done).
  356.    method(show) if 
  357.       setcolor(white),
  358.       circle(XCoord, YCoord, 50).
  359.    method(hide) if 
  360.       setcolor(black),
  361.       circle(XCoord, YCoord, 50).
  362.    method(drag) if 
  363.       msg(circle,hide),
  364.       is_a(circle, Ancestor),
  365.       msg(Ancestor,drag),
  366.       msg(circle,show).
  367. end.
  368.  
  369. arc = object(point)
  370.    int XCoord YCoord Radius StartAngle EndAngle
  371.    
  372.    method(init) if
  373.       Radius = 50, StartAngle = 25, EndAngle = 90,
  374.       msg(point, init).
  375.    method(done) if
  376.       retract(anyShape(arc)),
  377.       retractall(has(arc,_)),
  378.       msg(point, done).
  379.    method(show) if
  380.       setcolor(white),
  381.       arc(XCoord,YCoord,StartAngle,EndAngle,Radius).
  382.    method(hide) if
  383.       setcolor(black),
  384.       arc(XCoord,YCoord,StartAngle,EndAngle,Radius).
  385.    method(drag) if
  386.       msg(arc,hide),
  387.       is_a(arc,Ancestor),
  388.       msg(Ancestor,drag),
  389.       msg(arc,show).
  390. end.
  391.  
  392.  
  393. [LISTING FIVE]
  394.  
  395. /* File: PARSER.PRO -- Implements parser to translate ODL to Object Prolog 
  396.    code. Top-down parser; simulates parse tree through predicate calls.
  397.    Michael Floyd -- DDJ -- 8/28/90
  398. */   
  399. include "lex.pro"
  400.  
  401. DOMAINS 
  402.    file = infile; outfile; tmpfile
  403.    
  404. PREDICATES
  405.    main
  406.    repeat
  407.    gen(tokl)
  408.    scan
  409.    scan_object(tokl,string)
  410.    findAncestor(tokl)
  411.    init_vars
  412.    scan_methods(string)
  413.    getMethEnd(string,string)
  414.    write_includes
  415.    generate_code
  416.    generate_methods
  417.    generate_ancestor(string)
  418.    generate_vars
  419.    fixVar(tokl)
  420.    insert_isa(tokl)
  421.    bindvars(tokl,tokl)
  422.    addVarRef(tokl)
  423.    assert_temp(strings,tokl)
  424.    construct_has(tokl)
  425.    empty(tokl)
  426.    isvar(tokl,tokl)
  427.    is_op(tok)
  428.    value(tok, integer)
  429.    search_ch(CHAR,STRING,INTEGER,INTEGER)
  430.    process(string)
  431.    read(string)
  432.    datatype(string)
  433.     headbody(tokl,tokl,tokl)
  434.    search_msg(tokl,tokl,tokl)
  435.    constVar(string,tok)
  436.    writeSlotVars
  437.    write_seperator(tokl)
  438.    write_comma
  439.    append(tokl,tokl,tokl)
  440.  
  441. CLAUSES
  442.    repeat.
  443.    repeat:- repeat.
  444.  
  445. /**** Parser ****/
  446.    scan:-
  447.       readln(ObjectStr),
  448.       ObjectStr <> "",
  449.       tokl(ObjectStr,ObjList),
  450.       scan_object(ObjList,Object),
  451.       init_vars, 
  452.       scan_methods(Object),!,
  453.       generate_code.
  454.    scan:- scan.
  455.    
  456.    scan_object([H|List],S):-
  457.       member(object,List),
  458.       str_tok(S,H),
  459.       assert(objectname(S)),
  460.       findAncestor(List).      
  461.    scan_object(List,_):- 
  462.       openappend(tmpfile,"headers.$$$"),
  463.       writedevice(tmpfile),
  464.       gen(List),nl,
  465.       writedevice(screen),
  466.       closefile(tmpfile),trace(off),
  467.       fail.
  468.  
  469.    findAncestor(List):-
  470.       member(lpar,List),
  471.       insert_isa(List).
  472.    findancestor(_).
  473.  
  474.    insert_isa([H|List]):-
  475.       str_tok(S,H),
  476.       S <> "(",
  477.       insert_isa(List).
  478.    insert_isa([H1,H2|List]):-
  479.       str_tok(Ancestor,H2),
  480.       assert(ancestor(Ancestor)).
  481.  
  482.    init_vars:-
  483.       readln(VarStr), 
  484.       process(VarStr).
  485.  
  486.    process(VarStr):-
  487.       fronttoken(VarStr,Token, RestStr),
  488.       datatype(Token),
  489.       tokl(VarStr,VarList),!.            % tokenize/init variables
  490.    process(VarStr):-
  491.       assert(unread(VarStr)).
  492.  
  493.    datatype(int).                        % datatypes supported
  494.    datatype(real).
  495.  
  496.    constVar(int,int(_)).                 % convert tok to string
  497.    constVar(real,real_(_)).              
  498.  
  499.    read(Str):-
  500.       retract(unread(Str)),!.
  501.    read(Str):-
  502.       readln(Str).   
  503.  
  504.    scan_methods(MethodId):-
  505.       readln(FirstLn),
  506.       getMethEnd(FirstLn,Method),
  507.       search_ch('(',Method,0,N),          % Find lpar and insert MethodId
  508.       N1 = N+1,                           % and add comma
  509.       fronttoken(MComma,MethodId,","),
  510.       frontstr(N1,Method,Str,OUT1),!,
  511.       fronttoken(Method1,MComma,Out1),
  512.       fronttoken(Method2,Str,Method1),
  513.       tokl(Method2,MList),                % Now Tokenize the method
  514.       not(member(end,MList)),             % Check for End statement
  515.       assert(methods(MList)),             % Store method list
  516.       scan_methods(MethodId).             % Look for more methods
  517.    scan_methods(_):- !.
  518.  
  519.    getMethEnd(Line1,ReturnLn):-
  520.       search_ch('.',Line1,0,N),
  521.       N <> 0,!,
  522.       ReturnLn = Line1.
  523.    getMethEnd(Line1,ReturnLn):-
  524.       readln(Line2),
  525.       fronttoken(AppendLn,Line1,Line2),
  526.       getMethEnd(AppendLn,ReturnLn).
  527.  
  528. /**** Entry point into the code generator ****/
  529.    generate_code:-
  530.       objectname(Object),
  531.       generate_ancestor(Object),
  532.       openappend(tmpfile,"methods.$$$"),
  533.       writedevice(tmpfile),
  534.       generate_methods,
  535.       generate_vars,
  536.       vars(VarList),!,
  537.       openappend(tmpfile,"has.$$$"),
  538.       writedevice(tmpfile),
  539.       write("has(",Object,",",VarList),
  540.       write(")."),nl,
  541.       writedevice(screen),
  542.       closefile(tmpfile),
  543.       retract(objectname(Object)).
  544.    
  545.    generate_vars:-
  546.       findall(Var,var(Var),VarList),     % retrieve vars
  547.       retractall(var(_)),                % cleanup database
  548.       fixVar(VarList),
  549.       findall(X,var(X),Slots),           % retrieve new vars
  550.       retractall(var(_)),                % cleanup database
  551.       assert(vars(Slots)).               % store vars as list of slots
  552.    generate_vars:- !.
  553.  
  554.    fixVar([]):- !.
  555.    fixVar([slot(UpToken,Const)|Rest]):-
  556.       upper_lower(UpToken,Token),
  557.       assert(var(slot(Token,Const))),
  558.       fixVar(Rest).
  559.  
  560.    generate_ancestor(Object):-    
  561.       openappend(tmpfile,"isa.$$$"),     % open temp file for is_a
  562.       writedevice(tmpfile),              % stdout to tmpfile
  563.       objectname(Obj),                   % get current object id
  564.       retract(ancestor(Parent)),         % get parent in hierarchy
  565.       write("is_a(",Obj,",",Parent,")."), % write is_a clause
  566.       nl,
  567.       writedevice(screen),               % stdout to screen
  568.       closefile(tmpfile).                % close temp file
  569.    generate_ancestor(_):-                % always succeed
  570.       writedevice(screen),               % stdout to screen
  571.       closefile(tmpfile).                % close temp file
  572.       
  573.    generate_methods:- 
  574.       retract(methods(Method)),!,
  575.       headBody(Method,Head,Body), 
  576.       bindvars(Body,NewBody),
  577.       gen(Head),
  578.       write(":-"), nl,
  579.       addVarRef(NewBody),
  580.       gen(NewBody),nl,
  581.       generate_methods.
  582.    generate_methods:- 
  583.       writedevice(screen),
  584.       closefile(tmpfile).
  585.  
  586. /* Binding of variable names in for has() lookups */
  587.    addVarRef(Body):-
  588.       findall(Variable, var(slot(Variable,_)), VList),
  589.       findall(X, var(slot(_,X)), XList),
  590.       assert_temp(VList, XList),
  591.       construct_has(Body).
  592.    addVarRef(Body).
  593.       
  594.    assert_temp([],[]):- !.                  
  595.    assert_temp([V|VList],[X|XList]):-
  596.       constVar(Type,X),
  597.       assert(tempvar(V)),
  598.       assert(temptype(Type)),
  599.       assert_temp(VList,XList).
  600.       
  601.    construct_has(Body):-
  602.       objectname(Object),
  603.       write("   has(",Object,",","["),
  604.       writeSlotVars,
  605.       write(")"),
  606.       write_seperator(Body),nl.
  607.       
  608.    write_seperator([]):-
  609.       write(".").
  610.    write_seperator(_):-
  611.       write(",").
  612.  
  613.    writeSlotVars:-
  614.       retract(tempVar(Var)),
  615.       retract(temptype(Type)),
  616.       upper_lower(Var,VarId),
  617.       write("slot(",VarId,", ",Type,"(",Var,"))"),
  618.       write_comma,
  619.       writeSlotVars.
  620.    writeSlotVars:- !,
  621.       write("]").
  622.       
  623.    write_comma:-
  624.       tempvar(_),
  625.       write(",").
  626.    write_comma:- !.
  627.  
  628. /* Append two lists */   
  629.    append([], List, List).
  630.    append([H|List1], List2, [H|List3]):-
  631.       append(List1, List2, List3).
  632.  
  633.    search_msg([H,H2|Body],[],Body):-
  634.       H = msg,
  635.       H2 = lpar.  
  636.    search_msg([H|Method], [H|Head], Body):-
  637.       search_msg(Method,Head,Body).
  638.       
  639.   search_ch(CH,STR,N,N):-                 % Search for char in string
  640.     frontchar(STR,CH,_),!.            % and return its position
  641.   search_ch(CH,STR,N,N1):-
  642.     frontchar(STR,_,S1),
  643.     N2 = N + 1,
  644.     search_ch(CH,S1,N2,N1).
  645.  
  646.    headbody([H|Body],[],Body):-
  647.       str_tok("if",H).   
  648.    headBody([H|Method], [H|Head], Body):-
  649.       headBody(Method,Head,Body).
  650.  
  651.    bindvars(Method,NewMethod):-
  652.       is_op(Op),                              % supports any operator
  653.       member(Op,Method),                      % defined by is_op()
  654.       isvar(Method,[H|RestMethod]),           % locate variable in method
  655.       bindvars(RestMethod,NewMethod).         % look for more vars
  656.    bindvars(NewMethod,NewMethod):- !.         % return Method w/out vars
  657.    
  658.    empty([]).                                 % simple test for empty list
  659.  
  660.    isvar([],[]):-!.   
  661.    isvar([id(X),H2,H3|RestMethod],RestMethod):-
  662.       is_op(H2),
  663.       value(H3,Value),
  664.       objectname(ObjId),
  665.       retract(var(slot(X,_))),!,              % add "var not decl." error here
  666.       assert(var(slot(X,H3))).
  667.    isvar([H|Method],NewMethod):- 
  668.       isvar(Method,NewMethod).
  669.    
  670.    is_op(equals).
  671.    is_op(plus).
  672.    
  673.    value(int(X),X).
  674.    
  675.    gen([]):- !.            
  676.    gen([H|List]):-
  677.       str_tok(S,H),
  678.       write(S),
  679.       gen(List).
  680.       
  681.    write_includes:-
  682.       write("include \"oop.pro\""),nl.
  683.       
  684.    
  685.  main:-
  686.  /**** Reads file (e.g, FIGURES.ODL) specified on command line. First order of
  687.    business is to add error handling for command line processsor. ****/    
  688.    comline(Filename),
  689.    openread(infile, Filename),
  690.    readdevice(infile),
  691.    repeat,
  692.       scan,
  693.       eof(infile),
  694.    readdevice(keyboard),
  695.    openwrite(outfile,"newfig.pro"),
  696.    writedevice(outfile), 
  697.    write_includes,nl,
  698.    file_str("headers.$$$",Headers),
  699.    write(Headers),nl,
  700.    write("clauses\n"),
  701.    file_str("methods.$$$",Methods),
  702.    write(Methods),nl,nl,
  703.    file_str("isa.$$$",Isa),
  704.    write(Isa),nl,nl,
  705.    file_str("has.$$$",Has),
  706.    write(Has),
  707.    writedevice(screen), 
  708.    closefile(outfile),
  709.    closefile(infile),
  710.    deletefile("headers.$$$"),
  711.    deletefile("methods.$$$"),
  712.    deletefile("isa.$$$"),
  713.    deletefile("has.$$$"),
  714.    write("done").
  715.    
  716. goal
  717.    main.
  718.  
  719.  
  720. [LISTING SIX]
  721.  
  722. /* File: LEX.PRO -- Implements scanner which tokenizes ODL. To modify, add 
  723.    appropriate DOMAIN declarations and str_tok definitions.
  724.    Michael Floyd -- DDJ -- 8/28/90
  725. */   
  726.    
  727. DOMAINS
  728.    tok = id(string);   
  729.          int(integer); real_(real) ; 
  730.          plus;         minus;
  731.          mult;         div;
  732.          lpar;         rpar;
  733.          comma;        colon;
  734.          semicolon;    period;
  735.          object;       method;
  736.          msg;          end;
  737.          ancestor;     var(string);
  738.          equals;       if_;
  739.          slash;        bslash;
  740.          slot(string,tok); dummy
  741.  
  742.    tokl = tok*         
  743.    strings = string*
  744.  
  745. DATABASE
  746.    nextTok(string)                         % Token lookahead
  747.    objectname(string)                      % current Object ID
  748.    vars(tokl)                              % variables list
  749.    methods(tokl)                           % methods list
  750.    var(tok)                                % individual var
  751.    ancestor(string)                        % tracks Object's ancestor
  752.    unread(string)
  753.    tempVar(string)
  754.    temptype(string)
  755.  
  756. PREDICATES
  757.    tokl(string, tokl)                      % entry point into the scanner
  758.    tokenize(string,tokl)                   % tokenize a string
  759.    str_tok(string, tok)                    % return individual token
  760.    member(tok, tokl)                       % verify member is in list
  761.    scan_next(string)                       % setup lookahead stack
  762. clauses   
  763.    str_tok("int",slot(Token,int(0))):- 
  764.        retract(nextTok(Token)),!,
  765.        assert(var(slot(Token,int(0)))),
  766.        str_tok("int",_).
  767.    str_tok("int",slot(dummy,int(0))):- !,
  768.       assert(nextTok(dummy)).
  769.    str_tok("real",slot(Token,real_(0))):- 
  770.        retract(nextTok(Token)),!,
  771.        assert(var(slot(Token,real_(0)))),
  772.        str_tok("real",_).
  773.    str_tok("real",slot(dummy,real_(0))):- !.
  774.    str_tok("(", lpar):- !.
  775.    str_tok(")", rpar):- !.
  776.    str_tok("=", equals):- !.
  777.    str_tok("+", plus):- !.
  778.    str_tok("-", minus):- !.
  779.    str_tok("*", mult):- !.
  780.    str_tok("/", div):- !.
  781.    str_tok("\"",bslash):- !.
  782.    str_tok(",", comma):- !.
  783.    str_tok(":", colon):- !.
  784.    str_tok(";", semicolon):- !.
  785.    str_tok(".", period):- !.
  786.    str_tok("if", if_):- !.
  787.    str_tok("object", object):- !.
  788.    str_tok("method", method):- !.
  789.    str_tok("msg", msg):- !.
  790.    str_tok("end", end):-!.
  791. /*   str_tok(Var, var(Var)):-
  792.       frontchar(Var,X,_),
  793.       X >= 'A', X <= 'Z'.*/
  794.    str_tok(ID, id(ID)):-
  795.       isname(ID),!.
  796.    str_tok(IntStr,int(Int)):-
  797.       str_int(Intstr,Int).
  798.  
  799. /* Entry point into the scanner */
  800.    tokl(Str, Tokl):-
  801.       fronttoken(Str, Token, RestStr),
  802.       scan_next(RestStr), 
  803.       tokenize(Str,Tokl).
  804.    tokenize("",[]):- !, retractall(nexttok(_)). 
  805.    tokenize(Str, [Tok|Tokl]):-
  806.       fronttoken(Str, Token, RestStr),
  807.       str_tok(Token, Tok),
  808.       tokenize(RestStr, Tokl).
  809.    scan_next("").
  810.    scan_next(RestStr):-
  811.       fronttoken(RestStr, NextToken, MoreStr), 
  812.       assert(nexttok(NextToken)),
  813.       scan_next(MoreStr).
  814.    member(X,[X|_]):-!.
  815.    member(X,[_|L]):-member(X,L).
  816.  
  817.  
  818.  
  819.