add funstacker & stackerizer
This commit is contained in:
parent
68922b0cb5
commit
ff24afea7b
8
beautiful-racket/br/demo/funstacker-test.rkt
Normal file
8
beautiful-racket/br/demo/funstacker-test.rkt
Normal file
|
@ -0,0 +1,8 @@
|
||||||
|
#lang reader br/demo/funstacker
|
||||||
|
4
|
||||||
|
8
|
||||||
|
|
||||||
|
+
|
||||||
|
3
|
||||||
|
|
||||||
|
*
|
|
@ -5,7 +5,7 @@
|
||||||
|
|
||||||
(define (read-syntax src-path in-port)
|
(define (read-syntax src-path in-port)
|
||||||
(define args (port->list read in-port))
|
(define args (port->list read in-port))
|
||||||
(define module-datum `(module stacker2-mod br/demo/stacker2
|
(define module-datum `(module funstacker-mod br/demo/funstacker
|
||||||
,@args))
|
,@args))
|
||||||
(datum->syntax #f module-datum))
|
(datum->syntax #f module-datum))
|
||||||
|
|
||||||
|
@ -24,4 +24,4 @@
|
||||||
|
|
||||||
(module+ test
|
(module+ test
|
||||||
(require rackunit)
|
(require rackunit)
|
||||||
(check-equal? (with-output-to-string (λ () (dynamic-require "stacker2-test.rkt" #f))) "36"))
|
(check-equal? (with-output-to-string (λ () (dynamic-require "funstacker-test.rkt" #f))) "36"))
|
|
@ -1,8 +0,0 @@
|
||||||
#lang reader br/demo/stacker2
|
|
||||||
4
|
|
||||||
8
|
|
||||||
|
|
||||||
+
|
|
||||||
3
|
|
||||||
|
|
||||||
*
|
|
2
beautiful-racket/br/demo/stackerizer-test copy.rkt
Normal file
2
beautiful-racket/br/demo/stackerizer-test copy.rkt
Normal file
|
@ -0,0 +1,2 @@
|
||||||
|
#lang s-exp br/demo/stackerizer
|
||||||
|
(+ 3 (* 6 (*) 2 (+ 145 56 3 6 (* 3 56436 9)) 15 22))
|
29
beautiful-racket/br/demo/stackerizer.rkt
Normal file
29
beautiful-racket/br/demo/stackerizer.rkt
Normal file
|
@ -0,0 +1,29 @@
|
||||||
|
#lang br/quicklang
|
||||||
|
(provide + *)
|
||||||
|
|
||||||
|
(define-macro (stackerizer-module-begin EXPR ...)
|
||||||
|
#'(#%module-begin
|
||||||
|
(for-each displayln (reverse (flatten (list EXPR ...))))))
|
||||||
|
(provide (rename-out [stackerizer-module-begin #%module-begin]))
|
||||||
|
|
||||||
|
#|
|
||||||
|
(define-macro-cases *
|
||||||
|
[(*) #'1]
|
||||||
|
[(* EXPR0) #'EXPR0]
|
||||||
|
[(* EXPR0 EXPR ...) #'(list '* EXPR0 (* EXPR ...))])
|
||||||
|
|
||||||
|
(define-macro-cases +
|
||||||
|
[(+) #'0]
|
||||||
|
[(+ EXPR0) #'EXPR0]
|
||||||
|
[(+ EXPR0 EXPR ...) #'(list '+ EXPR0 (+ EXPR ...))])
|
||||||
|
|#
|
||||||
|
|
||||||
|
|
||||||
|
(define-macro (define-op-macro OP-NAME IDENTITY-VAL)
|
||||||
|
#'(define-macro-cases OP-NAME
|
||||||
|
[(OP-NAME) #'IDENTITY-VAL]
|
||||||
|
[(OP-NAME EXPR0) #'EXPR0]
|
||||||
|
[(OP-NAME EXPR0 EXPR (... ...)) #'(list 'OP-NAME EXPR0 (OP-NAME EXPR (... ...)))]))
|
||||||
|
|
||||||
|
(define-op-macro * 1)
|
||||||
|
(define-op-macro + 0)
|
Loading…
Reference in New Issue
Block a user