forked from cadence/breezewiki
		
	Move syntax definitions to a new file
This commit is contained in:
		
							parent
							
								
									e4bc962b05
								
							
						
					
					
						commit
						4ad22ca9c1
					
				
					 2 changed files with 56 additions and 24 deletions
				
			
		| 
						 | 
				
			
			@ -1,5 +1,6 @@
 | 
			
		|||
#lang racket/base
 | 
			
		||||
(require (for-syntax racket/base)
 | 
			
		||||
(require "syntax.rkt"
 | 
			
		||||
         (for-syntax racket/base)
 | 
			
		||||
         racket/string
 | 
			
		||||
         net/url
 | 
			
		||||
         (prefix-in host: web-server/dispatchers/dispatch-host)
 | 
			
		||||
| 
						 | 
				
			
			@ -15,29 +16,6 @@
 | 
			
		|||
 ; procedure to make the tree from the hashmap
 | 
			
		||||
 make-dispatcher-tree)
 | 
			
		||||
 | 
			
		||||
(define-syntax (if/out stx)
 | 
			
		||||
  (define tree (cdr (syntax->datum stx))) ; condition true false
 | 
			
		||||
  (define else (cddr tree)) ; the else branch cons cell
 | 
			
		||||
  (define result
 | 
			
		||||
   (let walk ([node tree])
 | 
			
		||||
     (cond
 | 
			
		||||
       ; normally, node should be a full cons cell (a pair) but it might be something else.
 | 
			
		||||
       ; situation: reached the end of a list, empty cons cell
 | 
			
		||||
       [(null? node) node]
 | 
			
		||||
       ; situation: reached the end of a list, cons cdr was non-list
 | 
			
		||||
       [(symbol? node) node]
 | 
			
		||||
       ; normal situation, full cons cell
 | 
			
		||||
       ; -- don't go replacing through nested if/out
 | 
			
		||||
       [(and (pair? node) (eq? 'if/out (car node))) node]
 | 
			
		||||
       ; -- replace if/in
 | 
			
		||||
       [(and (pair? node) (eq? 'if/in (car node)))
 | 
			
		||||
        (append '(if) (cdr node) else)]
 | 
			
		||||
       ; recurse down pair head and tail
 | 
			
		||||
       [(pair? node) (cons (walk (car node)) (walk (cdr node)))]
 | 
			
		||||
       ; something else that can't be recursed into, so pass it through
 | 
			
		||||
       [#t node])))
 | 
			
		||||
  (datum->syntax stx (cons 'if result)))
 | 
			
		||||
 | 
			
		||||
; make a hashmap out of the provided names and call make-dispatcher-tree with it
 | 
			
		||||
(define-syntax (dispatcher-tree stx)
 | 
			
		||||
  ; the arguments, which are names of dispatcher variables
 | 
			
		||||
| 
						 | 
				
			
			
 | 
			
		|||
							
								
								
									
										54
									
								
								src/syntax.rkt
									
										
									
									
									
										Normal file
									
								
							
							
						
						
									
										54
									
								
								src/syntax.rkt
									
										
									
									
									
										Normal file
									
								
							| 
						 | 
				
			
			@ -0,0 +1,54 @@
 | 
			
		|||
#lang racket/base
 | 
			
		||||
(require (for-syntax racket/base))
 | 
			
		||||
 | 
			
		||||
(provide
 | 
			
		||||
 ; help make a nested if where the false results are the same
 | 
			
		||||
 if/out)
 | 
			
		||||
 | 
			
		||||
(module+ test
 | 
			
		||||
  (require rackunit)
 | 
			
		||||
  (define (check-syntax-equal? s1 s2)
 | 
			
		||||
    (check-equal? (syntax->datum s1)
 | 
			
		||||
                  (syntax->datum s2))))
 | 
			
		||||
 | 
			
		||||
;; actual transforming goes on in here.
 | 
			
		||||
;; it's in a submodule so that it can be required in both levels, for testing
 | 
			
		||||
 | 
			
		||||
(module transform racket/base
 | 
			
		||||
  (provide transform-if/out)
 | 
			
		||||
  (define (transform-if/out stx)
 | 
			
		||||
    (define tree (cdr (syntax->datum stx))) ; condition true false
 | 
			
		||||
    (define else (cddr tree)) ; the else branch cons cell
 | 
			
		||||
    (define result
 | 
			
		||||
      (let walk ([node tree])
 | 
			
		||||
        (cond
 | 
			
		||||
          ; normally, node should be a full cons cell (a pair) but it might be something else.
 | 
			
		||||
          ; situation: reached the end of a list, empty cons cell
 | 
			
		||||
          [(null? node) node]
 | 
			
		||||
          ; situation: reached the end of a list, cons cdr was non-list
 | 
			
		||||
          [(symbol? node) node]
 | 
			
		||||
          ; normal situation, full cons cell
 | 
			
		||||
          ; -- don't go replacing through nested if/out
 | 
			
		||||
          [(and (pair? node) (eq? 'if/out (car node))) node]
 | 
			
		||||
          ; -- replace if/in
 | 
			
		||||
          [(and (pair? node) (eq? 'if/in (car node)))
 | 
			
		||||
           (append '(if) (cdr node) else)]
 | 
			
		||||
          ; recurse down pair head and tail
 | 
			
		||||
          [(pair? node) (cons (walk (car node)) (walk (cdr node)))]
 | 
			
		||||
          ; something else that can't be recursed into, so pass it through
 | 
			
		||||
          [#t node])))
 | 
			
		||||
    (datum->syntax stx (cons 'if result))))
 | 
			
		||||
 | 
			
		||||
;; the syntax definitions and their tests go below here
 | 
			
		||||
 | 
			
		||||
(require 'transform (for-syntax 'transform))
 | 
			
		||||
 | 
			
		||||
(define-syntax (if/out stx)
 | 
			
		||||
  (transform-if/out stx))
 | 
			
		||||
(module+ test
 | 
			
		||||
  (check-syntax-equal? (transform-if/out #'(if/out (condition 1) (if/in (condition 2) (do-yes)) (do-no)))
 | 
			
		||||
                       #'(if (condition 1) (if (condition 2) (do-yes) (do-no)) (do-no)))
 | 
			
		||||
  (check-equal? (if/out #t (if/in #t 'yes) 'no) 'yes)
 | 
			
		||||
  (check-equal? (if/out #f (if/in #t 'yes) 'no) 'no)
 | 
			
		||||
  (check-equal? (if/out #t (if/in #f 'yes) 'no) 'no)
 | 
			
		||||
  (check-equal? (if/out #f (if/in #f 'yes) 'no) 'no))
 | 
			
		||||
		Loading…
	
	Add table
		Add a link
		
	
		Reference in a new issue