Changeset 7332 in project


Ignore:
Timestamp:
01/10/08 10:42:32 (12 years ago)
Author:
felix winkelmann
Message:

merged from trunk rev. 7324

Location:
chicken/branches/release
Files:
13 edited
1 copied

Legend:

Unmodified
Added
Removed

  • chicken/branches/release/Makefile.cross-linux-mingw

    r7276 r7332  
    7070LIBCHICKEN_IMPORT_LIBRARY = libchicken.dll.a
    7171LIBUCHICKEN_IMPORT_LIBRARY = libuchicken.dll.a
     72LIBCHICKENGUI_IMPORT_LIBRARY = libchickengui.dll.a
    7273TARGET_C_COMPILER = gcc
    7374TARGET_CXX_COMPILER = g++

  • chicken/branches/release/Makefile.linux

    r7276 r7332  
    5252NEEDS_RELINKING = yes
    5353
     54
    5455# special files
    5556
    … …  
    100101        echo "#define C_HACKED_APPLY" >>$@
    101102endif
     103ifneq ($(USE_HOST_PCRE),)
     104        echo "#define C_USE_HOST_PCRE" >>$@
     105endif
    102106        cat chicken-defaults.h >>$@
    103107

  • chicken/branches/release/README

    r7276 r7332  
    33  (c)2000-2007 Felix L. Winkelmann
    44
    5   version 2.739
     5  version 2.740
    66
    77
    … …  
    149149          the one on which you are building it.
    150150
    151         TARGETSYSTEM=
    152           Similar to "HOSTSYSTEM", but specifies the name prefix to use for compiling
    153           code with the "csc" compiler driver. This is required for creating
    154           a "cross chicken", a specially built CHICKEN that invokes a cross
    155           C compiler to build the final binaries. You will need a cross compiled
    156           runtime system by building a version of CHICKEN with the "HOST" option
    157           mentioned above. More information about this process and the variables
    158           that you should set are provided in the CHICKEN wiki at
    159           <http://chicken.wiki.br/cross-compilation>.
     151        TARGETSYSTEM=
     152          Similar to "HOSTSYSTEM", but specifies the name
     153          prefix to use for compiling code with the "csc" compiler
     154          driver. This is required for creating a "cross chicken", a
     155          specially built CHICKEN that invokes a cross C compiler to
     156          build the final binaries. You will need a cross compiled
     157          runtime system by building a version of CHICKEN with the
     158          "HOST" option mentioned above. More information about this
     159          process and the variables that you should set are provided
     160          in the CHICKEN wiki at
     161          <http://chicken.wiki.br/cross-compilation>.
     162
     163        USE_HOST_PCRE=
     164          The PCRE library is included with the CHICKEN
     165          distribution to remove external dependencies and to avoid
     166          incompatibilities with any previously installed version. If
     167          you want to link with an installed libpcre, set this
     168          variable to a non-empty value. Only use this feature if you
     169          know what you are doing.
    160170
    161171        To remove CHICKEN from your file-system, enter (probably as

  • chicken/branches/release/buildversion

    r7276 r7332  
    1 2.739
     12.740

  • chicken/branches/release/csi.scm

    r7276 r7332  
    809809        (let ((x (car args)))
    810810          (cond
    811            ((string=? "--" x) args)
    812            ((or (string=? "-s" x) (string=? "-ss" x) (string=? "-script" x)) args)
     811           ((member x '("-s" "-ss" "-script" "--")) args)
    813812           ((and (fx> (##sys#size x) 2)
    814813                 (char=? #\- (##core#inline "C_subchar" x 0))
    … …  
    830829(define (run)
    831830  (let* ([extraopts (parse-option-string (or (getenv "CSI_OPTIONS") ""))]
    832          [args (canonicalize-args (cdr (argv)))]
     831         [args (canonicalize-args (command-line-arguments))]
    833832         [kwstyle (member* '("-k" "-keyword-style") args)]
    834833         [script (member* '("-s" "-ss" "-script") args)])

  • chicken/branches/release/defaults.make

    r7276 r7332  
    145145# options
    146146
     147ifneq ($(USE_HOST_PCRE),)
     148LIBRARIES += -lpcre
     149PCRE_INCLUDES =
     150C_COMPILER_PCRE_OPTIONS =
     151PCRE_OBJECTS_1 =
     152else
     153C_COMPILER_PCRE_OPTIONS = -DPCRE_STATIC
     154PCRE_INCLUDES = $(INCLUDES) -Ipcre
     155endif
    147156ifndef NOPTABLES
    148157C_COMPILER_PTABLES_OPTIONS = -DC_ENABLE_PTABLES
    149158endif
    150159INCLUDES ?= -I.
    151 PCRE_INCLUDES ?= $(INCLUDES) -Ipcre
    152160C_COMPILER_COMPILE_OPTION ?= -c
    153161C_COMPILER_OUTPUT_OPTION ?= -o
    … …  
    157165C_COMPILER_BUILD_RUNTIME_OPTIONS ?= -DC_BUILDING_LIBCHICKEN
    158166C_COMPILER_BUILD_UNSAFE_RUNTIME_OPTIONS ?= $(C_COMPILER_BUILD_RUNTIME_OPTIONS) -DNDEBUG -DC_UNSAFE_RUNTIME
    159 C_COMPILER_PCRE_OPTIONS ?= -DPCRE_STATIC
    160167C_COMPILER_SHARED_OPTIONS ?= -fPIC -DPIC
    161168LINKER_EXECUTABLE_OPTIONS ?= -L.
    … …  
    220227endif
    221228
     229
    222230# file extensions
    223231
    … …  
    231239POSIXFILE ?= posixunix
    232240CHICKEN_CONFIG_H = chicken-config.h
    233 PCRE_OBJECT_FILES ?= pcre/*.o
    234241
    235242ifneq ($(ARCH),)

  • chicken/branches/release/library.scm

    r7276 r7332  
    12081208    (##core#inline "C_copy_memory" s bv n)
    12091209    s) )
     1210
     1211(define (blob=? b1 b2)
     1212  (##sys#check-blob b1 'blob=?)
     1213  (##sys#check-blob b2 'blob=?)
     1214  (let ((n (##sys#size b1)))
     1215    (and (eq? (##sys#size b2) n)
     1216         (zero? (##core#inline "C_string_compare" b1 b2 n)))))
    12101217
    12111218
    … …  
    31363143                   (if (##sys#fudge 35) " applyhook" "")
    31373144                   (if (##sys#fudge 22) " lockts" "")
     3145                   (if (##sys#fudge 37) " hostpcre" "")
    31383146                   (if (##sys#fudge 39) " cross" "") ) ) )
    31393147        (string-append
    … …  
    40654073               (let ([arg (##sys#slot args 0)]
    40664074                     [r (##sys#slot args 1)] )
    4067                  (if (and (fx>= (##sys#size arg) 3) (string=? "-:" (##sys#substring arg 0 2)))
     4075                 (if (and (fx>= (##sys#size arg) 3)
     4076                          (string=? "-:" (##sys#substring arg 0 2)))
    40684077                     (loop r)
    40694078                     (cons arg (loop r)) ) ) ) )

  • chicken/branches/release/manual/The User's Manual

    r7276 r7332  
    33== The User's Manual
    44
    5 ''(This document describes version 2.739)''
     5''(This document describes version 2.740)''
    66
    77'''CHICKEN is a compiler that translates Scheme source files into C''', which in

  • chicken/branches/release/manual/Unit library

    r7276 r7332  
    937937Returns a blob with the contents of {{STRING}}.
    938938
     939==== blob=?
     940
     941 [procedure] (blob=? BLOB1 BLOB2)
     942
     943Returns {{#t}} if the two argument blobs are of the same
     944size and have the same content.
     945
    939946
    940947

  • chicken/branches/release/rules.make

    r7276 r7332  
    5757LIBCHICKENGUI_STATIC_OBJECTS = $(LIBCHICKENGUI_OBJECTS_1:=-static$(O))
    5858
    59 PCRE_OBJECTS_1 = \
     59PCRE_OBJECTS_1 ?= \
    6060       pcre/pcre_compile \
    6161       pcre/pcre_config \

  • chicken/branches/release/runtime.c

    r7276 r7332  
    41774177    return C_mk_bool(debug_mode);
    41784178
    4179     /* 37 - 38 */
     4179  case C_fix(37):
     4180#ifdef C_USE_HOST_PCRE
     4181    return C_SCHEME_TRUE;
     4182#else
     4183    return C_SCHEME_FALSE;
     4184#endif
     4185
     4186    /* 38 */
    41804187
    41814188  case C_fix(39):

  • chicken/branches/release/scheme-complete.el

    r7276 r7332  
    2828;;; (add-hook 'scheme-mode-hook
    2929;;;   (lambda ()
    30 ;;;     (setq eldoc-info-function 'scheme-get-current-symbol-info)
     30;;;     (make-local-variable 'eldoc-documentation-function)
     31;;;     (setq eldoc-documentation-function 'scheme-get-current-symbol-info)
    3132;;;     (eldoc-mode)))
    3233;;;
     34;;; There's a single custom variable, default-scheme-implementation,
     35;;; which you can use to specify your preferred implementation when we
     36;;; can't infer it from the source code.
     37;;;
    3338;;; That's all there is to it.
    3439
    3540;;; History:
    36 ;;;   0.4: 2007/11/14 - silly bugfixe plus better repo env support
     41;;;   0.6: 2008/01/06 - more bugfixes (merry christmas)
     42;;;   0.5: 2008/01/03 - handling internal defines, records, smarter
     43;;;                     parsing
     44;;;   0.4: 2007/11/14 - silly bugfix plus better repo env support
    3745;;;                     for searching chicken and gauche modules
    3846;;;   0.3: 2007/11/13 - bugfixes, better inference, smart strings
    … …  
    17101718    ))
    17111719
     1720;; by default chicken has a single top-level namespace, so we want to
     1721;; handle recursive imports
    17121722(defvar *scheme-chicken-deps*
    17131723  '((lolevel extras)
    … …  
    17191729    (args srfi-37)
    17201730    (array-lib srfi-1 srfi-4 lolevel miscmacros)
     1731    (awk regex)
     1732    (bloom-filter
     1733     srfi-1 utils lolevel
     1734     iset message-digest hash-utils lookup-table mathh-int
     1735     misc-extn-control misc-extn-numeric misc-extn-record)
     1736    (binary-tree srfi-1 misc-extn-record)
     1737    (box lolevel)
     1738    (cgi-util extras input-parse)
     1739    (charplot array-lib array-lib-hof)
     1740    (charconv regex posix)
     1741    (content-type regex format-modular)
    17211742    ))
    17221743
     1744;; another big table - consider moving to a separate file
    17231745(defvar *scheme-implementation-exports*
    17241746  '((chicken
    … …  
    27252747(defun chicken-available-modules (&optional sym)
    27262748  (append
    2727    (mapcar 'symbol-name (mapcar 'car *scheme-chicken-modules*))
     2749   (mapcar #'symbol-name (mapcar #'car *scheme-chicken-modules*))
     2750   (mapcar
     2751    #'file-name-sans-extension
     2752    (directory-files "." nil ".*\\.scm$" t))
    27282753   (append-map
    27292754    #'(lambda (dir)
    27302755        (mapcar
    2731          'file-name-sans-extension
     2756         #'file-name-sans-extension
    27322757         (directory-files dir nil ".*\\.\\(so\\|scm\\)$" t)))
    27332758    *chicken-repo-dirs*)))
    … …  
    27552780        (other-dirs
    27562781         (remove-if-not
    2757           #'file-directory-p
     2782          #'(lambda (d) (and (not (equal d "")) (file-directory-p d)))
    27582783          (split-string (or (getenv "GAUCHE_LOAD_PATH") "") ":"))))
    27592784    (mapcar
    … …  
    29042929
    29052930(defun goto-next-top-level ()
    2906   (or (re-search-forward "^(" nil t)
    2907       (goto-char (point-max))))
     2931  (let ((here (point)))
     2932    (or (ignore-errors (end-of-defun) (end-of-defun)
     2933                       (beginning-of-defun)
     2934                       (not (eq here (point))))
     2935        (progn (forward-char) (re-search-forward "^(" nil t))
     2936        (goto-char (point-max)))))
    29082937
    29092938;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
    29102939;; variable extraction
     2940
     2941(defun sexp-type-at-point (&optional env)
     2942  (case (char-syntax (char-after))
     2943    ((?\()
     2944     (forward-char 1)
     2945     (if (eq ?w (char-syntax (char-after)))
     2946         (let ((op (scheme-symbol-at-point)))
     2947           (cond
     2948            ((eq op 'lambda)
     2949             (let ((params
     2950                    (nth-sexp-at-point 1)))
     2951               `(lambda ,params)))
     2952            (t
     2953             (let ((spec (scheme-env-lookup env op)))
     2954               (and spec
     2955                    (consp (cadr spec))
     2956                    (eq 'lambda (caadr spec))
     2957                    (cddadr spec)
     2958                    (car (cddadr spec)))))))
     2959       nil))
     2960    ((?\")
     2961     'string)
     2962    ((?\w)
     2963     (if (string-match "[0-9]" (string (char-after)))
     2964         'number
     2965       nil))
     2966    (t
     2967     nil)))
    29112968
    29122969(defun let-vars-at-point (&optional env)
    … …  
    29192976          (forward-char 1)
    29202977          (if (eq ?w (char-syntax (char-after)))
    2921               (let ((sym (scheme-symbol-at-point)))
    2922                 (beginning-of-next-sexp)
    2923                 (let ((c (char-syntax (char-after))))
    2924                   (case c
    2925                     ((?\")
    2926                      (push (list sym 'string) vars))
    2927                     ((?\()
    2928                      (forward-char 1)
    2929                      (if (eq ?w (char-syntax (char-after)))
    2930                          (let ((op (scheme-symbol-at-point)))
    2931                            (cond
    2932                             ((eq op 'lambda)
    2933                              (let ((params
    2934                                     (nth-sexp-at-point 1)))
    2935                                (push (list sym `(lambda ,params)) vars)))
    2936                             (t
    2937                              (let ((spec (scheme-env-lookup env op)))
    2938                                (if (and spec
    2939                                         (consp (cadr spec))
    2940                                         (eq 'lambda (caadr spec))
    2941                                         (cddadr spec))
    2942                                    (push (list sym (car (cddadr spec))) vars)
    2943                                  (push (list sym) vars))))))
    2944                        (push (list sym) vars)))
    2945                     (t
    2946                      (push (list sym) vars))))))))
     2978              (let* ((sym (scheme-symbol-at-point))
     2979                     (type (ignore-errors
     2980                             (beginning-of-next-sexp)
     2981                             (sexp-type-at-point env))))
     2982                (push (if type (list sym type) (list sym)) vars)))))
    29472983      (or (ignore-errors (progn (beginning-of-next-sexp) t))
    29482984          (goto-char end)))
    … …  
    29843020;; (setq *current-scheme-implementation* whatever)
    29853021
     3022(defgroup scheme-complete nil
     3023  "Smart tab completion"
     3024  :group 'scheme)
     3025
     3026(defcustom default-scheme-implementation nil
     3027  "Default scheme implementation to provide completion for
     3028when scheme-complete can't infer the current implementation."
     3029  :type 'symbol
     3030  :group 'scheme-complete)
     3031
    29863032(defvar *current-scheme-implementation* nil)
    29873033(make-variable-buffer-local '*current-scheme-implementation*)
    29883034
    2989 (defvar *default-scheme-implementation* 'chicken)
    2990 
     3035;; most implementations use their name as the script name
    29913036(defvar *scheme-interpreter-alist*
    29923037  '(("csi" . chicken)
    … …  
    30143059                  'mzscheme))))))
    30153060  (or *current-scheme-implementation*
    3016       *default-scheme-implementation*))
     3061      default-scheme-implementation))
    30173062
    30183063;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
    … …  
    30203065(defun current-local-vars (&optional env)
    30213066  (let ((vars '())
    3022         (limit (save-excursion (beginning-of-defun) (+ (point) 1))))
     3067        (limit (save-excursion (beginning-of-defun) (+ (point) 1)))
     3068        (start (point))
     3069        (scan-internal))
    30233070    (save-excursion
    30243071      (while (> (point) limit)
    … …  
    30323079                   (eq ?\( (char-syntax (char-before (point))))
    30333080                   (eq ?w (char-syntax (char-after (point)))))
     3081          (setq scan-internal t)
    30343082          (let ((sym (scheme-symbol-at-point)))
    3035             ;; XXXX handle internal defines
    30363083            (case sym
    30373084              ((lambda)
    … …  
    30763123                             vars)))
    30773124              (t
    3078                (when (string-match "^define\\(-.*\\)?" (symbol-name sym))
    3079                  (setq vars
    3080                        (append (mapcar #'list (flatten (nth-sexp-at-point 1)))
    3081                                vars)))))
    3082             ))))
     3125               (if (string-match "^define\\(-.*\\)?" (symbol-name sym))
     3126                   (let ((defs (save-excursion
     3127                                 (backward-char)
     3128                                 (scheme-extract-definitions))))
     3129                     (setq vars
     3130                           (append (append-map
     3131                                    #'(lambda (x)
     3132                                        (and (consp (cdr x))
     3133                                             (consp (cadr x))
     3134                                             (eq 'lambda (caadr x))
     3135                                             (mapcar #'list
     3136                                                     (flatten (cadadr x)))))
     3137                                    defs)
     3138                                   defs
     3139                                   vars)))
     3140                 (setq scan-internal nil))))
     3141            ;; check for internal defines
     3142            (when scan-internal
     3143              (ignore-errors
     3144                (save-excursion
     3145                  (forward-sexp
     3146                   (+ 1 (if (numberp scan-internal) scan-internal 2)))
     3147                  (backward-sexp)
     3148                  (if (< (point) start)
     3149                      (setq vars (append (current-scheme-definitions) vars))
     3150                    ))))))))
    30833151    (reverse vars)))
    30843152
    … …  
    31943262    imports))
    31953263
    3196 (defun name-of-define (sexp)
    3197   (if (consp (cadr sexp)) (caadr sexp) (cadr sexp)))
    3198 
    3199 (defun scheme-top-definitions (sexp)
    3200   (let ((defs '())
    3201         (stack (list sexp)))
    3202     (while (consp stack)
    3203       (let ((sexp (pop stack)))
    3204         (when (and (consp sexp) (consp (cdr sexp)))
    3205           (case (car sexp)
    3206             ((define-syntax defmacro define-macro)
    3207              (push (list (name-of-define sexp) '(syntax)) defs))
    3208             ((define define-inline define-constant defun)
    3209              (push (list (name-of-define sexp)
    3210                          (if (or (eq 'defun (car sexp))
    3211                                  (consp (cadr sexp))
    3212                                  (and (consp (caddr sexp))
    3213                                       (eq 'lambda (caaddr sexp))))
    3214                              (cond
    3215                               ((eq 'defun (car sexp))
    3216                                `(lambda ,(caddr sexp)))
    3217                               ((consp (cadr sexp))
    3218                                `(lambda ,(cdadr sexp)))
    3219                               (t
    3220                                `(lambda ,(car (cdaddr sexp)))))
    3221                              'object))
    3222                    defs))
    3223             ((defvar define-class)
    3224              (push (list (name-of-define sexp) 'non-procedure) defs))
    3225             ((define-record-type)
    3226              (setq defs
    3227                    (cons (list (caddr sexp) 'procedure)
    3228                          (cons (list (cadddr sexp) 'procedure)
    3229                                (append (append-map #'(lambda (x)
    3230                                                    (list (cdr x) 'procedure))
    3231                                                (cdddr sexp))
    3232                                        defs)))))
    3233             ((begin progn)
    3234              (setq stack (append (cdr sexp) stack)))
    3235             ((cond-expand)
    3236              (setq stack (append-map #'cdr (cdr sexp))))
    3237             (t
    3238              '())))))
    3239     defs))
    3240 
     3264;; we should be just inside the opening paren of an expression
     3265(defun scheme-name-of-define ()
     3266  (save-excursion
     3267    (beginning-of-next-sexp)
     3268    (if (eq ?\( (char-syntax (char-after)))
     3269        (forward-char))
     3270    (and (memq (char-syntax (char-after)) '(?\w ?\_))
     3271         (scheme-symbol-at-point))))
     3272
     3273(defun scheme-type-of-define ()
     3274  (save-excursion
     3275    (beginning-of-next-sexp)
     3276    (cond
     3277     ((eq ?\( (char-syntax (char-after)))
     3278      `(lambda ,(cdr (nth-sexp-at-point 0))))
     3279     (t
     3280      (beginning-of-next-sexp)
     3281      (sexp-type-at-point)))))
     3282
     3283;; we should be at the opening paren of an expression
     3284(defun scheme-extract-definitions (&optional env)
     3285  (save-excursion
     3286    (let ((sym (ignore-errors (and (eq ?\( (char-syntax (char-after)))
     3287                                   (progn (forward-char)
     3288                                          (scheme-symbol-at-point))))))
     3289      (case sym
     3290        ((define-syntax defmacro define-macro)
     3291         (list (list (scheme-name-of-define) '(syntax))))
     3292        ((define define-inline define-constant define-primitive defun)
     3293         (let ((name (scheme-name-of-define))
     3294               (type (scheme-type-of-define)))
     3295           (list (if type (list name type) (list name)))))
     3296        ((defvar define-class)
     3297         (list (list (scheme-name-of-define) 'non-procedure)))
     3298        ((define-record)
     3299         (backward-char)
     3300         (ignore-errors
     3301           (let* ((sexp (nth-sexp-at-point 0))
     3302                  (name (symbol-name (cadr sexp))))
     3303             `((,(intern (concat name "?")) (lambda (obj) boolean))
     3304               (,(intern (concat "make-" name)) (lambda ,(cddr sexp) ))
     3305               ,@(append-map
     3306                  #'(lambda (x)
     3307                      `((,(intern (concat name "-" (symbol-name x)))
     3308                         (lambda (non-procedure)))
     3309                        (,(intern (concat name "-" (symbol-name x) "-set!"))
     3310                         (lambda (non-procedure val) undefined))))
     3311                  (cddr sexp))))))
     3312        ((define-record-type)
     3313         (backward-char)
     3314         (ignore-errors
     3315           (let ((sexp (nth-sexp-at-point 0)))
     3316             `((,(caaddr sexp) (lambda ,(cdaddr sexp)))
     3317               (,(cadddr sexp) (lambda (obj)))
     3318               ,@(append-map
     3319                  #'(lambda (x)
     3320                      (if (consp x)
     3321                          (if (consp (cddr x))
     3322                              `((,(cadr x) (lambda (non-procedure)))
     3323                                (,(caddr x)
     3324                                 (lambda (non-procedure val) undefined)))
     3325                            `((,(cadr x) (lambda (non-procedure)))))))
     3326                  (cddddr sexp))))))
     3327        ((begin progn)
     3328         (forward-sexp)
     3329         (current-scheme-definitions))
     3330        (t
     3331         '())))))
     3332
     3333;; a little more liberal than -definitions, we try to scan to a new
     3334;; top-level form (i.e. a line beginning with an open paren) if
     3335;; there's an error during normal sexp movement
    32413336(defun current-scheme-globals ()
    32423337  (let ((globals '()))
    32433338    (save-excursion
    32443339      (goto-char (point-min))
     3340      (or (ignore-errors (end-of-defun) (beginning-of-defun) t)
     3341          (re-search-forward "^(" nil t)
     3342          (goto-char (point-max)))
    32453343      (while (not (eobp))
    3246         (if (ignore-errors (progn (forward-sexp) t))
    3247             (setq globals
    3248                   ;; XXXX avoid reading whole top-level form
    3249                   (append (scheme-top-definitions (nth-sexp-at-point 0))
    3250                           globals))
    3251           (goto-next-top-level))))
     3344        (setq globals
     3345              (append (scheme-extract-definitions) globals))
     3346        (goto-next-top-level)))
    32523347    globals))
     3348
     3349;; for internal defines, etc.
     3350(defun current-scheme-definitions (&optional enclosing-end)
     3351  (let ((defs '())
     3352        (end (or enclosing-end (point-max))))
     3353    (save-excursion
     3354      (while (< (point) end)
     3355        (let ((new-defs (scheme-extract-definitions)))
     3356          (cond
     3357           (new-defs
     3358             (setq defs (append new-defs defs))
     3359             (or (ignore-errors (beginning-of-next-sexp) t)
     3360                 (goto-char end)))
     3361           (t ;; non-definition form, stop scanning
     3362            (goto-char end))))))
     3363    defs))
    32533364
    32543365(defun scheme-module-exports (mod)
    … …  
    33213432
    33223433;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
     3434;; This is rather complicated because we to auto-generate docstring
     3435;; summaries from the type information, which means inferring various
     3436;; types from common names.  The benefit is that you don't have to
     3437;; input the same information twice, and can often cut&paste&munge
     3438;; procedure descriptions from the original documentation.
    33233439
    33243440(defun scheme-translate-type (type)
    … …  
    33743490      (cond
    33753491        ((eq :optional (car spec))
    3376          (decf i))
    3377         ((eq '|...| (cadr spec))
     3492         (if (and (= i (- pos 1)) (consp (cdr spec)))
     3493             (setq type (cadr spec)))
     3494         (setq i pos))
     3495        ((and (consp (cdr spec)) (eq '|...| (cadr spec)))
    33783496         (setq type (car spec))
    33793497         (setq spec nil)))
    … …  
    33813499      (incf i))
    33823500    (if (and (not type) (= i pos))
    3383         (setq type (car (remove ':optional spec))))
     3501        (setq type (if (consp spec) (car spec) spec)))
    33843502    (if type
    33853503        (setq type (scheme-translate-type type)))
    … …  
    35033621               (t nil))))))
    35043622
     3623(defun nth* (n ls)
     3624  (while (and (consp ls) (> n 0))
     3625    (setq n (- n 1)
     3626          ls (cdr ls)))
     3627  (and (consp ls) (car ls)))
     3628
    35053629(defun scheme-smart-complete (&optional arg)
    35063630  (interactive "P")
    … …  
    35473671           (eq 'lambda (car outer-type))
    35483672           (not (zerop outer-pos))
    3549            (nth outer-pos (cadr outer-type))
     3673           (nth* outer-pos (cadr outer-type))
    35503674           (zerop inner-pos))
    35513675      (let ((ret-type (scheme-lookup-type (cadr outer-type) outer-pos)))
    … …  
    36533777(defun scheme-get-current-symbol-info ()
    36543778  (let* ((sym (eldoc-current-symbol))
    3655          (fnsym (eldoc-fnsym-in-current-sexp))
     3779         (fnsym0 (eldoc-fnsym-in-current-sexp))
     3780         (fnsym (if (consp fnsym0) (car fnsym0) fnsym0))
    36563781         (env (save-excursion
    36573782                (if (scheme-in-string-p) (beginning-of-string))

  • chicken/branches/release/version.scm

    r7276 r7332  
    1 (define-constant +build-version+ "2.739")
     1(define-constant +build-version+ "2.740")
Note: See TracChangeset for help on using the changeset viewer.