Skip to content

Commit 91f9e82

Browse files
vtjnashvtjnash
committed
remove magic ccall handling from parsing
1 parent 604d5a8 commit 91f9e82

File tree

4 files changed

+45
-53
lines changed

4 files changed

+45
-53
lines changed

‎src/julia-parser.scm

Lines changed: 1 addition & 12 deletions
Original file line numberDiff line numberDiff line change
@@ -113,7 +113,7 @@
113113

114114
(define initial-reserved-words '(begin while if for try return break continue
115115
function macro quote let local global const
116-
abstract typealias type bitstype immutable ccall do
116+
abstract typealias type bitstype immutable do
117117
module baremodule using import export importall))
118118

119119
(define initial-reserved-word? (Set initial-reserved-words))
@@ -1360,17 +1360,6 @@
13601360
(if (length= imports 1)
13611361
(car imports)
13621362
(cons 'toplevel imports))))
1363-
((ccall)
1364-
(if (not (eqv? (peek-token s) #\())
1365-
(error "invalid \"ccall\" syntax")
1366-
(begin
1367-
(take-token s)
1368-
(let ((al (parse-arglist s #\))))
1369-
(if (and (length> al 1)
1370-
(memq (cadr al) '(cdecl stdcall fastcall thiscall llvmcall)))
1371-
;; place (callingconv) at end of arglist
1372-
`(ccall ,(car al) ,@(cddr al) (,(cadr al)))
1373-
`(ccall ,.al))))))
13741363
((do)
13751364
(error "invalid \"do\" syntax"))
13761365
(else (error "unhandled reserved word")))))))

‎src/julia-syntax.scm

Lines changed: 39 additions & 40 deletions
Original file line numberDiff line numberDiff line change
@@ -533,10 +533,10 @@
533533
,@(if (null? vararg) '()
534534
(list `(... ,(arg-name (car vararg))))))
535535
;; otherwise add to rest keywords
536-
`(ccall 'jl_array_ptr_1d_push Void (tuple Any Any)
537-
,rkw (tuple ,elt
536+
`(foreigncall 'jl_array_ptr_1d_push (core Void) (call (core svec) Any Any)
537+
,rkw 0 (tuple ,elt
538538
(call (core arrayref) ,kw
539-
(call (top +) ,ii 1)))))
539+
(call (top +) ,ii 1))) 0))
540540
(map list vars vals flags))))
541541
;; set keywords that weren't present to their default values
542542
,@(apply append
@@ -897,7 +897,7 @@
897897
(if (or (null? F) (null? A))
898898
`(block
899899
,.(reverse! stmts)
900-
(call (core ccall) ,name ,RT (call (core svec) ,@(dots->vararg atypes))
900+
(foreigncall ,name ,RT (call (core svec) ,@(dots->vararg atypes))
901901
,.(reverse! C)
902902
,@A))
903903
(let* ((a (car A))
@@ -1206,7 +1206,7 @@
12061206
(= ,err true)))
12071207
(= ,finally-exception (the_exception))
12081208
,finalb
1209-
(if ,err (ccall 'jl_rethrow_other Void (tuple Any) ,finally-exception))
1209+
(if ,err (foreigncall 'jl_rethrow_other (core Void) (call (core svec) Any) ,finally-exception 0))
12101210
,(if hasret
12111211
(if ret
12121212
`(if ,ret (return ,retval) ,val)
@@ -1411,20 +1411,20 @@
14111411
(if (null? stmts)
14121412
(loop (cdr kw) (list* (caddr arg) `(quote ,(cadr arg)) initial-kw) stmts #t)
14131413
(loop (cdr kw) initial-kw
1414-
(cons `(ccall 'jl_array_ptr_1d_push2 Void (tuple Any Any Any)
1415-
,container
1416-
(|::| (quote ,(cadr arg)) (core Symbol))
1417-
,(caddr arg))
1414+
(cons `(foreigncall 'jl_array_ptr_1d_push2 (core Void) (call (core svec) Any Any Any)
1415+
,container 0
1416+
(|::| (quote ,(cadr arg)) (core Symbol)) 0
1417+
,(caddr arg) 0)
14181418
stmts)
14191419
#t)))
14201420
(else
14211421
(loop (cdr kw) initial-kw
14221422
(cons (let* ((k (make-ssavalue))
14231423
(v (make-ssavalue))
1424-
(push-expr `(ccall 'jl_array_ptr_1d_push2 Void (tuple Any Any Any)
1425-
,container
1426-
(|::| ,k (core Symbol))
1427-
,v)))
1424+
(push-expr `(foreigncall 'jl_array_ptr_1d_push2 (core Void) (call (core svec) Any Any Any)
1425+
,container 0
1426+
(|::| ,k (core Symbol)) 0
1427+
,v 0)))
14281428
(if (vararg? arg)
14291429
`(for (= (tuple ,k ,v) ,(cadr arg))
14301430
,push-expr)
@@ -1957,6 +1957,24 @@
19571957
(let ((f (cadr e)))
19581958
(cond ((dotop? f)
19591959
(expand-fuse-broadcast '() `(|.| ,(undotop f) (tuple ,@(cddr e)))))
1960+
((and (eq? f 'ccall) (length> e 4))
1961+
(let* ((cconv (cadddr e))
1962+
(have-cconv (memq cconv '(cdecl stdcall fastcall thiscall llvmcall)))
1963+
(after-cconv (if have-cconv (cddddr e) (cdddr e)))
1964+
(name (caddr e))
1965+
(RT (car after-cconv))
1966+
(argtypes (cadr after-cconv))
1967+
(args (cddr after-cconv)))
1968+
(begin
1969+
(if (not (and (pair? argtypes)
1970+
(eq? (car argtypes) 'tuple)))
1971+
(if (and (pair? RT)
1972+
(eq? (car RT) 'tuple))
1973+
(error "ccall argument types must be a tuple; try \"(T,)\" and check if you specified a correct return type")
1974+
(error "ccall argument types must be a tuple; try \"(T,)\"")))
1975+
(expand-forms
1976+
(lower-ccall name RT (cdr argtypes)
1977+
(if have-cconv (append args (list (list cconv))) args)))))) ;; place (callingconv) at end of arglist
19601978
((and (pair? (caddr e))
19611979
(eq? (car (caddr e)) 'parameters))
19621980
;; (call f (parameters . kwargs) ...)
@@ -2169,24 +2187,6 @@
21692187
'|'| (lambda (e) `(call ctranspose ,(expand-forms (cadr e))))
21702188
'|.'| (lambda (e) `(call transpose ,(expand-forms (cadr e))))
21712189

2172-
'ccall
2173-
(lambda (e)
2174-
(if (length> e 3)
2175-
(let ((name (cadr e))
2176-
(RT (caddr e))
2177-
(argtypes (cadddr e))
2178-
(args (cddddr e)))
2179-
(begin
2180-
(if (not (and (pair? argtypes)
2181-
(eq? (car argtypes) 'tuple)))
2182-
(if (and (pair? RT)
2183-
(eq? (car RT) 'tuple))
2184-
(error "ccall argument types must be a tuple; try \"(T,)\" and check if you specified a correct return type")
2185-
(error "ccall argument types must be a tuple; try \"(T,)\"")))
2186-
(expand-forms
2187-
(lower-ccall name RT (cdr argtypes) args))))
2188-
e))
2189-
21902190
'generator
21912191
(lambda (e)
21922192
(let* ((expr (cadr e))
@@ -3255,18 +3255,17 @@ f(x) = yt(x)
32553255
((and (pair? e) (eq? (car e) 'globalref)) (emit e) #f) ;; keep globals for undefined-var checking
32563256
(else #f)))
32573257
(case (car e)
3258-
((call new)
3259-
(let* ((ccall? (and (eq? (car e) 'call) (equal? (cadr e) '(core ccall))))
3260-
(args (if ccall?
3258+
((call new foreigncall)
3259+
(let* ((args (if (eq? (car e) 'foreigncall)
32613260
;; NOTE: 2nd and 3rd arguments of ccall must be left in place
32623261
;; the 1st should be compiled if an atom.
3263-
(append (list (cadr e))
3264-
(cond (atom? (caddr e) (compile-args (list (caddr e)) break-labels))
3265-
(else (caddr e)))
3266-
(list-head (cdddr e) 2)
3267-
(compile-args (list-tail e 5) break-labels))
3262+
(append (list)
3263+
(cond (atom? (cadr e) (compile-args (list (cadr e)) break-labels))
3264+
(else (cadr e)))
3265+
(list-head (cddr e) 2)
3266+
(compile-args (list-tail e 4) break-labels))
32683267
(compile-args (cdr e) break-labels)))
3269-
(callex (cons (car e) args)))
3268+
(callex (if (eq? (car e) 'foreigncall) (cons 'call (cons `(core ccall) args)) (cons (car e) args))))
32703269
(cond (tail (emit-return callex))
32713270
(value callex)
32723271
((eq? (car e) 'new) #f)

‎src/macroexpand.scm

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -203,7 +203,7 @@
203203
m inarg))
204204

205205
(define (resolve-expansion-vars- e env m inarg)
206-
(cond ((or (eq? e 'true) (eq? e 'false) (eq? e 'end))
206+
(cond ((or (eq? e 'true) (eq? e 'false) (eq? e 'end) (eq? e 'ccall))
207207
e)
208208
((symbol? e)
209209
(let ((a (assq e env)))

‎test/parse.jl

Lines changed: 4 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -924,3 +924,7 @@ let
924924
end
925925
@test c8925 == 3 && isconst(:c8925)
926926
@test d8925 == 4 && isconst(:d8925)
927+
928+
# issue #18754: parse ccall as a regular function
929+
@test parse("ccall([1], 2)[3]") == Expr(:ref, Expr(:call, :ccall, Expr(:vect, 1), 2), 3)
930+
@test parse("ccall(a).member") == Expr(:., Expr(:call, :ccall, :a), QuoteNode(:member))

0 commit comments

Comments
 (0)