From f4cbcc0ac5932a1e353a66ea2979fcf938368604 Mon Sep 17 00:00:00 2001 From: Matthew Butterick Date: Mon, 9 Jul 2018 16:11:28 -0600 Subject: [PATCH] shorten --- .../pythonesque-demo/grammar.rkt | 14 ++-- .../pythonesque-demo/main.rkt | 82 ++++++++++--------- 2 files changed, 50 insertions(+), 46 deletions(-) diff --git a/beautiful-racket-demo/pythonesque-demo/grammar.rkt b/beautiful-racket-demo/pythonesque-demo/grammar.rkt index b67d4b9..3a64690 100644 --- a/beautiful-racket-demo/pythonesque-demo/grammar.rkt +++ b/beautiful-racket-demo/pythonesque-demo/grammar.rkt @@ -1,15 +1,15 @@ #lang brag -top : @statement* -statement : func-def | expr | return | if -func-def : /"def" var /"(" ids /")" /":" @block +top : statement* +@statement : func-def | expr | return | if +func-def : /"def" var /"(" ids /")" /":" block /ids : [var (/"," var)*] -block : /INDENT @statement* /DEDENT +block : /INDENT statement* /DEDENT @expr : comparison comparison : [comparison "<"] value -@value : var | INTEGER | func-app | STRING -func-app : var /"(" @exprs /")" -exprs : [expr (/"," expr)*] +@value : var | INT | func-app | STRING +func-app : var /"(" exprs /")" +@exprs : [expr (/"," expr)*] return : /"return" expr if : /"if" expr /":" block [/"else" /":" block] @var : ID \ No newline at end of file diff --git a/beautiful-racket-demo/pythonesque-demo/main.rkt b/beautiful-racket-demo/pythonesque-demo/main.rkt index 16bfb4e..138123f 100644 --- a/beautiful-racket-demo/pythonesque-demo/main.rkt +++ b/beautiful-racket-demo/pythonesque-demo/main.rkt @@ -10,68 +10,72 @@ (define-lex-abbrev indent (:: (:+ "\n") (:* " "))) (define prev-indent 0) -(define pending-dedents 0) +(define pending-dedents 0) -(define (lex ip) - (define inner-lex - (lexer - [(eof) (cond - [(> prev-indent 0) - (set! pending-dedents prev-indent) - (set! prev-indent 0) - (lex input-port)] - [else eof])] - [(from/stop-before "#" "\n") (token 'COMMENT #:skip? #t)] - [indent - (match-let* ([(list _ spaces) (regexp-match #rx"^\n+( *)$" lexeme)] - [this-indent (/ (string-length spaces) 2)]) - (define tok - (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)) - (lex input-port)] - [(= this-indent prev-indent) (token lexeme #:skip? #t)])) - (set! prev-indent this-indent) - tok)] - [(:+ whitespace) (token lexeme #:skip? #t)] - [reserved-terms lexeme] - [(:+ (:- (:or alphabetic punctuation) reserved-terms)) - (token 'ID (string->symbol lexeme))] - [(:+ (char-set "0123456789")) - (token 'INTEGER (string->number lexeme))])) +(define (tokenize ip) (cond - [(equal? (peek-char ip) #\") (token 'STRING (read ip))] + ;; 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 (inner-lex ip)])) + [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-cases comparison - [(_ LEFT "<" RIGHT) #'(< LEFT RIGHT)] - [(_ OTHER) #'OTHER]) - (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-syntax-parameter return (λ (stx) (error 'not-parameterized))) +(define-macro block #'begin) + +(define-macro-cases comparison + [(_ LEFT "<" RIGHT) #'(< LEFT RIGHT)] + [(_ OTHER) #'OTHER]) (define-macro func-app #'#%app) -(define-macro block #'begin) +(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 parse-tree (parse (λ () (lex ip)))) + (define token-thunk (λ () (tokenize ip))) + (define parse-tree (parse token-thunk)) (strip-context (with-syntax ([PT parse-tree]) #'(module pyname pythonesque-demo