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