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 / conman.icn < prev    next >
Text File  |  2001-05-02  |  13KB  |  428 lines
  1. ############################################################################
  2. #
  3. #    File:     conman.icn
  4. #
  5. #    Subject:  Program to convert units
  6. #
  7. #    Author:   William E. Drissel
  8. #
  9. #    Date:     May 2, 2001
  10. #
  11. ############################################################################
  12. #
  13. #   This file is in the public domain.
  14. #
  15. ############################################################################
  16. #
  17. #  Conman is a toy I used to teach myself elementary Icon.  I 
  18. #  once vaguely heard of a program which could respond to queries 
  19. #  like "? Volume of the earth in tbsp".  
  20. #
  21. #  The keywords of the language (which are not reserved) are:
  22. #
  23. #          load
  24. #          save
  25. #          print
  26. #          ? (same as print)
  27. #          list
  28. #          is and are which have the same effect
  29. #
  30. #  "Load" followed by an optional filename loads definitions of 
  31. #  units from a file.  If filename is not supplied, it defaults to 
  32. #  "conman.sav"  
  33. #
  34. #  "Save" makes a file for "load".  Filename defaults to 
  35. #  "conman.sav".  "Save" appends to an existing file so a user 
  36. #  needs to periodically edit his save file to prune it back.
  37. #
  38. #  "Print" and "?" are used in phrases like:
  39. #
  40. #          ? 5 minutes in seconds
  41. #
  42. #  Conman replies:
  43. #
  44. #          5 minutes in seconds  equals  300
  45. #
  46. #  List puts up on the screen all the defined units and the 
  47. #  corresponding values.  Format is same as load/store format.
  48. #
  49. #  "Is" and "are" are used like this:
  50. #
  51. #          100 cm are 1 meter
  52. #
  53. #  The discovery of is or are causes the preceding token (in 
  54. #  this case "cm") to be defined.  The load/store format is:
  55. #
  56. #         unitname "is" value
  57. #
  58. #  Examples:
  59. #
  60. #       8 furlongs is 1 mile
  61. #       furlong is 1 / 8 mile
  62. #
  63. #  These last two are equivalent.  Note spaces before and after 
  64. #  "/".  Continuing examples:
  65. #
  66. #       1 fortnight is 14 days
  67. #       furlong/fortnight is furlong / fortnight
  68. #       inches/hour is inch / hour
  69. #
  70. #  After this a user might type:
  71. #
  72. #       ? 1 furlong/fortnight in inches/hour
  73. #       
  74. #  Conman will reply:
  75. #
  76. #       1 furlong/fortnight in inches/hour equals 23.57
  77. #
  78. #  Note: the following feature of Conman:  his operators have no 
  79. #  precedence so the line above gets the right answer but 
  80. #
  81. #        1 furlong/fortnight in inches / hour 
  82. #
  83. #  gets the wrong answer.  (One definition of a feature is a flaw we're 
  84. #  not going to fix).
  85. #
  86. ############################################################################
  87. #
  88. #  Program Notes:
  89. #
  90. #  The procedure, process, parses the user's string to see if it 
  91. #  begins with a keyword.  If so, it acts accordingly.  If not, 
  92. #  the user string is fed to isare.
  93. #
  94. #  Isare attempts to find "is" or "are" in the users string.  
  95. #  Failing to, isare feeds the string to conman which can 
  96. #  interpret anything.  If "is" or "are" is found, the tokens 
  97. #  (delimited by blanks) before the "is" or "are" are stacked in 
  98. #  foregoing; those after are stacked in subsequent.  Then the 
  99. #  name to be defined is popped off the foregoing and used as 
  100. #  the "index" into a table named values.  The corresponding 
  101. #  number is computed as eval(subsequent) / eval(foregoing).
  102. #
  103. #  The procedure, stack, is based on Griswold and Griswold, "The 
  104. #  Icon Programming Language", p122.
  105. #
  106. #  The procedure, eval, unstacks the tokens from a stack one by 
  107. #  one until all have been considered.  First, the tokens which 
  108. #  signify division by the next token are considered and used to 
  109. #  set a switch named action.  Then depending on action, the 
  110. #  token is used to multiply the accumulator or divide it.  If 
  111. #  eval can make the token into a number, the number is used, 
  112. #  failing that the token is looked up in the table named values 
  113. #  and the corresponding number is used.  Failing both of those, 
  114. #  conman gripes to the user and does nothing (in effect 
  115. #  multiplying or dividing by 1).  Finally, eval returns the 
  116. #  number accumulated by the operations with the tokens.
  117. #
  118. #  Load defaults the filename to conman.sav if the user didn't 
  119. #  supply one.  Each line read is fed to isare.  We will see 
  120. #  that save prepares the lines so isare can define the units.
  121. #
  122. #  Save uses Icon's sort to go thru the table "values".  The 
  123. #  unit name is the left of a pair and the number stored is the 
  124. #  right of the pair.  The word " is " is stuck between them so 
  125. #  isare will work.
  126. #
  127. #  Finally, we consider the procedure conman.  During initial 
  128. #  design, this was perceived to be the largest part of the 
  129. #  effort of conman.  It is a real tribute to the power of Icon 
  130. #  that only one non-trivial line of code is required.  The 
  131. #  user's string is reproduced then the word "equals" followed 
  132. #  the result produced by eval after the user's string is 
  133. #  stacked.
  134. #
  135. ############################################################################
  136. #
  137. # Requires:  conman.sav
  138. #
  139. ############################################################################
  140. #
  141. #  Links:  io
  142. #
  143. ############################################################################
  144.  
  145. link io
  146.  
  147. global values, blank, nonblank
  148.  
  149. procedure main (args)
  150.     local line
  151.  
  152.     if map(args[1]) == "-t" then &trace := -1
  153.  
  154.      init()
  155.  
  156.      while line := prompt() do {
  157.          process(line || " ")      # pad with a blank to make life easy
  158.      }
  159.      windup()
  160. end
  161. ############################################################################
  162. #
  163. # windup
  164. #
  165. procedure windup()
  166.      write(&errout,"windup")
  167. end
  168. ############################################################################
  169. #
  170. # process
  171. #
  172. procedure process(str)
  173.  
  174.      case parse(str) of {
  175.      "load"        : load(str)
  176.      "save"        : save(str)
  177.      "print"       : conman(butfirst(str))          # strip first token
  178.      "list"        : zlist()
  179.      default       : isare(str) # didn't start with a kw, try is or are
  180.      }
  181. end
  182. ############################################################################
  183. #
  184. # parse
  185. #
  186. procedure parse(str)
  187.     local token
  188.  
  189.      token := first(str)
  190.      case token of  {
  191.          "?"       : return "print"             # only special case at present
  192.          default   : return token
  193.      }
  194. end
  195. ############################################################################
  196. #
  197. # conman
  198. #
  199. # compute and write result - During initial design, this was perceived to
  200. #                            require 50 lines of complicated lookup etc.!
  201. #
  202. procedure conman(strn) 
  203.  
  204.      write (strn , " equals ", eval(stack(strn, 1, *strn)))
  205. end
  206. ############################################################################
  207. #
  208. # isare - routine to define values - tries to evaluate if not a definition
  209. #
  210. # locate is,are - delete
  211. # backup one word - save, delete
  212. # compute foregoing
  213. # compute subsequent
  214. # store word, subsequent/foregoing in values
  215. #
  216. procedure isare(str)
  217.     local after, before, foregoing, subsequent
  218.  
  219. # locate blank-delimited is or are - early (?clumsy) Icon code replaced at
  220. # the suggestion of one of REG's students
  221.  
  222.      if (str ? (before := tab(find(" is ")) & move(4) & 
  223.                  after := \tab(0)))  then {  }                    # is
  224.  
  225.      else if (str ? (before := tab(find(" are ")) & move(5) & 
  226.                  after := \tab(0)))  then {  }                    # are
  227.  
  228.      else {                          # found nothing - try to eval anyhow
  229.          conman(str)
  230.          return 
  231.      } 
  232. #
  233. # here if is or are
  234. #
  235.      foregoing  := stack(before)    # so we can look back one token
  236.      subsequent := stack(after)     # might as well stack this too
  237.  
  238.      name := singular(pop(foregoing))     # define token before is or are
  239. #
  240. # next line so we can support "100 cms are 1 meter"
  241. #
  242.      values[name] := eval(subsequent) / eval(foregoing) 
  243.      return
  244. end
  245. ############################################################################
  246. #
  247. # stack - stack tokens - based on IPL section 12.1 p122
  248. #
  249. #  stack the "words" in str - needs cset nonblank
  250. #
  251. procedure stack(str)
  252.     local i, j, words
  253.  
  254.     words := [] ; i := 1
  255.  
  256.     while j := upto(nonblank, str, i) do {
  257.          i := many(nonblank, str, j)
  258.          push(words, str[i:j])
  259.          }
  260.     return words
  261. end
  262. ############################################################################
  263. #
  264. # eval - evaluate a stack
  265. #
  266. #  while more remain
  267. #    unstack a token
  268. #    if "in" or "over" or "/", set to divide next time
  269. #    else if number multiply/divide it
  270. #    else if in values, multiply/divide value
  271. #    else gripe and leave accum alone
  272. #
  273. procedure eval(stk)
  274.     local accum, action, token
  275.  
  276.     accum := 1.0  ;  action := "multiply"
  277.  
  278.     while token := singular(pull(stk)) do {          
  279.  
  280.          if token == ("in" | "over" | "/" )then action := "divide"
  281.          else if action == "multiply" then {
  282.  
  283. #             write("multiplying by ", token, " ", (real(token) | 
  284.  #                                                  real(values[token]) |
  285.   #                                                 "unknown"))
  286.  
  287.               if not (accum *:= \(real(token) | real(values[token]))) then
  288.                    write (&errout,
  289.                          "Can't evaluate ", token, " - using 1.0 instead")
  290.          }
  291.          else if action == "divide" then {
  292.               action := "multiply"
  293.               if not (accum /:= \(real(token) | real(values[token]))) then
  294.                    write (&errout,
  295.                          "Can't evaluate ", token, " - using 1.0 instead")
  296.          }
  297.      }#........................................ # end of while more tokens
  298.     return accum       
  299. end
  300. ############################################################################
  301. #
  302. # init
  303. #
  304. procedure init()
  305.      write(&errout, "Conman version 1.1, 7/24/87")
  306.      values := table(&null)
  307.      nonblank := &ascii -- ' '
  308.      blank := ' '
  309.      values["times"] := 1.0
  310.      values["by"]    := 1.0
  311.      values["of"]    := 1.0
  312.      values["at"]    := 1.0
  313.      values["print"] := 1.0
  314.      values["?"]     := 1.0
  315.      values["meter"] := 1.0
  316.      values["kilogram"] := 1.0
  317.      values["second"]   := 1.0
  318.  
  319. end
  320. ############################################################################
  321. #
  322. # prompt
  323. #
  324. procedure prompt()
  325.     return read()
  326. end
  327. ############################################################################
  328. #
  329. # load - loads table from a file - assumes save format compatible 
  330. #        with isare
  331. #
  332. procedure load(str)
  333.     local intext, line, filnam
  334.  
  335.     filnam := (\second(str) | "conman.sav")
  336.     write (&errout, "Load from ", filnam, ".  May take a minute or so.")
  337.     intext := dopen(filnam,"r") | { write(&errout, "can't open ", filnam)
  338.                                     fail}
  339.      while line := read(intext)  do {
  340.          isare(line || " ")  # pad with a blank to make life easy
  341.      }
  342.     close(intext)
  343.     return
  344. end
  345. ############################################################################
  346. #
  347. # save - saves table to file in format compatible with isare
  348. #
  349. procedure save(str)
  350.     local i, outtext, pair, wlist, filnam
  351.  
  352.     filnam := (\second(str) | "conman.sav")
  353.     write (&errout, "Save into ", filnam)
  354.     outtext := open(filnam,"a") | { write(&errout, "can't save to ", filnam)
  355.                                     fail}
  356.     wlist := sort(values)
  357.     i := 0
  358.     every pair := !wlist do {
  359.          write(outtext, pair[1], " is ", pair[2])
  360.     }
  361.     close(outtext)
  362. end
  363. ############################################################################
  364. #
  365. # zlist - lists the table
  366. #
  367. procedure zlist()
  368.     local i, pair, wlist
  369.  
  370.     i := 0
  371.     wlist := sort(values)
  372.     every pair := !wlist do {
  373.          write(&errout, pair[1], " is ", pair[2])
  374.     }
  375. end
  376. ############################################################################
  377. #
  378. # first - returns first token in a string - needs cset nonblank
  379. #
  380. procedure first(s)
  381.     local stuff
  382.  
  383.     s? (tab(upto(nonblank)) , (stuff := tab(many(nonblank))))
  384.     return \stuff 
  385. end
  386. ############################################################################
  387. #
  388. # second - returns second token in a string - needs cset nonblank
  389. #
  390. procedure second(s)
  391.     local stuff
  392.  
  393.     s? (tab(upto(nonblank)) , (tab(many(nonblank)) & tab(upto(nonblank)) &
  394.          (stuff := tab(many(nonblank)))))
  395.     return \stuff 
  396. end
  397. ############################################################################
  398. #
  399. # butfirst - returns all butfirst token in a string - needs cset nonblank
  400. #
  401. procedure butfirst(s)
  402.     local stuff
  403.  
  404.     s? (tab(upto(nonblank)) , tab(many(nonblank)) & tab(upto(nonblank)) &
  405.          (stuff := tab(0)))
  406.     return \stuff 
  407. end
  408. ############################################################################
  409. #
  410. # singular - returns singular of a unit of measure - add special cases in 
  411. #            an obvious way.  Note: singulars ending in "e" should be handled
  412. #            here also "per second" units which end in "s".
  413. #
  414. procedure singular(str)
  415.     local s
  416.  
  417.     s := str 
  418.     if s == "fps" then return "fps"
  419.     if s == "feet" then return "foot"
  420.     if s == "minutes" then return "minute"
  421.     if s == "miles" then return "mile"
  422. #
  423. ## otherwise strip "es" or "s".  Slick code by Icon grad student
  424. #
  425.     return s? (1(tab(-2), ="es") | 1(tab(-1), ="s" ) | tab(0))
  426. end
  427. ############################################################################
  428.