;==============================================================================
;		       Copyright (C) 1992 by Marc Feeley -- all rights reserved

; file: "parms.scm"

;------------------------------------------------------------------------------
;
; Compiler parameters package:
; ---------------------------

; This package contains definitions that parameterize the behaviour of
; the compiler.

;------------------------------------------------------------------------------

; General stuff:
; -------------

; (string->canonical-symbol str) behaves like 'string->symbol' but all the
; letters in the symbol are in a given case.

(define (string->canonical-symbol str)
  (let ((len (string-length str)))
    (let loop ((str str)
               (s (make-string len))
               (i (- len 1)))
      (if (>= i 0)
        (begin
          (string-set! s i (char-downcase (string-ref str i)))
          (loop str s (- i 1)))
        (string->symbol s)))))

; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
;
; Special symbols:
; ---------------

(define QUOTE-sym             (string->canonical-symbol "QUOTE"))
(define QUASIQUOTE-sym        (string->canonical-symbol "QUASIQUOTE"))
(define UNQUOTE-sym           (string->canonical-symbol "UNQUOTE"))
(define UNQUOTE-SPLICING-sym  (string->canonical-symbol "UNQUOTE-SPLICING"))
(define LAMBDA-sym            (string->canonical-symbol "LAMBDA"))
(define IF-sym                (string->canonical-symbol "IF"))
(define SET!-sym              (string->canonical-symbol "SET!"))
(define COND-sym              (string->canonical-symbol "COND"))
(define =>-sym                (string->canonical-symbol "=>"))
(define ELSE-sym              (string->canonical-symbol "ELSE"))
(define AND-sym               (string->canonical-symbol "AND"))
(define OR-sym                (string->canonical-symbol "OR"))
(define CASE-sym              (string->canonical-symbol "CASE"))
(define LET-sym               (string->canonical-symbol "LET"))
(define LET*-sym              (string->canonical-symbol "LET*"))
(define LETREC-sym            (string->canonical-symbol "LETREC"))
(define BEGIN-sym             (string->canonical-symbol "BEGIN"))
(define DO-sym                (string->canonical-symbol "DO"))
(define DEFINE-sym            (string->canonical-symbol "DEFINE"))
(define DELAY-sym             (string->canonical-symbol "DELAY"))
(define FUTURE-sym            (string->canonical-symbol "FUTURE"))
(define **DEFINE-MACRO-sym    (string->canonical-symbol "##DEFINE-MACRO"))
(define **DECLARE-sym         (string->canonical-symbol "##DECLARE"))
(define **INCLUDE-sym         (string->canonical-symbol "##INCLUDE"))

(define NOT-sym               (string->canonical-symbol "NOT"))


; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -

; Non-standard objects:
; --------------------

(define false-object
  (if (eq? '() #f) (string->symbol "#f") #f))

(define (false-object? obj)
  (eq? obj false-object))

(define undef-object
  (string->symbol "#[undefined]"))

(define (undef-object? obj)
  (eq? obj undef-object))

(define (symbol-object? obj)
  (and (not (false-object? obj)) (not (undef-object? obj)) (symbol? obj)))


; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -

; For 'source.scm':
; ----------------

; Filename extensions used to find source files.

(define source-exts '(".scm" ""))



;==============================================================================