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

Handle escape sequences

Browse Source
This commit is contained in:
Nathanaël Courant 2020-11-18 13:06:03 +01:00
parent ee38746310
commit 42fa033ed2
1 changed files with 47 additions and 3 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

50
miniml/compiler/compile.scm
View File

@ -318,12 +318,50 @@
(else (comment errorp))
)))
(define (char-to-hex c)
(cond ((char-numeric? c) (- (char->integer c) (char->integer #\0)))
((and (char>=? c #\a) (char<=? c #\f)) (+ 10 (- (char->integer c) (char->integer #\a))))
((and (char>=? c #\A) (char<=? c #\F)) (+ 10 (- (char->integer c) (char->integer #\A))))))
(define (escape-sequence errorp)
(let* ((location (make-source-location "*stdin*" (port-line (current-input-port)) (port-column (current-input-port)) -1 -1))
(c (read-char)))
(cond ((eof-object? c) (errorp "Unterminated escape sequence"))
((char=? c #\\ ) #\\ )
((char=? c #\" ) #\" )
((char=? c #\' ) #\' )
((char=? c #\n ) #\newline)
((char=? c #\r ) #\cr)
((char=? c #\t ) #\tab)
((char=? c #\b ) #\bs)
((char=? c #\space) #\space)
((char=? c #\x)
(let* ((c2 (read-char))
(c3 (read-char)))
(integer->char (+ (* 16 (char-to-hex c2)) (char-to-hex c3)))
))
((char=? c #\o)
(let* ((c2 (read-char))
(c3 (read-char))
(c4 (read-char)))
(integer->char (+ (* 64 (char-to-hex c2)) (+ (* 8 (char-to-hex c3)) (char-to-hex c4))))
))
((char-numeric? c)
(let* ((c2 (read-char))
(c3 (read-char)))
(assert (char-numeric? c2))
(assert (char-numeric? c3))
(integer->char (+ (* 100 (char-to-hex c)) (+ (* 10 (char-to-hex c2)) (char-to-hex c3))))
))
(else (errorp "Invalid escape sequence")))
))
(define (string-chars errorp)
(let* ((location (make-source-location "*stdin*" (port-line (current-input-port)) (port-column (current-input-port)) -1 -1))
(c (read-char)))
(cond ((eof-object? c) (errorp "Unterminated string"))
((char=? c #\") #nil)
((char=? c #\\ ) (todo))
((char=? c #\\ ) (let* ((nc (escape-sequence errorp))) (cons nc (string-chars errorp))))
(else (cons c (string-chars errorp)))
)))
@ -416,9 +454,15 @@
((char=? c #\") (make-lexical-token 'STRING location (list->string (string-chars errorp))))
((char=? c #\') (let ((c (read-char)))
(if (char=? c #\\ )
(todo)
(let* ((nc (escape-sequence errorp))
(c2 (read-char)))
(if (char=? c2 #\')
(make-lexical-token 'INT location (char->integer nc))
(errorp "Unterminated character literal")
))
(if (char=? (peek-char) #\')
(begin (read-char) (make-lexical-token 'INT location (char->integer c)))
(begin
(read-char) (make-lexical-token 'INT location (char->integer c)))
(begin (unread-char c) (make-lexical-token 'QUOTE location #f))))
))
((or (char-lower-case? c) (char=? c #\_)) (mktoken location (get-lident (list->string (cons c (ident errorp))))))