#lang racket

#|
File: language/fundef.rkt
Author: Bill Turtle (wrturtle)

`fun' and `def' at the pypar layer
|#

(require (for-syntax syntax/parse))
(require (for-syntax "indent.rkt"))
(require (for-syntax racket/list))
(provide make-fun-and-def)

(define-syntax (make-fun-and-def stx)
  (syntax-parse stx
    [(_ fun-name:id def-name:id fun-to-use:id def-to-use:id)
     (syntax/loc stx
       (begin
         (define-syntax (def-name stx)
           (syntax-parse stx
             [(_ name:id expr:expr)
              ; no need for indentation checking
              (syntax/loc stx
                (def-to-use name expr))]))
         (define-syntax (fun-name stx)
           (syntax-parse stx
             [(kw_ name:id (args:id (... ...)) body:expr ...+)
              (let ([body-list (syntax->list (syntax (body (... ...))))]
                    [kw (syntax kw_)])
                ; first, check to make sure that every item in the body
                ; is indented correctly relative to the keyword
                (for-each (lambda (stx) (check-indent 'SLGC kw stx))
                          body-list)
                ; now make sure that the body expressions are lined up
                (let ([f (first body-list)]
                      [r (rest body-list)])
                  (for-each (lambda (stx) (check-indent 'SLSC f stx))
                            r))
                ; looks like indentation is good -- now we need to expand
                (let ([num-body-exprs (length body-list)]
                      [l (reverse (rest (reverse body-list)))]
                      [def-ctx (syntax-local-make-definition-context)]
                      [expand-context (cons (gensym 'intdef)
                                            (let ([orig-ctx (syntax-local-context)])
                                              (if (pair? orig-ctx)
                                                  orig-ctx
                                                  '())))])
                  (let ([expanded
                         (map
                           (lambda (stx)
                             (local-expand stx 
                                           expand-context 
                                           (list (syntax fun-to-use) (syntax def-to-use))
                                           def-ctx))
                           (reverse (rest (reverse body-list))))])
                    (internal-definition-context-seal def-ctx)
                    (with-syntax ([lst (last body-list)])
                      (quasisyntax/loc stx
                        (fun-to-use (name args (... ...))
                          (unsyntax-splicing expanded)
                          lst))))))]))))]))