home *** CD-ROM | disk | FTP | other *** search
/ ftp.cs.arizona.edu / ftp.cs.arizona.edu.tar / ftp.cs.arizona.edu / icon / historic / v941.tgz / icon.v941src.tar / icon.v941src / ipl / progs / interpp.icn < prev    next >
Text File  |  2000-07-29  |  7KB  |  383 lines
  1. ############################################################################
  2. #
  3. #    File:     interpp.icn
  4. #
  5. #    Subject:  Program to interpret Icon programs
  6. #
  7. #    Author:   Jerry Nowlin
  8. #
  9. #    Date:     December 30, 1991
  10. #
  11. ############################################################################
  12. #
  13. #   This file is in the public domain.
  14. #
  15. ############################################################################
  16. #  
  17. #    This program is kind of like an interactive version of BASIC in that Icon
  18. #  expressions are entered with line numbers and you can resequence them list
  19. #  them etc. and execute all the lines entered.  There is no editor built
  20. #  in.  You have to retype a line to change it.
  21. #
  22. #    Documentation is lacking but there is a "?" help command that lists all
  23. #  the other commands.
  24. #
  25. ############################################################################
  26. #
  27. #  See also:  interpe.icn
  28. #
  29. ############################################################################
  30.  
  31. global    WHITE,    # the white space cset
  32.     MFLAG,    # the modified flag
  33.     PRTBL    # the program table
  34.  
  35. procedure main(arg)
  36.    local line, lno, pline
  37.  
  38. #    define the needed cset
  39.     WHITE := ' \t\n\f'
  40.  
  41. #    initialize the program table
  42.     PRTBL := table()
  43.  
  44. #    initialize the modified flag
  45.     MFLAG := 0
  46.  
  47. #    get all the input
  48.     writes("Icon> ")
  49.     while line := read() do {
  50.  
  51. #        scan the input line
  52.         line ? {
  53.  
  54. #            skip any initial white space
  55.             tab(many(WHITE))
  56.  
  57. #            check for program lines (they have line numbers)
  58.             if lno := tab(many(&digits)) & tab(many(WHITE)) then {
  59.  
  60. #                get the program line
  61.                 pline := tab(0)
  62.  
  63. #                store the line in the program table
  64.                 PRTBL[numeric(lno)] := pline
  65.  
  66. #                set the modified flag
  67.                 MFLAG +:= 1
  68.             }
  69.  
  70. #            read command
  71.             else if (tab(upto(WHITE)) | tab(0)) ==
  72.                 ("read" | "r") then {
  73.                 readprog()
  74.  
  75. #                clear the modified flag
  76.                 MFLAG := 0
  77.             }
  78.  
  79. #            write command
  80.             else if (tab(upto(WHITE)) | tab(0)) ==
  81.                 ("write" | "w") then {
  82.                 writeprog()
  83.  
  84. #                clear the modified flag
  85.                 MFLAG := 0
  86.             }
  87.  
  88. #            delete command
  89.             else if (tab(upto(WHITE)) | tab(0)) ==
  90.                 ("delete" | "d") then {
  91.                 delprog()
  92.  
  93. #                set the modified flag
  94.                 MFLAG +:= 1
  95.             }
  96.  
  97. #            sequence command
  98.             else if (tab(upto(WHITE)) | tab(0)) ==
  99.                 ("sequence" | "s") then {
  100.                 seqprog()
  101.             }
  102.  
  103. #            list command
  104.             else if (tab(upto(WHITE)) | tab(0)) ==
  105.                 ("list" | "l") then {
  106.                 listprog()
  107.             }
  108.  
  109. #            execute command
  110.             else if (tab(upto(WHITE)) | tab(0)) ==
  111.                 ("execute" | "e") then {
  112.                 execprog()
  113.             }
  114.  
  115. #            help command
  116.             else if (tab(upto(WHITE)) | tab(0)) ==
  117.                 ("help" | "h" | "?") then {
  118.                 helpprog()
  119.             }
  120.  
  121. #            quit command
  122.             else if (tab(upto(WHITE)) | tab(0)) ==
  123.                 ("quit" | "q") then {
  124.                 quitprog()
  125.             }
  126.  
  127. #            invalid syntax input
  128.             else {
  129.                 write("Syntax Error: ",line)
  130.                 helpprog()
  131.             }
  132.         }
  133.         writes("Icon> ")
  134.     }
  135.  
  136. end
  137.  
  138. procedure execprog()
  139.    local runargs, out, prog, line, command
  140.  
  141.     static    tmpfile
  142.  
  143.     initial tmpfile := "TMPFILE.icn"
  144.  
  145. #    get any runtime arguments
  146.     runargs := tab(0)
  147.  
  148. #    create the temporary Icon file
  149.     (out := open(tmpfile,"w")) |
  150.  
  151. #    or mention the problem and fail
  152.     (write("I can't open '",tmpfile,"' for writing") & fail)
  153.  
  154. #    sort the program table
  155.     prog := sort(PRTBL)
  156.  
  157. #    put the program in the file
  158.     every line := !prog do {
  159.         write(out,line[2])
  160.     }
  161.     close(out)
  162.  
  163. #    format the command to execute the program
  164.     command := "icont -s " || tmpfile || " -x " || runargs
  165.  
  166. #    add the command to remove the temporary file
  167.     command ||:= " ; rm -f " || tmpfile
  168.  
  169. #    execute the command
  170.     system(command)
  171.  
  172. end
  173.  
  174. procedure seqprog()
  175.    local begno, incno, prog, lno, l
  176.  
  177. #    initialize the sequencing numbers
  178.     begno := incno := 10
  179.  
  180. #    skip any white space
  181.     tab(many(WHITE))
  182.  
  183. #    get an initial line number
  184.     begno := numeric(tab(many(&digits)))
  185.  
  186. #    skip any white space
  187.     tab(many(WHITE))
  188.  
  189. #    get a increment number
  190.     incno := numeric(tab(many(&digits)))
  191.  
  192. #    sort the program table
  193.     prog := sort(PRTBL)
  194.  
  195. #    reinitialize it
  196.     PRTBL := table()
  197.  
  198. #    sequence the program lines starting with begno by incno
  199.     lno := begno
  200.     every l := !prog do {
  201.         PRTBL[lno] := l[2]
  202.         lno +:= incno
  203.     }
  204.  
  205. end
  206.  
  207. procedure readprog()
  208.    local readfile, response, in, lno, line
  209.  
  210. #    get a possible command line file name
  211.     tab(many(WHITE))
  212.     readfile := tab(upto(WHITE) | 0)
  213.  
  214. #    if there was no file with the command get one
  215.     if /readfile | *readfile = 0 then {
  216.         writes("Read file name: ")
  217.         readfile := read()
  218.     }
  219.  
  220. #    make sure a modified file has been written
  221.     if MFLAG > 0 then {
  222.         writes("Write before reading over current program? ")
  223.         response := read()
  224.         if any('yY',response) then
  225.             writeprog()
  226.     }
  227.  
  228. #    initialize the program table
  229.     PRTBL := table()
  230.  
  231. #    read the program from the read file
  232.     in := open(readfile,"r")
  233.     lno := 10
  234.     every line := !in do {
  235.         PRTBL[lno] := line
  236.         lno +:= 10
  237.     }
  238.     close(in)
  239.  
  240. #    tell them what you did
  241.     write("Read '",readfile,"'...",*PRTBL," lines")
  242.  
  243. end
  244.  
  245. procedure writeprog()
  246.    local writefile, prog, out, l
  247.  
  248. #    get a possible command line file name
  249.     tab(many(WHITE))
  250.     writefile := tab(upto(WHITE) | 0)
  251.  
  252. #    if there was no file with the command get one
  253.     if /writefile | *writefile = 0 then {
  254.         writes("Write file name: ")
  255.         writefile := read()
  256.     }
  257.  
  258. #    sort the program table
  259.     prog := sort(PRTBL)
  260.  
  261. #    write the program to the write file
  262.     out := open(writefile,"w")
  263.     every l := !prog do {
  264.         write(out,l[2])
  265.     }
  266.     close(out)
  267.  
  268. #    tell them what you did
  269.     write("Write '",writefile,"'...",*PRTBL," lines")
  270.  
  271. end
  272.  
  273. procedure delprog()
  274.    local begno, endno, prog, l, lno
  275.  
  276. #    initialize the line numbers
  277.     begno := 0
  278.     endno := 99999
  279.  
  280. #    skip any white space
  281.     tab(many(WHITE))
  282.  
  283. #    get an initial line number
  284.     begno := endno := numeric(tab(many(&digits)))
  285.  
  286. #    skip any white space
  287.     tab(many(WHITE))
  288.  
  289. #    get a final line number
  290.     endno := numeric(tab(many(&digits)))
  291.  
  292. #    sort the program table
  293.     prog := sort(PRTBL)
  294.  
  295. #    reinitialize it
  296.     PRTBL := table()
  297.  
  298. #    delete the program lines between the optional numbers
  299.     every l := !prog do {
  300.         lno := numeric(l[1])
  301.         if (lno < begno) | (lno > endno) then PRTBL[lno] := l[2]
  302.     }
  303.  
  304. end
  305.  
  306. procedure listprog()
  307.    local begno, endno, prog, l, lno
  308.  
  309. #    initialize the line numbers
  310.     begno := 0
  311.     endno := 99999
  312.  
  313. #    skip any white space
  314.     tab(many(WHITE))
  315.  
  316. #    get an initial line number
  317.     begno := endno := numeric(tab(many(&digits)))
  318.  
  319. #    skip any white space
  320.     tab(many(WHITE))
  321.  
  322. #    get a final line number
  323.     endno := numeric(tab(many(&digits)))
  324.  
  325. #    sort the program table
  326.     prog := sort(PRTBL)
  327.  
  328. #    list the program lines between the optional numbers
  329.     every l := !prog do {
  330.         lno := numeric(l[1])
  331.         if (lno >= begno) & (lno <= endno) then
  332.             write(right(lno,5),": ",l[2])
  333.         if lno > endno then break
  334.     }
  335.  
  336. end
  337.  
  338. procedure helpprog()
  339.  
  340.     static helpmsg
  341.  
  342. #    define the help message
  343.     initial {
  344.         helpmsg := [
  345.         "<<< Icon Expression Syntax >>>",
  346.         "",
  347.         "lineno expression",
  348.         "",
  349.         "<<< Command Summary >>>",
  350.         " (1st character works)",
  351.         "",
  352.         "read [ file ]",
  353.         "write [ file ]",
  354.         "list [ begno [ endno ] ]",
  355.         "delete [ begno [ endno ] ]",
  356.         "sequence [ begno [ increment ] ]",
  357.         "execute [ args ]",
  358.         "quit",
  359.         "help"
  360.         ]
  361.     }
  362.  
  363. #    print it
  364.     every write(!helpmsg)
  365.  
  366. end
  367.  
  368. procedure quitprog()
  369.    local response
  370.  
  371. #    make sure a modified file has been written
  372.     if MFLAG > 0 then {
  373.         writes("Write before quitting? ")
  374.         response := read()
  375.         if any('yY',response) then
  376.             writeprog()
  377.     }
  378.  
  379.     stop("Goodbye.")
  380.  
  381. end
  382.  
  383.