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