#lang scheme/base

(require (for-syntax scheme/base)
         (for-syntax (prefix-in reader: "reader.ss")))
(require scheme/include
         "parser.ss"
         "ast.ss")
(provide (all-from-out "ast.ss")
         include-c
         typedef struct union enum array pointer)
(provide parse-decl parse-decls)

(define-syntax (include-c stx)
  (syntax-case stx ()
    [(_ path)
     (syntax/loc stx
       #'(include/reader path reader:read-syntax))]))

;; =============================================================================
;; PSEUDO-C MACROS
;; =============================================================================

(define-syntax (type stx)
  (syntax-case stx ()
    [(type id)
     (identifier? #'id)
     #'(make-type:ref 'id)]
    [(type t)
     #'(let ([tmp t])
         (if (decl:type:tagged? tmp)
             (decl:type:tagged-type tmp)
             tmp))]))

(define-syntax (typedef stx)
  (syntax-case stx ()
    [(_ t name)
     #'(make-decl:type:def (type t) '((name . #f)))]))

(define-syntax (struct stx)
  (syntax-case stx ()
    [(_ tag)
     (identifier? #'tag)
     #'(make-decl:type:tagged (make-type:struct 'tag #f))]
    [(_ tag (field ...))
     (identifier? #'tag)
     #'(make-decl:type:tagged (make-type:struct 'tag (list (struct-field field) ...)))]
    [(_ (field ...))
     #'(make-decl:type:tagged (make-type:struct #f (list (struct-field field) ...)))]))

(define-syntax (struct-field stx)
  (syntax-case stx ()
    [(_ [t name])
     #'`(name . ,(type t))]
    [(_ name)
     #'`(name . #f)]))

(define-syntax (union stx)
  (syntax-case stx ()
    [(_ tag)
     (identifier? #'tag)
     #'(make-decl:type:tagged (make-type:union 'tag #f))]
    [(_ tag (variant ...))
     (identifier? #'tag)
     #'(make-decl:type:tagged (make-type:union 'tag (list (union-variant variant) ...)))]
    [(_ (variant ...))
     #'(make-decl:type:tagged (make-type:union #f (list (union-variant variant) ...)))]))

(define-syntax (union-variant stx)
  (syntax-case stx ()
    [(_ [t name])
     #'`(name . ,(type t))]
    [(_ name)
     #'`(name . #f)]))

(define-syntax (enum stx)
  (syntax-case stx ()
    [(_ tag)
     (identifier? #'tag)
     #'(make-decl:type:tagged (make-type:enum 'tag #f))]
    [(_ tag (variant ...))
     (identifier? #'tag)
     #'(make-decl:type:tagged (make-type:enum 'tag (list (enum-variant variant) ...)))]
    [(_ (variant ...))
     #'(make-decl:type:tagged (make-type:enum #f (list (enum-variant variant) ...)))]))

(define-syntax (enum-variant stx)
  (syntax-case stx ()
    [(_ [name expr])
     #'`(name . ,(make-expr:lit 'int expr))]
    [(_ name)
     #'`(name . #f)]))

(define array (procedure-rename make-type:array 'array))
(define pointer (procedure-rename make-type:pointer 'pointer))