1 files changed, 62 insertions, 0 deletions
diff --git a/module/c/to-token.scm b/module/c/to-token.scm
new file mode 100644
index 00000000..c1efcc02
--- /dev/null
+++ b/module/c/to-token.scm
@@ -0,0 +1,62 @@
+(define-module (c to-token)
+  :use-module ((system base lalr)
+               :select (make-lexical-token))
+  :use-module (c cpp-types)
+  :use-module ((c lex2) :select (parse-c-number))
+  ;; :use-module (hnh util type)
+  :export (preprocessing-token->token))
+
+(define (pp-number->c-number token)
+  (parse-c-number (pp-number? token)))
+
+(define keywords
+  '("auto" "break" "case" "char" "const" "continue" "default"
+    "do" "double" "else" "enum" "extern" "float" "for" "goto"
+    "if" "inline" "int" "long" "register" "restrict" "return"
+    "short" "signed" "sizeof" "static" "struct" "switch"
+    "typedef" "union" "unsigned" "void" "volatile" "while"
+    "_Alignas" "_Alignof" "_Atomic" "_Bool" "_Complex"
+    "_Generic" "_Imaginary" "_Noreturn" "_Static_assert"
+    "_Thread_local"))
+
+(define (preprocessing-token->token cpp-token)
+  (cond ((string-token? cpp-token)
+         => (lambda (content)
+              (make-lexical-token 'string-literal #f content)))
+
+        ((identifier-token? cpp-token)
+            => (lambda (name)
+                 (if (member name keywords)
+                     (string->symbol name)
+                     (make-lexical-token 'identifier #f name))))
+
+        ((pp-number? cpp-token)
+         => (lambda (content)
+              ;; TOOD should return an integer-constant or a floating-constant
+              (make-lexical-token 'constant #f content)))
+
+        ((character-constant? cpp-token)
+         => (lambda (x) (make-lexical-token 'constant #f x)))
+
+        ((punctuator-token? cpp-token)
+         => (lambda (s)
+              (cond ((string=? s "{") 'lbrace)
+                    ((string=? s "}") 'rbrace)
+                    ((string=? s "[") 'lbrack)
+                    ((string=? s "]") 'rbrack)
+                    ((string=? s "(") 'lparen)
+                    ((string=? s ")") 'rparen)
+                    ((string=? s ".") 'dot)
+                    ((string=? s "|") 'pipe)
+                    ((string=? s "||") 'pipe2)
+                    ((string=? s ";") 'semicolon)
+                    ((string=? s "|=") 'pipe=)
+                    ((string=? s ",") 'comma)
+                    ((string=? s "#") 'hash)
+                    ((string=? s "##") 'hash2)
+                    (else (string->symbol s)))))
+
+        (else
+         (scm-error 'cpp-error "preprocessing-token->token"
+                    "Can't convert ~s into a \"regular\" token."
+                    (list cpp-token) #f))))