#lang zuo/datum

(require "and-or.zuo"
         "../pair.zuo"
         "../list.zuo"
         "define.zuo"
         "syntax-error.zuo")

(provide char
         at-source)

(define-syntax (char stx)
  (if (and (list? stx)
           (= 2 (length stx))
           (string? (cadr stx))
           (= 1 (string-length (cadr stx))))
      (string-ref (cadr stx) 0)
      (bad-syntax stx)))

(define (combine-path base)
  (lambda paths
    (cond
      [(pair? paths)
       (unless (path-string? (car paths))
         (arg-error 'at-source "path string" (car paths)))
       (for-each (lambda (path)
                   (unless (and (path-string? path)
                                (relative-path? path))
                     (arg-error 'at-source "relative path string" path)))
                 (cdr paths))
       (if (relative-path? (car paths))
           (apply build-path (cons (or (car (split-path base)) ".") paths))
           (apply build-path paths))]
      [else
       (or (car (split-path base)) ".")])))

(define-syntax (at-source stx)
  (if (list? stx)
      (cons (quote-syntax (combine-path (quote-module-path)))
            (cdr stx))
      (if (identifier? stx)
          (quote-syntax (combine-path (quote-module-path)))
          (bad-syntax stx))))

