99 lines
3.2 KiB
Racket
99 lines
3.2 KiB
Racket
#lang racket
|
|
(require parser-tools/lex)
|
|
(require parser-tools/yacc)
|
|
(require parser-tools/lex-sre)
|
|
|
|
(define-empty-tokens core/empty-tokens
|
|
(CASE OF IN LAM PACK ASSN ARROW LPAREN RPAREN LBRAC RBRAC LBRAK
|
|
RBRAK SEMICOLON EOF MULT DIV ADD MINUS AND OR COMMA DOT))
|
|
|
|
(define-tokens core/tokens
|
|
(NUM VAR RELOP LET))
|
|
|
|
(define core/lexer
|
|
(lexer
|
|
[(eof) (token-EOF)]
|
|
["." (token-DOT)]
|
|
["," (token-COMMA)]
|
|
["let" (token-LET 'let)]
|
|
["letrec" (token-LET 'letrec)]
|
|
["case" (token-CASE)]
|
|
["of" (token-OF)]
|
|
["in" (token-IN)]
|
|
["\\" (token-LAM)]
|
|
["Pack" (token-PACK)]
|
|
["=" (token-ASSN)]
|
|
["->" (token-ARROW)]
|
|
["+" (token-ADD)]
|
|
["-" (token-MINUS)]
|
|
["*" (token-MULT)]
|
|
["/" (token-DIV)]
|
|
["&" (token-AND)]
|
|
["|" (token-OR)]
|
|
["<" (token-LBRAK)]
|
|
[">" (token-RBRAK)]
|
|
[(or "<=" "==" "~=" ">=") (token-RELOP (string->symbol lexeme))]
|
|
["(" (token-LPAREN)]
|
|
[")" (token-RPAREN)]
|
|
["{" (token-LBRAC)]
|
|
["}" (token-RBRAC)]
|
|
[";" (token-SEMICOLON)]
|
|
[(+ numeric) (token-NUM (string->number lexeme))]
|
|
[(: alphabetic (* (or alphabetic numeric #\_))) (token-VAR (string->symbol lexeme))]
|
|
[whitespace (core/lexer input-port)]))
|
|
|
|
(define core/parser
|
|
(parser
|
|
[start program]
|
|
[end EOF]
|
|
[tokens core/empty-tokens core/tokens]
|
|
[precs
|
|
(nonassoc IN DOT OF ARROW)
|
|
(nonassoc SEMICOLON)
|
|
(right OR)
|
|
(right AND)
|
|
(right RELOP LBRAK RBRAK)
|
|
(left ADD MINUS)
|
|
(left MULT DIV)]
|
|
[error (λ (tok-ok? tok-name tok-value)
|
|
(error (format "Token Ok?: ~a\nToken name: ~a\nToken value: ~a" tok-ok? tok-name tok-value)))]
|
|
[grammar
|
|
[program [(sc) (list $1)]
|
|
[(program SEMICOLON sc) (cons $3 $1)]]
|
|
[sc [(VAR vars ASSN expr) (list 'define (cons $1 (reverse $2)) $4)]]
|
|
[expr [(expr ADD expr) (list (list '+ $1) $3)]
|
|
[(expr MINUS expr) (list (list '- $1) $3)]
|
|
[(LET defns IN expr) (list $1 (reverse $2) $4)]
|
|
[(expr MULT expr) (list (list '* $1) $3)]
|
|
[(expr OR expr) (list (list 'or $1) $3)]
|
|
[(expr AND expr) (list (list 'and $1) $3)]
|
|
[(expr RELOP expr) (list (list $2 $1) $3)]
|
|
[(expr LBRAK expr) (list (list '< $1) $3)]
|
|
[(expr RBRAK expr) (list (list '> $1) $3)]
|
|
[(expr DIV expr) (list (list '/ $1) $3)]
|
|
[(LAM vars1 DOT expr) (list 'λ (reverse $2) $4)]
|
|
[(CASE expr OF alts) (list 'case $2 (reverse $4))]
|
|
[(expr0) $1]]
|
|
[expr0 [(expr0 aexpr) (list $1 $2)]
|
|
[(aexpr) $1]]
|
|
[aexpr [(NUM) $1]
|
|
[(VAR) $1]
|
|
[(LPAREN expr RPAREN) $2]
|
|
[(PACK LBRAC NUM COMMA NUM RBRAC) (list 'pack $3 $5)]]
|
|
[defns [(defns SEMICOLON defn) (cons $3 $1)]
|
|
[(defn) (list $1)]]
|
|
[defn [(VAR ASSN expr) (list $1 $3)]]
|
|
[vars [() (list)]
|
|
[(vars VAR) (cons $2 $1)]]
|
|
[vars1 [(vars VAR) (cons $2 $1)]]
|
|
[alt [(LBRAK NUM RBRAK vars ARROW expr) (list $2 (reverse $4) $6)]]
|
|
[alts [(alt) (list $1)]
|
|
[(alts SEMICOLON alt) (cons $3 $1)]]]))
|
|
|
|
(define (parse-from-port p)
|
|
(reverse (core/parser (λ () (core/lexer p)))))
|
|
|
|
(define (parse-from-string s)
|
|
(parse-from-port (open-input-string s)))
|
|
|
|
(provide parse-from-port parse-from-string)
|