From e0b3406a8c0fa27345883adb94fd55e1955febd7 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Hugo=20H=C3=B6rnquist?= <hugo@lysator.liu.se>
Date: Thu, 30 Jun 2022 00:22:46 +0200
Subject: C-parser add strings.

---
 module/c/lex.scm   | 15 +++++++++------
 module/c/parse.scm | 19 +++++++++++++++++++
 2 files changed, 28 insertions(+), 6 deletions(-)

(limited to 'module/c')

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)))))
-- 
cgit v1.2.3