diff --git a/expander.rkt b/expander.rkt index a1ae13b..02de7b4 100644 --- a/expander.rkt +++ b/expander.rkt @@ -1,40 +1,108 @@ #lang br/quicklang -(namespace-require 'racket/base) ; must be added for the currect namespace + (require racket/dict) +(require racket/match) +(namespace-require/copy 'racket/base) ; must be added for the currect namespace + +(define-macro (init-defs) + #'(begin + '())) + +(define paperwidth 2480) +(define paperheight 3508) +(define frame-list '()) +(define main-style + (make-hash '(["font-family" . "FreeSerif"] + ["font-family-CJK" . "Noto Sans CJK TC"] + ["font-size" . 12] + ["font-weight" . "regular"] + ["font-style" . "normal"]))) + +(define main-frame + (make-hash '(["type" . "frame"] + ["id" . "main"] + ["content" . #f] + ["style" . main-style] + ["x". 1800] + ["y". 3200] + ["width". 1800] + ["height" . 3200] + ["skip-to-footnote". 80]) + )) +(set! frame-list (cons main-frame frame-list)) +(define (hd2 cont) + (make-hash `(["type" . "hbox"] + ["id" . ""] + ["content" . ,cont] + ["style" . ["style" . ,(make-hash '(["font-family" . "FreeSerif"] + ["font-family-CJK" . "Noto Sans CJK TC"] + ["font-size" . 15] + ["font-weight" . "regular"] + ["font-style" . "normal"]))]] + ["x". #f] + ["y". #f] + ["width". #f] + ["height" . #f] +) + )) + +(define (maintext cont) + (match cont + [`(mixed-series ,(list `newline a ...)) (mixed-series a)] + [_ cont])) -(define paperwidth #f) -(define paperheight #f) -(define (set x y) (set! x y)) -(define (add x y) (+ x y)) + + +[define ns (current-namespace)] + +(struct put-chars ([ch #:mutable]) #:transparent) ; flow of chars to be put +(struct mixed-series ([item #:mutable]) #:transparent) ; series of mixed item + (provide (matching-identifiers-out #rx"^u-" (all-defined-out))) (define-macro (u-id ID) #'(string->symbol ID)) -(define-macro (u-atom ITEM...) - #'ITEM...) -(define-macro (u-number NUM...) - #'(number->string NUM...)) + + +(define-macro (u-number NUM) + #'(number->string NUM)) +(define-macro-cases u-atom + [(u-atom (u-number NUM)) #'(put-chars (number->string NUM))] + [(u-atom "\n") #''newline] + [(u-atom HD_CHAR TL_CHAR ...) #'(put-chars (foldr string-append "" `(HD_CHAR TL_CHAR ...)))] + [(u-atom X) #'X]) + (define-macro (u-converting-num NUM...) #'(string->number NUM...)) (define-macro-cases u-expr + [(u-expr (u-atom (u-id ID))) #'(string->symbol ID)] + [(u-expr (put-chars X)) #'(put-chars X)] [(u-expr (u-atom ITEM)) #'ITEM] + [(u-expr (u-series SERIES ...)) #'(begin (mixed-series `(,SERIES ...)))] [(u-expr (u-converting-num (u-number NUM))) #'NUM] [(u-expr X) #'X]) (define-macro-cases u-sexp - [(u-sexp (u-expr (u-atom (u-id "set"))) X Y) #'(set! X Y)] + [(u-sexp (u-expr (u-atom (u-id "set"))) (u-expr (u-atom (u-id X))) Y) + #'(let ((tmp (string->symbol X))) (namespace-set-variable-value! tmp Y #f ns #f))] + [(u-sexp (u-expr (u-atom (u-id "maintext"))) X ...) #'(maintext X ...)] + [(u-sexp (u-expr (u-atom (u-id "hd2"))) X) #'(hd2 X)] ;[(u-sexp X Y) #'[X Y]] [(u-sexp REQ OPT ...) - #'(let ([head REQ] - (namespace (current-namespace))) - (namespace-variable-value head namespace) OPT ...)] - ) + #'(begin (display (memq 'maintext (namespace-mapped-symbols ns))) + + ((eval REQ ns) (eval OPT ... ns)))]) (define-macro (u-module-begin (u-program LINE ...)) #'(#%module-begin + (init-defs) LINE ...)) + + + (provide (rename-out [u-module-begin #%module-begin])) +(provide maintext) \ No newline at end of file diff --git a/parser-test.rkt b/parser-test.rkt index ff6205a..d502090 100644 --- a/parser-test.rkt +++ b/parser-test.rkt @@ -1,10 +1,12 @@ #lang br (require uahgi2/parser uahgi2/tokenizer brag/support) (define str #<