183
183
(meta ret-type ,R)
184
184
,@(list-tail body (+ 1 (length meta))))))))))
185
185
186
+
186
187
; ; convert x<:T<:y etc. exprs into (name lower-bound upper-bound)
187
188
; ; a bound is #f if not specified
188
189
(define (analyze-typevar e )
753
754
(params bounds) (sparam-name-bounds params)
754
755
(struct-def-expr- name params bounds super (flatten-blocks fields) mut)))
755
756
756
- ; ; replace field names with gensyms if they conflict with field-types
757
- (define (safe-field-names field-names field-types )
758
- (if (any (lambda (v ) (contains (lambda (e ) (eq? e v)) field-types))
759
- field-names)
760
- (map (lambda (x ) (gensy)) field-names)
761
- ; ; use a different name for a field called `_`
762
- (map (lambda (x ) (if (eq? x '_ ) (gensy) x)) field-names)))
763
-
764
- (define (with-wheres call wheres )
765
- (if (pair? wheres)
766
- `(where ,call ,@wheres)
767
- call))
768
-
769
- (define (default-inner-ctors name field-names field-types params bounds locs )
770
- (let* ((field-names (safe-field-names field-names field-types))
771
- (all-ctor (if (null? params)
772
- ; ; definition with exact types for all arguments
773
- `(function (call ,name
774
- ,@(map make-decl field-names field-types))
775
- (block
776
- ,@locs
777
- (new (globalref (thismodule) ,name) ,@field-names)))
778
- #f ))
779
- (any-ctor (if (or (not all-ctor) (any (lambda (t ) (not (equal? t ' (core Any))))
780
- field-types))
781
- ; ; definition with Any for all arguments
782
- ; ; only if any field type is not Any, checked at runtime
783
- `(function (call (|::| |#ctor-self#|
784
- ,(with-wheres
785
- `(curly (core Type) ,(if (pair? params)
786
- `(curly ,name ,@params)
787
- name))
788
- (map (lambda (b ) (cons 'var-bounds b)) bounds)))
789
- ,@field-names)
790
- (block
791
- ,@locs
792
- (call new ,@field-names))) ; this will add convert calls later
793
- #f )))
794
- (if all-ctor
795
- (if any-ctor
796
- (list all-ctor
797
- `(if ,(foldl (lambda (t u )
798
- `(&& ,u (call (core ===) (core Any) ,t)))
799
- `(call (core ===) (core Any) ,(car field-types))
800
- (cdr field-types))
801
- ' (block)
802
- ,any-ctor))
803
- (list all-ctor))
804
- (list any-ctor))))
805
-
806
- (define (default-outer-ctor name field-names field-types params bounds locs )
807
- (let ((field-names (safe-field-names field-names field-types)))
808
- `(function ,(with-wheres
809
- `(call ,name ,@(map make-decl field-names field-types))
810
- (map (lambda (b ) (cons 'var-bounds b)) bounds))
811
- (block
812
- ,@locs
813
- (new (curly ,name ,@params) ,@field-names)))))
757
+ ; ; definition with Any for all arguments (except type, which is exact)
758
+ ; ; field-kinds:
759
+ ; ; -1 no convert (e.g. because it is Any)
760
+ ; ; 0 normal convert to fieldtype
761
+ ; ; 1+ static_parameter N
762
+ (define (default-inner-ctor-body field-kinds file line )
763
+ (let* ((name '|#ctor-self#| )
764
+ (field-names (map (lambda (idx ) (symbol (string " _" (+ idx 1 )))) (iota (length field-kinds))))
765
+ (field-convert (lambda (fld fty val )
766
+ (cond ((eq? fty -1) val)
767
+ ((> fty 0 ) (convert-for-type-decl val `(static_parameter ,fty) #f #f ))
768
+ (else (convert-for-type-decl val `(call (core fieldtype) ,name ,(+ fld 1 )) #f #f )))))
769
+ (field-vals (map field-convert (iota (length field-names)) field-kinds field-names))
770
+ (body `(block
771
+ (line ,line ,file)
772
+ (return (new ,name ,@field-vals)))))
773
+ `(lambda ,(cons name field-names) () (scope-block ,body))))
774
+
775
+ ; ; definition with exact types for all arguments (except type, which is not parameterized)
776
+ (define (default-outer-ctor-body thistype field-count sparam-count file line )
777
+ (let* ((name '|#ctor-self#| )
778
+ (field-names (map (lambda (idx ) (symbol (string " _" (+ idx 1 )))) (iota field-count)))
779
+ (sparams (map (lambda (idx ) `(static_parameter ,(+ idx 1 ))) (iota sparam-count)))
780
+ (type (if (null? sparams) name `(curly ,thistype ,@sparams)))
781
+ (body `(block
782
+ (line ,line ,file)
783
+ (return (new ,type ,@field-names)))))
784
+ `(lambda ,(cons name field-names) () (scope-block ,body))))
814
785
815
786
(define (num-non-varargs args )
816
787
(count (lambda (a ) (not (vararg? a))) args))
993
964
fields)))
994
965
(attrs (reverse attrs))
995
966
(defs (filter (lambda (x ) (not (or (effect-free? x) (eq? (car x) 'string )))) defs))
996
- (locs (if (and (pair? fields0) (linenum? (car fields0)))
997
- (list ( car fields0) )
998
- '() ))
967
+ (loc (if (and (pair? fields0) (linenum? (car fields0)))
968
+ (car fields0)
969
+ ' (line 0 || )))
999
970
(field-names (map decl-var fields))
1000
971
(field-types (map decl-type fields))
1001
- (defs2 (if (null? defs)
1002
- (default-inner-ctors name field-names field-types params bounds locs)
1003
- defs))
1004
972
(min-initialized (min (ctors-min-initialized defs) (length fields)))
1005
973
(hasprev (make-ssavalue))
1006
974
(prev (make-ssavalue))
1042
1010
(const (globalref (thismodule) ,name) ,newdef)
1043
1011
(latestworld)
1044
1012
(null)))
1045
- ; ; "inner" constructors
1046
- (scope-block
1047
- (block
1048
- (hardscope)
1049
- (global ,name)
1050
- ,@(map (lambda (c )
1051
- (rewrite-ctor c name params field-names field-types))
1052
- defs2)))
1053
- ; ; "outer" constructors
1054
- ,@(if (and (null? defs)
1055
- (not (null? params))
1056
- ; ; To generate an outer constructor, each parameter must occur in a field
1057
- ; ; type, or in the bounds of a subsequent parameter.
1058
- ; ; Otherwise the constructor would not work, since the parameter values
1059
- ; ; would never be specified.
1060
- (let loop ((root-types field-types)
1061
- (sp (reverse bounds)))
1062
- (or (null? sp)
1063
- (let ((p (car sp)))
1064
- (and (expr-contains-eq (car p) (cons 'list root-types))
1065
- (loop (append (cdr p) root-types)
1066
- (cdr sp)))))))
1067
- `((scope-block
1068
- (block
1069
- (global ,name)
1070
- ,(default-outer-ctor name field-names field-types
1071
- params bounds locs))))
1072
- '() )
1013
+ ; ; Always define ctors even if we didn't change the definition.
1014
+ ; ; If newdef===prev, then this is a bit suspect, since we don't know what might be
1015
+ ; ; changing about the old ctor definitions (we don't even track whether we're
1016
+ ; ; replacing defaultctors with identical ones). But it seems better to have the ctors
1017
+ ; ; added alongside (replacing) the old ones, than to not have them and need them.
1018
+ ; ; Commonly Revise.jl should be used to figure out actually which methods should
1019
+ ; ; actually be deleted or added anew.
1020
+ ,(if (null? defs)
1021
+ `(call (core _defaultctors) ,newdef (inert ,loc))
1022
+ `(scope-block
1023
+ (block
1024
+ (hardscope)
1025
+ (global ,name)
1026
+ ,@(map (lambda (c ) (rewrite-ctor c name params field-names field-types)) defs))))
1027
+ (latestworld)
1073
1028
(null)))))
1074
1029
1075
1030
(define (abstract-type-def-expr name params super )
@@ -4646,7 +4601,7 @@ f(x) = yt(x)
4646
4601
; ; from the current function.
4647
4602
(define (compile e break-labels value tail )
4648
4603
(if (or (not (pair? e)) (memq (car e) ' (null true false ssavalue quote inert top core copyast the_exception $
4649
- globalref thismodule cdecl stdcall fastcall thiscall llvmcall)))
4604
+ globalref thismodule cdecl stdcall fastcall thiscall llvmcall static_parameter )))
4650
4605
(let ((e1 (if (and arg-map (symbol? e))
4651
4606
(get arg-map e e)
4652
4607
e)))
@@ -4657,7 +4612,7 @@ f(x) = yt(x)
4657
4612
(cond (tail (emit-return tail e1))
4658
4613
(value e1)
4659
4614
((symbol? e1) (emit e1) #f ) ; ; keep symbols for undefined-var checking
4660
- ((and (pair? e1) (eq? (car e1) 'globalref )) (emit e1) #f ) ; ; keep globals for undefined-var checking
4615
+ ((and (pair? e1) (memq (car e1) ' ( globalref static_parameter))) (emit e1) #f ) ; ; keep for undefined-var checking
4661
4616
(else #f )))
4662
4617
(case (car e)
4663
4618
((call new splatnew foreigncall cfunction new_opaque_closure)
0 commit comments