Skip to content
New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Add Dict comprehensions and typed Dicts #1467

Closed
wants to merge 3 commits into from
Closed
Show file tree
Hide file tree
Changes from all commits
Commits
File filter

Filter by extension

Filter by extension

Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
96 changes: 65 additions & 31 deletions src/julia-parser.scm
Original file line number Diff line number Diff line change
Expand Up @@ -107,6 +107,9 @@
(apply append
(map string->list (map symbol->string operators))))))

(define (dict-literal? l)
(and (length= l 3) (eq? (car l) '=>)))

; --- lexer ---

(define special-char?
Expand Down Expand Up @@ -756,8 +759,29 @@
((|.'| |'|) (take-token s)
(loop (list t ex)))
((#\{ ) (take-token s)
(loop (list* 'curly ex
(map subtype-syntax (parse-arglist s #\} )))))
(if (eqv? (peek-token s) '=>)
;; parse {=>} as a special case
(begin (take-token s)
(if (eqv? (require-token s) #\})
(begin (take-token s)
(if (not(dict-literal? ex))
(error "invalid dict type specification")
(loop (list* 'typed-dict ex '()))))
(error "invalid identifier name =>")))
(let ((al (parse-ref s #\})))
(if (dict-literal? ex)
(if (and (not(null? al)) (eq? (car al) 'comprehension))
(if (and (not(null? (cdr al)))
(dict-literal? (cadr al)))
(loop (list* 'typed-dict-comprehension ex (cdr al)))
(error "invalid dict comprehension syntax"))
(if (every dict-literal? al)
(loop (list* 'typed-dict ex al))
(else (error "invalid dict literal"))))
(if (any dict-literal? al)
(error "invalid dict type specification")
(loop (list* 'curly ex
(map subtype-syntax al))))))))
((#\")
(if (and (symbol? ex) (not (operator? ex))
(not (ts:space? s)))
Expand Down Expand Up @@ -1368,35 +1392,45 @@
;; cell expression
((eqv? t #\{ )
(take-token s)
(if (eqv? (require-token s) #\})
(begin (take-token s) '(cell1d))
(let ((vex (parse-cat s #\})))
(cond ((eq? (car vex) 'comprehension)
(list* 'typed-comprehension 'Any (cdr vex)))
((eq? (car vex) 'hcat)
`(cell2d 1 ,(length (cdr vex)) ,@(cdr vex)))
(else ; (vcat ...)
(if (and (pair? (cadr vex)) (eq? (caadr vex) 'row))
(let ((nr (length (cdr vex)))
(nc (length (cdadr vex))))
;; make sure all rows are the same length
(if (not (every
(lambda (x)
(and (pair? x)
(eq? (car x) 'row)
(length= (cdr x) nc)))
(cddr vex)))
(error "inconsistent shape in cell expression"))
`(cell2d ,nr ,nc
,@(apply append
;; transpose to storage order
(apply map list
(map cdr (cdr vex))))))
(if (any (lambda (x) (and (pair? x)
(eq? (car x) 'row)))
(cddr vex))
(error "inconsistent shape in cell expression")
`(cell1d ,@(cdr vex)))))))))
(if (eqv? (peek-token s) '=>)
;; parse {=>} as a special case
(begin (take-token s)
(if (eqv? (require-token s) #\})
(begin (take-token s)
(list* 'typed-dict '(=> Any Any) '()))
(error "invalid identifier name =>")))
(if (eqv? (require-token s) #\})
(begin (take-token s) '(cell1d))
(let ((vex (parse-cat s #\})))
(cond ((eq? (car vex) 'comprehension)
(if (and (not (null? (cdr vex)))
(dict-literal? (cadr vex)))
(list* 'dict-comprehension (cdr vex))
(list* 'typed-comprehension 'Any (cdr vex))))
((eq? (car vex) 'hcat)
`(cell2d 1 ,(length (cdr vex)) ,@(cdr vex)))
(else ; (vcat ...)
(if (and (pair? (cadr vex)) (eq? (caadr vex) 'row))
(let ((nr (length (cdr vex)))
(nc (length (cdadr vex))))
;; make sure all rows are the same length
(if (not (every
(lambda (x)
(and (pair? x)
(eq? (car x) 'row)
(length= (cdr x) nc)))
(cddr vex)))
(error "inconsistent shape in cell expression"))
`(cell2d ,nr ,nc
,@(apply append
;; transpose to storage order
(apply map list
(map cdr (cdr vex))))))
(if (any (lambda (x) (and (pair? x)
(eq? (car x) 'row)))
(cddr vex))
(error "inconsistent shape in cell expression")
`(cell1d ,@(cdr vex))))))))))

;; cat expression
((eqv? t #\[ )
Expand Down
87 changes: 82 additions & 5 deletions src/julia-syntax.scm
Original file line number Diff line number Diff line change
Expand Up @@ -839,6 +839,15 @@

(pattern-lambda (... a) `(curly ... ,a))

;; typed dict syntax
(pattern-lambda (typed-dict atypes . args)
(if (and (length= atypes 3)
(eq? (car atypes) '=>))
`(call (curly (top Dict) ,(cadr atypes) ,(caddr atypes))
(tuple ,@(map cadr args))
(tuple ,@(map caddr args)))
(error "invalid typed-dict syntax")))

;; cell array syntax
(pattern-lambda (cell1d . args)
(cond ((any (lambda (e) (and (length= e 3)
Expand Down Expand Up @@ -1097,8 +1106,8 @@

(define (get-eltype)
(if (null? atype)
`((call (top eltype) ,oneresult))
`(,atype)))
`((call (top eltype) ,oneresult))
`(,atype)))

;; Evaluate the comprehension
`(scope-block
Expand Down Expand Up @@ -1137,7 +1146,7 @@

;; construct loops to cycle over all dimensions of an n-d comprehension
(define (construct-loops ranges)
(if (null? ranges)
(if (null? ranges)
`(block (= ,oneresult ,expr)
(type_goto ,initlabl)
(call (top assign) ,result ,oneresult ,ri)
Expand Down Expand Up @@ -1167,7 +1176,7 @@
(pattern-lambda
(typed-comprehension atype expr . ranges)
(if (any (lambda (x) (eq? x ':)) ranges)
(lower-nd-comprehension atype expr ranges)
(lower-nd-comprehension atype expr ranges)
(let ( (result (gensy))
(ri (gensy))
(rs (map (lambda (x) (gensy)) ranges)) )
Expand All @@ -1181,7 +1190,7 @@

;; construct loops to cycle over all dimensions of an n-d comprehension
(define (construct-loops ranges rs)
(if (null? ranges)
(if (null? ranges)
`(block (call (top assign) ,result ,expr ,ri)
(+= ,ri 1))
`(for (= ,(cadr (car ranges)) ,(car rs))
Expand All @@ -1199,6 +1208,74 @@
,(construct-loops (reverse ranges) (reverse rs))
,result))))))

;; dict comprehensions
(pattern-lambda
(dict-comprehension expr . ranges)
(if (any (lambda (x) (eq? x ':)) ranges)
(error "invalid iteration syntax")
(let ((result (gensy))
(initlabl (gensy))
(onekey (gensy))
(oneval (gensy))
(rv (map (lambda (x) (gensy)) ranges)))

;; construct loops to cycle over all dimensions of an n-d comprehension
(define (construct-loops ranges)
(if (null? ranges)
`(block (= ,onekey ,(cadr expr))
(= ,oneval ,(caddr expr))
(type_goto ,initlabl)
(call (top assign) ,result ,oneval ,onekey))
`(for ,(car ranges)
,(construct-loops (cdr ranges)))))

;; Evaluate the comprehension
(let ((loopranges
(map (lambda (r v) `(= ,(cadr r) ,v)) ranges rv)))
`(block
,@(map (lambda (v r) `(= ,v ,(caddr r))) rv ranges)
(scope-block
(block
(local ,onekey)
(local ,oneval)
,@(map (lambda (r) `(local ,r))
(apply append (map (lambda (r) (lhs-vars (cadr r))) ranges)))
(label ,initlabl)
(= ,result (call (curly (top Dict)
(static_typeof ,onekey)
(static_typeof ,oneval))))
,(construct-loops (reverse loopranges))
,result)))))))

;; typed dict comprehensions
(pattern-lambda
(typed-dict-comprehension atypes expr . ranges)
(if (any (lambda (x) (eq? x ':)) ranges)
(error "invalid iteration syntax")
(if (not (and (length= atypes 3)
(eq? (car atypes) '=>)))
(error "invalid typed-dict-comprehension syntax")
(let ( (result (gensy))
(rs (map (lambda (x) (gensy)) ranges)) )

;; construct loops to cycle over all dimensions of an n-d comprehension
(define (construct-loops ranges rs)
(if (null? ranges)
`(call (top assign) ,result ,(caddr expr) ,(cadr expr))
`(for (= ,(cadr (car ranges)) ,(car rs))
,(construct-loops (cdr ranges) (cdr rs)))))

;; Evaluate the comprehension
`(block
,@(map make-assignment rs (map caddr ranges))
(scope-block
(block
,@(map (lambda (r) `(local ,r))
(apply append (map (lambda (r) (lhs-vars (cadr r))) ranges)))
(= ,result (call (curly (top Dict) ,(cadr atypes) ,(caddr atypes))))
,(construct-loops (reverse ranges) (reverse rs))
,result)))))))

)) ;; lower-comprehensions


Expand Down