diff options
Diffstat (limited to '')
-rw-r--r-- | module/c/lex.scm | 15 | ||||
-rw-r--r-- | module/c/parse.scm | 19 | ||||
-rw-r--r-- | tests/test/cpp.scm | 33 |
3 files changed, 53 insertions, 14 deletions
diff --git a/module/c/lex.scm b/module/c/lex.scm index 5f395322..30fcd3c1 100644 --- a/module/c/lex.scm +++ b/module/c/lex.scm @@ -71,7 +71,7 @@ (define-peg-pattern base-16-char all (and (ignore "x") base-16-digit (? base-16-digit))) -(define-peg-pattern escaped-char all +(define-peg-pattern escaped-char body (and (ignore "\\") (or base-16-char base-8-char peg-any))) @@ -79,10 +79,10 @@ (define-peg-pattern char all (and (ignore "'") (or escaped-char peg-any) (ignore "'"))) -;; (define-peg-pattern quot none (string "\"")) +(define-peg-pattern quot none "\"") -;; (define-peg-pattern string all -;; (and quot (* (or escaped-char (or peg-any))) quot)) +(define-peg-pattern string all + (and quot (* (or escaped-char (and (not-followed-by "\"") peg-any))) quot)) (define-peg-pattern* operator all `(or ,@(map symbol->string symbol-binary-operators) @@ -130,15 +130,18 @@ ;; first case is "same" as expr, but in different order to prevent ;; infinite self reference. Pre and postfix not here, solved by having ;; them before infix in expr - (and (or funcall postfix prefix group char number variable) + (and (or funcall postfix prefix group literal variable) sp operator sp expr)) (define-peg-pattern funcall all (and variable sp group)) +(define-peg-pattern literal body + (or char string number)) + ;;; main parser (define-peg-pattern expr body - (+ (and sp (or infix postfix prefix funcall group char number variable) + (+ (and sp (or infix postfix prefix funcall group literal variable) sp))) diff --git a/module/c/parse.scm b/module/c/parse.scm index d923e5b1..ad716132 100644 --- a/module/c/parse.scm +++ b/module/c/parse.scm @@ -3,6 +3,9 @@ :use-module (srfi srfi-1) :use-module (srfi srfi-71) :use-module (ice-9 match) + :use-module ((rnrs io ports) + :select (string->bytevector make-transcoder utf-8-codec)) + :use-module (rnrs bytevectors) :export (parse-lexeme-tree)) ;;; Rename this @@ -52,6 +55,14 @@ (list else vars) #f))) vars))) +;; Converts string to a null-terminated bytevector +(define* (string->c-string str optional: (transcoder (make-transcoder (utf-8-codec)))) + (let* ((bv* (string->bytevector str transcoder)) + (bv (make-bytevector (1+ (bytevector-length bv*))))) + (bytevector-copy! bv* 0 bv 0 (bytevector-length bv*)) + (bytevector-u8-set! bv (bytevector-length bv*) 0) + bv)) + (define (parse-lexeme-tree tree) (match tree ['() '()] @@ -149,6 +160,14 @@ ,(parse-lexeme-tree b) ,(parse-lexeme-tree c))] + + + + ['string #vu8(0)] + [('string str) (string->c-string str)] + [(('string str) ...) + (string->c-string (string-concatenate str))] + [('infix args ...) (let ((r (resolve-order-of-operations (flatten-infix (cons 'infix args))))) diff --git a/tests/test/cpp.scm b/tests/test/cpp.scm index 8a53ecce..f7b11296 100644 --- a/tests/test/cpp.scm +++ b/tests/test/cpp.scm @@ -13,8 +13,6 @@ ;; So changing the lexer test cases isn't a problem ;; but don't change the parser test cases -;; Strings aren't yet implemented -(test-skip "Strings") ;; __asm__ always has strings as arguments (test-skip "__asm__") ;; not implemented @@ -24,6 +22,10 @@ ;; order of operation is wrong, leading to an incorrect result (test-skip "Cast with operation") +;; A string follewed by a macro (which expands to a string) +;; should be concatenated. This is however not yet implemented +(test-skip "Implicit concatenation of string and macro") + (define run (compose parse-lexeme-tree lex)) (define-syntax let-group @@ -366,7 +368,7 @@ (test-group "Strings" (test-group "Empty string" (let ((form "\"\"")) - (test-equal '(string "") (lex form)) + (test-equal 'string (lex form)) (test-equal #vu8(0) (run form)))) (test-group "Simple string" @@ -384,13 +386,28 @@ (test-group "Implicit concatenation of string and macro" (let ((form "\"a\" MACRO")) - (test-equal '() (lex form)) + (test-equal '((string "a") (variable "MACRO")) (lex form)) (test-equal '() (run form)))) - (test-group "String with escape" - (let ((form (string #\\ #\"))) - (test-equal `(string ,(string #\")) (lex form)) - (test-equal #vu8(34 0) (run form))))) + (test-group "String with only escape" + (let ((form (string #\" #\\ #\" #\"))) + (test-equal `(string "\"") (lex form)) + (test-equal #vu8(34 0) (run form)))) + + (test-group "String with escape at start" + (let ((form (string #\" #\\ #\" #\a #\"))) + (test-equal `(string "\"a") (lex form)) + (test-equal #vu8(34 #x61 0) (run form)))) + + (test-group "String with escape at end" + (let ((form (string #\" #\a #\\ #\" #\"))) + (test-equal `(string "a\"") (lex form)) + (test-equal #vu8(#x61 34 0) (run form)))) + + (test-group "String with escape in middle" + (let ((form (string #\" #\a #\\ #\" #\b #\"))) + (test-equal `(string "a\"b") (lex form)) + (test-equal #vu8(#x61 34 #x62 0) (run form))))) (test-group "__asm__" (let ((form "__asm__(\".globl \" __XSTRING(sym))")) |