[honu] add list comprehensions

This commit is contained in:
Jon Rafkind 2011-08-19 16:04:49 -06:00
parent 816b1747e9
commit 6b766cd395
9 changed files with 47 additions and 14 deletions

View File

@ -21,6 +21,8 @@
[honu-> >] [honu-< <]
[honu->= >=] [honu-<= <=]
[honu-= =]
[literal:honu-<- <-]
[honu-map map]
[honu-flow \|]
[honu-dot |.|]
[honu-cons ::]

View File

@ -149,5 +149,6 @@
(define-binary-operator honu-and 0.5 'left and)
(define-binary-operator honu-or 0.5 'left or)
(define-binary-operator honu-cons 0.1 'right cons)
(define-binary-operator honu-map 0.09 'left map)
(define-unary-operator honu-not 0.7 'left not)

View File

@ -19,6 +19,7 @@
honu-&= honu-^= honu-\|= honu-<<= honu->>= honu->>>=
honu->> honu-<< honu->>> honu-< honu-> honu-<= honu->=
honu-!= honu-==
honu-<-
honu-literal
honu-then
honu-? honu-: honu-comma honu-. #%braces #%brackets #%parens colon
@ -27,4 +28,4 @@
honu-for-syntax
honu-for-template)
(define-literal-set cruft (#%parens #%brackets #%braces semicolon colon honu-comma))
(define-literal-set cruft (#%parens #%brackets #%braces semicolon colon honu-comma honu-<-))

View File

@ -225,17 +225,26 @@
(do-parse #'(rest ...) precedence left #'x))]
;; [1, 2, 3] -> (list 1 2 3)
[(#%brackets stuff ...)
(define value (with-syntax ([(data ...)
(parse-comma-expression #'(stuff ...))])
#'(list data ...)))
(define lookup (with-syntax ([(data ...)
(parse-comma-expression #'(stuff ...))]
[current current])
#'(do-lookup current data ...)))
(if current
;; (values (left current) stream)
(do-parse #'(rest ...) precedence left lookup)
(do-parse #'(rest ...) precedence left value))]
(syntax-parse #'(stuff ...) #:literal-sets (cruft)
[(work:honu-expression colon (~seq variable:id honu-<- list:honu-expression (~optional honu-comma)) ...)
(define comprehension #'(for/list ([variable list.result]
...)
work.result))
(if current
(error 'parse "a list comprehension cannot follow an expression")
(do-parse #'(rest ...) precedence left comprehension))]
[else
(define value (with-syntax ([(data ...)
(parse-comma-expression #'(stuff ...))])
#'(list data ...)))
(define lookup (with-syntax ([(data ...)
(parse-comma-expression #'(stuff ...))]
[current current])
#'(do-lookup current data ...)))
(if current
;; (values (left current) stream)
(do-parse #'(rest ...) precedence left lookup)
(do-parse #'(rest ...) precedence left value))])]
;; block of code
[(#%braces stuff ...)
(if current

View File

@ -34,7 +34,7 @@
(:~ #\")))
(define-lex-abbrev string (:: #\" (:* string-character) #\"))
(define-lex-abbrev operator (:or "+" "=" "*" "/" "-" "^" "||" "|" "&&" "<="
">=" "<" ">" "!" "::"))
">=" "<-" "<" ">" "!" "::"))
(define-lex-abbrev block-comment (:: "/*"
(complement (:: any-string "*/" any-string))
"*/"))

View File

@ -21,6 +21,7 @@
number? symbol?
null
null?
length
(rename-out [honu-cond cond]
[null empty]
[racket:empty? empty?]

View File

@ -0,0 +1,5 @@
#lang honu
[x + 2: x <- [1, 2, 3]];
[x + y: x <- [1, 2, 3], y <- [5, 6, 7]]

View File

@ -0,0 +1,3 @@
#lang honu
function(x){ x + 1 } map 1 :: 2 :: 3 :: null;

View File

@ -39,7 +39,9 @@
(apply string-append "" (append stuff (list "\n"))))
(define (test input output)
(same? (run-honu input) output))
(define final (run-honu input))
(when (not (same? final output))
(printf "Not the same!\n'~a'\nvs\n'~a'\n" final output)))
(define (input . stuff)
(apply string-append "#lang honu\n" stuff))
@ -94,3 +96,12 @@
@output{1
})
(test
@input{
[x + 1: x <- [1, 2, 3]];
[x + y: x <- [1, 2, 3], y <- [4, 5, 6]]
}
@output{'(2 3 4)
'(5 7 9)})