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
 | 
					#lang racket/base
 | 
				
			||||||
(require (for-syntax racket/base)
 | 
					(require "syntax.rkt"
 | 
				
			||||||
 | 
					         (for-syntax racket/base)
 | 
				
			||||||
         racket/string
 | 
					         racket/string
 | 
				
			||||||
         net/url
 | 
					         net/url
 | 
				
			||||||
         (prefix-in host: web-server/dispatchers/dispatch-host)
 | 
					         (prefix-in host: web-server/dispatchers/dispatch-host)
 | 
				
			||||||
| 
						 | 
					@ -15,29 +16,6 @@
 | 
				
			||||||
 ; procedure to make the tree from the hashmap
 | 
					 ; procedure to make the tree from the hashmap
 | 
				
			||||||
 make-dispatcher-tree)
 | 
					 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
 | 
					; make a hashmap out of the provided names and call make-dispatcher-tree with it
 | 
				
			||||||
(define-syntax (dispatcher-tree stx)
 | 
					(define-syntax (dispatcher-tree stx)
 | 
				
			||||||
  ; the arguments, which are names of dispatcher variables
 | 
					  ; 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