refinement

pull/21/head
Matthew Butterick 5 years ago
parent d649998e74
commit 7ea139ac4f

@ -1,8 +1,7 @@
#lang br #lang br
(require racket/stxparam) (require racket/stxparam)
(provide (all-defined-out) (provide (all-defined-out)
#%top-interaction #%top #%app #%app #%top #%datum #%top-interaction)
(rename-out [my-datum #%datum]))
(define-macro top #'#%module-begin) (define-macro top #'#%module-begin)
@ -18,20 +17,19 @@
[(_ VAL) #'VAL] [(_ VAL) #'VAL]
[(_ L "&&" R) #'(and L R)]) [(_ L "&&" R) #'(and L R)])
(define-macro (my-datum . VAL) (define-macro (my-app ID ARG ...)
(with-syntax ([NEW-VAL (let ([val (syntax->datum #'VAL)]) #'(error 'boom))
(cond
[(and (integer? val) (inexact? val))
(inexact->exact val)]
[(boolean? val) (if val "True" "False")]
[else val]))])
#'(#%datum . NEW-VAL)))
(define-macro (var ID VAL) #'(define ID VAL)) (define-macro-cases var
[(_ ID VAL) #'(define ID VAL)]
[(_ ID ... VAL) #'(begin (define ID VAL) ...)])
(define (add/concat . xs) (define (add/concat . xs)
(cond (cond
[(andmap number? xs) (apply + xs)] [(andmap number? xs) (let ([sum (apply + xs)])
(if (and (integer? sum) (inexact? sum))
(inexact->exact sum)
sum))]
[(ormap string? xs) (string-join (map ~a xs) "")])) [(ormap string? xs) (string-join (map ~a xs) "")]))
(define-macro-cases add-or-sub (define-macro-cases add-or-sub

@ -2,7 +2,7 @@
top : @statement* top : @statement*
statement : (var | expr | return | defun) /";" | if-else | while statement : (var | expr | return | defun) /";" | if-else | while
var : /"var" varname /"=" expr var : /"var" (varname /"=")+ expr
@expr : reassignment @expr : reassignment
reassignment : ID [("+=" | "-=") expr] | ternary reassignment : ID [("+=" | "-=") expr] | ternary
ternary : expr /"?" expr /":" expr | logical-or ternary : expr /"?" expr /":" expr | logical-or

@ -4,7 +4,7 @@
(module+ reader (module+ reader
(provide read-syntax)) (provide read-syntax))
(define-lex-abbrev reserved-terms (define-lex-abbrev reserved-toks
(:or "var" "=" ";" "{" "}" "//" "/*" "*/" (:or "var" "=" ";" "{" "}" "//" "/*" "*/"
"+" "*" "/" "-" "+" "*" "/" "-"
"'" "\"" "'" "\""
@ -20,14 +20,14 @@
(lexer-srcloc (lexer-srcloc
[(:or (from/stop-before "//" "\n") [(:or (from/stop-before "//" "\n")
(from/to "/*" "*/")) (token 'COMMENT #:skip? #t)] (from/to "/*" "*/")) (token 'COMMENT #:skip? #t)]
[reserved-terms lexeme] [reserved-toks lexeme]
[(:+ (:- (:or alphabetic punctuation) "." reserved-terms))
(token 'ID (string->symbol lexeme))]
[(:+ (:- (:or alphabetic punctuation) reserved-terms))
(token 'DEREF (map string->symbol (string-split lexeme ".")))]
[(:seq (:? "-") (:or (:seq (:? digits) "." digits) [(:seq (:? "-") (:or (:seq (:? digits) "." digits)
(:seq digits (:? ".")))) (:seq digits (:? "."))))
(token 'NUMBER (string->number lexeme))] (token 'NUMBER (string->number lexeme))]
[(:seq (:+ (:- (:or alphabetic punctuation digits) reserved-toks)))
(if (string-contains? lexeme ".")
(token 'DEREF (map string->symbol (string-split lexeme ".")))
(token 'ID (string->symbol lexeme)))]
[(:or (from/to "\"" "\"") (from/to "'" "'")) [(:or (from/to "\"" "\"") (from/to "'" "'"))
(token 'STRING (string-trim lexeme (substring lexeme 0 1)))] (token 'STRING (string-trim lexeme (substring lexeme 0 1)))]
[whitespace (token 'WHITE #:skip? #t)] [whitespace (token 'WHITE #:skip? #t)]

Loading…
Cancel
Save