;; Copyright (C) 2008-2013 Tommi Höynälänmaa
;; Distributed under GNU General Public License version 3,
;; see file doc/GPL-3.


;; *** Linker core definitions ***


(import (rnrs exceptions)
	(srfi srfi-1)
	(th-scheme-utilities stdutils)
	(th-scheme-utilities hrecord))


;; Generic procedures shall not be added into global-decls.
(define-hrecord-type <linker> ()
  state
  all-assertions?
  factorize?
  pretty-print?
  verbose-errors?
  verbose-typechecks?
  backtrace?
  runtime-pretty-backtrace?
  strip?
  verbose-unlinked-procedures?
  module-debug-output?
  s-intermediate-language
  repr-list
  ht-used
  ht-var-defs
  ht-method-defs
  ht-method-decls
  ht-used-decls
  ht-rebound
  ht-decl-types
  ht-cycles
  ht-goops-classes
  ht-prim-classes
  ht-fact
  ht-module-indices
  ht-lexical-vars
  ht-equal
  ht-equal-objects
  ht-equal-contents
  lst-enclosing-cycles
  interm-file
  interm-filename
  target-filename
  module-search-path
  param-cache-parsing
  param-cache-instantiation
  binder-parsing
  binder-instantiation
  fixed-tvars
  next-free-loc
  next-tvar-number
  current-module
  linked-interfaces
  linked-bodies
  l-linked-bodies2
  l-bodies-to-process
  l-bodies-to-link
  root-env
  global-decls
  ht-globals-by-name
  ht-globals-by-address
  decl-proc-instances
  inside-param-def?
  tcomp-inside-param-proc?
  t-tvars
  visited-in-binding
  i-next-var-start
  current-expr
  current-toplevel-expr
  current-repr
  current-toplevel-repr
  current-instance
  current-repr-to-bind)


(define is-linker? (get-hrecord-type-predicate <linker>))


(define (linker-alloc-loc linker name toplevel?)
  (let ((result
	 (make-hrecord <address>
		       #f
		       (hfield-ref linker 'next-free-loc)
		       name
		       toplevel?)))
    (hfield-set! linker 'next-free-loc
		 (+ (hfield-ref linker 'next-free-loc) 1))
    result))
