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


;; *** Pseudocode common ***


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


(define (parse-address module decl)
  (assert (= (length decl) 5))
  (assert (eqv? (car decl) 'address))
  (let* ((mod1 (list-ref decl 1))
	 (mod
	  (cond
	   ((not mod1) #f)
	   ((not-null? mod1) mod1)
	   (else module))))
    (make-hrecord
     <address>
     mod
     (list-ref decl 2)
     (list-ref decl 3)
     (list-ref decl 4))))


(define (theme-compile-address address)
  (assert (hrecord-is-instance? address <address>))
  `(address
    ,(hfield-ref address 'module)
    ,(hfield-ref address 'number)
    ,(hfield-ref address 'source-name)
    ,(hfield-ref address 'toplevel?)))


(define (parse-type-variable module tvar)
  (let ((r-address (parse-address module tvar)))
    (make-type-variable r-address)))


(define (parse-type-variables module type-vars)
  (map (lambda (tvar) (parse-type-variable module tvar))
       type-vars))
