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


;; *** Shared utilities ***

(define-module (theme-d translator theme-d-utilities)
  #:declarative? #t #:duplicates (merge-generics replace last))

(export is-t-uniform-list-type2?
        is-t-uniform-list-type0?
        is-t-uniform-list-type?
        gen-tuple-type->type-list
        is-general-tuple-type?
        is-tuple-type?
        is-tuple-type0?
        tuple-type->list-reject-cycles
        is-proc-deduction-alist?
        is-procedure-object?
        get-uniform-list-param
        get-uniform-list-param0
        make-irregular-union
        get-union-of-types0
        get-union-of-types
        make-union-expression0
        cowb-apti
        cowb-signature
        cowb-field
        cowb-union
        cowb-procedure-type
        cowb-param-class-instance
        cowb-param-proc-class
        cowb-type-loop
        cowb-type-join
        contains-type-modifiers?
        translate-irregular-pair-class
        translate-pair-class-expression
        translate-param-class-instance-expr
        translate-param-sgn-instance-expr
        translate-param-ltype-instance-expr
        translate-vector-expression0
        translate-vector-expression
        translate-mutable-vector-expression0
        translate-mutable-vector-expression)


(use-modules (rnrs lists)
             (rnrs base))

(use-modules (th-scheme-utilities hrecord)
             (th-scheme-utilities stdutils))

(use-modules (theme-d translator theme-d-forward-declarations)
             (theme-d translator theme-d-representation)
             (theme-d translator theme-d-entities)
             (theme-d translator theme-d-binder)
             (theme-d translator theme-d-debug))

;; These forward declarations are needed only in the RTE.            
(define cowb-apti-fwd '())
(define cowb-signature-fwd '())
(define cowb-field-fwd '())
(define cowb-union-fwd '())
(define cowb-procedure-type-fwd '())
(define cowb-param-class-instance-fwd '())
(define cowb-param-proc-class-fwd '())
(define cowb-type-loop-fwd '())
(define cowb-type-join-fwd '())

(define translate-vector-expression0-fwd '())
(define translate-mutable-vector-expression0-fwd '())

(define (make-signature-object2 repr-old l-members)
  (make-signature-object (hfield-ref repr-old 'address) l-members))

(define (type-dispatched? to)
  (assert (is-target-object? to))
  (hfield-ref to 'type-dispatched?))
