← Back to branch summary

~ubuntu-branches/ubuntu/wily/julia/wily

« back to all changes in this revision

Viewing changes to src/julia-syntax.scm

  • Committer: Package Import Robot
  • Author(s): Sébastien Villemot
  • Date: 2013-11-17 19:32:52 UTC
  • mfrom: (1.1.12)
  • Revision ID: package-import@ubuntu.com-20131117193252-tkrpclguqqebqa35
Tags: 0.2.0+dfsg-3
testsuite-i386.patch: loosen the numerical precision for yet another test.

Show diffs side-by-side

added added

removed removed

Lines of Context:
src/julia-syntax.scm
69
69
(define (effect-free? e)
70
70
  (or (not (pair? e)) (sym-dot? e) (quoted? e) (equal? e '(null))))
71
71
 
 
72
(define (undot-name e)
 
73
  (if (symbol? e)
 
74
      e
 
75
      (cadr (caddr e))))
 
76
 
72
77
; make an expression safe for multiple evaluation
73
78
; for example a[f(x)] => (temp=f(x); a[temp])
74
79
; retuns a pair (expr . assignments)
373
378
     (let* ((types (llist-types argl))
374
379
            (body  (method-lambda-expr argl body)))
375
380
       (if (null? sparams)
376
 
           `(method ,name (tuple ,@types) ,body (tuple))
377
 
           (let ((f (gensy)))
378
 
             `(call (lambda (,@names ,f)
379
 
                      (method ,name (tuple ,@types) ,f (tuple ,@names)))
380
 
                    ,@(symbols->typevars names bounds #t)
381
 
                    ,body)))))))
 
381
           `(method ,name (tuple (tuple ,@types) (tuple)) ,body)
 
382
           `(method ,name
 
383
                    (call (lambda ,names
 
384
                            (tuple (tuple ,@types) (tuple ,@names)))
 
385
                          ,@(symbols->typevars names bounds #t))
 
386
                    ,body))))))
382
387
 
383
388
(define (vararg? x) (and (pair? x) (eq? (car x) '...)))
384
389
(define (trans?  x) (and (pair? x) (eq? (car x) '|.'|)))
435
440
          (map (lambda (s) (if (symbol? s) s (cadr s))) keyword-sparams)))
436
441
    (let ((kw (gensy)) (i (gensy)) (ii (gensy)) (elt (gensy)) (rkw (gensy))
437
442
          (mangled (symbol (string "__"
438
 
                                   (if (symbol? name)
439
 
                                       name
440
 
                                       (cadr (caddr name)))
 
443
                                   (undot-name name)
441
444
                                   "#"
442
445
                                   (string.sub (string (gensym)) 1)
443
446
                                   "__")))
449
452
          `(,@vars ,@restkw ,@pargl ,@vararg)
450
453
          `(block
451
454
            ,@(if (null? lno) '()
452
 
                  (list (append (car lno) (list name))))
 
455
                  (list (append (car lno) (list (undot-name name)))))
453
456
            ,@stmts))
454
457
 
455
458
        ;; call with no keyword args
525
528
                                   ,else)))
526
529
                          (if (null? restkw)
527
530
                              ;; if no rest kw, give error for unrecognized
528
 
                              `(call (top error) "unrecognized named argument " ,elt)
 
531
                              `(call (top error) "unrecognized keyword argument " ,elt)
529
532
                              ;; otherwise add to rest keywords
530
533
                              `(ccall 'jl_cell_1d_push Void (tuple Any Any)
531
534
                                      ,rkw (tuple ,elt
779
782
                             ,mut)))
780
783
           (scope-block
781
784
            (block
 
785
             (global ,name)
782
786
             (global ,@params)
783
787
             ,@(if (and (null? defs)
784
788
                        ;; don't generate an outer constructor if the type has
1256
1260
                                              (vararg? x))))
1257
1261
                         kw)))
1258
1262
    (if (pair? invalid)
1259
 
        (error (string "invalid named argument " (car invalid))))))
 
1263
        (if (and (pair? (car invalid)) (eq? 'parameters (caar invalid)))
 
1264
            (error "more than one semicolon in argument list")
 
1265
            (error (string "invalid keyword argument " (car invalid)))))))
1260
1266
 
1261
1267
(define (lower-kw-call f kw pa)
1262
1268
  (check-kw-args kw)
1263
1269
  (receive
1264
1270
   (keys restkeys) (separate kwarg? kw)
1265
1271
   (let ((keyargs (apply append
1266
 
                         (map (lambda (a) `((quote ,(cadr a)) ,(caddr a)))
 
1272
                         (map (lambda (a)
 
1273
                                (if (not (symbol? (cadr a)))
 
1274
                                    (error (string "keyword argument is not a symbol: " (cadr a))))
 
1275
                                `((quote ,(cadr a)) ,(caddr a)))
1267
1276
                              keys))))
1268
1277
     (if (null? restkeys)
1269
1278
         `(call (top kwcall) ,f ,(length keys) ,@keyargs
2740
2749
                     (vinfo:set-iasg! vi #t)))))
2741
2750
         `(method ,(cadr e)
2742
2751
                  ,(analyze-vars (caddr  e) env captvars)
2743
 
                  ,(analyze-vars (cadddr e) env captvars)
2744
 
                  ,(cadddr (cdr e))))
 
2752
                  ,(analyze-vars (cadddr e) env captvars)))
2745
2753
        (else (cons (car e)
2746
2754
                    (map (lambda (x) (analyze-vars x env captvars))
2747
2755
                         (cdr e))))))
3080
3088
      '()
3081
3089
      (case (car e)
3082
3090
        ((escape)  '())
3083
 
        ((= function)
 
3091
        ((= function ->)
3084
3092
         (append! (filter
3085
3093
                   symbol?
3086
3094
                   (if (and (pair? (cadr e)) (eq? (car (cadr e)) 'tuple))