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