diff options
-rw-r--r-- | module/c/cpp.scm | 60 | ||||
-rw-r--r-- | module/c/lex.scm | 25 | ||||
-rw-r--r-- | module/c/operators.scm | 1 | ||||
-rw-r--r-- | module/c/parse.scm | 138 | ||||
-rw-r--r-- | tests/test/cpp.scm | 407 |
5 files changed, 557 insertions, 74 deletions
diff --git a/module/c/cpp.scm b/module/c/cpp.scm index a2935352..9a8245ad 100644 --- a/module/c/cpp.scm +++ b/module/c/cpp.scm @@ -11,7 +11,7 @@ :use-module (c lex) :use-module (c parse) :use-module (c operators) - :export (do-funcall replace-symbols include#) + :export (replace-symbols include#) ) @@ -20,7 +20,7 @@ ;; 2 macro name | F ;; 3 macro args | (x, y) ;; 4 macro body | x + y -(define define-re (make-regexp "^#define ((\\w+)(\\([^)]*\\))?) (.*)")) +(define define-re (make-regexp "^#define ((\\w+)([(][^)]*[)])?) (.*)")) (define (tokenize-define-line header-line) (aif (regexp-exec define-re header-line) @@ -32,20 +32,6 @@ (list header-line) #f))) -(define (do-funcall function arguments) - (if (list? arguments) - (apply function arguments) - (function arguments))) - -(define symb-map - `((,(symbol #\|) . logior) - (funcall . (@ (c cpp) do-funcall)) - (&& . and) - (& . logand) - (== . =) - (!= . (negate =)) - )) - (define (replace-symbols tree dict) (if (not (list? tree)) (or (assoc-ref dict tree) tree) @@ -77,7 +63,6 @@ [arg (list arg)])) (define right (f (cdr pair))) - (define alt-right (replace-symbols right symb-map)) (define dependencies (lset-difference eq? @@ -91,12 +76,12 @@ dependencies (match left [('funcall name ('#{,}# args ...)) - (cons name `(lambda ,args ,alt-right))] + (cons name `(lambda ,args ,right))] [('funcall name arg) - (cons name `(lambda (,arg) ,alt-right))] + (cons name `(lambda (,arg) ,right))] - [name (cons name alt-right)]))) + [name (cons name right)]))) (define (parse-cpp-file lines) @@ -104,7 +89,9 @@ (catch #t (lambda () (parse-cpp-define line)) (lambda (err caller fmt args data) - (format #t "~a ~?~%" fmt args) + (format #t "~a in ~a: ~?~%" + err caller fmt args) + (format #t "~s~%" line) #f))) lines)) @@ -114,29 +101,32 @@ (define (tokenize-header-file header-file) (map tokenize-define-line (call-with-port - (open-input-pipe - (string-append "cpp -dM " header-file)) + (open-pipe* OPEN_READ "cpp" "-dM" header-file) read-lines))) -(define-macro (include# header-file . args) - - (define define-form (if (null? args) 'define (car args))) - - (define lines (remove (compose private-c-symbol? car) - (tokenize-header-file header-file))) +(define (load-cpp-file header-file) + (define lines (tokenize-header-file header-file)) (define forms (parse-cpp-file lines)) - (define graph* - (fold (lambda (node graph) - (add-node graph (cdr node) (car node))) - (make-graph car) - (filter identity forms))) + (fold (lambda (node graph) + (add-node graph (cdr node) (car node))) + (make-graph car) + (filter identity forms))) +(define (include% header-file) + (define graph* (load-cpp-file header-file)) ;; Hack for termios since this symbol isn't defined. ;; (including in the above removed private c symbols) (define graph (add-node graph* (cons '_POSIX_VDISABLE #f) '())) + ;; TODO expand bodies + ;; (remove (compose private-c-symbol? car)) + (resolve-dependency-graph graph)) + +(define-macro (include# header-file . args) + + (define define-form (if (null? args) 'define (car args))) `(begin ,@(map (lambda (pair) `(,define-form ,(car pair) ,(cdr pair))) - (resolve-dependency-graph graph)))) + (include% header-file)))) diff --git a/module/c/lex.scm b/module/c/lex.scm index 34e52d88..5f395322 100644 --- a/module/c/lex.scm +++ b/module/c/lex.scm @@ -43,8 +43,22 @@ (define-peg-pattern integer all (and (or base-8 base-16 base-10) (? integer-suffix))) +;; (define-peg-pattern float-suffix all +;; (* (or "f" "F" "l" "L"))) + +;; (define-peg-pattern exponent all +;; (and (ignore (or "e" "E")) (? (or "+" "-")) base-10)) + +;; (define-peg-pattern float all +;; (or +;; (and base-10 exponent (? float-suffix)) +;; (and base-10 (ignore ".") (? exponent) (? float-suffix)) +;; (and (? base-10) (ignore ".") base-10 (? exponent) (? float-suffix)))) + (define-peg-pattern number body - (or integer)) + (or ; float + integer + )) (define-peg-pattern group all (and (ignore "(") expr (ignore ")"))) @@ -65,11 +79,16 @@ (define-peg-pattern char all (and (ignore "'") (or escaped-char peg-any) (ignore "'"))) +;; (define-peg-pattern quot none (string "\"")) + +;; (define-peg-pattern string all +;; (and quot (* (or escaped-char (or peg-any))) quot)) (define-peg-pattern* operator all `(or ,@(map symbol->string symbol-binary-operators) ,@(map (lambda (op) `(and ,(symbol->string op) ws)) - wordy-binary-operators))) + wordy-binary-operators) + "?" ":")) ;; whitespace (define-peg-pattern ws none @@ -99,7 +118,7 @@ ))) (define-peg-pattern postfix-operator all - (or "++" "--")) + (or "++" "--" "*")) (define-peg-pattern postfix all ;; literals can't be in-place incremented and decremented diff --git a/module/c/operators.scm b/module/c/operators.scm index ab1b3e7c..131c702c 100644 --- a/module/c/operators.scm +++ b/module/c/operators.scm @@ -9,6 +9,7 @@ `(+ - * / & ,(symbol #\|) ^ << >> % < > =)) ;; apparently part of C +;; https://en.cppreference.com/w/cpp/language/operator_alternative (define wordy-binary-operators '(bitand and_eq and bitor or_eq or xor_eq xor)) diff --git a/module/c/parse.scm b/module/c/parse.scm index 8030da77..d407f5ac 100644 --- a/module/c/parse.scm +++ b/module/c/parse.scm @@ -38,6 +38,19 @@ "Invalid integer suffix ~s" (list str) #f))) +(define (group-body->type vars) + (concatenate + (map + (match-lambda (('variable var) (list (parse-lexeme-tree `(variable ,var)))) + (('postfix ('variable var) + ('postfix-operator "*")) + (list (parse-lexeme-tree `(variable ,var)) + '*)) + (else (scm-error 'c-parse-error "parse-lexeme-tree" + "Invalid token ~s in typecast form: ~s" + (list else vars) #f))) + vars))) + (define (parse-lexeme-tree tree) (match tree ['() '()] @@ -74,25 +87,43 @@ ((#\v) #\vtab) ((#\\) #\\) ((#\') #\')))] + [('char c) (char->integer (string-ref c 0))] [('variable var) (string->symbol var)] + + [('operator "&&") 'and] + [('operator "&=") 'and_eq] + [('operator "&") 'bitand] + [('operator "|") 'bitor] + [('operator "!=") 'not_eq] + [('operator "||") 'or] + [('operator "|=") 'or_eq] + [('operator "^") 'xor] + [('operator "^=") 'xor_eq] [('operator op) (string->symbol op)] + [('prefix-operator op) (case (string->symbol op) + ((!) 'not) + ((~) 'compl) ((*) 'dereference) ((&) 'pointer) ((++) 'pre-increment) ((--) 'pre-decrement) - (else => identity))] + (else (scm-error 'c-parse-error "parse-lexeme-tree" + "Unknown prefix operator ~s" + (list op) #f)))] [('postfix-operator op) (case (string->symbol op) [(++) 'post-increment] [(--) 'post-decrement] - [else => identity])] + [else (scm-error 'c-parse-error "parse-lexeme-tree" + "Unknown postfix operator ~s" + (list op) #f)])] ;; Parenthesis grouping - [('group args) + [('group args ...) (parse-lexeme-tree args)] ;; Atomic item. Used by flatten-infix @@ -108,37 +139,104 @@ ,(parse-lexeme-tree arg))] [('infix args ...) - (resolve-order-of-operations - (flatten-infix (cons 'infix args)))] + (let ((r + (resolve-order-of-operations + (flatten-infix (cons 'infix args))))) + (match r + (`(: (? ,op ,true) + ,false) + `(ternary ,op ,true ,false)) + (_ r)))] [('funcall function ('group arguments)) `(funcall ,(parse-lexeme-tree function) ,(parse-lexeme-tree arguments))] - [bare (scm-error 'c-parse-error - "parse-lexeme-tree" - "Naked literal in lex-tree: ~s" - (list bare) - #f)])) + [(('variable "struct") ('variable value) ..1) + `(struct-type ,@(map string->symbol value)) + ] + + ;; A list of variables. Most likely a type signature + ;; [(('variable value) ..1) + ;; ] + + ;; A typecast with only variables must (?) be a typecast? + [(('group groups ..1) ... value) + (fold-right (lambda (type done) `(as-type ,type ,done)) + (parse-lexeme-tree value) + (map group-body->type groups))] + + ;; Type name resolution? + ;; https://en.wikipedia.org/wiki/C_data_types + ;; base types with spaces: + ;; ======================= + ;; [[un]signed] char + ;; [[un]signed] short [int] + ;; [[un]signed] int + ;; [un]signed [int] + ;; [[un]signed] long [int] + ;; [[un]signed] long long [int] + ;; float + ;; [long] double + + ;; https://en.wikipedia.org/wiki/Type_qualifier + ;; qualifiers + ;; const + ;; volatile + ;; restrict + ;; _Atomic + + + ;; Storage specifiers + ;; auto + ;; register + ;; static + ;; extern + + ;; struct <typename> + ;; enum <typename> + ;; union <typename> + + ;; https://en.wikipedia.org/wiki/C_syntax + ;; int (*ptr_to_array)[100] + + + [(? symbol? bare) + (scm-error 'c-parse-error + "parse-lexeme-tree" + "Naked literal in lex-tree: ~s" + (list bare) + #f)] + + [form + (scm-error 'c-parse-error + "parse-lexeme-tree" + "Unknown form in lex-tree: ~s" + (list form) #f) + ])) ;; https://en.wikipedia.org/wiki/Operators_in_C_and_C%2B%2B +;; https://en.cppreference.com/w/c/language/operator_precedence (define order-of-operations (reverse (concatenate ;; This is only for binary operations `((-> ,(symbol #\.)) + ;; All unary procedures go here, incnluding typecasts, and sizeof (* / %) (+ -) (<< >>) (< <= > >=) - (== !=) - (&) - (^) - (,(symbol #\|)) - (&&) - (,(symbol #\| #\|)) - (= += -= *= /= %= <<= >>= &= ^= ,(symbol #\| #\=)) + (== != not_eq) + (& bitand) + (^ xorg) + (,(symbol #\|) bitor) + (&& and) + (,(symbol #\| #\|) or) + (? :) + (= += -= *= /= %= <<= >>= &= ^= ,(symbol #\| #\=) + and_eq or_eq xor_eq) (,(symbol #\,)) )))) @@ -148,8 +246,12 @@ (define* (resolve-order-of-operations tree optional: (order order-of-operations)) + (format (current-error-port) "~s~%" tree) (if (null? order) - (car tree) + (scm-error 'c-parse-error + "resolve-order-of-operations" + "Out of operations to resolve when resolving expression ~s" + (list tree) #f) (match tree [('*other* body ...) body] [(form) (resolve-order-of-operations form order)] diff --git a/tests/test/cpp.scm b/tests/test/cpp.scm index 9c720fde..f3b9ff72 100644 --- a/tests/test/cpp.scm +++ b/tests/test/cpp.scm @@ -8,32 +8,403 @@ :use-module ((c lex) :select (lex)) :use-module ((c parse) :select (parse-lexeme-tree))) +;; Note that the lexer's output isn't stable. +;; The tests here are more to see where the lexer succeeds but the parser fails. +;; So changing the lexer test cases isn't a problem +;; but don't change the parser test cases + (define run (compose parse-lexeme-tree lex)) -(test-equal - '(+ (post-increment (dereference C)) 3) - (run "(*C)++ + 3")) +(define-syntax let-group + (syntax-rules () + ((let ((form name) rest ...) body ...) + (test-group name + (let ((form name) + rest ...) + body ...))))) + +(let-group + ((form "(*C)++ + 3")) + (test-equal '(infix (postfix (group (prefix (prefix-operator "*") + (variable "C"))) + (postfix-operator "++")) + (operator "+") + (integer (base-10 "3"))) + (lex form)) + (test-equal '(+ (post-increment (dereference C)) 3) + (run form))) + +(let-group + ((form "*C++ + 3")) + (test-equal '(infix (postfix (prefix (prefix-operator "*") + (variable "C")) + (postfix-operator "++")) + (operator "+") + (integer (base-10 "3"))) + (lex form)) + (test-equal '(+ (post-increment (dereference C)) 3) + (run form))) + +(let-group + ((form "*C++")) + (test-equal '(postfix (prefix (prefix-operator "*") + (variable "C")) + (postfix-operator "++")) + (lex form)) + (test-equal '(post-increment (dereference C)) + (run form))) + +(let-group + ((form "C++ + C++")) + (test-equal '(infix (postfix (variable "C") + (postfix-operator "++")) + (operator "+") + (postfix (variable "C") + (postfix-operator "++"))) + (lex form)) + (test-equal '(+ (post-increment C) (post-increment C)) + (run form))) + +(let-group + ((form "++C + ++C")) + (test-equal '(infix (prefix (prefix-operator "++") + (variable "C")) + (operator "+") + (prefix (prefix-operator "++") + (variable "C"))) + (lex form)) + (test-equal '(+ (pre-increment C) (pre-increment C)) + (run form))) + +(let-group + ((form "2 + 2 * 2")) + (test-equal '(infix (integer (base-10 "2")) + (operator "+") + (infix (integer (base-10 "2")) + (operator "*") + (integer (base-10 "2")))) + (lex form)) + (test-equal '(+ 2 (* 2 2)) (run form))) + +(let-group + ((form "2 * 2 + 2")) + (test-equal '(infix (integer (base-10 "2")) + (operator "*") + (infix (integer (base-10 "2")) + (operator "+") + (integer (base-10 "2")))) + (lex form)) + (test-equal '(+ (* 2 2) 2) (run form))) + +(let-group + ((form "2+2+2")) + (test-equal '(infix (integer (base-10 "2")) + (operator "+") + (infix (integer (base-10 "2")) + (operator "+") + (integer (base-10 "2")))) (lex form)) + (test-equal '(+ 2 2 2) (run form))) + + + + +(test-skip "Strings") +(test-skip "__asm__") +(test-skip "Token concatenation") +(test-skip "Floating point numbers") + +;; Hand picked forms from output of `cpp -dM /usr/include/termios.h` on +;; FreeBSD 13.1-RELEASE releng/13.1-n250148-fc952ac2212 GENERIC amd64 +;; 2022-06-28 + +(let ((form "00000200")) + (test-equal '(integer (base-8 "0000200")) (lex form)) + (test-equal 128 (run form))) + +(let ((form "0")) + (test-equal '(integer (base-10 "0")) (lex form)) + (test-equal 0 (run form))) + +(let ((form "1000000U")) + (test-equal '(integer (base-10 "1000000") (integer-suffix "U")) (lex form)) + (test-equal '(as-type (unsigned) 1000000) (run form))) + + +(let ((form "0x10c")) + (test-equal '(integer (base-16 "10c")) (lex form)) + (test-equal 268 (run form))) + +;; Lexer keeps original case, handled later by parser +(let ((form "0X10C")) + (test-equal '(integer (base-16 "10C")) (lex form)) + (test-equal 268 (run form))) + +(let ((form "a != b")) + (test-equal '(infix (variable "a") + (operator "!=") + (variable "b")) + (lex form)) + (test-equal '(not_eq a b) (run form))) + +(let ((form "((c) == (val) && (val) != _POSIX_VDISABLE)")) + ;; (test-equal '() (lex form)) + (test-equal '(and (== c val) + (not_eq val _POSIX_VDISABLE)) + (run form))) + +(let ((form "CTRL('O')")) + (test-equal '(funcall (variable "CTRL") (group (char "O"))) (lex form)) + (test-equal '(funcall CTRL 79) (run form))) + +(let ((form "CREPRINT")) + (test-equal '(variable "CREPRINT") (lex form)) + (test-equal 'CREPRINT (run form))) + +(let ((form "(CCTS_OFLOW | CRTS_IFLOW)")) + (test-equal '(group (infix (variable "CCTS_OFLOW") + (operator "|") + (variable "CRTS_IFLOW"))) + (lex form)) + (test-equal '(bitor CCTS_OFLOW CRTS_IFLOW) (run form))) + +;; ((x) >= 'a' && (x) <= 'z' +;; ? ((x) - 'a' + 1) +;; : (((x) - 'a' + 1) & 0x7f)) +(let ((form "((x) >= 'a' && (x) <= 'z' ? ((x) - 'a' + 1) : (((x) - 'a' + 1) & 0x7f))")) + ;; (test-equal '() (lex form)) + (test-equal '(ternary + (and (>= x #x61) + (<= x #x7A)) + (- x (+ #x61 1)) + (bitand (- x (+ #x61 1)) 127)) + (run form))) + +(let ((form "((x) & ~(IOCPARM_MASK << 16))")) + ;; (test-equal '() (lex form)) + (test-equal '(bitand x (compl (<< IOCPARM_MASK 16))) (run form))) + +(let ((form "(((x) >> 8) & 0xff)")) + ;; (test-equal '() (lex form)) + (test-equal '(bitand (>> x 8) 255) (run form))) + +(let ((form "(((x) >> 16) & IOCPARM_MASK)")) + ;; (test-equal '() (lex form)) + (test-equal '(bitand (>> x 16) IOCPARM_MASK) (run form))) + +(let ((form "((1 << IOCPARM_SHIFT) - 1)")) + ;; (test-equal '() (lex form)) + (test-equal '(- (<< 1 IOCPARM_SHIFT) 1) (run form))) + +(let ((form "_IO('t', 120)")) + (test-equal '(funcall + (variable "_IO") + (group (infix (char "t") + (operator ",") + (integer (base-10 "120"))))) + (lex form)) + (test-equal '(funcall _IO (#{,}# 116 120)) (run form))) + +;; note the lone type +(let ((form "_IOW('t', 98, int)")) + ;; (test-equal '() (lex form)) + (test-equal '(funcall _IOW (#{,}# 116 98 int)) + (run form))) + +;; note the multi-word type +(let ((form "_IOR('t', 19, struct termios)")) + ;; (test-equal '() (lex form)) + (test-equal '(funcall _IOR (#{,}# 116 19 (struct-type termios))) (run form))) + + +(test-group "Token concatenation" + (let ((form "x ## y")) + (test-equal '() (lex form)) + (test-equal '0 (run form)))) + +(test-group "Floating point numbers" + (let ((form "4.9406564584124654e-324")) + (test-equal '(float (base-10 "4") (base-10)) (lex form)) + (test-equal '0 (run form))) + + (let ((form "1.7976931348623157e+308")) + (test-equal '() (lex form)) + (test-equal '0 (run form)))) + +(test-group "Typecasts" + + (let ((form "(unsigned) 5")) + (test-equal '((group (variable "unsigned")) + (integer (base-10 "5"))) + (lex form)) + (test-equal '(as-type (unsigned) 5) + (run form))) + + (let ((form "(unsigned integer) 5")) + (test-equal '((group (variable "unsigned") + (variable "integer")) + (integer (base-10 "5"))) + (lex form)) + (test-equal '(as-type (unsigned integer) 5) (run form))) + + (test-group "Pointer with space" + (let ((form "(int *) 5")) + (test-equal '((group (postfix (variable "int") + (postfix-operator "*"))) + (integer (base-10 "5"))) + (lex form)) + (test-equal '(as-type (int *) 5) + (run form)))) + + (test-group "Pointer without space" + (let ((form "(int*) 5")) + (test-equal '((group (postfix (variable "int") + (postfix-operator "*"))) + (integer (base-10 "5"))) + (lex form)) + (test-equal '(as-type (int *) 5) + (run form)))) + + (test-group "Multi word type pointer" + (let ((form "(unsigned int*) 5")) + (test-equal '((group (variable "unsigned") + (postfix (variable "int") + (postfix-operator "*"))) + (integer (base-10 "5"))) + (lex form)) + (test-equal '(as-type (unsigned int *) 5) + (run form)))) + + (test-group "Double cast" + (let ((form "(int)(unsigned) 5")) + (test-equal '((group (variable "int")) + (group (variable "unsigned")) + (integer (base-10 "5"))) (lex form)) + (test-equal '(as-type (int) (as-type (unsigned) 5)) + (run form)))) + + (test-group "Cast with operation" + (let ((form "(int) 5 + 7")) + (test-equal '((group (variable "int")) + (infix (integer (base-10 "5")) + (operator "+") + (integer (base-10 "7")))) + (lex form)) + + (test-equal '(+ (as-type (int) 5) 7) + (run form)))) + + + + (test-group "Tripple cast, with value inside paranthesis" + (let ((form "(type)(__uintptr_t)(const void *)(var)")) + (test-equal '((group (variable "type")) + (group (variable "__uintptr_t")) + (group (variable "const") + (postfix (variable "void") + (postfix-operator "*"))) + (group (variable "var"))) + (lex form)) + (test-equal '(as-type (type) + (as-type (__uintptr_t) + (as-type (const void *) + var))) + (run form)))) + + (test-group "Same as above, but whole thing inside parenthesis" + (let ((form "((type)(__uintptr_t)(const void *)(var))")) + (test-equal '(group (group (variable "type")) + (group (variable "__uintptr_t")) + (group (variable "const") + (postfix (variable "void") + (postfix-operator "*"))) + (group (variable "var"))) + (lex form)) + (test-equal '(as-type (type) + (as-type (__uintptr_t) + (as-type (const void *) + var))) + (run form)))) + + (let ((form "((type)(__uintptr_t)(const volatile void *)(var))")) + ;; (test-equal '() (lex form)) + (test-equal '(as-type (type) + (as-type (__uintptr_t) + (as-type (const volatile void *) + var))) + (run form))) + + (let ((form "((unsigned long) ((inout) | (((len) & IOCPARM_MASK) << 16) | ((group) << 8) | (num)))")) + (test-equal '(group (group (variable "unsigned") (variable "long")) + (group (infix (group (variable "inout")) + (operator "|") + (infix (group (infix (group (infix (group (variable "len")) + (operator "&") + (variable "IOCPARM_MASK"))) + (operator "<<") + (integer (base-10 "16")))) + (operator "|") + (infix (group (infix (group (variable "group")) + (operator "<<") + (integer (base-10 "8")))) + (operator "|") + (group (variable "num"))))))) + (lex form)) + (test-equal '(as-type (unsigned long) + (bitor (<< (bitand len IOCPARM_MASK) 16) + (<< group 8) + num)) + (run form)))) -(test-equal - '(+ (post-increment (dereference C)) 3) - (run "*C++ + 3")) -(test-equal - '(post-increment (dereference C)) - (run "*C++")) +(test-group "Strings" + (test-group "Empty string" + (let ((form "\"\"")) + (test-equal '(string "") (lex form)) + (test-equal #vu8(0) (run form)))) -(test-equal - '(+ (post-increment C) (post-increment C)) - (run "C++ + C++")) + (test-group "Simple string" + (let ((form "\"li\"")) + (test-equal '(string "li") (lex form)) + (test-equal #vu8(#x6C #x69 0) (run form)))) -(test-equal - '(+ (pre-increment C) (pre-increment C)) - (run "++C + ++C")) + (test-group "Implicit concatenation of strings" + (let ((form "\"a\" \"b\"")) + (test-equal '((string "a") + (string "b")) + (lex form)) + (test-equal #vu8(#x61 #x62 0) + (run form)))) -(test-equal '(+ 2 (* 2 2)) (run "2 + 2 * 2")) + (test-group "Implicit concatenation of string and macro" + (let ((form "\"a\" MACRO")) + (test-equal '() (lex form)) + (test-equal '() (run form)))) -(test-equal '(+ (* 2 2) 2) (run "2 * 2 + 2")) + (test-group "String with escape" + (let ((form (string #\\ #\"))) + (test-equal `(string ,(string #\")) (lex form)) + (test-equal #vu8(34 0) (run form))))) -(test-equal '(+ 2 2 2) (run "2+2+2")) +(test-group "__asm__" + (let ((form "__asm__(\".globl \" __XSTRING(sym))")) + (test-equal '() (lex form)) + ;; TODO implicit string concatenation + (test-equal '(funcall __asm__ + (string ".globl ") + (funcall __XSTRING sym)) (run form)))) +(let ((form "__attribute__((__aligned__(x)))")) + (test-equal '(funcall (variable "__attribute__") + (group (group (funcall (variable "__aligned__") + (group (variable "x")))))) + (lex form)) + ;; This drops the extra set of parenthesis. Do we care? + (test-equal '(funcall __attribute__ + (funcall __aligned__ x)) + (run form))) +;; TODO concatenation rules +;; #define __CONCAT(x,y) __CONCAT1(x,y) +;; #define __CONCAT1(x,y) x ## y +;; #define __CONSTANT_CFSTRINGS__ 1 +;; #define __COPYRIGHT(s) __IDSTRING(__CONCAT(__copyright_,__LINE__),s) |