home *** CD-ROM | disk | FTP | other *** search
/ Power-Programmierung / CD1.mdf / magazine / aijournl / 1988_08 / codebox.asc next >
Encoding:
Text File  |  1988-05-04  |  19.4 KB  |  547 lines
  1. ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
  2.  
  3.        Generating List Mapping Predicates
  4.  
  5. program_list_map( Predicate_name,
  6.                   Element_predicate) :-
  7.                 % build the head for the null list rule
  8.          Null_list_rule_head =.. [ Predicate_name, [] , [] ],
  9.                 % assert the null list rule, including a cut
  10.          asserta(( Null_list_rule_head  :- !)),
  11.                 % build recursive rule head
  12.          Recursive_rule_head =.. [ Predicate_name, [H | T] , [H1 | T1] ],
  13.                 % build call for Element_predicate
  14.          Element_predicate_call =.. [ Element_predicate , H, H1 ],
  15.                 % build recursive call
  16.          Recursive_call =.. [ Predicate_name , T, T1 ],
  17.                 % assert recursive rule
  18.          assertz( ( Recursive_rule_head :-
  19.                            Element_predicate_call,
  20.                            Recursive_call )).
  21.  
  22.  
  23.                   Box 1
  24.  
  25. ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
  26.  
  27.                A Program Scheme with Comments
  28.  
  29.       $  /*  Predicate_name User_defined_purpose */
  30.           /*  Predicate_name maps null set into null set */
  31.        Predicate_name( [], []) :- !.
  32.           /*  recursive rule for Predicate_name */
  33.        Predicate_name( [H|T], [H1|T1]) :-
  34.                  /* apply Element_predicate to head of list */
  35.               Element_predicate( H, H1),
  36.                  /* recurse with Predicate_name on tail of list */
  37.               Predicate_name(T, T1).   $,
  38.  
  39.  
  40.                      Box 2
  41.  
  42. ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
  43.  
  44.        Information in a Programmer's Scheme
  45.  
  46. [comment([$/*$, var($Predicate_name$),
  47.                 var($User_defined_purpose$), $*/$]),
  48.  comment([$/*$, var($Predicate_name$),
  49.                 $maps$, $null$, $set$, $into$, $null$, $set$, $*/$]),
  50.  rule((var_functor_term(var($Predicate_name$),[[],[]]) :- [$!$])),
  51.  comment([$/*$,$recursive$,$rule$,$for$,var($Predicate_name$),$*/$]),
  52.  rule((var_functor_term(var($Predicate_name$),
  53.                             [[var($H$) | var($T$)],
  54.                              [var($H1$) | var($T1$)]]) :-
  55.          [ comment([$/*$, $apply$, var($Element_predicate$),
  56.                           $to$, $head$, $of$, $list$, $*/$]),
  57.            var_functor_term(var($Predicate_name$),
  58.                              [var($H1$) ,  var($H1$)]),
  59.            comment([$/*$, $recurse$, $with$,
  60.                           var($Predicate_name$), $*/$]),
  61.            var_functor_term(var($Predicate_name$),
  62.                             [var($T1$) ,  var($T1$)]) ]))]
  63.  
  64.                   Box 4
  65.  
  66. ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
  67.  
  68.  
  69.            A BNF for Prolog Program Schemes
  70.  
  71.      % a schema definition is a list of items (clauses or comments)
  72. scheme_def --> item | scheme_def | []
  73.  
  74.      % an item is a clause or comment
  75. item --> clause | comment
  76.  
  77.      % an clause is a fact or rule
  78. clause --> fact | rule
  79.  
  80.      % a fact is a term followed by a period
  81. fact --> term .
  82.  
  83.      % a rule is a term (the head) followed by the neck symbol
  84.      % followed by a (rule) body followed by a period
  85. rule --> term :- body .
  86.  
  87.      % a body is a comment followed by body
  88.      % or a term followed by a comma followed by a body
  89.      % or a term or a comment
  90. body --> comment body | term , body | term  | comment
  91.  
  92.      % a term is a functor symbol followed by an argument list
  93.      % or a set or a constant or a variable
  94. term --> functor_symbol arg_list | set | constant | variable
  95.  
  96.      % an arg_list is a term_list in parens
  97. arg_list --> ( termlist )
  98.  
  99.      % a term_list is a term followed by a ter_list or a term
  100. term_list --> term term_list | term
  101.  
  102.      % a functor symbol is an atom or variable
  103. functor_symbol --> atom | variable
  104.  
  105.      % a set is a list of terms or the empty list
  106. set  --> [ set_termlist  | []
  107.  
  108.      % a termlist is a term followed by a comma followed by a termlist
  109.      % or a term followed by a right bracket
  110.      % or a term, a bar, a term, and a right bracket
  111. set_termlist --> term, set_termlist | term  ] |  term bar term ]
  112.  
  113.      % def. of bar
  114. bar --> |
  115.  
  116.      % a comment is a comment starter followed by a (comment)
  117.      % word list
  118. comment        --> start_comment word_list
  119.  
  120.      % a word_list is a word followed by a word_list
  121.      % or an end of comment
  122. word_list      --> word word_list | end_comment
  123.  
  124.      % a word is a variable or a token
  125. word           --> variable | token
  126.  
  127. start_comment  --> /*
  128.  
  129. end_comment    --> */
  130.  
  131.                   Box 5
  132.  
  133. ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
  134.  
  135.           A Definite Clause Grammar for Schemes
  136.  
  137.  
  138. scheme_def(Scheme) --> item(H), scheme_def( T),
  139.                          {Scheme= [ H | T],
  140.                           p_trace($Scheme : $, Scheme)},!.
  141. scheme_def([],[],[]) :- p_trace($Scheme = [] $),!.
  142.  
  143. item(X) --> fact(X) , !,{p_trace($item : $, X)}.
  144. item(X) --> rule(X) , !,{p_trace($item : $, X)}.
  145. item(X) --> comment(X) , !,{p_trace($item : $, X)}.
  146.  
  147. fact(fact(Fact)) --> term( Fact), [$.$],
  148.                      {p_trace($Fact : $,Fact)}.
  149.  
  150. rule(Rule) --> term(Head), [$:-$],
  151.                {p_trace($starting rule body$)},
  152.                body(Body),
  153.                {Rule = rule((Head :- Body)),
  154.                 p_trace($Rule : $,Rule)}.
  155.  
  156. body( Body ) -->   comment(H), body(T),!,
  157.                    { Body = [H | T],
  158.                      p_trace($Body : $,Body)}.
  159. body( Body ) -->   term(H), [$,$], body(T),!,
  160.                    { Body = [H | T],
  161.                      p_trace($Body : $,Body)}.
  162. body( [Term]) -->  term( Term), [$.$],!,
  163.                    {p_trace($Body : $, Term)}.
  164. body( [Comment]) -->  comment(Comment), [$.$],!,
  165.                       {p_trace($Body : $, Comment)}.
  166.  
  167.      % a term is a functor symbol followed by an argument list
  168.      % or a set or a constant or a variable or a set
  169. term(Term) --> variable(Variable), [$($],
  170.                {p_trace($entering arg_list $)},
  171.                arg_list(Arg_list), !,
  172.                {Term = var_functor_term( Variable, Arg_list),
  173.                 p_trace($term: $,Term)}.
  174.  
  175. term(Term) --> is_atom(X), [$($], arg_list(Arg_list), !,
  176.                {Term = const_functor_term( X, Arg_list),
  177.                 p_trace($term: $,Term)}.
  178.  
  179. term(X) --> set(X), ! , { p_trace($term: $,X)}.
  180.  
  181. term(X) --> is_atomic(X), ! , { p_trace($term: $,X)}.
  182.  
  183. term(X) --> variable(X), ! , { p_trace($term: $,X)}.
  184.  
  185. arg_list(Arglist = [Term | Termlist]) --> term(Term) ,
  186.                                 arg_list_hlpr(Termlist),!,
  187.                                 { Arglist = [Term | Termlist],
  188.                                   p_trace($arg_list: $,Arglist)}.
  189.  
  190. arg_list_hlpr([]) -->  [$)$] , !,
  191.                        { p_trace($arg_list_hlpr: []$)}.
  192. arg_list_hlpr(Termlist) --> [$,$] , arg_list( Termlist) , !,
  193.                        { p_trace($arg_list_hlpr: $,
  194.                                  Termlist )}.
  195.  
  196.      % set  --> [ termlist
  197. set( Set ) --> [$[$], termlist(Set),!,{p_trace($Set : $,Set)}.
  198.      % set  --> [ ]
  199. set( Set ) --> [$[$,$]$],{Set = [], p_trace($Set : $,Set)}.
  200.  
  201. termlist(Termlist) --> term(H), termlist_hlpr(T),
  202.                        { Termlist = [H | T],
  203.                         p_trace($termlist : $, Termlist)}.
  204. termlist_hlpr([]) --> [$]$],!,{p_trace($termlist : []$)}.
  205. termlist_hlpr(T) --> [$|$], term(T),[$]$],!,
  206.                      {p_trace($termlist : $, T)}.
  207. termlist_hlpr(T) --> comma($,$), termlist(T), !,
  208.                      {p_trace($termlist : $, T)}.
  209.  
  210. comment( Comment ) --> start_comment( H), word_list(T),
  211.                                 { Comment = comment([H | T]),
  212.                                   p_trace($Comment : $,Comment) }.
  213.  
  214.         % the straightforward implementation, like that of
  215.         % start_comment, did not work properly
  216. end_comment($*/$) --> [$*/$].
  217.  
  218. start_comment($/*$) --> [$/*$].
  219.  
  220.           % word_list --> word word_list | end_comment
  221. word_list( [H | T] ) --> word(H), word_list( T ), !.
  222. word_list( [H] ) --> end_comment( H ).
  223.  
  224.           % word --> variable | token
  225. word(X) --> variable(X),!.
  226.           % don't let an end of comment be a word
  227. word(X) --> end_comment(X), !, {fail}.
  228. word(X) --> token(X).
  229.  
  230.           % returns a variable inside a var(*) marker
  231. variable(var(X)) --> [X], % get the next token
  232.                      % get its first character
  233.                 {nth_char(0,X,Char),
  234.                      % see if it's upper case
  235.                  is_uc(Char)}.
  236.  
  237.            % get an atom from input stream
  238. is_atom(X)  --> [X], % get the next token
  239.                    % get its first character
  240.                {nth_char(0,X,Char),
  241.                    % see if it's lower case
  242.                is_lc(Char)}.
  243.  
  244.            % get an atomic structure from input stream
  245. is_atomic(X)  --> [X], % get the next token
  246.                    % see if it's atomic
  247.                   {atomic(X)},!.
  248.  
  249. comma(X) --> [$,$],!.
  250.  
  251.      % returns an arbitrary token as itself
  252. token(X) --> [X],!.
  253.  
  254.  
  255.                         Box 6
  256.  
  257. ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
  258.  
  259.                A User-Supplied Scheme Fact
  260.  
  261. scheme( program_list_map,
  262.  
  263.       $  /*  Predicate_name User_defined_purpose */
  264.                .......................
  265.            < complete scheme from Box 2 goes here>
  266.                .......................
  267.               Predicate_name(T, T1).   $,
  268.  
  269.      [ $Predicate_name$ : $name of predicate to be defined$,
  270.        $User_defined_purpose$ :
  271.              $description of what the predicate does$,
  272.        $Element_predicate$ : $predicate that maps set elements$]).
  273.  
  274.                      Box 7
  275. ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
  276.  
  277.          Converting a Scheme to Internal Form
  278.  
  279. preprocess( scheme( Name, Scheme, Table),
  280.             internal_scheme( Name, Internal_Scheme,
  281.                              Table) :-
  282.                % tokenize the input
  283.             tokenize(Scheme,  Tokens),
  284.                % build scheme semantic structure
  285.             scheme_def( Internal_Scheme, Tokens, []).
  286.  
  287.                       Box 8
  288.  
  289. ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
  290.  
  291.                Top Level of Code Generation
  292.  
  293.          % generate code from a scheme given its name
  294. process( Scheme_name) :-
  295.           % look up internal scheme
  296.      internal_scheme( Name, Internal_Scheme,
  297.                       Table),
  298.           % get the values of variables in Table,
  299.      get_variable_values(Table, Values),
  300.           % get temporary file for code
  301.       temporary_file_handle(Temp_file_name, Temp_file_handle),
  302.           % get the file name where the code should go permanently
  303.       get_destination_file(Peramanent_filename),
  304.           % generate the code
  305.       generate_code(Temp_file_handle, Values, Internal_Scheme),
  306.           % close temp file
  307.       close( Temp_file_handle ),
  308.           % append code to the permanent file
  309.       append_files( Temp_file_name, Peramanent_filename).
  310.  
  311.  
  312.      % get the values of variables in a scheme Table
  313. get_variable_values(Table, Values) :-
  314.          % get Table in reverse order to make questions
  315.          % come out in forward order during recursion
  316.       reverse(Table, Reversed_table),
  317.          % ask questions and build frame of variable values
  318.       ask_questions( Reversed_table, Values0),
  319.          % put attribautes back in original order
  320.       reverse(Values0, Values).
  321.  
  322.          % ask questions and build frame of variable values
  323. ask_questions( [], [] ) :- !.
  324. ask_questions( [H | T], [H1 | T1] ) :-
  325.           ask_question(H , H1),
  326.           ask_questions(T , T1).
  327.  
  328.          % ask the user a question
  329. ask_question(  Variable : Question,
  330.                 Variable : Value) :-
  331.                 % write question to screen
  332.           write( Question),write($ ? $),
  333.                 % read user response
  334.           read_line(1, Value).
  335.  
  336.     % append File2 to File1
  337. append_files( File1, File2) :-
  338.              % build a DOS copy command that appends files
  339.          concat([$copy $,File1,$+$,File2,$,$,File1],Cmd),
  340.              % send it to DOS
  341.          shell(Cmd).
  342.  
  343.                   Box 10
  344.  
  345. ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
  346.  
  347.              Code Generation
  348.  
  349.           % generate the output code.  Scheme is input stream.
  350.           % This is written as a Prolog predicate instead of
  351.           % a grammar rule because of a suspected bug in the DCG
  352.           % translator
  353. generate_code_hlpr(Temp_file_handle, Values,
  354.                       % does the input start with a comment
  355.                    [comment(X) | Rest],
  356.                    Left_over) :-
  357.           o_trace($e generate_code_hlpr$),
  358.                   % generate initial comment with 0 indent
  359.           generate_comment( Temp_file_handle, Values, 0,
  360.                             [comment(X)],[]),!,
  361.                    % blank line after this comment
  362.          nl(Temp_file_handle),
  363.          o_trace($a initial comment$),
  364.           % generate each clause in turn
  365.          generate_clauses( Temp_file_handle, Values,
  366.                            Rest, Left_over).
  367.  
  368. generate_code_hlpr(Temp_file_handle, Values) -->
  369.           % otherwise just generate clauses
  370.        generate_clauses( Temp_file_handle, Values).
  371.  
  372.  
  373. generate_comment( Handle, Values, Offset) -->
  374.        {o_trace($e generate_comment$)},
  375.        [comment([$/*$ | X])],
  376.        { nl(Handle), tab(Handle,Offset), write(Handle, $/*$),
  377.          generate_comment_hlpr( Handle,
  378.                                  Values, X, [])},!.
  379.  
  380. generate_comment_hlpr( Handle, Values) -->
  381.               [$*/$],{write_spaced_token(Handle,$*/$)},!.
  382. generate_comment_hlpr( Handle, Values) -->
  383.               scheme_token( Values, Value),
  384.               {write_spaced_token(Handle, Value)},
  385.               generate_comment_hlpr( Handle, Values).
  386.  
  387. write_spaced_token(Handle, Value) :-
  388.           tab(Handle, 1), write(Handle, Value).
  389.  
  390. scheme_token( Values, Value) -->
  391.      [var(Indicator)],!,
  392.      {get_frame_value_with_default(Values, Indicator,
  393.                                    Indicator, Value),
  394.       o_trace($Token = $,Value)}.
  395. scheme_token( Values, Value) -->  [Value],
  396.       {o_trace($Token = $, Value)}.
  397.  
  398.  
  399. %%%%%%%%%%%%%%%%%%% tests %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  400.  
  401. test :- generate_code(1,   % put output to screen for test
  402.                 % Here are the values of the template variables
  403.           [$Predicate_name$ :  list_of_types,
  404.            $User_defined_purpose$ :
  405.    $maps a list into a list of types elementwise$,
  406.            $Element_predicate$ :  type],
  407.                 % Here is the processed template
  408. [comment([$/*$, var($Predicate_name$),
  409.                 var($User_defined_purpose$), $*/$]),
  410.  comment([$/*$, var($Predicate_name$),
  411.                 $maps$, $null$, $set$, $into$, $null$, $set$, $*/$]),
  412.  rule((var_functor_term(var($Predicate_name$),[[],[]]) :- [$!$])),
  413.  comment([$/*$,$recursive$,$rule$,$for$,var($Predicate_name$),$*/$]),
  414.  rule((var_functor_term(var($Predicate_name$),
  415.                             [[var($H$) | var($T$)],
  416.                              [var($H1$) | var($T1$)]]) :-
  417.          [ comment([$/*$, $apply$, var($Element_predicate$),
  418.                           $to$, $head$, $of$, $list$, $*/$]),
  419.            var_functor_term(var($Element_predicate$),
  420.                              [var($H1$) ,  var($H1$)]),
  421.            comment([$/*$, $recurse$, $with$,
  422.                           var($Predicate_name$), $*/$]),
  423.            var_functor_term(var($Predicate_name$),
  424.                             [var($T1$) ,  var($T1$)]) ]))]
  425.          ).
  426.  
  427.                   Box 11
  428.  
  429. ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
  430.  
  431.                 Retrieval from Frames
  432.  
  433.  
  434. /* This predicate gets a Value from a Frame given an Indicator
  435.    (slot name).  It gets the Value stored in the frame if there
  436.    is one, and Default otherwise.
  437. */
  438.           % rule after frame is searched
  439. get_frame_value_with_default( [], _, Default, Default) :-!.
  440.           % rule for when the value is in the first pair
  441. get_frame_value_with_default( [Indicator : Value | _],
  442.                                Indicator, _, Value):- !.
  443.           % recursive rule
  444. get_frame_value_with_default( [_|T], Indicator, Default, Value) :-
  445.      get_frame_value_with_default( T, Indicator, Default, Value).
  446.  
  447.  
  448.                  Box 12
  449.  
  450. ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
  451.  
  452.                A Test of the Code Generator
  453.  
  454. /* Here is the test: the box 2 template with some scheme
  455.    variable values.  */
  456.  
  457. test :- generate_code(1,   % put output to screen for test
  458.                 % Here are the values of the template variables
  459.           [$Predicate_name$ :  list_of_types,
  460.            $User_defined_purpose$ :
  461.    $maps a list into a list of types elementwise$,
  462.            $Element_predicate$ :  type],
  463.                 % Here is the processed template
  464. [comment([$/*$, var($Predicate_name$),
  465.                 var($User_defined_purpose$), $*/$]),
  466.  comment([$/*$, var($Predicate_name$),
  467.                 $maps$, $null$, $set$, $into$, $null$, $set$, $*/$]),
  468.  rule((var_functor_term(var($Predicate_name$),[[],[]]) :- [$!$])),
  469.  comment([$/*$,$recursive$,$rule$,$for$,var($Predicate_name$),$*/$]),
  470.  rule((var_functor_term(var($Predicate_name$),
  471.                             [[var($H$) | var($T$)],
  472.                              [var($H1$) | var($T1$)]]) :-
  473.          [ comment([$/*$, $apply$, var($Element_predicate$),
  474.                           $to$, $head$, $of$, $list$, $*/$]),
  475.            var_functor_term(var($Element_predicate$),
  476.                              [var($H1$) ,  var($H1$)]),
  477.            comment([$/*$, $recurse$, $with$,
  478.                           var($Predicate_name$), $*/$]),
  479.            var_functor_term(var($Predicate_name$),
  480.                             [var($T1$) ,  var($T1$)]) ]))]
  481.          ).
  482.  
  483.  
  484. /*  Here is the generated code:  */
  485.  
  486. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  487.  
  488.  
  489. /* list_of_types maps a list into a list of types elementwise */
  490.  
  491.           /* list_of_types maps null set into null set */
  492. list_of_types([], []) :-
  493.                     !.
  494.  
  495.           /* recursive rule for list_of_types */
  496. list_of_types([H | T], [H1 | T1]) :-
  497.                     /* apply type to head of list */
  498.                     type(H1, H1),
  499.                     /* recurse with list_of_types */
  500.                     list_of_types(T1, T1).
  501.  
  502.  
  503.  
  504. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  505.  
  506.  
  507.                Box 13
  508.  
  509. ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
  510.  
  511.           A Scheme for Selecting a Scheme
  512.  
  513. internal_scheme(
  514.       sort,
  515.       [$memory_size$ : $how much memory do you have$,
  516.        $sort_size$ : $how many items do you have to sort$,
  517.        $item_size$ : $how big is each item$],
  518.       sort_helper).
  519.  
  520. sort_helper( Variables) :-
  521.       get_frame_value(Variables, $memory_size$, Memory),
  522.       get_frame_value(Variables, $sort_size$, Items),
  523.       get_frame_value(Variables, $item_size$, Size),
  524.       select_sort( Memory, Items, Size).
  525.  
  526. select_sort( Memory, Items, Size) :-
  527.        Size < 20,
  528.        process(insert_sort).
  529.  
  530. select_sort( Memory, Items, Size) :-
  531.        Required is Items * Size + 10E5,
  532.        Memory > Required,
  533.        process(quick_sort).
  534.  
  535. select_sort( _, _, _) :-
  536.        process(merge_sort).
  537.  
  538.                 Box 14
  539.  
  540. ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
  541.  
  542. 
  543.        process(merge_sort).
  544.  
  545.                 Box 14
  546.  
  547. ~~~~~~~~~~~~~~~~~~~~~~