/scheme/src/foreign/silex-1.0/updateo2.scm

http://github.com/marcomaggi/nausicaa · Scheme · 76 lines · 54 code · 2 blank · 20 comment · 0 complexity · 5dafbed1c2e4fafddab2c95becdfa970 MD5 · raw file

  1. ; SILex - Scheme Implementation of Lex
  2. ; Copyright (C) 2001 Danny Dube'
  3. ;
  4. ; This program is free software; you can redistribute it and/or
  5. ; modify it under the terms of the GNU General Public License
  6. ; as published by the Free Software Foundation; either version 2
  7. ; of the License, or (at your option) any later version.
  8. ;
  9. ; This program is distributed in the hope that it will be useful,
  10. ; but WITHOUT ANY WARRANTY; without even the implied warranty of
  11. ; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
  12. ; GNU General Public License for more details.
  13. ;
  14. ; You should have received a copy of the GNU General Public License
  15. ; along with this program; if not, write to the Free Software
  16. ; Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
  17. ;
  18. ; Fonction pour reconstituer le module output2.scm a partir du fichier
  19. ; multilex.scm
  20. ;
  21. (define update
  22. (let ((entete
  23. '("; SILex - Scheme Implementation of Lex"
  24. "; Copyright (C) 2001 Danny Dube'"
  25. "; "
  26. "; This program is free software; you can redistribute it and/or"
  27. "; modify it under the terms of the GNU General Public License"
  28. "; as published by the Free Software Foundation; either version 2"
  29. "; of the License, or (at your option) any later version."
  30. "; "
  31. "; This program is distributed in the hope that it will be useful,"
  32. "; but WITHOUT ANY WARRANTY; without even the implied warranty of"
  33. "; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the"
  34. "; GNU General Public License for more details."
  35. "; "
  36. "; You should have received a copy of the GNU General Public License"
  37. "; along with this program; if not, write to the Free Software"
  38. "; Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA."
  39. ""
  40. ";"
  41. "; Fonction de copiage du fichier run-time"
  42. ";"
  43. ""
  44. "(define out-print-run-time-lib"
  45. " (lambda (port)"
  46. " (display \"; *** This file start\" port)"
  47. " (display \"s with a copy of the \" port)"
  48. " (display \"file multilex.scm ***\" port)"
  49. " (newline port)")))
  50. (lambda ()
  51. (let ((in-port (open-input-file "multilex.scm"))
  52. (out-port (open-output-file "output2.scm")))
  53. (for-each (lambda (str)
  54. (display str out-port)
  55. (newline out-port))
  56. entete)
  57. (display " (display \"" out-port)
  58. (let loop ((c (read-char in-port)))
  59. (if (eof-object? c)
  60. (begin
  61. (display "\" port)))" out-port)
  62. (newline out-port)
  63. (close-input-port in-port)
  64. (close-output-port out-port))
  65. (begin
  66. (cond ((char=? c #\")
  67. (write-char #\\ out-port)
  68. (write-char #\" out-port))
  69. ((char=? c #\\)
  70. (write-char #\\ out-port)
  71. (write-char #\\ out-port))
  72. (else
  73. (write-char c out-port)))
  74. (loop (read-char in-port)))))))))