#lang zuo/datum

;; Helpers for "parse.zuo" that depends on the implementation of
;; syntax objects

(define (name-lambda name form)
  (if name
      ;; `zuo/kernel` recognizes this pattern to name the form
      (cons 'lambda (cons (cadr form) (cons (symbol->string (syntax-e name)) (cddr form))))
      form))

(define (syntax-error msg s)
  (error (~a msg ": " (~s (syntax->datum s)))))

(define (bad-syntax s)
  (syntax-error "bad syntax" s))

(define (duplicate-identifier id s)
  (error "duplicate identifier:" (syntax-e id) (syntax->datum s)))

(define (id-sym-eq? id sym)
  (and (identifier? id)
       (eq? (syntax-e id) sym)))

(define (unwrap-mod-path mod-path)
  (if (identifier? mod-path)
      (syntax-e mod-path)
      mod-path))

(define (add-binding state id binding)
  (state-set-binds state (add-binding* (state-binds state) id binding)))

(define (resolve state id same-defn-ctx?)
  (let* ([bind (resolve* (state-binds state) id same-defn-ctx?)]
         [bind (unwrap-specific bind)])
    (if (initial-import? bind)
        (initial-import-bind bind)
        bind)))

(define (merge-binds state m-binds)
  (if m-binds
      (state-set-binds state (merge-binds* (state-binds state) m-binds))
      state))

(define (new-defn-context state)
  (state-set-binds state (new-defn-context* (state-binds state))))

(define (nest-bindings new-cls body)
  (letrec ([nest-bindings (lambda (new-cls)
                            (if (null? new-cls)
                                body
                                (list 'let (list (car new-cls))
                                      (nest-bindings (cdr new-cls)))))])
    (nest-bindings (reverse new-cls))))

;; Use to communicate a `variable-set!` form from `define` to `parse`:
(define set-var-tag (string->uninterned-symbol "setvar"))

(define (print-result v)
  (unless (eq? v (void))
    (alert (~v v))))

(define (add-print s)
  (list print-result s))
(define (no-wrap s) s)
