You can not select more than 25 topics
Topics must start with a letter or number, can include dashes ('-') and can be up to 35 characters long.
63 lines
2.4 KiB
63 lines
2.4 KiB
;; Prevent the GC from collecting the associations
|
|
(define hr-syms '())
|
|
(define pc-syms '())
|
|
(define text-syms '())
|
|
|
|
(define-once $hr-tree
|
|
(csv->sxml (open-input-file path-hr-info)
|
|
#:record-sym (lambda x "hr")))
|
|
|
|
(define-once $pc-tree
|
|
(csv->sxml (open-input-file path-hr-pc-map)
|
|
#:record-sym (lambda x "pc")))
|
|
|
|
(define-syntax hr
|
|
(syntax-rules ()
|
|
((hr (($sym) (province $prov) (province_full $prov_text)
|
|
(province_short $prov_abbr) (health_region $hr_terse)
|
|
(health_region_esri $hr_full) $pop))
|
|
(begin (set! hr-syms (cons '$sym hr-syms))
|
|
(let (($text-sym (ssa> $prov "-" $hr_terse)))
|
|
(begin (set! text-syms (cons $text-sym text-syms))
|
|
(symbol-fset! $text-sym '$sym)))
|
|
(set-symbol-property! '$sym 'prov-code $prov_abbr)
|
|
(set-symbol-property! '$sym 'province $prov)
|
|
(set-symbol-property! '$sym 'terse $hr_terse)
|
|
(set-symbol-property! '$sym 'hr-full $hr_full)
|
|
(set-symbol-property! '$sym 'population $pop)))))
|
|
|
|
(define (hrinfo!)
|
|
(for-each (lambda (x) (eval x (interaction-environment)))
|
|
(pre-post-order
|
|
(cdr $hr-tree)
|
|
`((HR_UID . ,(lambda (l x) `(,(ssa> "HR" x))))
|
|
(pop . ,(lambda (l x) (string->number x)))
|
|
(*text* . ,(lambda (l x) x))
|
|
(*default* . ,(lambda x x))))))
|
|
|
|
(define-syntax pc
|
|
(syntax-rules ()
|
|
((pc (($pc) ($sym) (Prov $prov_num) (ENGNAME $eng_name)
|
|
(FRENAME $fre_name) (EstimatedPop $pop)))
|
|
(begin (set! pc-syms (cons '$pc pc-syms))
|
|
(symbol-fset! '$pc (cons '$sym (if-some (symbol-fref '$pc))))))))
|
|
|
|
(define (pcinfo!)
|
|
(for-each (lambda (x) (eval x (interaction-environment)))
|
|
(pre-post-order
|
|
(cdr $pc-tree)
|
|
`((FSA . ,(lambda (l x) `(,(ssa> "PC" x))))
|
|
(HR_UID . ,(lambda (l x) `(,(ssa> "HR" x))))
|
|
(*text* . ,(lambda (l x) x))
|
|
(*default* . ,(lambda x x))))))
|
|
|
|
(begin (hrinfo!)
|
|
(set! hr-syms (delq! 'HR9999 hr-syms))
|
|
(if test-mode?
|
|
(begin (display "Testing hr symbols") (newline)
|
|
(for-each (lambda (s) (run-hook test-hr s)) hr-syms)))
|
|
(pcinfo!)
|
|
(if test-mode?
|
|
(begin (display "Testing pc symbols") (newline)
|
|
(for-each (lambda (s) (run-hook test-pc s)) pc-syms))))
|