shorten

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

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