home *** CD-ROM | disk | FTP | other *** search
/ Programmer 7500 / MAX_PROGRAMMERS.iso / CLIPPER / MISC / AIE8911.ZIP / STUBS.ARI < prev    next >
Encoding:
Text File  |  1989-08-28  |  9.5 KB  |  356 lines
  1.  
  2. %%%%%%%%%% end genned decs %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  3.  
  4. :- extrn   stub / 1             : interp.
  5. %  :- extrn   stub_out / 1         : interp.
  6. :- extrn   zzz_turned_off / 1 : interp.
  7. :- extrn   stub_trace / 0 : interp.
  8. :- extrn   zzz_loop / 0   : interp.
  9. :- visible turn / 2 .
  10. :- visible show    / 2 .
  11.  
  12.  
  13. stub_trace( X ) :-
  14.     call( stub_trace ),
  15.     !,
  16.     trace_message(X).
  17. stub_trace( _ ).
  18.  
  19.  
  20. %%%%%%%%%%%%%%% control of stub use %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  21.  
  22.  
  23. turn( Predicate, on    ) :-
  24.       retractall( zzz_turned_off( Predicate )),
  25.        stub_trace( [ Predicate , $ zzz-retracted$]).
  26.  
  27.  
  28. turn( Predicate, off   ) :-
  29.            asserta( zzz_turned_off( Predicate )),
  30.        stub_trace( [ Predicate , $ zzz-asserted$]),
  31.            !.
  32.  
  33. show( Predicate, off) :-
  34.       retractall( zzz_displayed( Predicate )),
  35.        stub_trace( [ Predicate , $ zzz-un-displayed$]).
  36.  
  37.  
  38. show( Predicate, on    ) :-
  39.            asserta( zzz_displayed( Predicate )),
  40.        stub_trace( [ Predicate , $ zzz-displayed$]),
  41.            !.
  42.  
  43.  
  44. use_the_stub_q( Frame) :-
  45.       frame_slot_val( call ,Frame, Call       ),
  46.       functor( Call, Name, Arity),
  47.       current_predicate( Name / Arity ),
  48.       !,
  49.        stub_trace( [ $b predicate_turned_off$]),
  50.       predicate_turned_off( Name / Arity),
  51.        stub_trace( [ $b predicate_turned_off$]).
  52.  
  53. use_the_stub_q( _     ) :-  !.
  54.  
  55. predicate_turned_off( Predicate  ) :-
  56.        stub_trace( [ $e predicate_turned_off, Pred = $,Predicate]),
  57.        fail.
  58.  
  59. predicate_turned_off( Predicate  ) :-
  60.           call( zzz_turned_off( Predicate)),
  61.           !.
  62.  
  63. predicate_turned_off( Name / _     ) :-
  64.     predicate_turned_off( Name  ).
  65.  
  66.  
  67. has_stub( Call, Frame) :-
  68.       stub( Frame ),
  69.       frame_slot_val( call, Frame, Call1   ),
  70.       Call1 = Call.
  71.  
  72. %%%%%%%%%%%%%%% doing the stub %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  73.  
  74.               % trace for debugging
  75. do_stub( Frame ) :-
  76.        stub_trace( [ $E do_stub, Frame = : $]),
  77.        stub_trace( [   Frame ]),
  78.        fail.
  79.  
  80.               % stub execution when stub is a boolean decision
  81. do_stub( Frame ) :-
  82.       is_a_boolean( Frame),
  83.       !,
  84.       yes(  question_prompt( Frame) ,
  85.             q_means_no,
  86.             do_quit  )  .
  87.  
  88.               % stub execution when stub is a loop
  89. do_stub( Frame ) :-
  90.       is_a_loop( Frame),
  91.        stub_trace( [ $I do_stub loop rule $]),
  92.        stub_trace( [ $a is_a_loop$]),
  93.       !,
  94.       do_a_loop( Frame).
  95.  
  96.               % stub execution when stub is an action
  97. do_stub( Frame ) :-
  98.       display_purpose( Frame),
  99.       !.
  100.  
  101. %%%%%%%%%%%%%%%%%%% deciding what kind of stub it is %%%%%%%%%%%%%%%%%%%%%
  102.  
  103. is_a_boolean( Frame ) :-
  104.       frame_slot_val( purpose, Frame, Purpose),
  105.       boolean_purpose( Purpose ).
  106.  
  107.  
  108. is_a_loop( Frame) :-
  109.       frame_slot_val( purpose, Frame, Purpose),
  110.       loop_description_p( Purpose ).
  111.  
  112. loop_description_p( Purpose ) :-
  113.       singular( Purpose, _).
  114.  
  115. boolean_purpose( Purpose ) :-
  116.      string_search( $decide$,  Purpose, _),!.
  117.  
  118. %%%%%%%%%%%%%%%%%%% doing action stubs %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  119.  
  120. display_purpose( Frame ) :-
  121.       !,
  122.       frame_slot_val( call, Frame, Call   ),
  123.       frame_slot_val( purpose, Frame, Purpose),
  124.       log_write( Call),
  125.       log_tab(1),
  126.       log_write( Purpose),
  127.       log_write($.$),
  128.       log_nl.
  129.  
  130. %%%%%%%%%%%%%%%% boolean processsing %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  131. %%%%%%%%%%%%%%%% ( and also used for loop exit ) %%%%%%%%%%%%%%%%%%%%%%%%%%%
  132. %
  133. %   yes( Question  , Q_meaning, Quit_flag )
  134. %
  135. %     Displays Question, insists that the user type
  136. %     Y or N ( upper or lower case ), and then succeeds
  137. %     if user typed Y, or fails if user typed N.
  138. %
  139. %
  140. %   Q_meaning = q_means_yes | q_means_no
  141. %
  142. %   Quit_flag = do_quit   | no_quit
  143. %
  144. %   Usual call:  yes( Question  , q_means_no, do_quit  )
  145. %
  146. %
  147.  
  148.  
  149. yes( Question , Q_meaning, Quit_flag ) :-
  150.    yes_hlpr( Question, Answer),
  151.    !,
  152.    process_q_answer( Answer, Quit_flag),
  153.    answer_means_yes( Answer,  Q_meaning).
  154.  
  155. process_q_answer( q     , do_quit   ) :-
  156.       !,
  157.       halt.
  158. process_q_answer( _     , _     ) :- !.
  159.  
  160.  
  161. answer_means_yes( yes   ,  _           ) :- !.
  162. answer_means_yes( q     ,  q_means_yes ) :- !.
  163.  
  164. yes_hlpr( Question, Answer) :-
  165.     repeat,
  166.         write_question( Question ),
  167.         flush,
  168.         keyb( Char   , Scan),
  169.         log_put( Char),
  170.         log_nl,
  171.         yes_aux( Char, Scan, Answer ).
  172.  
  173. yes_aux( `Q , _ , q   )   :-  !.          /*  Q  */
  174.  
  175. yes_aux( `q , _ , q   )   :-  !.          /*  q  */
  176.  
  177. yes_aux( 89 , _ , yes )   :-  !.          /*  Y  */
  178.  
  179. yes_aux( 121 , _, yes )  :-  !.          /*  y  */
  180.  
  181. yes_aux( 78 , _, no )   :-  !.           /*  N  */
  182.  
  183. yes_aux( 110 ,  _, no )  :-  ! .            /*  n  */
  184.  
  185. yes_aux( 0, 59, _  )  :-
  186.      get_specs_help ,
  187.      !,
  188.      fail.
  189.  
  190. yes_aux(_, _, _ )    :-
  191.                  log_put( 7 ),      /*  beep  */
  192.                  log_write(  ' Please enter a "y" for yes or "n" for no.'  ),
  193.                  log_nl,
  194.                  fail.
  195.  
  196. write_question( Question ) :-
  197.     atomic( Question),
  198.     !,
  199.     log_write( Question).
  200. write_question( Question ) :-
  201.     defined_predicate( Question),
  202.     !,
  203.     call( Question).
  204.  
  205. defined_predicate( Question) :-
  206.    functor( Question, Name, Arity),
  207.    (     system( Name / Arity)
  208.      ;   current_predicate( Name / Arity )).
  209.  
  210.  
  211. % test( yes)  :- yes( $why?$, q_means_yes, do_quit       ).
  212. %
  213. %
  214. %%%%%%%%%%%%%%%% end yes and helpers%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  215.  
  216.  
  217.           % generate prompt for boolean question
  218. question_prompt( Frame) :-
  219.       frame_slot_val( purpose, Frame, Purpose),
  220.       frame_slot_val( call, Frame, Call   ),
  221.       functor( Call, Name, _),
  222.       !,
  223.       log_write(Name   ),
  224.       log_tab(1),
  225.       log_write( Purpose),
  226.       log_write($.$),
  227.       log_nl,
  228.       log_write($Is $),
  229.       log_write( Call),
  230.       log_tab(1),
  231.       log_write($true? ( y or n) : $).
  232.  
  233.  
  234. /********************* loop processing *****************************/
  235.  
  236.             %%%%%%% executing a loop stub %%%%%%%%%%%%%%%%
  237.  
  238. do_a_loop( Frame) :-
  239.             % get rid of old definitions
  240.        stub_trace( [ $e do_a_loop$]),
  241.       abolish( zzz_loop / 0),
  242.       abolish( zzz_loop_hlpr / 0),
  243.  
  244.             % get purpose of procedure defined in stub
  245.       frame_slot_val( purpose, Frame, Purpose),
  246.  
  247.             % get purpose in past form
  248.        stub_trace( [ $b done_it_prompt $]),
  249.       done_it_prompt( Purpose , Done ),
  250.        stub_trace( [ $done_it_prompt = $, Done]),
  251.  
  252.             % get prompt to ask for repeating loop
  253.       another_prompt( Purpose , More ),
  254.        stub_trace( [ $More_it_prompt = $, More]),
  255.  
  256.             % define question to ask user
  257.       Question =
  258.               yes(  log_write( More ) ,
  259.                     q_means_no,
  260.                     do_quit  ) ,
  261.        stub_trace( [ $Question = $, Question ]),
  262.  
  263.             % define the simulated loop
  264.       Loop_rule1 =
  265.         (zzz_loop :-
  266.             repeat,
  267.               zzz_loop_hlpr),
  268.        stub_trace( [ $Loop_rule1 = $, Loop_rule1 ]),
  269.       assertz(  Loop_rule1 ),
  270. /*
  271.       Loop_rule2 = zzz_loop,
  272.       assertz(  Loop_rule2 ),
  273.        stub_trace( [ $Loop_rule2 = $, Loop_rule2 ]),
  274. */
  275.             % and the helper functions for the loop
  276.       Loop_hlpr_rule1 =
  277.           (  zzz_loop_hlpr :-
  278.               Question,
  279.               !,
  280.               log_write( Done),
  281.               log_nl,
  282.               fail),
  283.       assertz(  Loop_hlpr_rule1 ),
  284.        stub_trace( [ $Loop_hlpr_rule1 = $, Loop_hlpr_rule1 ]),
  285.  
  286.       Loop_hlpr_rule2 =
  287.           (  zzz_loop_hlpr :- ! ),
  288.       assertz(  Loop_hlpr_rule2 ),
  289.        stub_trace( [ $Loop_hlpr_rule2 = $, Loop_hlpr_rule2 ]),
  290.  
  291.             % now execute the loop
  292.        stub_trace( [ $b call zzz_loop$]),
  293.       call( zzz_loop ).
  294.  
  295.             %%%%%%% NLP FOR LOOP PROCESSING %%%%%%%%%%%%%%
  296.  
  297. done_it_prompt( Command, Done ) :-
  298.        stub_trace( [ $e done_it_prompt, b action$ ]),
  299.       action( Command, Action),
  300.       !,
  301.        stub_trace( [ $b object$ ]),
  302.       object( Command, Object),
  303.       !,
  304.        stub_trace( [ $b singular$ ]),
  305.       singular( Object, S_object),
  306.       !,
  307.        stub_trace( [ $b past, Action = $ , Action ]),
  308.       past( Action, Past),
  309.       !,
  310.       concat([S_object, $ $, Past,$.$], Done).
  311.  
  312. another_prompt( Command, More ) :-
  313.         object( Command, Object),
  314.         concat([$More $, Object ,$ (y or n) ? $], More).
  315.  
  316. action( Command, Action) :-
  317.       string_search( $ $, Command, Pos),
  318.       substring( Command, 0, Pos, Action).
  319.  
  320. object( Command, Object) :-
  321.       string_search( $ $, Command, Pos),
  322.       Pos1 is Pos+1,
  323.       string_length( Command, L),
  324.       O_lnth is L - Pos1,
  325.       substring( Command, Pos1, O_lnth, Object ).
  326.  
  327.      % find past form of verb given present
  328. past( Action, Past) :-
  329.       list_text( List, Action),     !,
  330.       reverse( List, List1),      !,
  331.       past_hlpr( List1, List2),   !,
  332.       reverse( List2, List3),     !,
  333.       list_text( List3, Past).
  334.  
  335. past_hlpr( [`s, `e | T] ,  [`d, `e | T] ) :- !.
  336. past_hlpr( [ `e | T] ,  [`d, `e | T] ) :- !.
  337. past_hlpr(   T  ,  [`d, `e | T] ) :- !.
  338.  
  339. singular( Plural, Singular) :-
  340.       string_length( Plural, N),
  341.       M is N-1  ,
  342.       nth_char(M, Plural, `s),
  343.       substring( Plural , 0, M, Singular).
  344.  
  345. /***************** the test   *************************************/
  346. /*
  347. EXAMPLE OF A TEST
  348.  
  349. test :- do_goal(
  350.     process_housing_unit( 1 )
  351.     ).
  352. */
  353. /************* end the test   *************************************/
  354.  
  355. %%%%%%%%%%%%%%%%%%%%%%%%%%%% eof %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  356.