home *** CD-ROM | disk | FTP | other *** search
/ MacFormat 1994 November / macformat-018.iso / Utility Spectacular / Developer / macgambit-20-compiler-src-p2 / Interp⁄Comp (.scm) / parms.scm < prev    next >
Encoding:
Text File  |  1994-07-26  |  3.4 KB  |  98 lines  |  [TEXT/gamI]
  1. ;==============================================================================
  2.  
  3. ; file: "parms.scm"
  4.  
  5. ;------------------------------------------------------------------------------
  6. ;
  7. ; Compiler parameters package:
  8. ; ---------------------------
  9.  
  10. ; This package contains definitions that parameterize the behaviour of
  11. ; the compiler.
  12.  
  13. ;------------------------------------------------------------------------------
  14.  
  15. ; General stuff:
  16. ; -------------
  17.  
  18. ; (string->canonical-symbol str) behaves like 'string->symbol' but all the
  19. ; letters in the symbol are in a given case.
  20.  
  21. (define (string->canonical-symbol str)
  22.   (let ((len (string-length str)))
  23.     (let loop ((str str)
  24.                (s (make-string len))
  25.                (i (- len 1)))
  26.       (if (>= i 0)
  27.         (begin
  28.           (string-set! s i (char-downcase (string-ref str i)))
  29.           (loop str s (- i 1)))
  30.         (string->symbol s)))))
  31.  
  32. ; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
  33. ;
  34. ; Special symbols:
  35. ; ---------------
  36.  
  37. (define QUOTE-sym             (string->canonical-symbol "QUOTE"))
  38. (define QUASIQUOTE-sym        (string->canonical-symbol "QUASIQUOTE"))
  39. (define UNQUOTE-sym           (string->canonical-symbol "UNQUOTE"))
  40. (define UNQUOTE-SPLICING-sym  (string->canonical-symbol "UNQUOTE-SPLICING"))
  41. (define LAMBDA-sym            (string->canonical-symbol "LAMBDA"))
  42. (define IF-sym                (string->canonical-symbol "IF"))
  43. (define SET!-sym              (string->canonical-symbol "SET!"))
  44. (define COND-sym              (string->canonical-symbol "COND"))
  45. (define =>-sym                (string->canonical-symbol "=>"))
  46. (define ELSE-sym              (string->canonical-symbol "ELSE"))
  47. (define AND-sym               (string->canonical-symbol "AND"))
  48. (define OR-sym                (string->canonical-symbol "OR"))
  49. (define CASE-sym              (string->canonical-symbol "CASE"))
  50. (define LET-sym               (string->canonical-symbol "LET"))
  51. (define LET*-sym              (string->canonical-symbol "LET*"))
  52. (define LETREC-sym            (string->canonical-symbol "LETREC"))
  53. (define BEGIN-sym             (string->canonical-symbol "BEGIN"))
  54. (define DO-sym                (string->canonical-symbol "DO"))
  55. (define DEFINE-sym            (string->canonical-symbol "DEFINE"))
  56. (define DELAY-sym             (string->canonical-symbol "DELAY"))
  57. (define FUTURE-sym            (string->canonical-symbol "FUTURE"))
  58. (define **DEFINE-MACRO-sym    (string->canonical-symbol "##DEFINE-MACRO"))
  59. (define **DECLARE-sym         (string->canonical-symbol "##DECLARE"))
  60. (define **INCLUDE-sym         (string->canonical-symbol "##INCLUDE"))
  61.  
  62. (define NOT-sym               (string->canonical-symbol "NOT"))
  63.  
  64.  
  65. ; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
  66.  
  67. ; Non-standard objects:
  68. ; --------------------
  69.  
  70. (define false-object
  71.   (if (eq? '() #f) (string->symbol "#f") #f))
  72.  
  73. (define (false-object? obj)
  74.   (eq? obj false-object))
  75.  
  76. (define undef-object
  77.   (string->symbol "#[undefined]"))
  78.  
  79. (define (undef-object? obj)
  80.   (eq? obj undef-object))
  81.  
  82. (define (symbol-object? obj)
  83.   (and (not (false-object? obj)) (not (undef-object? obj)) (symbol? obj)))
  84.  
  85.  
  86. ; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
  87.  
  88. ; For 'source.scm':
  89. ; ----------------
  90.  
  91. ; Filename extensions used to find source files.
  92.  
  93. (define source-exts '(".scm" ""))
  94.  
  95.  
  96.  
  97. ;==============================================================================
  98.