fixes for very-linear mode

src/julia-syntax.scm

@@ -359,7 +359,7 @@
  types)))
  (call (core svec) ,@temps)))
  ,body ,isstaged))))
- (if (symbol? name)
+ (if (or (symbol? name) (globalref? name))
  `(block (method ,name) ,mdef (unnecessary ,name)) ;; return the function
  mdef)))))
 
@@ -1011,7 +1011,7 @@
  (dcl (and (pair? name) (eq? (car name) '|::|)))
  (rett (if dcl (caddr name) '(core Any)))
  (name (if dcl (cadr name) name)))
- (cond ((and (length= e 2) (symbol? name))
+ (cond ((and (length= e 2) (or (symbol? name) (globalref? name)))
  (if (or (eq? name 'true) (eq? name 'false))
  (error (string "invalid function name \"" name "\"")))
  `(method ,name))
@@ -3458,15 +3458,23 @@ f(x) = yt(x)
  (else #f)))
  (case (car e)
  ((call new foreigncall)
- (let* ((args (if (eq? (car e) 'foreigncall)
- ;; NOTE: 2nd to 5th arguments of ccall must be left in place
- ;; the 1st should be compiled if an atom.
- (append (list)
- (cond (atom? (cadr e) (compile-args (list (cadr e)) break-labels linearize-args))
- (else (cadr e)))
- (list-head (cddr e) 4)
- (compile-args (list-tail e 6) break-labels linearize-args))
- (compile-args (cdr e) break-labels linearize-args)))
+ (let* ((args
+ (cond ((eq? (car e) 'foreigncall)
+ ;; NOTE: 2nd to 5th arguments of ccall must be left in place
+ ;; the 1st should be compiled if an atom.
+ (append (if (atom? (cadr e))
+ (compile-args (list (cadr e)) break-labels linearize-args)
+ (list (cadr e)))
+ (list-head (cddr e) 4)
+ (compile-args (list-tail e 6) break-labels linearize-args)))
+ ;; TODO: evaluate first argument to cglobal some other way
+ ((and (length> e 2)
+ (or (eq? (cadr e) 'cglobal)
+ (equal? (cadr e) '(outerref cglobal))))
+ (list* (cadr e) (caddr e)
+ (compile-args (cdddr e) break-labels linearize-args)))
+ (else
+ (compile-args (cdr e) break-labels linearize-args))))
  (callex (cons (car e) args)))
  (cond (tail (emit-return callex))
  (value callex)
@@ -3674,26 +3682,28 @@ f(x) = yt(x)
 
  ;; top level expressions returning values
  ((abstract_type primitive_type struct_type thunk toplevel module)
- (case (car e)
- ((abstract_type)
- (let* ((para (compile (caddr e) break-labels #t #f))
- (supe (compile (cadddr e) break-labels #t #f)))
- (emit `(abstract_type ,(cadr e) ,para ,supe))))
- ((primitive_type)
- (let* ((para (compile (caddr e) break-labels #t #f))
- (supe (compile (list-ref e 4) break-labels #t #f)))
- (emit `(primitive_type ,(cadr e) ,para ,(cadddr e) ,supe))))
- ((struct_type)
- (let* ((para (compile (caddr e) break-labels #t #f))
- (supe (compile (list-ref e 4) break-labels #t #f))
- ;; struct_type has an unconventional evaluation rule that
- ;; needs to do work around the evaluation of the field types,
- ;; so the field type expressions need to be kept in place as
- ;; much as possible. (part of issue #21923)
- (ftys (compile (list-ref e 5) break-labels #t #f #f)))
- (emit `(struct_type ,(cadr e) ,para ,(cadddr e) ,supe ,ftys ,@(list-tail e 6)))))
- (else
- (emit e)))
+ (with-bindings
+ ((*very-linear-mode* #f)) ;; type defs use nonstandard evaluation order
+ (case (car e)
+ ((abstract_type)
+ (let* ((para (compile (caddr e) break-labels #t #f))
+ (supe (compile (cadddr e) break-labels #t #f)))
+ (emit `(abstract_type ,(cadr e) ,para ,supe))))
+ ((primitive_type)
+ (let* ((para (compile (caddr e) break-labels #t #f))
+ (supe (compile (list-ref e 4) break-labels #t #f)))
+ (emit `(primitive_type ,(cadr e) ,para ,(cadddr e) ,supe))))
+ ((struct_type)
+ (let* ((para (compile (caddr e) break-labels #t #f))
+ (supe (compile (list-ref e 4) break-labels #t #f))
+ ;; struct_type has an unconventional evaluation rule that
+ ;; needs to do work around the evaluation of the field types,
+ ;; so the field type expressions need to be kept in place as
+ ;; much as possible. (part of issue #21923)
+ (ftys (compile (list-ref e 5) break-labels #t #f #f)))
+ (emit `(struct_type ,(cadr e) ,para ,(cadddr e) ,supe ,ftys ,@(list-tail e 6)))))
+ (else
+ (emit e))))
  (if tail (emit-return '(null)))
  '(null))