home *** CD-ROM | disk | FTP | other *** search
/ Liren Large Software Subsidy 9 / 09.iso / l / l210 / 1.ddi / EXAMPLES.ARC / CH07EX12.PRO < prev    next >
Encoding:
Prolog Source  |  1988-06-21  |  3.5 KB  |  108 lines
  1. /*
  2.    Turbo Prolog 2.0 Chapter 7, Example Program 10
  3.    
  4.    Copyright (c) 1986, 88 by Borland International, Inc
  5.    
  6.    
  7.    Fast tree-based sort program.
  8.    Reads lines from a file, sorts them in alphabetical
  9.    order, and writes them on another file.
  10.  
  11. */
  12.  
  13. domains
  14.    treetype = tree(string, treetype, treetype) ; empty
  15.    file     = infile ; outfile                        /* covered in Chapter 9 */
  16.  
  17. predicates
  18.    main
  19.    read_input(treetype)
  20.    read_input_aux(treetype, treetype)
  21.    insert(string, treetype, treetype)
  22.    write_output(treetype)
  23.  
  24. clauses
  25.  
  26. main :-
  27.    clearwindow,                            /* Main procedure, invoked by goal */
  28.    write("Turbo Prolog Treesort"),nl,
  29.    write("File to read:  "),
  30.    readln(In),
  31.    openread(infile, In),               /* open the specified file for reading */
  32.    write("File to write: "),
  33.    readln(Out),
  34.    openwrite(outfile, Out),
  35.    readdevice(infile),     /* redirect all read operations to the opened file */
  36.    read_input(Tree),
  37.    writedevice(outfile),   /* redirect all write operations to the opened file */
  38.    write_output(Tree),
  39.    closefile(infile),                    /* close the file opened for reading */
  40.    closefile(outfile).
  41.  
  42. main :-
  43.    /* Execution drops to this clause if   */
  44.    /* anything in the preceding one fails */
  45.    closefile(outfile),
  46.    writedevice(screen),
  47.    write("Unable to perform sort.\n"),
  48.    write("Probable cause: can't open file.\n").
  49.  
  50. /* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
  51.  * read_input(Tree)                                            *
  52.  *   reads lines from the current input device until EOF, then *
  53.  *   instantiates Tree to the binary search tree built         *
  54.  *   therefrom                                                 *
  55.  * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * */
  56.  
  57. read_input(Tree) :-
  58.    read_input_aux(empty,Tree).
  59.  
  60. /* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
  61.  * read_input_aux(Tree, NewTree)                                *
  62.  *  reads a line, inserts it into Tree giving NewTree,         *
  63.  *  and calls itself recursively unless at EOF.                *
  64.  * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * */
  65.  
  66. read_input_aux(Tree, NewTree) :-
  67.    readln(S),
  68.    !,
  69.    insert(S, Tree, Tree1),
  70.    read_input_aux(Tree1, NewTree).
  71.  
  72. read_input_aux(Tree, Tree). /* If the first clause failed, this
  73. is EOF.
  74.  So the second clause succeeds with no further action. */
  75.  
  76. /* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
  77.  *  insert(Element, Tree, NewTree)                             *
  78.  *     inserts Element into Tree giving NewTree.               *
  79.  * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * */
  80.  
  81. insert(NewItem, empty, tree(NewItem, empty, empty)) :- !.
  82.  
  83. insert(NewItem, tree(Element, Left, Right), tree(Element,
  84. NewLeft, Right)) :-
  85.       NewItem < Element,
  86.       !,
  87.       insert(NewItem, Left, NewLeft).
  88.  
  89. insert(NewItem, tree(Element, Left, Right), tree(Element, Left,
  90. NewRight)) :-
  91.       insert(NewItem, Right, NewRight).
  92.  
  93. /* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
  94.  * write_output(Tree)                                          *
  95.  *    writes out the elements of Tree in alphabetical order.   *
  96.  * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * */
  97.  
  98. write_output(empty). /* Do nothing */
  99.  
  100. write_output(tree(Item, Left, Right)) :-
  101.      write_output(Left),
  102.      write(Item), nl,
  103.      write_output(Right).
  104.  
  105.  
  106. goal
  107.    main.
  108.