maru-2.4/tpeg.g at master · Rokhan/maru-2.4 · GitHub

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
# -*- coke -*-

<tpeg> : <text-parser> ()

equals    	= "=" space ;
blank		= [\t ] ;
eol		= ("\n" "\r"*) | ("\r" "\n"*) ;
comment		= "#" (!eol .)* ;
space		= (blank | eol | comment)* ;
bar       	= "|"  space ;
pling     	= "!"  space ;
ampersand 	= "&"  space ;
colon     	= ":"  space ;
arrow     	= "->" space ;
quotesgl     	= "\'" space ;
backquote     	= "`"  space ;
commaat     	= ",@" space ;
comma     	= ","  space ;
dollarhash	= "$#" space ;
dollardbl	= "$$" space ;
dollar		= "$"  space ;
at		= "@"  space ;
query     	= "?"  space ;
minus      	= "-"  space ;
plus      	= "+"  space ;
star      	= "*"  space ;
lparen      	= "("  space ;
rparen     	= ")"  space ;
lbrace      	= "{"  space ;
rbrace     	= "}"  space ;
dot       	= "."  space ;
tilde       	= "~"  space ;
digit		= [0-9] ;
higit		= [0-9A-Fa-f] ;
number		= ("-"? digit+) @$#:n space -> n ;
letter		= [A-Z_a-z] ;
idpart		= (letter (letter | digit)*) @$$ ;
identifier	= idpart:id space				-> id ;

char		= "\\"	( "t"					->  9
			| "n"					-> 10
			| "r"					-> 13
			| "x" (higit higit) @$#16
			| "u" (higit higit higit higit) @$#16
			| .
                        )
		| . ;
string		= "\""  (!"\""  char)* $:s "\""  space		-> s ;
class		= "["   (!"]"   char)* $:s "]"   space		-> s ;

grammar         = symbol:name space plus
                  definition*:rules space                       -> `(grammar-extend ,name                 ,@rules)
                | symbol:name space colon symbol:parent space
                  (lparen identifier*:fields rparen)?
                  definition*:rules space                       -> `(grammar-define ,name ,parent ,fields ,@rules)
                | definition*:d space expression?:e             -> `(grammar-eval ,d ,(car e))
                ;

symfirst	= [-!#$%&*+/:<=>@A-Z^_a-z|~] ;
symrest		= [-!#$%&*+./:0-9<=>?@A-Z^_a-z|~] ;
symbol		= (symfirst symrest*) @$$ ;
sexpr		= ("-"? digit+) @$#
		| symbol
		| "?".
		| "\""  (!"\""  char)* $:e "\""					-> e
		| "("  sexpression*:e (space dot sexpression:f)? sspace ")"	-> (set-list-source `(,@e ,@f) e)
		| "["  sexpression*:e (space dot sexpression:f)? sspace "]"	-> (set-list-source `(bracket ,@e ,@f) e)
		| "'"  sexpression:e						-> (list 'quote e)
		| "`"  sexpression:e						-> (list 'quasiquote e)
		| ",@" sexpression:e						-> (list 'unquote-splicing e)
		| ","  sexpression:e						-> (list 'unquote e)
		| "{"  space grammar:e	( "}"					-> e
					|					-> (error "error in grammar near: "(parser-context self))
					)
		| ";" (![\n\r] .)*
		;
scomment	= ";" (!eol .)* ;
sspace		= (blank | eol | scomment)* ;
sexpression	= sspace sexpr ;

llist		= lparen expression:e rparen			-> e ;
atom		= lparen expression:e rparen			-> e
		| quotesgl sexpression:e space			-> `(match-object ,e)
		| string:e					-> `(match-string ,e)
		| class:e					-> `(match-class ,e)
		| idpart:p "-" identifier:e			-> `(match-rule-in ,p ,e)
		| identifier:e					-> `(match-rule ,e)
		| lbrace sexpression*:e space rbrace		-> `(match-rule ,@e)
		| dot						-> `(match-any)
		| arrow sexpression:e space			-> `(result-expr ,e)
		| backquote llist:e				-> `(match-list ,e)
		;
repetition	= atom :e ( query				-> `(match-zero-one ,e)  :e
			  | star				-> `(match-zero-more ,e) :e
			  | plus				-> `(match-one-more ,e)  :e
			  )?					-> e ;
conversion	= repetition :e ( at				-> `(make-span	    ,e) :e
				| dollarhash ( number:n		-> `(make-number ,n ,e) :e
					     |			-> `(make-number 10 ,e) :e
					     )
				| dollardbl			-> `(make-symbol      ,e   ) :e
				| dollar			-> `(make-string      ,e   ) :e
				| colon identifier :i		-> `(assign-result ,i ,e   ) :e
				)*				-> e ;
predicate	= pling     conversion:e			-> `(peek-not  ,e)
		| ampersand ( arrow sexpression:e space		-> `(peek-expr ,e)
			    | conversion:e			-> `(peek-for  ,e)
			    )
		| conversion ;

require		= predicate:p	( tilde string:e		-> `(match-require ,p ,e)
				|				-> p
				) ;

sequence	= require:p	( require+:q			-> `(match-all ,p ,@q)
				|				-> p
				) ;

expression	= sequence:s	( (bar sequence)+:t		-> `(match-first ,s ,@t)
				|				-> s
				) ;

parameters	= (colon identifier)* ;

definition	= space identifier:id parameters:p
		  equals expression:e ";"			-> `(,id ,e ,p) ;

definitions	= definition* ;

varname		= symbol:s space -> s ;

parser_decl	= space varname:name colon varname:parent lparen (varname*):vars rparen	-> `(,name ,parent ,vars) ;

parser_spec	= parser_decl?:decl definition*:defns		-> `(,decl ,@defns) ;