shorten

beautiful-racket-demo/pythonesque-demo/grammar.rkt

@@ -1,15 +1,15 @@
 #lang brag
 
-top : @statement*
+top : statement*
-statement : func-def | expr | return | if
+@statement : func-def | expr | return | if
-func-def : /"def" var /"(" ids /")" /":" @block
+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
+@value : var | INT | func-app | STRING
-func-app : var /"(" @exprs /")"
+func-app : var /"(" exprs /")"
-exprs : [expr (/"," expr)*]
+@exprs : [expr (/"," expr)*]
 return : /"return" expr
 if : /"if" expr /":" block [/"else" /":" block]
 @var : ID

beautiful-racket-demo/pythonesque-demo/main.rkt

@@ -12,66 +12,70 @@
 (define prev-indent 0)
 (define pending-dedents 0) 
 
-(define (lex ip)
+(define (tokenize ip)
-  (define inner-lex
+  (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
+        [(eof)
-              [(> prev-indent 0)
+         (cond
+           [(> prev-indent 0) ; if last line is indented, queue dedents
             (set! pending-dedents prev-indent)
             (set! prev-indent 0)
-               (lex input-port)]
+            (tokenize input-port)]
-              [else eof])]
+           [else eof])] ; otherwise finish
         [(from/stop-before "#" "\n") (token 'COMMENT #:skip? #t)]
         [indent
-      (match-let* ([(list _ spaces) (regexp-match #rx"^\n+( *)$" lexeme)]
+         ;; measure current indent and take action based on
-                   [this-indent (/ (string-length spaces) 2)])
+         ;; whether it implies an indent, dedent, or neither
-        (define tok
+         (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))
-             (lex input-port)]
+                (tokenize input-port)]
-            [(= this-indent prev-indent) (token lexeme #:skip? #t)]))
+               [(= this-indent prev-indent) (token lexeme #:skip? #t)])
-        (set! prev-indent this-indent)
+             (set! prev-indent this-indent)))]
-        tok)]
+        [(:+ whitespace) (token 'WHITESPACE #:skip? #t)]
-     [(:+ whitespace) (token lexeme #:skip? #t)]
         [reserved-terms lexeme]
-     [(:+ (:- (:or alphabetic punctuation) reserved-terms))
+        [(:+ alphabetic) (token 'ID (string->symbol lexeme))]
-      (token 'ID (string->symbol lexeme))]
+        [(:+ (char-set "0123456789")) (token 'INT (string->number lexeme))]))
-     [(:+ (char-set "0123456789"))
+     (lex ip)]))
-      (token 'INTEGER (string->number lexeme))]))
-  (cond
-    [(equal? (peek-char ip) #\") (token 'STRING (read ip))]
-    [(> pending-dedents 0)
-     (set! pending-dedents (sub1 pending-dedents))
-     (token 'DEDENT)]
-    [else (inner-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