home *** CD-ROM | disk | FTP | other *** search
/ Programmer 7500 / MAX_PROGRAMMERS.iso / CLIPPER / MISC / AIE8911.ZIP / FILEMOD.ARI < prev    next >
Encoding:
Text File  |  1989-08-27  |  16.0 KB  |  583 lines
  1.  
  2.  
  3.  
  4. %%%%%%%%%% end prepcomp generated declarations %%%%%%%%%%%%%%%%%%%%
  5.  
  6.  
  7. % :- module filemod.
  8.  
  9. :- visible testfn / 1 .
  10. :- extrn
  11.        already_at_eof / 1 : interp.
  12.  
  13. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  14. %%%%%%%%%%%%%%%%%%%%%  tracing %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  15. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  16.  
  17.  
  18. file_trace(X) :- trace_message( file_trace, X  ).
  19.  
  20.  
  21. filenames_trace(X) :- trace_message( filenames_trace , X).
  22.  
  23.  
  24. /*
  25. #########################################################################
  26.                  reconsult_if_there -- with no message to user
  27. #########################################################################
  28.  
  29. Purpose:
  30.  
  31.     reconsults a file if it is there
  32.  
  33. Call:
  34.  
  35.     reconsult_if_there(Filename)
  36.  
  37. Input args:
  38.  
  39.  
  40.     Filename = name of file to reconsult
  41.  
  42. Output args:
  43.  
  44.     none
  45.  
  46. Success conditions:
  47.  
  48.     always succeeds
  49.  
  50. Effect:
  51.  
  52.     If the file Filename exists, it is reconsulted.  If Filename does not
  53.     exist,  reconsult_if_there has no effect.
  54. */
  55.  
  56. reconsult_if_there(Filename) :-
  57.       file_exists(Filename),
  58.       reconsult(Filename),!.
  59. reconsult_if_there(_).
  60.  
  61.  
  62.  
  63. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  64. %%%%%%%%%%%%%%%%%%%%%  open_if_possible  %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  65. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  66.  
  67. open_if_possible( KB_file,
  68.                   _,
  69.                   Inhandle) :-
  70.       file_exists( KB_file),
  71.       open(Inhandle,  KB_file  , r), !.
  72.  
  73. open_if_possible( KB_file,
  74.                   Msg,
  75.                   _) :-
  76.        log_write(KB_file),
  77.        log_write( Msg),
  78.        log_nl,
  79.        fail.
  80.  
  81. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  82. %%%%%%%%%%%%%%%%%%%%% process_file_lines %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  83. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  84. /*
  85.    Purpose:  to apply a Prolog goal to every line in the file,
  86.              checking for whether the file is there, and
  87.              doing all file housekeeping.
  88.  
  89.    Input parms:
  90.  
  91.         LineVar = a variable that gets successively set to each
  92.               line in the file
  93.  
  94.         Inhandle = handle of input file
  95.  
  96.         Outhandle = handle of output file
  97.  
  98.         Term = a Prolog goal containing the Var's.  Term is tried with
  99.                LineVar set to each line in the file in succession
  100.                and HandleVar set to the output file handle
  101.  
  102.    Success conditions:
  103.  
  104.           succeeds when the goal is successfully applied to the file.
  105.  
  106.    Notes:
  107.  
  108.    applies Term to each line in Filename.
  109.    LineVar is the variable in Term which each line in turn gets
  110.         substituted for.
  111.    Keeps going even if Term fails on some lines until end of file.
  112.    Succeeds iff file is successfully processed.
  113.  
  114. */
  115.  
  116. :- mode  process_file_lines( +, +, +, +).
  117.  
  118. process_file_lines( LineVar,
  119.                     Inhandle,
  120.                     Outhandle,
  121.                     Term      ) :-
  122.         file_trace([$e process_file_lines$]),
  123.       process_file_lines_hlpr( LineVar, Inhandle, Outhandle, Term ),
  124.       !,
  125.       (       valid_handle( Outhandle),
  126.               write( Outhandle,
  127. $%%%%%%%%%%%%%%%%%%%%%%%%% eof %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%$),
  128.               nl( Outhandle),
  129.               log_write(
  130. $%%%%%%%%%%%%%%%%%%%%%%%%% eof %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%$),
  131.               log_nl ,
  132.               close( Outhandle)
  133.           ;   true),
  134.       close(Inhandle).
  135. process_file_lines( _  , Filename, _         ) :-
  136.       trace_message([$unable to process $,Filename]),fail.
  137.  
  138. valid_handle( Outhandle) :-
  139.      integer( Outhandle),
  140.      Outhandle > 0.
  141.  
  142. %%%%%%%%%%%%%%% process_file_lines_hlpr %%%%%%%%
  143.  
  144. :- mode process_file_lines_hlpr( +,  +, +, +).
  145.  
  146. process_file_lines_hlpr( Var, Inhandle, Outhandle, Term )     :-
  147.       repeat,
  148.         file_trace([$b process_file_line  $  ]),
  149.         process_file_line(Var, Inhandle, Outhandle, Term ) .
  150.  
  151. %%%%%%%%%%%%%%% process_file_line %%%%%%%%
  152.  
  153. :- mode process_file_line( +, +, +, +).
  154.  
  155. process_file_line( Var, Inhandle,   Outhandle , Term        ) :-
  156. %       log_write($ process file line trace rule$), nl,
  157.         file_trace([$e process_file_line  trace rule$ ,
  158.                     Var, $ $,
  159.                     Inhandle, $ $,
  160.                     Outhandle, $ $,
  161.                     Term
  162.                     ]),
  163.         fail.
  164.  
  165. process_file_line( Var, Inhandle,   Outhandle , Term        ) :-
  166.         file_trace([$e process_file_line  eof rule  $ ]),
  167.       retract(already_at_eof(Inhandle)),!,
  168.         file_trace([$x process_file_line  r 1$ ]).
  169.  
  170. process_file_line(Var, Inhandle, Outhandle, Term  )    :-
  171.         file_trace([$e process_file_line  main rule $ ]),
  172.       gc,
  173.       get_next_line(Inhandle,Line),!,
  174.         file_trace([$i process_file_line  Line = $, Line ]),
  175. %     log_write($at $), log_write(Line),nl,
  176.       process_file_line1(Var,  Inhandle, Line, Outhandle, Term ),
  177.       !,
  178.       fail.
  179.  
  180. process_file_line(  _  , _    , _    , _        )  :-
  181.         file_trace([$x process_file_line  $ ]).
  182.  
  183. %%%%%%%%%%%%%%% unread_line_to_handle %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  184. /*
  185. CALL:
  186.  
  187.       unread_line_to_handle(Inhandle,Line)
  188.  
  189. INPUTS:
  190.  
  191.       Inhandle = the handle to read from
  192.  
  193. OUTPUTS:
  194.  
  195.       Line = the line read.
  196.  
  197. PURPOSE:
  198.  
  199.       Unreads a line from a file.
  200. */
  201.  
  202. :- mode unread_line_to_handle( +, -).
  203.  
  204. unread_line_to_handle( Inhandle, Line) :-
  205.        asserta( zzz_read_from_handle( Inhandle, Line)),
  206.        !.
  207.  
  208.  
  209. %%%%%%%%%%%%%%% process_file_line1 %%%%%%%%
  210.  
  211. :- mode process_file_line1( +, +, +, +, +).
  212.  
  213. process_file_line1( _  ,  Inhandle , Line  , _   , _        )  :-
  214.         file_trace([$e process_file_line1 eof rule  $ ]),
  215.        is_eof(Line),!,
  216.        asserta(already_at_eof(Inhandle)).
  217.  
  218. process_file_line1( Var, _,  Line, Outhandle, Term  )     :-
  219.         file_trace([$e process_file_line1 main rule $ ]),
  220.       Var = Line,
  221.       once( call( Term) ), ! .
  222.  
  223. list_of_lines(In_handle, List) :-
  224.     list_of_lines_hlpr(In_handle, [],  List) .
  225.  
  226. list_of_lines_hlpr( In_handle, Sofar,  List) :-
  227.     get_next_line( In_handle, Line), !,
  228.     (      blank_line( Line),
  229.            !,
  230.            reverse( Sofar, List)
  231.       ;    list_of_lines_hlpr( In_handle, [Line  | Sofar] ,  List) ).
  232. list_of_lines_hlpr( In_handle, Sofar,  Sofar).
  233.  
  234.  
  235. %%%%%%%%%%%%%%% get_next_line %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  236. /*
  237. CALL:
  238.  
  239.       get_next_line(Inhandle,Line)
  240.  
  241. INPUTS:
  242.  
  243.       Inhandle = the handle to read from
  244.  
  245. OUTPUTS:
  246.  
  247.       Line = the line read.
  248.  
  249. SUCCESS CONDITIONS:
  250.  
  251.       There is an unused line from the input handle to be processed.
  252. */
  253.  
  254. :- mode get_next_line( +, -).
  255.  
  256.  
  257. get_next_line( Inhandle, Line) :-
  258.       call(already_at_eof(Inhandle)),
  259.       !,
  260.       Line = $ $.
  261.  
  262. get_next_line(  Inhandle, Line) :-
  263.        retract( zzz_read_from_handle( Inhandle, Line)),
  264.        !.
  265.  
  266. get_next_line( Inhandle, Line) :-
  267.       gc,
  268.       read_line(Inhandle,Line0),!,
  269.       log_write($at $), log_write(Line0),log_nl,
  270.       (        is_eof(Line0),!,
  271.                asserta(already_at_eof(Inhandle)),
  272.                Line = $ $
  273.           ;    Line = Line0).
  274.  
  275.  
  276.  
  277. /*
  278. #########################################################################
  279.                  is_eof : succeeds at end of file
  280. #########################################################################
  281.  
  282.    */
  283. % This first rule is just to trace with -- comment it out if U do not
  284. % want to trace this pred.
  285.  
  286.  
  287. % is_eof(X):- file_trace([$ e is_eof, Arg = $,X]),
  288. %           fail.
  289.  
  290. is_eof( Line) :-
  291.     string_length( Line, Lnth),
  292.     Last_pos is Lnth - 1,
  293.     nth_char( Last_pos, Line, 26),  % is ascii 26 last char
  294.     !.
  295.  
  296. is_eof(end_of_file) :-
  297.             !.
  298.  
  299.  
  300. /*
  301. #########################################################################
  302.                  create_new_file_for_appending
  303. #########################################################################
  304.  
  305.             create_new_file_for_appending(Outhandle,Output_file)
  306.  
  307.    Opens an output file for appending stuff into the file.
  308.  
  309. Arument               Mode        Function
  310. -------               ----        --------
  311. Outhandle             out         output file handle, file open for append
  312. Output_file           in          name of file to be opened for append
  313.  
  314. */
  315.  
  316. create_new_file_for_appending(Outhandle,Output_file):-
  317.           create(H1,Output_file),
  318.           close(H1),
  319.          open(Outhandle,Output_file,a).
  320.  
  321.  
  322.  
  323.  
  324. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  325. %%%%%%%%%%%%%%%%%%%%%  get file names %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  326. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  327.  
  328.  
  329. get_file_names(InName, _ , OutName, _ ) :-
  330.               file_trace([$e get_compare_file_names$]),
  331.        command_string(Cmd_line),
  332.        filenames(Cmd_line, [InName, OutName | _]),
  333.               file_trace([$x get_compare_file_names$]),!.
  334.  
  335.  
  336. get_file_names(InName, InPrompt, OutName, OutPrompt) :-
  337.        get_file_name( InPrompt,   InName         ),
  338.        get_file_name( OutPrompt,  OutName         ).
  339.  
  340. get_file_name(Prompt, Filename) :-
  341.        log_write(Prompt),
  342.        read_line(0, String),
  343.        filenames(String,[Filename|_]).
  344.  
  345.  
  346. %%%%%%%%%%%%%%%%%%%% file_id preds %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  347. /*
  348.  
  349. file_id( String, [device : D,
  350.                   path : P,
  351.                   name : N,
  352.                   ext  : E ]  )
  353.  
  354. finds the parts of a file description that occur first in a string.
  355.  
  356.  
  357. file_id_rule /3  does the same to as a grammar rule to a list of chars.
  358.  
  359. filename( String, Filename) finds a file name located initially in a string,
  360.            ingoring any init. spaces.
  361. filename_rule does the same thing to a list of chars as a grammar rule
  362.  
  363. filenames(String, List_of_file_names) returns a list of file names in a
  364.                                      string.
  365. filenames_rule does the same thing to a list of chars as a grammar rule.
  366.  
  367. DEFAULTS
  368.  
  369. All these predicates return as defaults the current directory and path.
  370.  
  371. FILES TO RECONSULT IN ADDITION TO THIS ONE:
  372.  
  373. :- reconsult(next_tok).
  374. :- reconsult($\lib\strings\IS_CHAR$).
  375.  
  376. EXAMPLES
  377.  
  378.  
  379. testpred :-      % for file_id
  380.     chdir(C),
  381.     log_write($current directory = $),
  382.     log_write(C), log_nl,
  383.     file_id(C, Frame),
  384.     log_write(Frame),log_nl.
  385.  
  386. testpred :-      % FOR filenames
  387.     log_write($list of files : $),
  388.     read_line(0,Response),
  389.     filenames(Response, Files),
  390.     log_write($Files = $),log_write(Files),log_nl.
  391.  
  392.  
  393.  
  394. testpred :-      % FOR filenames
  395.     log_write($list of files : $),
  396.     read_line(0,Response),
  397.     filenames(Response, File ),
  398.     log_write($File = $),log_write(File ),log_nl.
  399.  
  400.  
  401. :- public  file_id /2: far          ,
  402.            file_id_rule /3: far     ,
  403.            filename /2: far         ,
  404.            filenames_rule /3: far   ,
  405.            filenames/2: far         .
  406.  
  407. :- visible file_id /2         ,
  408.            file_id_rule /3    ,
  409.            filename /2        ,
  410.            filenames_rule /3  ,
  411.            filenames/2        .
  412.  
  413. */
  414.  
  415.  
  416. % :- extrn
  417. %         tokens / 3,
  418. %         trace_message / 2 :far.
  419.  
  420.  
  421.  
  422.  
  423. filenames(String, List_of_file_names) :-
  424.      list_text(List, String),   !,
  425.      tokens( Tokens, List, []), !,
  426.      filenames_rule( List_of_file_names,
  427.                      Tokens,
  428.                      _).
  429.  
  430. filenames_rule( Filenames ) --> filename_separator(_),!,
  431.                                 filenames_rule( Filenames ).
  432.  
  433. filenames_rule([Filename | Filenames]) -->
  434.             filename_rule( Filename ),!,
  435.             filenames_rule( Filenames ).
  436.  
  437. filenames_rule( []) --> !.
  438.  
  439. filename_separator($,$) --> [char($,$)],!.
  440.  
  441.  
  442. filename( String, Filename) :-
  443.          file_id( String, Frame),
  444.             filenames_trace([$i filename, Frame = $, Frame]),
  445.          Frame =  [device : D,
  446.                    path : P,
  447.                    name : N,
  448.                    ext  : E ]  ,
  449.          concat([D,$:$,P,$\$,N,$.$,E], Filename).
  450.  
  451.  
  452. file_id( String, [device : D,
  453.                   path : P,
  454.                   name : N,
  455.                   ext  : E ]  ) :-
  456.               % get part of string before a space
  457.      list_text(List, String),   !,
  458.      tokens( Tokens, List, []), !,
  459.      file_id_rule( [device : D,
  460.                     path : P,
  461.                     name : N,
  462.                     ext  : E ] ,
  463.                    Tokens,
  464.                    _).
  465.  
  466. filename_rule( Filename ) -->
  467.          file_id_rule( Frame),
  468.        { filenames_trace([$i filename_rule Frame = $, Frame]),
  469.          Frame =  [device : D,
  470.                    path   : P,
  471.                    name   : N,
  472.                    ext    : E ]  ,
  473.           concat([D,$:$,P,$\$,N,$.$,E], Filename)}.
  474.  
  475.  
  476. file_id_rule( [device : D,
  477.                path   : P,
  478.                name   : N,
  479.                ext    : E ] ) --> device(D),!,
  480.                                   path_and_file([path : P,
  481.                                                  name : N,
  482.                                                  ext  : E]).
  483.  
  484. file_id_rule( [device : D,
  485.                path   : P,
  486.                name   : N,
  487.                ext    : E ] ) -->   path_and_file([path : P,
  488.                                                    name : N,
  489.                                                    ext  : E]),
  490.                                     {disk(D)},!.
  491.  
  492. device(D)  --> [alphanum(D),char($:$)],!.
  493.  
  494. path_and_file([path : P,
  495.                name : N,
  496.                ext  : E])   -->   path(P) , !,
  497.                                   name_and_ext([name :  N,
  498.                                                 ext  :  E] ).
  499. path_and_file([path : P,
  500.                name : N,
  501.                ext  : E])   -->   name_and_ext([name :  N,
  502.                                                 ext  :  E] ),!,
  503.                                    {chdir(X),
  504.                                        filenames_trace([$Chdir = $,X]),
  505.                                     path_and_file_hlpr(X, P)}.
  506.  
  507.  
  508. path_and_file_hlpr(Device_and_path, Path) :-
  509.               filenames_trace([$e path_and_file_hlpr$]),
  510.        concat( Device_and_path, $\a.b$, String),
  511.        file_id( String,
  512.                      [device : _,
  513.                       path   : Path,
  514.                       name   : _,
  515.                       ext    : _ ] ),
  516.               filenames_trace([$x path_and_file_hlpr Path = $, Path ]).
  517.  
  518.  
  519.      % find explicit paths
  520. path(P) --> init_segment_of_path(I),!,
  521.             path_tail(T),
  522.             {concat(I,T,P)}.
  523.  
  524. path(P) --> path_segment(S), !,
  525.             path_tail(T),
  526.             {concat(S,T,P)}.
  527.  
  528. init_segment_of_path($\$ )  --> [char($\$)] ,!.
  529. init_segment_of_path($..\$)  --> [char($.$), char($.$), char($\$) ] ,!.
  530.  
  531. path_tail(T) --> path_segment(S), !,
  532.                  path_tail(T2),
  533.                  {T2 == $$, !, T=S;
  534.                   concat([S, $\$,T2], T)}.
  535.  
  536. path_tail($$) --> !.
  537.  
  538. path_segment(S)  -->  subdir_name(S),[char($\$)],!.
  539.  
  540. subdir_name(N)   -->  n_and_e(N1,E), !,
  541.                       {concat([N1,$.$,E],N)}.
  542.  
  543. subdir_name(N) --> [alphanum(N) ],!.
  544.  
  545. n_and_e(N ,E) -->  [alphanum(N),char($.$),alphanum(E)] ,!.
  546.  
  547. name_and_ext([name :  N,
  548.               ext  :  E] ) --> n_and_e(N ,E),!.
  549.  
  550. name_and_ext([name :  N,
  551.               ext  :  E] ) --> [ alphanum(N) ],!,
  552.                                { E = $$}.
  553.  
  554. %%%%%%%%%%%%%%%% end file_id %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  555.  
  556.  
  557. /*
  558. #########################################################################
  559.                  File Exits
  560. #########################################################################
  561.  
  562.    */
  563.  
  564. file_exists(Filename):-
  565.     directory(Filename,_,_,_,_,_).  /* look for Filename on disk */
  566.                                     /* succeed if there */
  567.  
  568.  
  569.  
  570. %%%%%%%%%%%%%%% test %%%%%%%%%%%%%%%%%%%%%%
  571. /* Here is a test for process_file_lines.
  572.    To run it you should have an ASCII text
  573.    file named foo in your current directory.
  574.  
  575.    (Uncomment out the test to run it.)
  576. */
  577.  
  578. testfn(X) :- log_write(X), log_nl.
  579.  
  580.  
  581.  
  582.                    % eof %%%
  583.