simplify

beautiful-racket-lib/br/syntax.rkt

@@ -80,7 +80,7 @@
                (if (pair? sis-in)
                    (apply append sis-in)
                    (list
-                    (let ([si (make-syntax-introducer 'use-site)])
+                    (let ([si (make-syntax-introducer)])
                       (list (procedure-rename (curryr si 'add) 'add-id)
                             (procedure-rename (curryr si 'flip) 'flip-id)
                             (procedure-rename (curryr si 'remove) 'remove-id)))))))

beautiful-racket/br/demo/hdl-tst/expander.rkt

@@ -8,34 +8,27 @@
       (displayln (format "got unbound identifier: ~a" 'id))
       (procedure-rename (λ xs (cons 'id xs)) (string->symbol (format "undefined:~a" 'id)))))
 
-(define #'(tst-program _arg ...)
+(define #'(tst-program _arg ...) #'(begin _arg ...))
-  #'(begin 
-      _arg ...))
 
-(define-for-syntax output-here #'output-here)
 
 (define #'(header-expr _filename (_colid ... _outid))
   (with-syntax* ([filename-string (symbol->string (syntax->datum #'_filename))]
                  [procname (string->symbol (cadr (regexp-match #rx"^(.*)\\.hdl$"(symbol->string (syntax->datum #'_filename)))))]
-                 [output (shared-syntax 'output)])
+                 [output (syntax-local-introduce (datum->syntax #f 'output))])
-  #'(begin
+    #'(begin
-      (provide (all-defined-out))
+        (provide (all-defined-out))
-      (define procname (dynamic-require (findf file-exists? (list filename-string (format "~a.rkt" filename-string))) 'procname))
+        (define procname
-      (display-header '_colid ... '_outid)
+          (dynamic-require (findf file-exists?
-      (define _colid (make-parameter 0)) ...
+                                  (list filename-string (format "~a.rkt" filename-string))) 'procname))
-      (define (_outid)
+        (display-header '_colid ... '_outid)
-        (keyword-apply procname
+        (define _colid (make-parameter 0)) ...
-                       (map (compose1 string->keyword symbol->string) (list '_colid ...))
+        (define (_outid)
-                       (list (_colid) ...) null))
+          (keyword-apply procname
-      
+                         (map (compose1 string->keyword symbol->string) (list '_colid ...))
-      (define (output)
+                         (list (_colid) ...) null))
-        (display-values (_colid) ... (_outid))))))
+        
-
+        (define (output)
-
+          (display-values (_colid) ... (_outid))))))
-(define #'(load-expr _filename)
-  (inject-syntax ([#'filename-string (symbol->string (syntax->datum #'_filename))]
-                  [#'proc-name (string->symbol (cadr (regexp-match #rx"^(.*)\\.hdl$"(symbol->string (syntax->datum #'_filename)))))])
-                 #'(filename-string proc-name)))
 
 (define #'(display-header _sym ...)
   #'(begin
@@ -54,5 +47,5 @@
 (define #'eval-expr #'void)
 
 (define #'(output-expr)
-  (inject-syntax ([#'output (shared-syntax 'output)])
+  (inject-syntax ([#'output 'output])
                  #'(output)))