;;; ----------------------------------------------------------------------
;;; Copyright 2010-2011 National University of Ireland.
;;; ----------------------------------------------------------------------
;;; This file is part of DysVunctional Language.
;;; 
;;; DysVunctional Language is free software; you can redistribute it and/or modify
;;; it under the terms of the GNU Affero General Public License as
;;; published by the Free Software Foundation, either version 3 of the
;;;  License, or (at your option) any later version.
;;; 
;;; DysVunctional Language is distributed in the hope that it will be useful,
;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
;;; GNU General Public License for more details.
;;; 
;;; You should have received a copy of the GNU Affero General Public License
;;; along with DysVunctional Language.  If not, see <http://www.gnu.org/licenses/>.
;;; ----------------------------------------------------------------------

(declare (usual-integrations))

;;; In addition to the Scheme tradition of using symbols for names,
;;; FOL also uses FOL-NAME objects to serve as variables.  This much
;;; simplifies autogeneration of unique names, without having to
;;; intern huge numbers of Scheme symbols.  Particularly if such any
;;; such autogenerated names are temporary to the process of
;;; compilation and do not appear in the final output, they can be
;;; garbage collected.

;;; FOL-NAME objects print like valid Scheme identifiers so that FOL
;;; source containing them is easy to read (this makes them not
;;; read-write invariant).  They are also convertible to symbols to
;;; allow FOL source containing them to be evaluated directly by
;;; Scheme.

(define *symbol-count* 0)

(define-structure
  (fol-name
   safe-accessors
   (print-procedure
    (lambda (state object)
      (with-current-unparser-state state
        (lambda (port)
          (write (fol-name-base object) port)
          (write '- port)
          (write (fol-name-count object) port))))))
  base
  count)

(define (name-base thing)
  (cond ((fol-name? thing)
         (fol-name-base thing))
        ((symbol? thing) thing)
        (else (error "Invalid name" thing))))

(define (make-name template)
  (set! *symbol-count* (+ *symbol-count* 1))
  (make-fol-name (name-base template) *symbol-count*))

(define (name->symbol thing)
  (cond ((fol-name? thing)
         (symbol (fol-name-base thing) '- (fol-name-count thing)))
        ((symbol? thing) thing)
        (else "Invalid var" thing)))

(define prepare-for-scheme
  (rule-simplifier
   (list
    (rule `(? name ,fol-name?) (name->symbol name)))))

(define (reset-fol-names!)
  (set! *symbol-count* 0))
