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