Changeset 29088 in project


Ignore:
Timestamp:
06/13/13 13:48:04 (8 years ago)
Author:
juergen
Message:

improved error-messages

Location:
release/4/multi-methods
Files:
7 edited
1 copied

Legend:

Unmodified
Added
Removed
  • release/4/multi-methods/tags/0.1.2/multi-methods.scm

    r29080 r29088  
    11; Author: Juergen Lorenz ; ju (at) jugilo (dot) de
    22;
    3 ; Last update: June 10, 2013
     3; Last update: June 13, 2013
    44;
    55; Copyright (c) 2013, Juergen Lorenz
     
    378378(import scheme
    379379        method-helper
    380         (only chicken condition-case assert gensym error fx= fx<)
     380        (only chicken condition-case assert gensym error fx>= fx- fx= fx<)
     381        (only extras sprintf)
    381382        (only lolevel procedure-data))
    382383(import-for-syntax (only chicken receive)
    383                    ;method-helper
    384384                   (only data-structures list-of?))
    385385
     
    470470               (variadic? #f))
    471471           (lambda (arg . args)
    472              (if (and (null? args) (eq? arg state))
    473                (lambda (sym)
    474                  (case sym
    475                    ((proc-tree) proc-tree)
    476                    ((arity) (length (apply list ',(cadr form) ',(cddr form))))
    477                    ((variadic?) variadic?)
    478                    ((type) 'multi-method)
    479                    ((method-insert!)
    480                     (lambda (meth . keys)
    481                       ;; only at first insert
    482                       (if (null? proc-tree)
    483                         (set! variadic? ((meth state) 'variadic?)))
    484                       (set! proc-tree
    485                             (apply ',tree-insert
    486                                    proc-tree
    487                                    (',pair->tree ((meth state) 'proc-list))
    488                                    keys))))
    489                    (else (error 'multi-method
    490                                 "message not understood"
    491                                 sym))))
    492                (apply
    493                  ;; find the matching procedure
    494                  (apply ',tree-action proc-tree variadic? arg args)
    495                  ;; apply it
    496                  arg args))))))))
     472             (let ((arity (length (apply list ',(cadr form) ',(cddr form))))
     473                   (arglist (apply list arg args)))
     474               (if (and (null? args) (eq? arg state))
     475                 (lambda (sym)
     476                   (case sym
     477                     ((proc-tree) proc-tree)
     478                     ((arity) arity)
     479                     ((variadic?) variadic?)
     480                     ((type) 'multi-method)
     481                     ((method-insert!)
     482                      (lambda (meth . keys)
     483                        ;; only at first insert
     484                        (if (null? proc-tree)
     485                          (set! variadic? ((meth state) 'variadic?)))
     486                        (set! proc-tree
     487                              (apply ',tree-insert
     488                                     proc-tree
     489                                     (',pair->tree ((meth state) 'proc-list))
     490                                     keys))))
     491                     (else (error 'multi-method
     492                                  "message not understood"
     493                                  sym))))
     494                 (cond
     495                   ((null? proc-tree)
     496                    (error 'multi-method "empty multi-method"))
     497                   ((and (not variadic?)
     498                         (not (fx= (length arglist) arity)))
     499                    (error 'multi-method
     500                           (sprintf "arguments ~S don't match arity ~S and variadicity ~S~%"
     501                                    arglist arity variadic?)))
     502                   ((and variadic?
     503                         (not (fx>= (length arglist) (fx- arity 1))))
     504                    (error 'multi-method
     505                           (sprintf "arguments ~S don't match arity ~S and variadicity ~S~%"
     506                                    arglist arity variadic?)))
     507                   (else
     508                     (apply
     509                       ;; find the matching procedure
     510                       (apply ',tree-action proc-tree variadic? arg args)
     511                       ;; apply it
     512                       arg args)))))))))))
    497513
    498514;;; (multi-method? xpr)
  • release/4/multi-methods/tags/0.1.2/multi-methods.setup

    r29080 r29088  
    99 'multi-methods
    1010 '("multi-methods.so" "method-helper.import.so" "methods.import.so" "multi-methods.import.so")
    11  '((version "0.1.1")))
     11 '((version "0.1.2")))
  • release/4/multi-methods/tags/0.1.2/tests/run.scm

    r29064 r29088  
    1 (require-library multi-methods simple-tests lolevel)
    2 (import methods multi-methods simple-tests lolevel)
     1(require-library multi-methods simple-tests)
     2(import methods multi-methods simple-tests)
    33
    44(effects-checked? #t)
  • release/4/multi-methods/tags/0.1/multi-methods.scm

    r29060 r29088  
    197197;;; effect-checker checks proc's return values or side-effects,
    198198;;; i.e. either query-checker or command-checker is used,
    199 ;;; name a symbol describing the predicate(conjoin pred . preds) which
     199;;; name a symbol describing the predicate (conjoin pred . preds) which
    200200;;; do the argument checks.
    201 ;;; Note that the doc variable is used to decide if the method is
    202 ;;; variadic: If must be #f for method to be variadic.
    203201(define-syntax method
    204202  (ir-macro-transformer
  • release/4/multi-methods/trunk/multi-methods.scm

    r29080 r29088  
    11; Author: Juergen Lorenz ; ju (at) jugilo (dot) de
    22;
    3 ; Last update: June 10, 2013
     3; Last update: June 13, 2013
    44;
    55; Copyright (c) 2013, Juergen Lorenz
     
    378378(import scheme
    379379        method-helper
    380         (only chicken condition-case assert gensym error fx= fx<)
     380        (only chicken condition-case assert gensym error fx>= fx- fx= fx<)
     381        (only extras sprintf)
    381382        (only lolevel procedure-data))
    382383(import-for-syntax (only chicken receive)
    383                    ;method-helper
    384384                   (only data-structures list-of?))
    385385
     
    470470               (variadic? #f))
    471471           (lambda (arg . args)
    472              (if (and (null? args) (eq? arg state))
    473                (lambda (sym)
    474                  (case sym
    475                    ((proc-tree) proc-tree)
    476                    ((arity) (length (apply list ',(cadr form) ',(cddr form))))
    477                    ((variadic?) variadic?)
    478                    ((type) 'multi-method)
    479                    ((method-insert!)
    480                     (lambda (meth . keys)
    481                       ;; only at first insert
    482                       (if (null? proc-tree)
    483                         (set! variadic? ((meth state) 'variadic?)))
    484                       (set! proc-tree
    485                             (apply ',tree-insert
    486                                    proc-tree
    487                                    (',pair->tree ((meth state) 'proc-list))
    488                                    keys))))
    489                    (else (error 'multi-method
    490                                 "message not understood"
    491                                 sym))))
    492                (apply
    493                  ;; find the matching procedure
    494                  (apply ',tree-action proc-tree variadic? arg args)
    495                  ;; apply it
    496                  arg args))))))))
     472             (let ((arity (length (apply list ',(cadr form) ',(cddr form))))
     473                   (arglist (apply list arg args)))
     474               (if (and (null? args) (eq? arg state))
     475                 (lambda (sym)
     476                   (case sym
     477                     ((proc-tree) proc-tree)
     478                     ((arity) arity)
     479                     ((variadic?) variadic?)
     480                     ((type) 'multi-method)
     481                     ((method-insert!)
     482                      (lambda (meth . keys)
     483                        ;; only at first insert
     484                        (if (null? proc-tree)
     485                          (set! variadic? ((meth state) 'variadic?)))
     486                        (set! proc-tree
     487                              (apply ',tree-insert
     488                                     proc-tree
     489                                     (',pair->tree ((meth state) 'proc-list))
     490                                     keys))))
     491                     (else (error 'multi-method
     492                                  "message not understood"
     493                                  sym))))
     494                 (cond
     495                   ((null? proc-tree)
     496                    (error 'multi-method "empty multi-method"))
     497                   ((and (not variadic?)
     498                         (not (fx= (length arglist) arity)))
     499                    (error 'multi-method
     500                           (sprintf "arguments ~S don't match arity ~S and variadicity ~S~%"
     501                                    arglist arity variadic?)))
     502                   ((and variadic?
     503                         (not (fx>= (length arglist) (fx- arity 1))))
     504                    (error 'multi-method
     505                           (sprintf "arguments ~S don't match arity ~S and variadicity ~S~%"
     506                                    arglist arity variadic?)))
     507                   (else
     508                     (apply
     509                       ;; find the matching procedure
     510                       (apply ',tree-action proc-tree variadic? arg args)
     511                       ;; apply it
     512                       arg args)))))))))))
    497513
    498514;;; (multi-method? xpr)
  • release/4/multi-methods/trunk/multi-methods.setup

    r29080 r29088  
    99 'multi-methods
    1010 '("multi-methods.so" "method-helper.import.so" "methods.import.so" "multi-methods.import.so")
    11  '((version "0.1.1")))
     11 '((version "0.1.2")))
  • release/4/multi-methods/trunk/tests/run.scm

    r29064 r29088  
    1 (require-library multi-methods simple-tests lolevel)
    2 (import methods multi-methods simple-tests lolevel)
     1(require-library multi-methods simple-tests)
     2(import methods multi-methods simple-tests)
    33
    44(effects-checked? #t)
Note: See TracChangeset for help on using the changeset viewer.