Ekdohibs/camlboot
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

Use string-index to make symbol lexing more readable, remove unused errorp parameter

Browse Source
This commit is contained in:
Nathanaël Courant 2020-12-07 21:44:29 +01:00
parent 2617b736cc
commit 435d3f8755
1 changed files with 21 additions and 30 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

51
miniml/compiler/compile.scm
View File

@ -551,12 +551,12 @@
)))
(define (symbol-char? c)
(member c (list #\! #\$ #\% #\& #\* #\+ #\- #\. #\/ #\: #\< #\= #\> #\? #\@ #\^ #\| #\~) char=?))
(string-index "!$%&*+-./:<=>?@^|~" c))
(define (symbol-chars errorp)
(define (symbol-chars)
(let ((c (peek-char)))
(cond ((eof-object? c) #nil)
((symbol-char? c) (begin (read-char) (cons c (symbol-chars errorp))))
((symbol-char? c) (begin (read-char) (cons c (symbol-chars))))
(else #nil)
)))
@ -564,15 +564,15 @@
(let ((p (assoc name operator-kw))
(c (string-ref name 0)))
(cond (p (cdr p))
((member c (list #\! #\~ #\?) char=?) (cons 'PREFIXOP name))
((member c (list #\= #\< #\> #\| #\& #\$) char=?) (cons 'INFIXOP0 name))
((member c (list #\@ #\^) char=?) (cons 'INFIXOP1 name))
((member c (list #\+ #\-) char=?) (cons 'INFIXOP2 name))
((string-index "!~?" c) (cons 'PREFIXOP name))
((string-index "=<>|&$" c) (cons 'INFIXOP0 name))
((string-index "@^" c) (cons 'INFIXOP1 name))
((string-index "+-" c) (cons 'INFIXOP2 name))
((and (char=? c #\*) (> (string-length name) 1) (char=? (string-ref name 1) #\*)) (cons 'INFIXOP4 name))
((member c (list #\* #\/ #\%) char=?) (cons 'INFIXOP3 name)))))
((string-index "*/%" c) (cons 'INFIXOP3 name)))))
(define (mksymbol location errorp c)
(mktoken location (get-operator (list->string (cons c (symbol-chars errorp))))))
(define (mksymbol location c)
(mktoken location (get-operator (list->string (cons c (symbol-chars))))))
(define (skip-until-newline)
(let ((c (read-char)))
@ -604,36 +604,27 @@
(begin (read-char) (make-lexical-token 'LBRACKBAR location #f))
(make-lexical-token 'LBRACK location #f)))
((char=? c #\]) (make-lexical-token 'RBRACK location #f))
((char=? c #\|) (cond
((char=? (peek-char) #\])
(read-char) (make-lexical-token 'BARRBRACK location #f))
(else (mksymbol location errorp c))))
((char=? c #\;) (if (char=? (peek-char) #\;)
(begin (read-char) (make-lexical-token 'SEMICOLONSEMICOLON location #f))
(make-lexical-token 'SEMICOLON location #f)))
((char=? c #\=) (mksymbol location errorp c))
((char=? c #\.) (make-lexical-token 'DOT location #f))
((char=? c #\:) (if (char=? (peek-char) #\:)
(begin (read-char) (make-lexical-token 'COLONCOLON location #f))
(if (char=? (peek-char) #\=)
(begin (read-char) (make-lexical-token 'COLONEQ location #f))
(make-lexical-token 'COLON location #f))))
((char=? c #\+) (mksymbol location errorp c))
; Handle '|' separately because of the "|]" token
((char=? c #\|) (cond
((char=? (peek-char) #\])
(read-char) (make-lexical-token 'BARRBRACK location #f))
(else (mksymbol location c))))
; Handle '-' separately because of negative integer literals
((char=? c #\-) (if (char-numeric? (peek-char))
(make-lexical-token 'INT location (- (string->number (list->string (number-chars errorp)))))
(mksymbol location errorp c)))
((char=? c #\*) (mksymbol location errorp c))
((char=? c #\~) (mksymbol location errorp c))
((char=? c #\@) (mksymbol location errorp c))
((char=? c #\^) (mksymbol location errorp c))
((char=? c #\?) (mksymbol location errorp c))
((char=? c #\!) (mksymbol location errorp c))
((char=? c #\&) (mksymbol location errorp c))
((char=? c #\<) (mksymbol location errorp c))
((char=? c #\>) (mksymbol location errorp c))
((char=? c #\/) (mksymbol location errorp c))
((char=? c #\%) (mksymbol location errorp c))
((char=? c #\$) (mksymbol location errorp c))
(make-lexical-token 'INT location
(- (string->number (list->string (number-chars errorp)))))
(mksymbol location c)))
; All other characters that can begin an operator
((string-index "+=*~@^?!&<>/%$" c) (mksymbol location c))
((char=? c #\") (make-lexical-token 'STRING location (list->string (string-chars errorp))))
((char=? c #\') (let ((c (read-char)))
(if (char=? c #\\ )