/core/source-files/source-files.factor

http://github.com/abeaumont/factor · Factor · 78 lines · 60 code · 16 blank · 2 comment · 4 complexity · 1055ffa8446a6ed887bbe01892fcb92a MD5 · raw file

  1. ! Copyright (C) 2007, 2009 Slava Pestov.
  2. ! See http://factorcode.org/license.txt for BSD license.
  3. USING: accessors arrays assocs checksums checksums.crc32
  4. compiler.units continuations definitions io.encodings.utf8
  5. io.files io.pathnames kernel namespaces sequences
  6. source-files.errors strings words ;
  7. IN: source-files
  8. SYMBOL: source-files
  9. TUPLE: source-file
  10. path
  11. top-level-form
  12. checksum
  13. definitions
  14. main ;
  15. : record-top-level-form ( quot file -- )
  16. top-level-form<<
  17. [ ] [ H{ } notify-definition-observers ] if-bootstrapping ;
  18. : record-checksum ( lines source-file -- )
  19. [ crc32 checksum-lines ] dip checksum<< ;
  20. : record-definitions ( file -- )
  21. new-definitions get >>definitions drop ;
  22. : <source-file> ( path -- source-file )
  23. \ source-file new
  24. swap >>path
  25. <definitions> >>definitions ;
  26. ERROR: invalid-source-file-path path ;
  27. : source-file ( path -- source-file )
  28. dup string? [ invalid-source-file-path ] unless
  29. source-files get [ <source-file> ] cache ;
  30. : reset-checksums ( -- )
  31. source-files get [
  32. swap dup exists? [
  33. utf8 file-lines swap record-checksum
  34. ] [ 2drop ] if
  35. ] assoc-each ;
  36. M: pathname where string>> 1 2array ;
  37. : forget-source ( path -- )
  38. source-files get delete-at*
  39. [ definitions>> [ keys forget-all ] each ] [ drop ] if ;
  40. M: pathname forget*
  41. string>> forget-source ;
  42. : rollback-source-file ( file -- )
  43. [
  44. new-definitions get [ assoc-union ] 2map
  45. ] change-definitions drop ;
  46. SYMBOL: file
  47. : wrap-source-file-error ( error -- * )
  48. file get rollback-source-file
  49. \ source-file-error new
  50. f >>line#
  51. file get path>> >>file
  52. swap >>error rethrow ;
  53. : with-source-file ( name quot -- )
  54. #! Should be called from inside with-compilation-unit.
  55. [
  56. [
  57. source-file
  58. [ file set ]
  59. [ definitions>> old-definitions set ] bi
  60. ] dip
  61. [ wrap-source-file-error ] recover
  62. ] with-scope ; inline