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/pl-checklist-lang-maker/main.rkt

64 lines
1.6 KiB
Racket

#lang at-exp br/quicklang
(require brag/support racket/runtime-path racket/file)
(module reader syntax/module-reader
pl-checklist-lang-maker/main)
(provide (rename-out [plc-mb #%module-begin]))
(define-macro (plc-mb . ARGS)
#'(#%module-begin
(module+ main
(displayln "My new #lang technique is unstoppable"))
(module+ reader
(provide (rename-out [plc-rs read-syntax])))))
(define (plc-rs path ip)
(strip-context
(with-syntax ([PT (parse (λ () (plc-lexer ip)))])
#'(module _ (submod pl-checklist-lang-maker expander)
PT))))
(define plc-lexer
(lexer
[whitespace (token 'WHITE #:skip? #t)]
[(:: "(" (:? " ") ")") (token 'VALUE #f)]
[(:: "(" any-char ")") (token 'VALUE #t)]
[(:+ alphabetic punctuation) (token 'WORD lexeme)]))
@module/lang[parser]{
#lang brag
plc-top : (/WORD | plc-field)*
/plc-field : VALUE WORD
}
(require 'parser)
(module+ expander
(provide #%module-begin plc-top))
(define-runtime-path checklist "checklist.txt")
(define-macro-cases plc-top
[(_) #'(displayln (string-append "\n" (file->string checklist)))]
[(_ (VAL NAME) ...)
#'(let ([adjectives (map cdr (filter car (list '(VAL . NAME) ...)))])
(stringify adjectives))])
(define (stringify adjectives)
(displayln "")
(display
(if (pair? adjectives)
(string-append
"You appear to be proposing a new "
(string-join adjectives ", ")
" language. "
(if (< (length adjectives) 6)
"\n\nThat will never work."
"\n\nNow you're showing some ambition! Welcome to Racket School!"))
"No language proposed. You are in danger of flunking out.")))