Changeset 35430 in project


Ignore:
Timestamp:
04/22/18 18:46:48 (4 months ago)
Author:
kon
Message:

reflow

Location:
release/4/locale/trunk
Files:
7 edited

Legend:

Unmodified
Added
Removed
  • release/4/locale/trunk/locale-categories.scm

    r35403 r35430  
    1919  #;srfi-9
    2020  (only miscmacros define-parameter)
    21   lookup-table
    22   type-checks
    23   type-errors
     21  (only lookup-table make-dict dict-delete! dict-set! dict-ref)
     22  type-checks type-errors
    2423  locale-components)
    2524
     
    2726
    2827(define-record-type locale-dictionary
    29   (%make-locale-dictionary tbl)
     28  (%make-locale-dictionary dict)
    3029  locale-dictionary?
    31   (tbl locale-dictionary-table) )
     30  (dict locale-dictionary-dict) )
    3231
    3332(define (make-locale-dictionary)
     
    4140  (check-symbol 'set-locale-dictionary-category! key)
    4241  (let (
    43     (tbl
    44       (locale-dictionary-table
     42    (dict
     43      (locale-dictionary-dict
    4544        (check-locale-dictionary 'set-locale-dictionary-category! rec))) )
    4645    (cond
    4746      ((not val)
    48         (dict-delete! tbl key))
     47        (dict-delete! dict key))
    4948      (else
    5049        (check-locale-components 'set-locale-dictionary-category! val)
    51         (dict-set! tbl key val) ) ) ) )
     50        (dict-set! dict key val) ) ) ) )
    5251
    5352;; A locale-component or #f
    5453
    5554(define (locale-dictionary-category rec key #!optional def)
    56   (check-locale-dictionary 'locale-dictionary-category rec)
    57   (check-symbol 'locale-dictionary-category key)
    58   (dict-ref (locale-dictionary-table rec) key def) )
     55  (dict-ref
     56    (locale-dictionary-dict
     57      (check-locale-dictionary 'locale-dictionary-category rec))
     58    (check-symbol 'locale-dictionary-category key)
     59    def) )
    5960
    6061;;;
  • release/4/locale/trunk/locale-components.scm

    r35426 r35430  
    9494
    9595(define-inline (*locale-component-ref loc lc what def)
    96   (let ((cell (assq what lc)))
     96  (let (
     97    (cell (assq what lc)) )
    9798    (if cell
    9899      (cdr cell)
     
    105106  (if (null? lc)
    106107    (alist-cons what value lc)
    107     (let ((cell (assq what lc)))
     108    (let (
     109      (cell (assq what lc)) )
    108110      (cond
    109111        (cell
    110112          (set-cdr! cell value))
    111113        (else
    112           (set-cdr! (last-pair lc) (list (cons what value)))))
     114          (set-cdr! (last-pair lc) (list (cons what value)))) )
    113115      lc ) ) )
    114116
     
    266268(define (make-timezone-dst-rule-julian-noleap j o)
    267269  (%make-timezone-dst-rule-julian-noleap
    268   (check-timezone-dst-rule-julian-noleap-day 'make-timezone-dst-rule-julian-noleap j)
    269   (check-timezone-offset 'make-timezone-dst-rule-julian-noleap o)) )
     270    (check-timezone-dst-rule-julian-noleap-day 'make-timezone-dst-rule-julian-noleap j)
     271    (check-timezone-offset 'make-timezone-dst-rule-julian-noleap o)) )
    270272
    271273;;
     
    287289(define (make-timezone-dst-rule-julian-leap j o)
    288290  (%make-timezone-dst-rule-julian-leap
    289   (check-timezone-dst-rule-julian-leap-day 'make-timezone-dst-rule-julian-leap j)
    290   (check-timezone-offset 'make-timezone-dst-rule-julian-leap o)) )
     291    (check-timezone-dst-rule-julian-leap-day 'make-timezone-dst-rule-julian-leap j)
     292    (check-timezone-offset 'make-timezone-dst-rule-julian-leap o)) )
    291293
    292294;;
     
    399401
    400402(define (timezone-components? obj)
    401   (and (locale-components? obj)
    402        (eq? 'timezone (*locale-component-ref 'timezone-components? obj 'tag #f))) )
     403  (and
     404    (locale-components? obj)
     405    (eq? 'timezone (*locale-component-ref 'timezone-components? obj 'tag #f))) )
    403406
    404407(define-check+error-type timezone-components)
    405408
    406409(define (timezone-components=? a b)
    407   (check-timezone-components 'timezone-components=? a)
    408   (check-timezone-components 'timezone-components=? b)
    409   (*locale-components=? a b) )
     410  (*locale-components=?
     411    (check-timezone-components 'timezone-components=? a)
     412    (check-timezone-components 'timezone-components=? b)) )
    410413
    411414(define (timezone-component-ref tz what . def)
    412   (check-timezone-components 'timezone-component-ref tz)
    413   (*locale-component-ref 'timezone-component-ref tz what (optional def #f)) )
     415  (*locale-component-ref 'timezone-component-ref
     416    (check-timezone-components 'timezone-component-ref tz)
     417    what (optional def #f)) )
    414418
    415419(define (set-timezone-component! tz what value)
    416   (check-timezone-components 'set-timezone-component! tz)
    417   (*set-locale-component! 'set-timezone-component! tz what value check-timezone-component) )
     420  (*set-locale-component! 'set-timezone-component!
     421    (check-timezone-components 'set-timezone-component! tz)
     422    what value check-timezone-component) )
    418423
    419424(define (update-timezone-components! tz . args)
    420   (check-timezone-components 'update-timezone-components! tz)
    421   (*update-locale-components! 'update-timezone-components! tz args check-timezone-component) )
     425  (*update-locale-components! 'update-timezone-components!
     426    (check-timezone-components 'update-timezone-components! tz)
     427    args check-timezone-component) )
    422428
    423429) ;module locale-components
  • release/4/locale/trunk/locale-current.scm

    r35413 r35430  
    2828  locale-categories)
    2929
    30 ;;;
     30;;; Local Utility
    3131
     32;;
     33
     34;TLS
    3235(define *setup?* (make-parameter #f))
    3336
    3437(define-inline (ensure-setup)
     38  ;critical region ?
    3539  (unless (*setup?*)
    3640    (*setup?* #t)
    3741    (locale-setup)) )
    3842
     43;;
     44
    3945;only useful for non-scalar (non-boolean) component
    40 (define-inline (locale-category+component-ref catnam cmpnam)
     46(define-inline (locale-category-component-ref catnam cmpnam)
    4147  (and-let* (
    4248    (lc (locale-category-ref catnam)) )
     
    4652  (and (not (timezone-components? obj)) (locale-components? obj)) )
    4753
     54;;; Utility
     55
     56(define (current-second-dst?)
     57  (vector-ref (seconds->local-time (current-seconds)) 8) )
     58
    4859;;; Parameters (Well, parameter-like)
     60
     61;Delays initialization
     62;TLS (via current-locale-dictionary)
    4963
    5064;;
     
    5367  (ensure-setup)
    5468  (if (null? args)
    55     (locale-category+component-ref 'timezone 'name)
     69    (locale-category-component-ref 'timezone 'name)
    5670    (let-optionals args ((obj #f) (src "USER"))
    5771      (cond
     
    5973          (set-locale-category! 'timezone #f) )
    6074        ((string? obj)
    61           (set-locale-category!
    62             'timezone
     75          (set-locale-category! 'timezone
    6376            (posix-timezone-string->timezone-components obj src)) )
    6477        ((timezone-components? obj)
     
    7487  (ensure-setup)
    7588  (if (null? args)
    76     (locale-category+component-ref 'current 'name)
     89    (locale-category-component-ref 'current 'name)
    7790    (let-optionals args ((obj #f) (src "USER"))
    7891      (cond
     
    98111  (ensure-setup)
    99112  (locale-category-ref 'current) )
    100 
    101 (define (current-second-dst?)
    102   (vector-ref (seconds->local-time (current-seconds)) 8) )
    103113
    104114;;
     
    127137  ;Chicken platform extensions
    128138  (when (current-timezone-components)
    129     (set-timezone-component! (current-timezone-components) 'dst? (current-second-dst?))) )
     139    (set-timezone-component!
     140      (current-timezone-components) 'dst?
     141      (current-second-dst?))) )
    130142
    131143) ;module locale
  • release/4/locale/trunk/locale-posix.scm

    r35426 r35430  
    9191;; timezone specifier
    9292
     93(define-constant INT-NAME-RE "(^[^<:0-9,+-][^0-9,+-]*)|^<([^>]+)>")
     94(define-constant OFFSET-NAME-RE "(^[+-][0-9]+)")
     95
    9396(define parse-posix-literal-timezone
    9497  (let (
    95     (ext-name-re (regexp "(^[+-][0-9]+)|(^[^<:0-9,+-][^0-9,+-]*)|^<([^>]+)>"))
    96     (int-name-re (regexp "(^[^<:0-9,+-][^0-9,+-]*)|^<([^>]+)>"))
     98    (ext-name-re (regexp (string-append OFFSET-NAME-RE "|" INT-NAME-RE)))
     99    (int-name-re (regexp INT-NAME-RE))
    97100    (offset-re (regexp "^(\\+|-)?([0-9]+)(:[0-9]+)?(:[0-9]+)?"))
    98101    ;For compatibility with System V Release 3.1, a semicolon (`;') may be
     
    412415;;; The POSIX/GNU locale categories
    413416
    414 (define *posix-locale-category-names*
    415   '(("LC_COLLATE" . collate)
    416     ("LC_CTYPE" . character)
    417     ("LC_MESSAGES" . messages)
    418     ("LC_MONETARY" . monetary)
    419     ("LC_NUMERIC" . numberic)
    420     ("LC_ADDRESS" . address)
    421     ("LC_IDENTIFICATION" . identification)
    422     ("LC_MEASUREMENT" . measurement)
    423     ("LC_NAME" . name)
    424     ("LC_PAPER" . paper)
    425     ("LC_TELEPHONE" . telephone)
    426     ("LC_TIME" . time)) )
     417(define *posix-locale-category-names* '(
     418  ("LC_COLLATE" . collate)
     419  ("LC_CTYPE" . character)
     420  ("LC_MESSAGES" . messages)
     421  ("LC_MONETARY" . monetary)
     422  ("LC_NUMERIC" . numberic)
     423  ("LC_ADDRESS" . address)
     424  ("LC_IDENTIFICATION" . identification)
     425  ("LC_MEASUREMENT" . measurement)
     426  ("LC_NAME" . name)
     427  ("LC_PAPER" . paper)
     428  ("LC_TELEPHONE" . telephone)
     429  ("LC_TIME" . time)) )
    427430
    428431(define (set-posix-locale-categories func)
     
    450453          ;Keep in priority order
    451454          (reverse!
    452             (fold
     455            (foldl
    453456              ;May not have a 'country or 'region. Should use locale's?
    454               (lambda (str ls)
    455               ;Ignore when no parse
    456               (let ((lc (posix-locale-string->locale-components str src)))
    457               (if lc (cons lc ls) ls) ) )
     457              (lambda (ls str)
     458                ;Ignore when no parse
     459                (let (
     460                  (lc (posix-locale-string->locale-components str src)) )
     461                  (if lc (cons lc ls) ls) ) )
    458462              '()
    459463              (string-split str ":")))) ) ) ) )
  • release/4/locale/trunk/locale-timezone.scm

    r35363 r35430  
    4848(define (get-tz tv)
    4949  ;Note that the tz-off should be in the tv!
    50   (let* ((tz (time->string (seconds->local-time (local-time->seconds tv)) "%z %Z"))
    51          (1stch (string-ref tz 0))
    52          (neg? (char=? #\- 1stch))
    53          (start (if (or neg? (char=? #\+ 1stch)) 1 0))
    54          (end (+ start 2))
    55          (secs (+ (* (string->number (substring tz start end)) 3600)
    56                   (* (string->number (substring tz end (+ end 2))) 60))) )
     50  (let* (
     51    (tz (time->string (seconds->local-time (local-time->seconds tv)) "%z %Z"))
     52    (1stch (string-ref tz 0))
     53    (neg? (char=? #\- 1stch))
     54    (start (if (or neg? (char=? #\+ 1stch)) 1 0))
     55    (end (+ start 2))
     56    (secs
     57      (+
     58        (* (string->number (substring tz start end)) 3600)
     59        (* (string->number (substring tz end (+ end 2))) 60))) )
    5760    (values (if neg? (- secs) secs) (substring tz (+ start 5))) ) )
    5861
    5962;#!required tv | yr mo dy #!optional (hr 12) (mn 0) (sc 0) #!key dst?
    6063(define (*local-tz-info loc . args)
    61 
    62   (let ((argcnt (length args))
    63         (yr #f) (mo #f) (dy #f) (hr #f) (mn #f) (sc #f) (dst? #f))
    64 
     64  ;
     65  (let (
     66    (argcnt (length args))
     67    (yr #f) (mo #f) (dy #f) (hr #f) (mn #f) (sc #f) (dst? #f) )
     68    ;
    6569    (define (kwdarg kwd rest)
    6670      (cond
    6771        ((eq? #:dst? kwd) (set! dst? (cadr rest)) )
    6872        (else (error-argument-type loc "keyword #:dst?" kwd) ) ) )
    69 
     73    ;
    7074    ; DSSSL lambda list parsing behavior as I wish it was
    7175    (check-minimum-argument-count loc argcnt 1)
    7276    (if (vector? (car args))
    73         ;then time-vector is argument
    74         ;kwd dst? overrides vector elm
    75         (let ((tv (car args)))
    76           (when (< (vector-length tv) 10)
    77             (error-argument-type loc tv "ten element time vector") )
    78           (set! dst? (vector-ref tv 8))
    79           (set! yr (+ (vector-ref tv 5) 1900))
    80           (set! mo (vector-ref tv 4))
    81           (set! dy (vector-ref tv 3))
    82           (set! hr (vector-ref tv 2))
    83           (set! mn (vector-ref tv 1))
    84           (set! sc (vector-ref tv 0))
    85           (let loop ((args (cdr args)))
    86             (unless (null? args)
    87               (let ((arg (car args)))
    88                 (cond
    89                   ((keyword? arg)
    90                     (kwdarg arg args)
    91                     (loop (cddr args)) )
    92                   (else
    93                     (error-keyword loc arg) ) ) ) ) ) )
    94         ;else atomic time elements
    95         (begin
    96           (check-minimum-argument-count loc argcnt 3)
    97           (set! yr (car args))
    98           (set! mo (cadr args))
    99           (set! dy (caddr args))
    100           (let loop ((args (cdddr args)))
    101             (if (null? args)
    102                 (begin
    103                   (unless hr (set! hr 12))
    104                   (unless mn (set! mn 0))
    105                   (unless sc (set! sc 0)))
    106                 (let ((arg (car args)))
    107                   (cond
    108                     ((keyword? arg)
    109                       (kwdarg arg args)
    110                       (loop (cddr args)) )
    111                     ((and hr mn sc)
    112                       (error-argument-count loc argcnt 8) )
    113                     (else
    114                       (if hr (if mn (set! sc arg) (set! mn arg)) (set! hr arg))
    115                       (loop (cdr args)) ) ) ) ) ) ) )
    116 
     77      ;then time-vector is argument
     78      ;kwd dst? overrides vector elm
     79      (let ((tv (car args)))
     80        (when (< (vector-length tv) 10)
     81          (error-argument-type loc tv "ten element time vector") )
     82        (set! dst? (vector-ref tv 8))
     83        (set! yr (+ (vector-ref tv 5) 1900))
     84        (set! mo (vector-ref tv 4))
     85        (set! dy (vector-ref tv 3))
     86        (set! hr (vector-ref tv 2))
     87        (set! mn (vector-ref tv 1))
     88        (set! sc (vector-ref tv 0))
     89        (let loop ((args (cdr args)))
     90          (unless (null? args)
     91            (let ((arg (car args)))
     92              (cond
     93                ((keyword? arg)
     94                  (kwdarg arg args)
     95                  (loop (cddr args)) )
     96                (else
     97                  (error-keyword loc arg) ) ) ) ) ) )
     98      ;else atomic time elements
     99      (begin
     100        (check-minimum-argument-count loc argcnt 3)
     101        (set! yr (car args))
     102        (set! mo (cadr args))
     103        (set! dy (caddr args))
     104        (let loop ((args (cdddr args)))
     105          (if (null? args)
     106            (begin
     107              (unless hr (set! hr 12))
     108              (unless mn (set! mn 0))
     109              (unless sc (set! sc 0)))
     110            (let ((arg (car args)))
     111              (cond
     112                ((keyword? arg)
     113                  (kwdarg arg args)
     114                  (loop (cddr args)) )
     115                ((and hr mn sc)
     116                  (error-argument-count loc argcnt 8) )
     117                (else
     118                  (if hr (if mn (set! sc arg) (set! mn arg)) (set! hr arg))
     119                  (loop (cdr args)) ) ) ) ) ) ) )
     120    ;
    117121    (check-fixnums loc yr mo dy hr mn sc)
    118122    (check-closed-intervals loc
     
    122126      (<= 1 dy 31)
    123127      (<= 0 mo 11))
    124 
     128    ;
    125129    (get-tz (vector sc mn hr dy mo (- yr 1900) 0 0 dst? 0)) ) )
    126130
     
    130134
    131135(define (local-timezone-name . args)
    132   (let-values (((tzo tzn) (apply *local-tz-info 'local-timezone-name args)))
     136  (let-values (
     137    ((tzo tzn) (apply *local-tz-info 'local-timezone-name args)) )
    133138    tzn ) )
    134139
     
    139144
    140145(define (local-timezone-offset . args)
    141   (let-values (((tzo tzn) (apply *local-tz-info 'local-timezone-offset args)))
     146  (let-values (
     147    ((tzo tzn) (apply *local-tz-info 'local-timezone-offset args)) )
    142148    tzo ) )
    143149
  • release/4/locale/trunk/locale.scm

    r35403 r35430  
    99
    1010(;export
    11   ;; locale-timezone
     11  ;
     12  ;;locale-timezone
    1213  local-timezone ;Deprecated
    1314  local-timezone-name
     
    1516  local-timezone-name+offset
    1617  with-tzset
    17   ;; locale-builtin
     18  ;
     19  ;;locale-builtin
    1820  builtin-source-name builtin-source-name?
    1921  unknown-timezone-name unknown-timezone-name?
     
    2123  use-builtin-locale
    2224  use-builtin-language
    23   ;; locale-posix
     25  ;
     26  ;;locale-posix
    2427  seconds->h:m:s-string
    2528  make-posix-timezone
     
    3033  posix-load-locale
    3134  gnu-load-locale
    32   ;; locale-components
     35  ;
     36  ;;locale-components
    3337  ;
    3438  make-locale-components
     
    8387  ;
    8488  timezone-dst-rule-offset
    85   ;; locale-categories
     89  ;
     90  ;;locale-categories
    8691  make-locale-dictionary
    8792  locale-dictionary?
     
    9196  locale-category-ref
    9297  set-locale-category!
    93   ;; locale-current
     98  ;;locale-current
    9499  current-timezone
    95100  current-locale
     
    101106(import chicken scheme)
    102107(use
    103   locale-timezone locale-builtin locale-posix locale-components
    104   locale-categories locale-current)
     108  locale-builtin locale-posix
     109  locale-categories locale-components
     110  locale-timezone
     111  locale-current)
    105112
    106113) ;module locale
  • release/4/locale/trunk/locale.setup

    r35409 r35430  
    55(verify-extension-name "locale")
    66
    7 (setup-shared-extension-module 'locale-components (extension-version "0.7.1")
     7(setup-shared-extension-module 'locale-components (extension-version "0.7.2")
    88  #:inline? #t
    99  #:types? #t
    1010  #:compile-options '(
    11     -disable-interrupts
    12     -fixnum-arithmetic
     11    -scrutinize -lfa2
    1312    -optimize-level 3 -debug-level 1
    14     -no-procedure-checks))
     13    -no-procedure-checks-for-toplevel-bindings))
    1514
    16 (setup-shared-extension-module 'locale-categories (extension-version "0.7.1")
     15(setup-shared-extension-module 'locale-categories (extension-version "0.7.2")
    1716  #:inline? #t
    1817  #:types? #t
    1918  #:compile-options '(
    20     -fixnum-arithmetic
     19    -scrutinize -lfa2
    2120    -optimize-level 3 -debug-level 1
    22     -no-procedure-checks))
     21    -no-procedure-checks-for-toplevel-bindings))
    2322
    24 (setup-shared-extension-module 'locale-posix (extension-version "0.7.1")
     23(setup-shared-extension-module 'locale-posix (extension-version "0.7.2")
    2524  #:inline? #t
    2625  #:types? #t
    2726  #:compile-options '(
     27    -scrutinize -lfa2
    2828    -optimize-level 3 -debug-level 1
    29     -no-procedure-checks))
     29    -no-procedure-checks-for-toplevel-bindings))
    3030
    31 (setup-shared-extension-module 'locale-timezone (extension-version "0.7.1")
     31(setup-shared-extension-module 'locale-timezone (extension-version "0.7.2")
    3232  #:inline? #t
    3333  #:types? #t
    3434  #:compile-options '(
    35     -fixnum-arithmetic
     35    -scrutinize -lfa2
    3636    -optimize-level 3 -debug-level 1
    37     -no-procedure-checks))
     37    -no-procedure-checks-for-toplevel-bindings))
    3838
    39 (setup-shared-extension-module 'locale-builtin (extension-version "0.7.1")
     39(setup-shared-extension-module 'locale-builtin (extension-version "0.7.2")
    4040  #:inline? #t
    4141  #:types? #t
    4242  #:compile-options '(
    43     -fixnum-arithmetic
     43    -scrutinize -lfa2
    4444    -optimize-level 3 -debug-level 1
    45     -no-procedure-checks))
     45    -no-procedure-checks-for-toplevel-bindings))
    4646
    47 (setup-shared-extension-module 'locale-current (extension-version "0.7.1")
     47(setup-shared-extension-module 'locale-current (extension-version "0.7.2")
    4848  #:inline? #t
    4949  #:types? #t
    5050  #:compile-options '(
    51     -fixnum-arithmetic
     51    -scrutinize -lfa2
    5252    -optimize-level 3 -debug-level 1
    53     -no-procedure-checks))
     53    -no-procedure-checks-for-toplevel-bindings))
    5454
    55 (setup-shared-extension-module 'locale (extension-version "0.7.1"))
     55(setup-shared-extension-module 'locale (extension-version "0.7.2"))
Note: See TracChangeset for help on using the changeset viewer.