process-context.scm 2.0 KB

1234567891011121314151617181920212223242526272829303132333435363738394041424344454647484950515253545556575859
  1. ;;; R7RS compatibility libraries
  2. ;;; Copyright (C) 2019 Free Software Foundation, Inc.
  3. ;;;
  4. ;;; This library is free software: you can redistribute it and/or modify
  5. ;;; it under the terms of the GNU Lesser General Public License as
  6. ;;; published by the Free Software Foundation, either version 3 of the
  7. ;;; License, or (at your option) any later version.
  8. ;;;
  9. ;;; This library is distributed in the hope that it will be useful, but
  10. ;;; WITHOUT ANY WARRANTY; without even the implied warranty of
  11. ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
  12. ;;; Lesser General Public License for more details.
  13. ;;;
  14. ;;; You should have received a copy of the GNU Lesser General Public
  15. ;;; License along with this program. If not, see
  16. ;;; <http://www.gnu.org/licenses/>.
  17. ;;; Based on code from https://gitlab.com/akku/akku-scm, written
  18. ;;; 2018-2019 by Göran Weinholt <goran@weinholt.se>, as well as
  19. ;;; https://github.com/okuoku/yuni, written 2014-2018 by OKUMURA Yuki
  20. ;;; <mjt@cltn.org>. This code was originally released under the
  21. ;;; following terms:
  22. ;;;
  23. ;;; To the extent possible under law, the author(s) have dedicated
  24. ;;; all copyright and related and neighboring rights to this
  25. ;;; software to the public domain worldwide. This software is
  26. ;;; distributed without any warranty.
  27. ;;;
  28. ;;; See <http://creativecommons.org/publicdomain/zero/1.0/>, for a
  29. ;;; copy of the CC0 Public Domain Dedication.
  30. (define-module (scheme process-context)
  31. #:use-module (srfi srfi-98)
  32. #:re-export (command-line
  33. get-environment-variable
  34. get-environment-variables)
  35. #:export (emergency-exit
  36. (r7:exit . exit)))
  37. (define (translate-status status)
  38. (case status
  39. ((#t) 0)
  40. ((#f) 1)
  41. (else status)))
  42. (define r7:exit
  43. (case-lambda
  44. (()
  45. (exit))
  46. ((status)
  47. (exit (translate-status status)))))
  48. (define emergency-exit
  49. (case-lambda
  50. (()
  51. (primitive-_exit))
  52. ((status)
  53. (primitive-_exit (translate-status status)))))