#lang racket/base

(provide pattern->unparser)

(require preserves)
(require racket/match)
(require (only-in racket/syntax format-symbol))
(require (only-in racket/list append-map))

(require "type.rkt")
(require "gen/schema.rkt")

(define (pattern->unparser pattern src-stx)
  (match (unwrap pattern)
    [(NamedSimplePattern_ n p) (pattern->unparser p (escape n))]
    [(SimplePattern-any) src-stx]
    [(SimplePattern-atom (AtomKind-Float)) `(->float ,src-stx)]
    [(SimplePattern-atom (AtomKind-Double)) `(exact->inexact ,src-stx)]
    [(SimplePattern-atom _) src-stx]
    [(SimplePattern-embedded _interface) `(embedded ,src-stx)]
    [(SimplePattern-lit v) `',v]
    [(SimplePattern-seqof variable-pat)
     `(for/list [(item (in-list ,src-stx))] ,(pattern->unparser variable-pat 'item))]
    [(SimplePattern-setof pat)
     `(for/set [(item (in-set ,src-stx))] ,(pattern->unparser pat 'item))]
    [(SimplePattern-dictof key-pat value-pat)
     `(for/hash [((key value) (in-dict ,src-stx))]
        (values ,(pattern->unparser key-pat 'key)
                ,(pattern->unparser value-pat 'value)))]
    [(SimplePattern-Ref r)
     `(*->preserve ,src-stx)]
    [(CompoundPattern-rec label-pat fields-pat)
     `(record ,(pattern->unparser label-pat src-stx) ,(pattern->unparser fields-pat src-stx))]
    [(CompoundPattern-tuple named-pats)
     `(list ,@(for/list [(p (in-list named-pats))] (pattern->unparser p src-stx)))]
    [(CompoundPattern-tuple* fixed-named-pats variable-named-pat)
     `(list* ,@(for/list [(p (in-list fixed-named-pats))] (pattern->unparser p src-stx))
             ,(pattern->unparser variable-named-pat src-stx))]
    [(CompoundPattern-dict (DictionaryEntries entries))
     `(hash ,@(append-map (lambda (entry)
                            (list `',(car entry)
                                  (pattern->unparser (cdr entry) src-stx)))
                          (sorted-dict-entries entries)))]))