home *** CD-ROM | disk | FTP | other *** search
/ Geek Gadgets 1 / ADE-1.bin / ade-dist / tile-forth-2.1-bin.lha / lib / tile-forth / enumerates.f83 < prev    next >
Text File  |  1996-10-12  |  2KB  |  76 lines
  1. \
  2. \  ENUMERATE VARIABLES
  3. \
  4. \  Copyright (C) 1988-1990 by Mikael R.K. Patel
  5. \
  6. \  Computer Aided Design Laboratory (CADLAB)
  7. \  Department of Computer and Information Science
  8. \  Linkoping University
  9. \  S-581 83 LINKOPING
  10. \  SWEDEN
  11. \
  12. \  Email: mip@ida.liu.se
  13. \
  14. \  Started on: 30 June 1988
  15. \
  16. \  Last updated on: 25 July 1990
  17. \
  18. \  Dependencies:
  19. \       (forth) forth
  20. \
  21. \  Description:
  22. \       Forth level definition of enumerate types and variables.
  23. \
  24. \  Copying:
  25. \       This program is free software; you can redistribute it and\or modify
  26. \       it under the terms of the GNU General Public License as published by
  27. \       the Free Software Foundation; either version 1, or (at your option)
  28. \       any later version.
  29. \
  30. \       This program is distributed in the hope that it will be useful,
  31. \       but WITHOUT ANY WARRANTY; without even the implied warranty of
  32. \       MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  33. \       GNU General Public License for more details.
  34. \
  35. \       You should have received a copy of the GNU General Public License
  36. \       along with this program; see the file COPYING.  If not, write to
  37. \       the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. 
  38.  
  39. .( Loading Enumerates definitions...) cr
  40.  
  41. vocabulary enumerates ( -- )
  42.  
  43. enumerates definitions 
  44.  
  45. : enum.type ( -- enum.type enum0)  
  46.   create here 0 , 0
  47. does> ( enum.type -- )
  48.   drop variable
  49. ;
  50.  
  51. : enum ( enum1 -- enum2)  
  52.   create dup , 1+
  53. does> ( addr -- enum)
  54.   @
  55. ;
  56.  
  57. : enum.end ( enum.type enum3 -- )  
  58.   drop last swap ! 
  59. ;
  60.  
  61. : (>enum) ( enum enum.type -- )
  62.   dup >r >body @
  63.   begin
  64.     2dup >body @ =
  65.     if swap r> 2drop exit then
  66.     @ r@ over =
  67.   until
  68.   2drop r> drop false
  69. ; private
  70.  
  71. : >enum ( enum -- entry)
  72.   ' [compile] literal ?compile (>enum)
  73. ; immediate
  74.  
  75. forth only
  76.