#lang scheme/base
(require "../syntax/ast-core.ss"
"../syntax/ast-utils.ss"
"../syntax/token.ss")
(provide (all-defined-out))
(define stx-for-original-property (read-syntax #f (open-input-string "original")))
(define (Identifier->syntax id [loc (Term-location id)])
(build-syntax (Identifier-name id) loc))
(define (Identifier->key id)
(build-syntax (symbol->string (Identifier-name id))
(Term-location id)))
(define (build-syntax expr [location #f] [original? #t])
(datum->syntax #f
expr
(and location (region->syntax location original?))
(and original? stx-for-original-property)))
(define (region->syntax region [original? #t])
(let ([start (region-start region)]
[end (region-end region)])
(datum->syntax #f
'source-location
(list
(region-source region)
(position-line start)
(position-col start)
(position-offset start)
(- (position-offset end) (position-offset start)))
(and original? stx-for-original-property))))