#lang scheme/base

(require "../syntax/"

(provide (all-defined-out))

;; This syntax object will have the syntax-original? property. It can be used
;; with datum->syntax-object to give subsequent syntax objects this property.
(define stx-for-original-property (read-syntax #f (open-input-string "original")))

;; Identifier->syntax : Identifier -> syntax
(define (Identifier->syntax id [loc (Term-location id)])
  (build-syntax (Identifier-name id) loc))

;; Identifier->key : Identifier -> syntax
(define (Identifier->key id)
  (build-syntax (symbol->string (Identifier-name id))
                (Term-location id)))

;; build-syntax : any [(optional region) boolean] -> syntax
(define (build-syntax expr [location #f] [original? #t])
  (datum->syntax #f
                 (and location (region->syntax location original?))
                 (and original? stx-for-original-property)))

;; region->syntax : (optional region) [boolean] -> syntax
(define (region->syntax region [original? #t])
  (if (not region)
      (datum->syntax #f 'source-location #f (and original? stx-for-original-property))
      (let ([start (region-start region)]
            [end (region-end region)])
        (datum->syntax #f
                        (region-source region)
                        (position-line start)
                        (position-col start)
                        (position-offset start)
                        (- (position-offset end) (position-offset start)))
                       (and original? stx-for-original-property)))))