C-parser add strings.

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))"))