Changeset 7332 in project
- Timestamp:
- 01/10/08 10:42:32 (13 years ago)
- Location:
- chicken/branches/release
- Files:
-
- 13 edited
- 1 copied
Legend:
- Unmodified
- Added
- Removed
-
chicken/branches/release/Makefile.cross-linux-mingw
r7276 r7332 70 70 LIBCHICKEN_IMPORT_LIBRARY = libchicken.dll.a 71 71 LIBUCHICKEN_IMPORT_LIBRARY = libuchicken.dll.a 72 LIBCHICKENGUI_IMPORT_LIBRARY = libchickengui.dll.a 72 73 TARGET_C_COMPILER = gcc 73 74 TARGET_CXX_COMPILER = g++ -
chicken/branches/release/Makefile.linux
r7276 r7332 52 52 NEEDS_RELINKING = yes 53 53 54 54 55 # special files 55 56 … … 100 101 echo "#define C_HACKED_APPLY" >>$@ 101 102 endif 103 ifneq ($(USE_HOST_PCRE),) 104 echo "#define C_USE_HOST_PCRE" >>$@ 105 endif 102 106 cat chicken-defaults.h >>$@ 103 107 -
chicken/branches/release/README
r7276 r7332 3 3 (c)2000-2007 Felix L. Winkelmann 4 4 5 version 2.7 395 version 2.740 6 6 7 7 … … 149 149 the one on which you are building it. 150 150 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. 160 170 161 171 To remove CHICKEN from your file-system, enter (probably as -
chicken/branches/release/buildversion
r7276 r7332 1 2.7 391 2.740 -
chicken/branches/release/csi.scm
r7276 r7332 809 809 (let ((x (car args))) 810 810 (cond 811 ((string=? "--" x) args) 812 ((or (string=? "-s" x) (string=? "-ss" x) (string=? "-script" x)) args) 811 ((member x '("-s" "-ss" "-script" "--")) args) 813 812 ((and (fx> (##sys#size x) 2) 814 813 (char=? #\- (##core#inline "C_subchar" x 0)) … … 830 829 (define (run) 831 830 (let* ([extraopts (parse-option-string (or (getenv "CSI_OPTIONS") ""))] 832 [args (canonicalize-args (c dr (argv)))]831 [args (canonicalize-args (command-line-arguments))] 833 832 [kwstyle (member* '("-k" "-keyword-style") args)] 834 833 [script (member* '("-s" "-ss" "-script") args)]) -
chicken/branches/release/defaults.make
r7276 r7332 145 145 # options 146 146 147 ifneq ($(USE_HOST_PCRE),) 148 LIBRARIES += -lpcre 149 PCRE_INCLUDES = 150 C_COMPILER_PCRE_OPTIONS = 151 PCRE_OBJECTS_1 = 152 else 153 C_COMPILER_PCRE_OPTIONS = -DPCRE_STATIC 154 PCRE_INCLUDES = $(INCLUDES) -Ipcre 155 endif 147 156 ifndef NOPTABLES 148 157 C_COMPILER_PTABLES_OPTIONS = -DC_ENABLE_PTABLES 149 158 endif 150 159 INCLUDES ?= -I. 151 PCRE_INCLUDES ?= $(INCLUDES) -Ipcre152 160 C_COMPILER_COMPILE_OPTION ?= -c 153 161 C_COMPILER_OUTPUT_OPTION ?= -o … … 157 165 C_COMPILER_BUILD_RUNTIME_OPTIONS ?= -DC_BUILDING_LIBCHICKEN 158 166 C_COMPILER_BUILD_UNSAFE_RUNTIME_OPTIONS ?= $(C_COMPILER_BUILD_RUNTIME_OPTIONS) -DNDEBUG -DC_UNSAFE_RUNTIME 159 C_COMPILER_PCRE_OPTIONS ?= -DPCRE_STATIC160 167 C_COMPILER_SHARED_OPTIONS ?= -fPIC -DPIC 161 168 LINKER_EXECUTABLE_OPTIONS ?= -L. … … 220 227 endif 221 228 229 222 230 # file extensions 223 231 … … 231 239 POSIXFILE ?= posixunix 232 240 CHICKEN_CONFIG_H = chicken-config.h 233 PCRE_OBJECT_FILES ?= pcre/*.o234 241 235 242 ifneq ($(ARCH),) -
chicken/branches/release/library.scm
r7276 r7332 1208 1208 (##core#inline "C_copy_memory" s bv n) 1209 1209 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))))) 1210 1217 1211 1218 … … 3136 3143 (if (##sys#fudge 35) " applyhook" "") 3137 3144 (if (##sys#fudge 22) " lockts" "") 3145 (if (##sys#fudge 37) " hostpcre" "") 3138 3146 (if (##sys#fudge 39) " cross" "") ) ) ) 3139 3147 (string-append … … 4065 4073 (let ([arg (##sys#slot args 0)] 4066 4074 [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))) 4068 4077 (loop r) 4069 4078 (cons arg (loop r)) ) ) ) ) -
chicken/branches/release/manual/The User's Manual
r7276 r7332 3 3 == The User's Manual 4 4 5 ''(This document describes version 2.7 39)''5 ''(This document describes version 2.740)'' 6 6 7 7 '''CHICKEN is a compiler that translates Scheme source files into C''', which in -
chicken/branches/release/manual/Unit library
r7276 r7332 937 937 Returns a blob with the contents of {{STRING}}. 938 938 939 ==== blob=? 940 941 [procedure] (blob=? BLOB1 BLOB2) 942 943 Returns {{#t}} if the two argument blobs are of the same 944 size and have the same content. 945 939 946 940 947 -
chicken/branches/release/rules.make
r7276 r7332 57 57 LIBCHICKENGUI_STATIC_OBJECTS = $(LIBCHICKENGUI_OBJECTS_1:=-static$(O)) 58 58 59 PCRE_OBJECTS_1 = \59 PCRE_OBJECTS_1 ?= \ 60 60 pcre/pcre_compile \ 61 61 pcre/pcre_config \ -
chicken/branches/release/runtime.c
r7276 r7332 4177 4177 return C_mk_bool(debug_mode); 4178 4178 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 */ 4180 4187 4181 4188 case C_fix(39): -
chicken/branches/release/scheme-complete.el
r7276 r7332 28 28 ;;; (add-hook 'scheme-mode-hook 29 29 ;;; (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) 31 32 ;;; (eldoc-mode))) 32 33 ;;; 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 ;;; 33 38 ;;; That's all there is to it. 34 39 35 40 ;;; 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 37 45 ;;; for searching chicken and gauche modules 38 46 ;;; 0.3: 2007/11/13 - bugfixes, better inference, smart strings … … 1710 1718 )) 1711 1719 1720 ;; by default chicken has a single top-level namespace, so we want to 1721 ;; handle recursive imports 1712 1722 (defvar *scheme-chicken-deps* 1713 1723 '((lolevel extras) … … 1719 1729 (args srfi-37) 1720 1730 (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) 1721 1742 )) 1722 1743 1744 ;; another big table - consider moving to a separate file 1723 1745 (defvar *scheme-implementation-exports* 1724 1746 '((chicken … … 2725 2747 (defun chicken-available-modules (&optional sym) 2726 2748 (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)) 2728 2753 (append-map 2729 2754 #'(lambda (dir) 2730 2755 (mapcar 2731 'file-name-sans-extension2756 #'file-name-sans-extension 2732 2757 (directory-files dir nil ".*\\.\\(so\\|scm\\)$" t))) 2733 2758 *chicken-repo-dirs*))) … … 2755 2780 (other-dirs 2756 2781 (remove-if-not 2757 #' file-directory-p2782 #'(lambda (d) (and (not (equal d "")) (file-directory-p d))) 2758 2783 (split-string (or (getenv "GAUCHE_LOAD_PATH") "") ":")))) 2759 2784 (mapcar … … 2904 2929 2905 2930 (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))))) 2908 2937 2909 2938 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 2910 2939 ;; 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))) 2911 2968 2912 2969 (defun let-vars-at-point (&optional env) … … 2919 2976 (forward-char 1) 2920 2977 (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))))) 2947 2983 (or (ignore-errors (progn (beginning-of-next-sexp) t)) 2948 2984 (goto-char end))) … … 2984 3020 ;; (setq *current-scheme-implementation* whatever) 2985 3021 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 3028 when scheme-complete can't infer the current implementation." 3029 :type 'symbol 3030 :group 'scheme-complete) 3031 2986 3032 (defvar *current-scheme-implementation* nil) 2987 3033 (make-variable-buffer-local '*current-scheme-implementation*) 2988 3034 2989 (defvar *default-scheme-implementation* 'chicken) 2990 3035 ;; most implementations use their name as the script name 2991 3036 (defvar *scheme-interpreter-alist* 2992 3037 '(("csi" . chicken) … … 3014 3059 'mzscheme)))))) 3015 3060 (or *current-scheme-implementation* 3016 *default-scheme-implementation*))3061 default-scheme-implementation)) 3017 3062 3018 3063 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; … … 3020 3065 (defun current-local-vars (&optional env) 3021 3066 (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)) 3023 3070 (save-excursion 3024 3071 (while (> (point) limit) … … 3032 3079 (eq ?\( (char-syntax (char-before (point)))) 3033 3080 (eq ?w (char-syntax (char-after (point))))) 3081 (setq scan-internal t) 3034 3082 (let ((sym (scheme-symbol-at-point))) 3035 ;; XXXX handle internal defines3036 3083 (case sym 3037 3084 ((lambda) … … 3076 3123 vars))) 3077 3124 (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 )))))))) 3083 3151 (reverse vars))) 3084 3152 … … 3194 3262 imports)) 3195 3263 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 3241 3336 (defun current-scheme-globals () 3242 3337 (let ((globals '())) 3243 3338 (save-excursion 3244 3339 (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))) 3245 3343 (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))) 3252 3347 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)) 3253 3364 3254 3365 (defun scheme-module-exports (mod) … … 3321 3432 3322 3433 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 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. 3323 3439 3324 3440 (defun scheme-translate-type (type) … … 3374 3490 (cond 3375 3491 ((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))) 3378 3496 (setq type (car spec)) 3379 3497 (setq spec nil))) … … 3381 3499 (incf i)) 3382 3500 (if (and (not type) (= i pos)) 3383 (setq type ( car (remove ':optional spec))))3501 (setq type (if (consp spec) (car spec) spec))) 3384 3502 (if type 3385 3503 (setq type (scheme-translate-type type))) … … 3503 3621 (t nil)))))) 3504 3622 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 3505 3629 (defun scheme-smart-complete (&optional arg) 3506 3630 (interactive "P") … … 3547 3671 (eq 'lambda (car outer-type)) 3548 3672 (not (zerop outer-pos)) 3549 (nth outer-pos (cadr outer-type))3673 (nth* outer-pos (cadr outer-type)) 3550 3674 (zerop inner-pos)) 3551 3675 (let ((ret-type (scheme-lookup-type (cadr outer-type) outer-pos))) … … 3653 3777 (defun scheme-get-current-symbol-info () 3654 3778 (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)) 3656 3781 (env (save-excursion 3657 3782 (if (scheme-in-string-p) (beginning-of-string)) -
chicken/branches/release/version.scm
r7276 r7332 1 (define-constant +build-version+ "2.7 39")1 (define-constant +build-version+ "2.740")
Note: See TracChangeset
for help on using the changeset viewer.