#lang racket
(require "error-msgs.rkt")
(require "../utilities.rkt")
(require (for-syntax syntax/parse))
(require (for-syntax racket/syntax))
(require (for-syntax "../utilities.rkt"))
(require (for-syntax syntax/stx))
(require (for-syntax "indent.rkt"))
(require (prefix-in pysem:
(only-in "../semantics/beginner-syntax.rkt"
cond)))
(define-syntax (pypar-done stx)
(pypar-syntax-error "done: not allowed outside of an if statement" stx))
(define-syntax (pypar-else stx)
(pypar-syntax-error "else: not allowed outside of an if statement" stx))
(define-syntax (pypar-elif stx)
(pypar-syntax-error "elif: not allowed outside of an if statement" stx))
(define-syntax (pypar:if stx)
(define-syntax-class elif-expr
#:description "elif expression"
#:literals (pypar-elif)
(pattern (pypar-elif test:expr then:expr)))
(define-syntax-class else-expr
#:description "else expression"
#:literals (pypar-else)
(pattern (pypar-else then:expr)))
(syntax-parse stx
#:literals (pypar-done)
[(kw test:expr then:expr eli:elif-expr ...+ pypar-done)
(with-syntax* ([sloc (syntax->vector stx)]
[els (syntax/loc #'done (pypar-else (fell-through sloc)))])
(syntax/loc stx
(kw test then eli ... els)))]
[(kw test:expr then:expr eli:elif-expr ... els:else-expr)
(let ([elif-list (syntax->list (syntax (eli ...)))]
[els-stx (syntax els)])
(check-indent 'SLGC #'kw #'test)
(check-indent 'SLGC #'kw #'then)
(for-each (lambda (s)
(let ([elif-kw (stx-car s)]
[elif-test (stx-car (stx-cdr s))]
[elif-then (stx-car (stx-cdr (stx-cdr s)))])
(check-indent 'SLSC #'kw elif-kw)
(check-indent 'SLGC elif-kw elif-then)))
elif-list)
(check-indent 'SLSC #'kw (stx-car els-stx))
(check-indent 'SLGC (stx-car els-stx) (stx-car (stx-cdr els-stx)))
(syntax/loc stx
(pysem:cond
[test then]
[eli.test eli.then]
...
[else els.then])))]))
(define (fell-through sloc)
(raise-pyret-error MSG-COND-FELLTHROUGH
sloc))
(provide (rename-out [pypar:if if])
(rename-out [pypar-else else])
(rename-out [pypar-elif elif])
(rename-out [pypar-done done]))