Re: [Chicken-hackers] [PATCH] Evaluate length/##sys#length subforms when specializing for null

[Christian Kellermann]

Hi Evan,

I have pushed all these.

Thanks,

Christian

* Evan Hanson <address@hidden> [140909 11:50]:
> ---
>  types.db |    4 ++--
>  1 file changed, 2 insertions(+), 2 deletions(-)
> 
> diff --git a/types.db b/types.db
> index 2621686..2b6c85b 100644
> --- a/types.db
> +++ b/types.db
> @@ -156,11 +156,11 @@
>  (##sys#list (#(procedure #:pure) ##sys#list (#!rest) list))
>  
>  (length (#(procedure #:clean #:enforce) length (list) fixnum) ; may loop
> -     ((null) '0)
> +     ((null) (let ((#(tmp) #(1))) '0))
>       ((list) (##core#inline "C_u_i_length" #(1))))
>  
>  (##sys#length (#(procedure #:clean #:enforce) ##sys#length (list) fixnum)
> -           ((null) '0)
> +           ((null) (let ((#(tmp) #(1))) '0))
>             ((list) (##core#inline "C_u_i_length" #(1))))
>  
>  ;; these are special cased (see scrutinizer.scm)
> -- 
> 1.7.10.4
> 
> 
> _______________________________________________
> Chicken-hackers mailing list
> address@hidden
> https://lists.nongnu.org/mailman/listinfo/chicken-hackers

* Evan Hanson <address@hidden> [140909 11:51]:
> Previously, if typevars were given in a polymorphic type specification
> but none of them were actually used within its body, type simplification
> would still produce a "forall" type, e.g. `(forall () list)` where
> simply a `list` would do. This patch fixes these cases by only keeping
> the "forall" when at least one typevar is used within a type's body.
> ---
>  scrutinizer.scm |    2 +-
>  1 file changed, 1 insertion(+), 1 deletion(-)
> 
> diff --git a/scrutinizer.scm b/scrutinizer.scm
> index c437933..77b14f5 100644
> --- a/scrutinizer.scm
> +++ b/scrutinizer.scm
> @@ -1389,7 +1389,7 @@
>                 (cdr e)))
>              (else t)))))
>      (let ((t2 (simplify t)))
> -      (when (pair? typeenv)
> +      (when (pair? used)
>       (set! t2 
>         `(forall ,(filter-map
>                    (lambda (e)
> -- 
> 1.7.10.4
> 
> 
> _______________________________________________
> Chicken-hackers mailing list
> address@hidden
> https://lists.nongnu.org/mailman/listinfo/chicken-hackers

* Evan Hanson <address@hidden> [140909 11:52]:
> As with list/##sys#list.
> ---
>  types.db |    4 ++--
>  1 file changed, 2 insertions(+), 2 deletions(-)
> 
> diff --git a/types.db b/types.db
> index 2621686..9575a1b 100644
> --- a/types.db
> +++ b/types.db
> @@ -571,8 +571,8 @@
>  (vector-set! (#(procedure #:enforce) vector-set! (vector fixnum *) 
> undefined))
>  
>  ;; special cased (see scrutinizer.scm)
> -(vector (#(procedure #:clean #:clean) vector (#!rest) vector))
> -(##sys#vector (#(procedure #:clean #:clean) ##sys#vector (#!rest) vector))
> +(vector (#(procedure #:pure) vector (#!rest) vector))
> +(##sys#vector (#(procedure #:pure) ##sys#vector (#!rest) vector))
>  
>  (vector-length (#(procedure #:clean #:enforce) vector-length (vector) fixnum)
>              ((vector) (##sys#size #(1))))
> -- 
> 1.7.10.4
> 
> 
> _______________________________________________
> Chicken-hackers mailing list
> address@hidden
> https://lists.nongnu.org/mailman/listinfo/chicken-hackers

* Evan Hanson <address@hidden> [140909 11:53]:
> ---
>  scrutinizer.scm |   75 
> +------------------------------------------------------
>  1 file changed, 1 insertion(+), 74 deletions(-)
> 
> diff --git a/scrutinizer.scm b/scrutinizer.scm
> index c437933..2221aac 100644
> --- a/scrutinizer.scm
> +++ b/scrutinizer.scm
> @@ -30,7 +30,7 @@
>       procedure-type? named? procedure-result-types procedure-argument-types
>       noreturn-type? rest-type procedure-name d-depth
>       noreturn-procedure-type? trail trail-restore walked-result 
> -     typename multiples procedure-arguments procedure-results
> +     multiples procedure-arguments procedure-results
>       smash-component-types! generate-type-checks! over-all-instantiations
>       compatible-types? type<=? match-types resolve match-argument-types))
>  
> @@ -895,79 +895,6 @@
>                (cute set-car! (cddr t) <>))))))))
>  
>  
> -;;; Converting type into string
> -
> -(define (typename t)
> -  (define (argument-string args)
> -    (let* ((len (length (delete '#!optional args eq?)))
> -        (m (multiples len)))
> -      ;;XXX not quite right for rest/optional arguments
> -      (cond ((memq '#!rest args)
> -          (sprintf "~a or more arguments" len))
> -         ((zero? len) "zero arguments")
> -         (else
> -          (sprintf 
> -              "~a argument~a of type~a ~a"
> -            len m m
> -            (string-intersperse (map typename args) ", "))))))
> -  (define (result-string results)
> -    (if (eq? '* results) 
> -     "an unknown number of values"
> -     (let* ((len (length results))
> -            (m (multiples len)))
> -       (if (zero? len)
> -           "zero values"
> -           (sprintf 
> -               "~a value~a of type~a ~a"
> -             len m m
> -             (string-intersperse (map typename results) ", "))))))
> -  (case t
> -    ((*) "anything")
> -    ((char) "character")
> -    (else
> -     (cond ((symbol? t) (symbol->string t))
> -        ((pair? t)
> -         (case (car t)
> -           ((procedure) 
> -            (if (or (string? (cadr t)) (symbol? (cadr t)))
> -                (->string (cadr t))
> -                (sprintf "a procedure with ~a returning ~a"
> -                  (argument-string (cadr t))
> -                  (result-string (cddr t)))))
> -           ((or)
> -            (string-intersperse
> -             (map typename (cdr t))
> -             " OR "))
> -           ((struct)
> -            (sprintf "a structure of type ~a" (cadr t)))
> -           ((forall) 
> -            (sprintf "~a (for all ~a)"
> -              (typename (third t))
> -              (string-intersperse
> -               (map (lambda (tv)
> -                      (if (symbol? tv)
> -                          (symbol->string tv)
> -                          (sprintf "~a being ~a" (first tv) (typename 
> (second tv)))))
> -                    (second t))
> -               " ")))
> -           ((not)
> -            (sprintf "NOT ~a" (typename (second t))))
> -           ((pair)
> -            (sprintf "a pair wth car ~a and cdr ~a"
> -              (typename (second t))
> -              (typename (third t))))
> -           ((vector-of)
> -            (sprintf "a vector with element type ~a" (typename (second t))))
> -           ((list-of)
> -            (sprintf "a list with element type ~a" (typename (second t))))
> -           ((vector list)
> -            (sprintf "a ~a with the element types ~a"
> -              (car t)
> -              (map typename (cdr t))))
> -           (else (bomb "typename: invalid type" t))))
> -        (else (bomb "typename: invalid type" t))))))
> -
> -
>  ;;; Type-matching
>  ;
>  ; - "exact" means: first argument must match second one exactly
> -- 
> 1.7.10.4
> 
> 
> _______________________________________________
> Chicken-hackers mailing list
> address@hidden
> https://lists.nongnu.org/mailman/listinfo/chicken-hackers


-- 
May you be peaceful, may you live in safety, may you be free from
suffering, and may you live with ease.