yoxem/uahgi2
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

remove uahgi-ng/
Some checks are pending
CI / Build on Racket 'stable' (BC) (push) Waiting to run
Details
CI / Build on Racket 'stable' (CS) (push) Waiting to run
Details
CI / Build on Racket 'current' (BC) (push) Waiting to run
Details
CI / Build on Racket 'current' (CS) (push) Waiting to run
Details

Browse source
This commit is contained in:
Tan, Kian-ting 2025-10-07 01:37:09 +08:00
parent c0d3e83989
commit 1b43574c01
14 changed files with 167 additions and 1035 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

140
expander.rkt
View file

@ -1,108 +1,42 @@
#lang br/quicklang
(module uahgi2 racket/base
(require racket/dict) (require racket/dict)
(require racket/match) (define main-config (make-hash
(namespace-require/copy 'racket/base) ; must be added for the currect namespace '(["paper-width". 2480]
["paper-height". 3508]
(define-macro (init-defs) ["font-family" . "FreeSerif"]
#'(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-family-CJK" . "Noto Sans CJK TC"]
["font-size" . 12] ["font-size" . 14]
["font-weight" . "regular"] ["font-weight" . "regular"]
["font-style" . "normal"]))) ["font-style" . "normal"]
)))
(define main-frame (make-hash
'(["id" . 1]
["font-family" . (dict-ref main-config "font-family")]
["class" . frame]
["width" . 2000]
["height" . 3000]
["x" . 200]
["y" . 250]
["content" . #f])))
(define (set-main-config attr val)
(dict-set! main-config attr val))
(define (main-text txt)
(dict-set! main-frame "content" txt))
(define-syntax text-series
(syntax-rules ()
[(_ x ...)
; delete the beginning newline
(if (eq? (caar `(x ...)) "\n")
`('text ,(cdar `(x ...)))
`('text ,(caar `(x ...)) ,(cdar `(x ...)))))]))
(provide text-series main-text main-frame main-config set-main-config set!
(all-from-out racket/base) (all-from-out racket/dict)
#%module-begin #%app #%datum #%expression #%top)
(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 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-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"))) (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 ...)
#'(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)

67
lexer.rkt
View file

@ -1,27 +1,48 @@
#lang br #lang racket
(require brag/support) (require parser-tools/lex)
(require parser-tools/lex-sre)
(define-lex-abbrev digits (:+ (char-set "0123456789")))
(define-lex-abbrev raw-id (:: (:or "_" (:/ "a" "z") (:/ "A" "Z")) (:* (:or "_" (:/ "0" "9") (:/ "a" "z") (:/ "A" "Z")))))
(define-lex-abbrev any-other-char (:~ (char-set "0123456789@\\{}%|"))) (define-empty-tokens unary-tokens (L_PAREN R_PAREN NUM_CONVERTER SEPERATOR EOF))
(define-tokens value-tokens ( CHAR ID NUM NEWLINE))
(define-lex-abbrev digits (+ (char-set "0123456789")))
(define-lex-abbrev raw-id (: (or "_" (/ "a" "z") (/ "A" "Z")) (* (or "_" "-" "!" "?" (/ "0" "9") (/ "a" "z") (/ "A" "Z")))))
(define-lex-abbrev any-other-char (~ (char-set "0123456789@\\{}%|")))
(define uahgi2-lexer (define uahgi2-lexer
(lexer-srcloc (lexer-src-pos
[(:or "\r\n" "\n") (token 'NEWLINE lexeme)] ; newline ["\n" (token-NEWLINE lexeme)] ; newline
[whitespace (token lexeme lexeme)] ; whitespace [whitespace (token-CHAR lexeme)] ; whitespace
[(:: "\\"(char-set "@\\{}%|")) (token 'CHAR (substring lexeme [(: "\\"(char-set "@\\{}%|")) (token-CHAR (substring lexeme
1 (string-length lexeme)))] 1 (string-length lexeme)))]
[(:: "@" raw-id) (token 'ID (substring lexeme [(: "@" raw-id) (token-ID (string->symbol(substring lexeme
1 (string-length lexeme)))] ; @id 1 (string-length lexeme))))] ; @id
["{" (token 'L_PAREN lexeme)] ; { ["{" (token-L_PAREN)] ; {
["}" (token 'R_PAREN lexeme)] ; } ["}" (token-R_PAREN)] ; }
["|" (token 'SEPERATOR lexeme)] ; | (general) seperator ["|" (token-SEPERATOR)] ; | seperator
["@@" (token 'G_SEPERATOR lexeme)] ; @@ great seperator ["`" (token-NUM_CONVERTER)] ; ` convert to number
["`" (token 'NUM_CONVERTER lexeme)] ; ` convert to number [digits (token-NUM (string->number lexeme))] ;123
[digits (token 'INTEGER (string->number lexeme))] ;123 [(: (? (char-set "-")) digits "." digits) ; 123.456
[(:: (:? (char-set "-")) digits "." digits) ; 123.456 (token-NUM (string->number lexeme))]
(token 'DECIMAL (string->number lexeme))] [ (: "%" (complement (: any-string "%" any-string)) "%") ; %COMMENT%
[ (from/to "%" "%") ; %COMMENT% (return-without-pos (uahgi2-lexer input-port))]
(token 'COMMENT #:skip? #t)] [(eof) (token-EOF)]
[any-other-char (token 'CHAR lexeme)])) ; any char into char [any-other-char (token-CHAR lexeme)] ; any char into char
(provide uahgi2-lexer) ))
(define (looping-lex str)
(define in (open-input-string str))
(port-count-lines! in)
(let loop ([v (uahgi2-lexer in)])
(cond [(void? (position-token-token v)) (loop (uahgi2-lexer in))]
[(eq? 'EOF (position-token-token v)) '()]
[else (cons v (loop (uahgi2-lexer in)))])))
(provide uahgi2-lexer unary-tokens value-tokens looping-lex)

7
main.rkt
View file

@ -1,9 +1,10 @@
#lang br/quicklang #lang racket/base
(require "parser.rkt" "tokenizer.rkt") (require "parser.rkt" "tokenizer.rkt")
(require syntax/strip-context)
(define (read-syntax path port) (define (read-syntax path port)
(define parse-tree (parse path (make-tokenizer port path))) (define parse-tree (parse-tkns (make-tokenizer port path)))
(strip-bindings (strip-context
#`(module uahgi2-mod uahgi2/expander #`(module uahgi2-mod uahgi2/expander
#,parse-tree))) #,parse-tree)))

92
parser.rkt
View file

@ -1,17 +1,75 @@
#lang brag #lang racket
u-program: [/NEWLINE+] (u-expr [/NEWLINE+])* (require megaparsack megaparsack/text)
u-expr: (require uahgi2/lexer)
u-series ; string series (require megaparsack/parser-tools/lex)
| u-atom (require data/monad)
| u-converting-num (require data/applicative)
| u-sexp
u-sexp: (define newline/p (token/p 'NEWLINE))
/L_PAREN u-expr (/SEPERATOR u-expr)* /R_PAREN (define num/p (do
| /L_PAREN [(/" "|/NEWLINE)+] u-expr (/G_SEPERATOR [(/" "|/NEWLINE)+] u-expr [(/" "|/NEWLINE)+])* /R_PAREN ; ?? [num <- (token/p 'NUM)]
u-series: (u-atom | u-sexp)+ (pure (number->string num))))
u-converting-num: /NUM_CONVERTER (u-id | u-number) (define char/p (token/p 'CHAR))
u-atom: u-id | u-string | u-number | (NEWLINE+) (define id/p (token/p 'ID))
u-number: INTEGER | DECIMAL (define num-converter/p (token/p 'NUM_CONVERTER))
u-id: ID
@u-string: u-char+ (define string/p
@u-char: CHAR | " " (do
[chars <- (many+/p char/p)]
(pure (foldr string-append "" chars))))
(define atom/p (or/p
num/p
string/p
id/p))
(define converting-num/p
(do
(token/p 'NUM_CONVERTER)
[num <- num/p]
(pure (string->number num))))
(define sexp-elem/p
(delay/p (or/p (try/p series/p)
expr/p)))
(define sexp/p
(do
(token/p 'L_PAREN)
[args <- (many/p sexp-elem/p #:sep (token/p 'SEPERATOR))]
(token/p 'R_PAREN)
(pure (list* args))))
(define expr/p
(or/p atom/p
converting-num/p
sexp/p))
(define series-elem/p
(or/p newline/p
num/p
string/p
id/p
sexp/p))
(define series/p
(do [args <- (many/p series-elem/p #:min 2)]
(pure (list 'text-series args))))
(define prog/p
(syntax/p
(do
(many/p (token/p 'NEWLINE))
[lines <- (many/p expr/p #:sep (many/p(token/p 'NEWLINE)))]
(many/p (token/p 'NEWLINE))
(pure `(begin ,@lines)))))
(define (parse-tkns tokens)
(parse-result! (parse-tokens prog/p tokens)))
(define (parse-string str)
(parse-tkns (looping-lex str)))
(provide parse-tkns parse-string)

0
uahgi-ng/test.ug → test.ug
View file

0
uahgi-ng/test1.ug → test1.ug
View file

9
tokenizer.rkt
View file

@ -1,10 +1,9 @@
#lang br #lang racket/base
(require "lexer.rkt" brag/support) (require "lexer.rkt" parser-tools/lex racket/port)
(define (make-tokenizer ip [path #f]) (define (make-tokenizer ip [path #f])
(port-count-lines! ip) (port-count-lines! ip)
(lexer-file-path path) (file-path path)
(define (next-token) (uahgi2-lexer ip)) (looping-lex (port->string ip)))
next-token)
(provide make-tokenizer) (provide make-tokenizer)

679
uahgi-ng/a.txt
View file

@ -1,679 +0,0 @@
0 g1038660 = (g1038661)
1 g1038661 = (u-program EOF)
2 u-program = ()
3 u-program = (u-expr u-program)
4 u-expr = (u-series)
5 u-expr = (u-atom)
6 u-expr = (u-converting-num)
7 u-expr = (L_PAREN u-sexps R_PAREN)
8 u-sexps = ()
9 u-sexps = (u-expr u-sexps)
10 u-series-unit = (ID)
11 u-series-unit = (u-string)
12 u-series-unit = (NUM)
13 u-series-unit = (L_PAREN u-sexps R_PAREN)
14 u-series-unit = (newlines)
15 u-series = ()
16 u-series = (u-series-unit u-series)
17 u-converting-num = (NUM_CONVERTER ID)
18 u-converting-num = (NUM_CONVERTER NUM)
19 u-atom = (ID)
20 u-atom = (u-string)
21 u-atom = (NUM)
22 u-atom = (newlines)
23 u-string = (CHAR)
24 u-string = (u-string CHAR)
25 newlines = (NEWLINE)
26 newlines = (NEWLINE newlines)
State 0
g1038660 -> . g1038661
begin conflict:
NEWLINE shift 15
NEWLINE reduce 15
end conflict
g1038661 goto 1
u-atom goto 7
begin conflict:
CHAR shift 12
CHAR reduce 15
end conflict
u-converting-num goto 6
begin conflict:
EOF reduce 15
EOF reduce 2
end conflict
u-string goto 8
u-program goto 2
u-series-unit goto 4
u-expr goto 3
newlines goto 9
u-series goto 5
begin conflict:
NUM shift 14
NUM reduce 15
end conflict
begin conflict:
ID shift 13
ID reduce 15
end conflict
begin conflict:
L_PAREN shift 10
L_PAREN reduce 15
end conflict
begin conflict:
NUM_CONVERTER shift 11
NUM_CONVERTER reduce 15
end conflict
State 1
g1038660 -> g1038661 .
State 2
g1038661 -> u-program . EOF
EOF accept
State 3
u-program -> u-expr . u-program
begin conflict:
NEWLINE shift 15
NEWLINE reduce 15
end conflict
u-atom goto 7
begin conflict:
CHAR shift 12
CHAR reduce 15
end conflict
u-converting-num goto 6
begin conflict:
EOF reduce 15
EOF reduce 2
end conflict
u-string goto 8
u-program goto 17
u-series-unit goto 4
u-expr goto 3
newlines goto 9
u-series goto 5
begin conflict:
NUM shift 14
NUM reduce 15
end conflict
begin conflict:
ID shift 13
ID reduce 15
end conflict
begin conflict:
L_PAREN shift 10
L_PAREN reduce 15
end conflict
begin conflict:
NUM_CONVERTER shift 11
NUM_CONVERTER reduce 15
end conflict
State 4
u-series -> u-series-unit . u-series
begin conflict:
NEWLINE shift 15
NEWLINE reduce 15
end conflict
begin conflict:
CHAR shift 12
CHAR reduce 15
end conflict
R_PAREN reduce 15
EOF reduce 15
u-string goto 19
u-series-unit goto 4
newlines goto 20
u-series goto 18
begin conflict:
NUM shift 23
NUM reduce 15
end conflict
begin conflict:
ID shift 22
ID reduce 15
end conflict
begin conflict:
L_PAREN shift 21
L_PAREN reduce 15
end conflict
NUM_CONVERTER reduce 15
State 5
u-expr -> u-series .
EOF reduce 4
NEWLINE reduce 4
CHAR reduce 4
NUM reduce 4
R_PAREN reduce 4
L_PAREN reduce 4
ID reduce 4
NUM_CONVERTER reduce 4
State 6
u-expr -> u-converting-num .
EOF reduce 6
NEWLINE reduce 6
CHAR reduce 6
NUM reduce 6
R_PAREN reduce 6
L_PAREN reduce 6
ID reduce 6
NUM_CONVERTER reduce 6
State 7
u-expr -> u-atom .
EOF reduce 5
NEWLINE reduce 5
CHAR reduce 5
NUM reduce 5
R_PAREN reduce 5
L_PAREN reduce 5
ID reduce 5
NUM_CONVERTER reduce 5
State 8
u-series-unit -> u-string .
u-atom -> u-string .
u-string -> u-string . CHAR
begin conflict:
EOF reduce 11
EOF reduce 20
end conflict
begin conflict:
NEWLINE reduce 11
NEWLINE reduce 20
end conflict
begin conflict:
CHAR shift 24
CHAR reduce 11
CHAR reduce 20
end conflict
begin conflict:
NUM reduce 11
NUM reduce 20
end conflict
begin conflict:
R_PAREN reduce 11
R_PAREN reduce 20
end conflict
begin conflict:
L_PAREN reduce 11
L_PAREN reduce 20
end conflict
begin conflict:
ID reduce 11
ID reduce 20
end conflict
begin conflict:
NUM_CONVERTER reduce 11
NUM_CONVERTER reduce 20
end conflict
State 9
u-series-unit -> newlines .
u-atom -> newlines .
begin conflict:
EOF reduce 14
EOF reduce 22
end conflict
begin conflict:
NEWLINE reduce 14
NEWLINE reduce 22
end conflict
begin conflict:
CHAR reduce 14
CHAR reduce 22
end conflict
begin conflict:
NUM reduce 14
NUM reduce 22
end conflict
begin conflict:
R_PAREN reduce 14
R_PAREN reduce 22
end conflict
begin conflict:
L_PAREN reduce 14
L_PAREN reduce 22
end conflict
begin conflict:
ID reduce 14
ID reduce 22
end conflict
begin conflict:
NUM_CONVERTER reduce 14
NUM_CONVERTER reduce 22
end conflict
State 10
u-expr -> L_PAREN . u-sexps R_PAREN
u-series-unit -> L_PAREN . u-sexps R_PAREN
begin conflict:
NEWLINE shift 15
NEWLINE reduce 15
end conflict
u-atom goto 7
begin conflict:
CHAR shift 12
CHAR reduce 15
end conflict
begin conflict:
R_PAREN reduce 15
R_PAREN reduce 8
end conflict
u-sexps goto 26
u-converting-num goto 6
u-string goto 8
u-series-unit goto 4
u-expr goto 25
newlines goto 9
u-series goto 5
begin conflict:
NUM shift 14
NUM reduce 15
end conflict
begin conflict:
ID shift 13
ID reduce 15
end conflict
begin conflict:
L_PAREN shift 10
L_PAREN reduce 15
end conflict
begin conflict:
NUM_CONVERTER shift 11
NUM_CONVERTER reduce 15
end conflict
State 11
u-converting-num -> NUM_CONVERTER . ID
u-converting-num -> NUM_CONVERTER . NUM
NUM shift 28
ID shift 27
State 12
u-string -> CHAR .
EOF reduce 23
NEWLINE reduce 23
CHAR reduce 23
NUM reduce 23
R_PAREN reduce 23
L_PAREN reduce 23
ID reduce 23
NUM_CONVERTER reduce 23
State 13
u-series-unit -> ID .
u-atom -> ID .
begin conflict:
EOF reduce 10
EOF reduce 19
end conflict
begin conflict:
NEWLINE reduce 10
NEWLINE reduce 19
end conflict
begin conflict:
CHAR reduce 10
CHAR reduce 19
end conflict
begin conflict:
NUM reduce 10
NUM reduce 19
end conflict
begin conflict:
R_PAREN reduce 10
R_PAREN reduce 19
end conflict
begin conflict:
L_PAREN reduce 10
L_PAREN reduce 19
end conflict
begin conflict:
ID reduce 10
ID reduce 19
end conflict
begin conflict:
NUM_CONVERTER reduce 10
NUM_CONVERTER reduce 19
end conflict
State 14
u-series-unit -> NUM .
u-atom -> NUM .
begin conflict:
EOF reduce 12
EOF reduce 21
end conflict
begin conflict:
NEWLINE reduce 12
NEWLINE reduce 21
end conflict
begin conflict:
CHAR reduce 12
CHAR reduce 21
end conflict
begin conflict:
NUM reduce 12
NUM reduce 21
end conflict
begin conflict:
R_PAREN reduce 12
R_PAREN reduce 21
end conflict
begin conflict:
L_PAREN reduce 12
L_PAREN reduce 21
end conflict
begin conflict:
ID reduce 12
ID reduce 21
end conflict
begin conflict:
NUM_CONVERTER reduce 12
NUM_CONVERTER reduce 21
end conflict
State 15
newlines -> NEWLINE .
newlines -> NEWLINE . newlines
begin conflict:
NEWLINE shift 15
NEWLINE reduce 25
end conflict
CHAR reduce 25
R_PAREN reduce 25
EOF reduce 25
NUM reduce 25
newlines goto 29
ID reduce 25
L_PAREN reduce 25
NUM_CONVERTER reduce 25
State 16
g1038661 -> u-program EOF .
State 17
u-program -> u-expr u-program .
EOF reduce 3
State 18
u-series -> u-series-unit u-series .
EOF reduce 16
NEWLINE reduce 16
CHAR reduce 16
NUM reduce 16
R_PAREN reduce 16
L_PAREN reduce 16
ID reduce 16
NUM_CONVERTER reduce 16
State 19
u-series-unit -> u-string .
u-string -> u-string . CHAR
EOF reduce 11
NEWLINE reduce 11
begin conflict:
CHAR shift 24
CHAR reduce 11
end conflict
NUM reduce 11
R_PAREN reduce 11
L_PAREN reduce 11
ID reduce 11
NUM_CONVERTER reduce 11
State 20
u-series-unit -> newlines .
EOF reduce 14
NEWLINE reduce 14
CHAR reduce 14
NUM reduce 14
R_PAREN reduce 14
L_PAREN reduce 14
ID reduce 14
NUM_CONVERTER reduce 14
State 21
u-series-unit -> L_PAREN . u-sexps R_PAREN
begin conflict:
NEWLINE shift 15
NEWLINE reduce 15
end conflict
u-atom goto 7
begin conflict:
CHAR shift 12
CHAR reduce 15
end conflict
begin conflict:
R_PAREN reduce 15
R_PAREN reduce 8
end conflict
u-sexps goto 30
u-converting-num goto 6
u-string goto 8
u-series-unit goto 4
u-expr goto 25
newlines goto 9
u-series goto 5
begin conflict:
NUM shift 14
NUM reduce 15
end conflict
begin conflict:
ID shift 13
ID reduce 15
end conflict
begin conflict:
L_PAREN shift 10
L_PAREN reduce 15
end conflict
begin conflict:
NUM_CONVERTER shift 11
NUM_CONVERTER reduce 15
end conflict
State 22
u-series-unit -> ID .
EOF reduce 10
NEWLINE reduce 10
CHAR reduce 10
NUM reduce 10
R_PAREN reduce 10
L_PAREN reduce 10
ID reduce 10
NUM_CONVERTER reduce 10
State 23
u-series-unit -> NUM .
EOF reduce 12
NEWLINE reduce 12
CHAR reduce 12
NUM reduce 12
R_PAREN reduce 12
L_PAREN reduce 12
ID reduce 12
NUM_CONVERTER reduce 12
State 24
u-string -> u-string CHAR .
EOF reduce 24
NEWLINE reduce 24
CHAR reduce 24
NUM reduce 24
R_PAREN reduce 24
L_PAREN reduce 24
ID reduce 24
NUM_CONVERTER reduce 24
State 25
u-sexps -> u-expr . u-sexps
begin conflict:
NEWLINE shift 15
NEWLINE reduce 15
end conflict
u-atom goto 7
begin conflict:
CHAR shift 12
CHAR reduce 15
end conflict
begin conflict:
R_PAREN reduce 15
R_PAREN reduce 8
end conflict
u-sexps goto 31
u-converting-num goto 6
u-string goto 8
u-series-unit goto 4
u-expr goto 25
newlines goto 9
u-series goto 5
begin conflict:
NUM shift 14
NUM reduce 15
end conflict
begin conflict:
ID shift 13
ID reduce 15
end conflict
begin conflict:
L_PAREN shift 10
L_PAREN reduce 15
end conflict
begin conflict:
NUM_CONVERTER shift 11
NUM_CONVERTER reduce 15
end conflict
State 26
u-expr -> L_PAREN u-sexps . R_PAREN
u-series-unit -> L_PAREN u-sexps . R_PAREN
R_PAREN shift 32
State 27
u-converting-num -> NUM_CONVERTER ID .
EOF reduce 17
NEWLINE reduce 17
CHAR reduce 17
NUM reduce 17
R_PAREN reduce 17
L_PAREN reduce 17
ID reduce 17
NUM_CONVERTER reduce 17
State 28
u-converting-num -> NUM_CONVERTER NUM .
EOF reduce 18
NEWLINE reduce 18
CHAR reduce 18
NUM reduce 18
R_PAREN reduce 18
L_PAREN reduce 18
ID reduce 18
NUM_CONVERTER reduce 18
State 29
newlines -> NEWLINE newlines .
EOF reduce 26
NEWLINE reduce 26
CHAR reduce 26
NUM reduce 26
R_PAREN reduce 26
L_PAREN reduce 26
ID reduce 26
NUM_CONVERTER reduce 26
State 30
u-series-unit -> L_PAREN u-sexps . R_PAREN
R_PAREN shift 33
State 31
u-sexps -> u-expr u-sexps .
R_PAREN reduce 9
State 32
u-expr -> L_PAREN u-sexps R_PAREN .
u-series-unit -> L_PAREN u-sexps R_PAREN .
begin conflict:
EOF reduce 7
EOF reduce 13
end conflict
begin conflict:
NEWLINE reduce 7
NEWLINE reduce 13
end conflict
begin conflict:
CHAR reduce 7
CHAR reduce 13
end conflict
begin conflict:
NUM reduce 7
NUM reduce 13
end conflict
begin conflict:
R_PAREN reduce 7
R_PAREN reduce 13
end conflict
begin conflict:
L_PAREN reduce 7
L_PAREN reduce 13
end conflict
begin conflict:
ID reduce 7
ID reduce 13
end conflict
begin conflict:
NUM_CONVERTER reduce 7
NUM_CONVERTER reduce 13
end conflict
State 33
u-series-unit -> L_PAREN u-sexps R_PAREN .
EOF reduce 13
NEWLINE reduce 13
CHAR reduce 13
NUM reduce 13
R_PAREN reduce 13
L_PAREN reduce 13
ID reduce 13
NUM_CONVERTER reduce 13
38 shift/reduce conflicts
45 reduce/reduce conflicts

42
uahgi-ng/expander.rkt
View file

@ -1,42 +0,0 @@
(module uahgi-ng racket/base
(require racket/dict)
(define main-config (make-hash
'(["paper-width". 2480]
["paper-height". 3508]
["font-family" . "FreeSerif"]
["font-family-CJK" . "Noto Sans CJK TC"]
["font-size" . 14]
["font-weight" . "regular"]
["font-style" . "normal"]
)))
(define main-frame (make-hash
'(["id" . 1]
["font-family" . (dict-ref main-config "font-family")]
["class" . frame]
["width" . 2000]
["height" . 3000]
["x" . 200]
["y" . 250]
["content" . #f])))
(define (set-main-config attr val)
(dict-set! main-config attr val))
(define (main-text txt)
(dict-set! main-frame "content" txt))
(define-syntax text-series
(syntax-rules ()
[(_ x ...)
; delete the beginning newline
(if (eq? (caar `(x ...)) "\n")
`('text ,(cdar `(x ...)))
`('text ,(caar `(x ...)) ,(cdar `(x ...)))))]))
(provide text-series main-text main-frame main-config set-main-config set!
(all-from-out racket/base) (all-from-out racket/dict)
#%module-begin #%app #%datum #%expression #%top)
)

48
uahgi-ng/lexer.rkt
View file

@ -1,48 +0,0 @@
#lang racket
(require parser-tools/lex)
(require parser-tools/lex-sre)
(define-empty-tokens unary-tokens (L_PAREN R_PAREN NUM_CONVERTER SEPERATOR EOF))
(define-tokens value-tokens ( CHAR ID NUM NEWLINE))
(define-lex-abbrev digits (+ (char-set "0123456789")))
(define-lex-abbrev raw-id (: (or "_" (/ "a" "z") (/ "A" "Z")) (* (or "_" "-" "!" "?" (/ "0" "9") (/ "a" "z") (/ "A" "Z")))))
(define-lex-abbrev any-other-char (~ (char-set "0123456789@\\{}%|")))
(define uahgi2-lexer
(lexer-src-pos
["\n" (token-NEWLINE lexeme)] ; newline
[whitespace (token-CHAR lexeme)] ; whitespace
[(: "\\"(char-set "@\\{}%|")) (token-CHAR (substring lexeme
1 (string-length lexeme)))]
[(: "@" raw-id) (token-ID (string->symbol(substring lexeme
1 (string-length lexeme))))] ; @id
["{" (token-L_PAREN)] ; {
["}" (token-R_PAREN)] ; }
["|" (token-SEPERATOR)] ; | seperator
["`" (token-NUM_CONVERTER)] ; ` convert to number
[digits (token-NUM (string->number lexeme))] ;123
[(: (? (char-set "-")) digits "." digits) ; 123.456
(token-NUM (string->number lexeme))]
[ (: "%" (complement (: any-string "%" any-string)) "%") ; %COMMENT%
(return-without-pos (uahgi2-lexer input-port))]
[(eof) (token-EOF)]
[any-other-char (token-CHAR lexeme)] ; any char into char
))
(define (looping-lex str)
(define in (open-input-string str))
(port-count-lines! in)
(let loop ([v (uahgi2-lexer in)])
(cond [(void? (position-token-token v)) (loop (uahgi2-lexer in))]
[(eq? 'EOF (position-token-token v)) '()]
[else (cons v (loop (uahgi2-lexer in)))])))
(provide uahgi2-lexer unary-tokens value-tokens looping-lex)

12
uahgi-ng/main.rkt
View file

@ -1,12 +0,0 @@
#lang racket/base
(require "parser.rkt" "tokenizer.rkt")
(require syntax/strip-context)
(define (read-syntax path port)
(define parse-tree (parse-tkns (make-tokenizer port path)))
(strip-context
#`(module uahgi-ng-mod uahgi-ng/expander
#,parse-tree)))
(module+ reader
(provide read-syntax))

75
uahgi-ng/parser.rkt
View file

@ -1,75 +0,0 @@
#lang racket
(require megaparsack megaparsack/text)
(require uahgi-ng/lexer)
(require megaparsack/parser-tools/lex)
(require data/monad)
(require data/applicative)
(define newline/p (token/p 'NEWLINE))
(define num/p (do
[num <- (token/p 'NUM)]
(pure (number->string num))))
(define char/p (token/p 'CHAR))
(define id/p (token/p 'ID))
(define num-converter/p (token/p 'NUM_CONVERTER))
(define string/p
(do
[chars <- (many+/p char/p)]
(pure (foldr string-append "" chars))))
(define atom/p (or/p
num/p
string/p
id/p))
(define converting-num/p
(do
(token/p 'NUM_CONVERTER)
[num <- num/p]
(pure (string->number num))))
(define sexp-elem/p
(delay/p (or/p (try/p series/p)
expr/p)))
(define sexp/p
(do
(token/p 'L_PAREN)
[args <- (many/p sexp-elem/p #:sep (token/p 'SEPERATOR))]
(token/p 'R_PAREN)
(pure (list* args))))
(define expr/p
(or/p atom/p
converting-num/p
sexp/p))
(define series-elem/p
(or/p newline/p
num/p
string/p
id/p
sexp/p))
(define series/p
(do [args <- (many/p series-elem/p #:min 2)]
(pure (list 'text-series args))))
(define prog/p
(syntax/p
(do
(many/p (token/p 'NEWLINE))
[lines <- (many/p expr/p #:sep (many/p(token/p 'NEWLINE)))]
(many/p (token/p 'NEWLINE))
(pure `(begin ,@lines)))))
(define (parse-tkns tokens)
(parse-result! (parse-tokens prog/p tokens)))
(define (parse-string str)
(parse-tkns (looping-lex str)))
(provide parse-tkns parse-string)

16
uahgi-ng/parser.txt
View file

@ -1,16 +0,0 @@
#lang brag
u-program: [/NEWLINE+] (u-expr [/NEWLINE+])*
u-expr:
; u-series ; string series
| u-atom
| u-converting-num
| u-sexp
u-sexp:
/L_PAREN u-expr (/SEPERATOR u-expr)* /R_PAREN
u-series: (u-atom | u-sexp)+
~~~u-converting-num: /NUM_CONVERTER (u-id | u-number)
~~~u-atom: u-id | u-string | u-number | (NEWLINE+)
~~~u-number: INTEGER | DECIMAL
u-id: ID
@u-string: u-char+
@u-char: CHAR | " "

9
uahgi-ng/tokenizer.rkt
View file

@ -1,9 +0,0 @@
#lang racket/base
(require "lexer.rkt" parser-tools/lex racket/port)
(define (make-tokenizer ip [path #f])
(port-count-lines! ip)
(file-path path)
(looping-lex (port->string ip)))
(provide make-tokenizer)