You cannot select more than 25 topics Topics must start with a letter or number, can include dashes ('-') and can be up to 35 characters long.
beautiful-racket/beautiful-racket-demo/pythonesque-demo/main.rkt

82 lines
2.7 KiB
Racket

#lang br/quicklang
(require "grammar.rkt" brag/support racket/stxparam)
(provide #%module-begin (all-defined-out))
(module+ reader
(provide read-syntax))
(define-lex-abbrev reserved-terms
(:or "def" "(" ")" ":" "," "return" "<" "if" "else"))
(define-lex-abbrev indent (:: (:+ "\n") (:* " ")))
(define prev-indent 0)
(define pending-dedents 0)
(define (tokenize ip)
(cond
;; delegate string reading to Racket
[(eqv? (peek-char ip) #\") (token 'STRING (read ip))]
;; we queue dedents because we can only return one dedent at a time
[(> pending-dedents 0)
(set! pending-dedents (sub1 pending-dedents))
(token 'DEDENT)]
[else
(define lex
(lexer
[(eof)
(cond
[(> prev-indent 0) ; if last line is indented, queue dedents
(set! pending-dedents prev-indent)
(set! prev-indent 0)
(tokenize input-port)]
[else eof])] ; otherwise finish
[(from/stop-before "#" "\n") (token 'COMMENT #:skip? #t)]
[indent
;; measure current indent and take action based on
;; whether it implies an indent, dedent, or neither
(match-let* ([(list _ spaces) (regexp-match #rx"^\n+( *)$" lexeme)])
(define this-indent (/ (string-length spaces) 2))
(begin0
(cond
[(> (- this-indent prev-indent) 1) (error 'only-one-indent-please)]
[(> this-indent prev-indent) (token 'INDENT)]
[(< this-indent prev-indent)
(set! pending-dedents (- prev-indent this-indent))
(tokenize input-port)]
[(= this-indent prev-indent) (token lexeme #:skip? #t)])
(set! prev-indent this-indent)))]
[(:+ whitespace) (token 'WHITESPACE #:skip? #t)]
[reserved-terms lexeme]
[(:+ alphabetic) (token 'ID (string->symbol lexeme))]
[(:+ (char-set "0123456789")) (token 'INT (string->number lexeme))]))
(lex ip)]))
(define-macro top #'begin)
(define-macro (func-def VAR VARS STMT ...)
#'(define (VAR . VARS)
(let/cc return-cc
(syntax-parameterize ([return (make-rename-transformer #'return-cc)])
STMT ... (void)))))
(define-macro block #'begin)
(define-macro-cases comparison
[(_ LEFT "<" RIGHT) #'(< LEFT RIGHT)]
[(_ OTHER) #'OTHER])
(define-macro func-app #'#%app)
(define-syntax-parameter return (λ (stx) (error 'not-parameterized)))
(provide (rename-out [my-if if]))
(define-macro (my-if COND TBLOCK FBLOCK)
#'(if COND (let () TBLOCK) (let () FBLOCK)))
(define (read-syntax src ip)
(define token-thunk (λ () (tokenize ip)))
(define parse-tree (parse token-thunk))
(strip-context
(with-syntax ([PT parse-tree])
#'(module pyname pythonesque-demo
PT))))