[racket] Use of map and eval to evaluate symbol in namespace

From: Galler (lzgaller at optonline.net)
Date: Thu Jul 31 00:01:59 EDT 2014

Henri
Is this what you're after? 



#lang racket/base

(require (for-syntax syntax/parse
                      racket/base
                     ))


(provide make-script)
        
(begin-for-syntax

(define-syntax-class unit-dictionary
  #:attributes (str)
  (pattern  (~literal p)
           #:with str "pills")
  (pattern (~literal c)
           #:with str "capsules"))
   
(define qu-regex (pregexp "^(?i:(\\d+)([^\\d]{1}))$"))

(define-syntax-class quantity-units
  #:attributes (str)
  (pattern candidate:id
           #:with (_ q:id u:unit-dictionary) #`#,(map (compose
string->symbol string-downcase) (or (regexp-match qu-regex (symbol->string
(syntax->datum #'candidate)))
                                                                 null))
           #:with str  #`#,(apply format "~a ~a" (syntax->datum #'(q  u.str)))))
                                         

(define-syntax-class formula-dictionary
  #:attributes (str)
  (pattern  (~literal hctz)
           #:with str "Hydrochlorothiazide")
  (pattern (~literal omz)
           #:with str "Omeprazol")
   (pattern (~literal simva)
           #:with str "Simvastatin"))
  

(define formula-regex (pregexp "^(?i:([^\\d]+)(\\d+))$"))

(define-syntax-class formula
  #:attributes (str)
  (pattern candidate:id
           #:with (_ code:formula-dictionary packaging:id) #`#,(map (compose
string->symbol string-downcase) (or (regexp-match formula-regex
(symbol->string (syntax->datum #'candidate)))
                                                                           
                   null))
          #:with str  #`#,(apply format "~a - ~a mg" (syntax->datum
#'(code.str  packaging)))))
           

(define-syntax-class medication           
  #:attributes (str)
  (pattern (f:formula q-u:quantity-units)
      #:with str #`#,(apply format "~a ---------------------~a\n"
(syntax->datum #'(f.str q-u.str)))))



(define-syntax-class periodicity-dictionary
  #:attributes (str)
  (pattern  (~literal cu)
           #:with str "Continuous use")
  (pattern (~literal iu)
           #:with str "Intermittent use"))
           

(define duration-regex (pregexp "^(?i:(cu|iu)(\\d+))$"))

(define-syntax-class duration
  #:attributes (str)
  (pattern candidate:id
           #:with (_ code:periodicity-dictionary length:id) #`#,(map
(compose string->symbol string-downcase) (or (regexp-match duration-regex
(symbol->string (syntax->datum #'candidate)))
                                                                           
                   null))
          #:with str  #`#,(apply format "~a - ~a months" (syntax->datum
#'(code.str  length)))))
           

(define-splicing-syntax-class sentence
  #:description "sentence"
  #:attributes (ast) 
  (pattern (~seq patient-name:str d:duration meds:medication ...)
         #:with ast #'((patient . patient-name) (directions . d.str)
(medication . meds.str) ...)))
  

)

(define-syntax (make-script stx)
  (syntax-parse stx
    ((_ x:sentence) #''x.ast)
    (_  #'#f)))


(make-script "John Doe" CU4 (HCTZ25 30P) (OMZ20 30P) (SIMVA20 30c))
(make-script "Jane Doe" IU6  (OMZ100 55C))

#|
program output
'((patient . "John Doe")
  (directions . "Continuous use - 4 months")
  (medication . "Hydrochlorothiazide - 25 mg ---------------------30 pills\n")
  (medication . "Omeprazol - 20 mg ---------------------30 pills\n")
  (medication . "Simvastatin - 20 mg ---------------------30 capsules\n"))
'((patient . "Jane Doe") (directions . "Intermittent use - 6 months")
(medication . "Omeprazol - 100 mg ---------------------55 capsules\n"))

|#




Posted on the users mailing list.