accept pub enum, and enums used as types
Implement pub support for enums, and also anonymous enums declared in-place. Also give the cdr of a `pub' form the form's own location, so a error about what follows `pub' can say where it was written
This commit is contained in:
@@ -382,10 +382,17 @@ forms, and what remains."
|
|||||||
|
|
||||||
(define (walk-enum form)
|
(define (walk-enum form)
|
||||||
(match form
|
(match form
|
||||||
|
;; Naming one without defining it: `(var m (enum mood))', the same
|
||||||
|
;; shape walk-struct accepts for `(struct foo)'. Guarded, and
|
||||||
|
;; before the anonymous case, since `(enum (red green))' is also a
|
||||||
|
;; two-element form
|
||||||
|
(('enum (? symbol? name))
|
||||||
|
`(enum ,(atom-to-fmt-c name)))
|
||||||
(('enum (values ...))
|
(('enum (values ...))
|
||||||
`(enum ,(map atom-to-fmt-c values)))
|
`(enum ,(map atom-to-fmt-c values)))
|
||||||
(('enum name (values ...))
|
(('enum name (values ...))
|
||||||
`(enum ,(atom-to-fmt-c name) ,(map atom-to-fmt-c values)))))
|
`(enum ,(atom-to-fmt-c name) ,(map atom-to-fmt-c values)))
|
||||||
|
(else (sex-error form "malformed enum" form))))
|
||||||
|
|
||||||
(define (walk-extern form)
|
(define (walk-extern form)
|
||||||
(match form
|
(match form
|
||||||
@@ -410,6 +417,7 @@ forms, and what remains."
|
|||||||
|
|
||||||
('struct . _)
|
('struct . _)
|
||||||
('union . _)
|
('union . _)
|
||||||
|
('enum . _)
|
||||||
|
|
||||||
('typedef . _))
|
('typedef . _))
|
||||||
;; ignore here, used in generating public interface
|
;; ignore here, used in generating public interface
|
||||||
@@ -423,7 +431,10 @@ forms, and what remains."
|
|||||||
(('fn . _) (list 'static (walk-function form)))
|
(('fn . _) (list 'static (walk-function form)))
|
||||||
(('var . _) (list 'static (walk-var form)))
|
(('var . _) (list 'static (walk-var form)))
|
||||||
(('extern . rest) (walk-extern rest))
|
(('extern . rest) (walk-extern rest))
|
||||||
(('pub . rest) (walk-public rest))
|
;; The cdr of a form has no location of its own, so hand it the
|
||||||
|
;; `pub' form's -- otherwise a complaint about what follows `pub'
|
||||||
|
;; cannot say where it was written
|
||||||
|
(('pub . rest) (walk-public (copy-form-source! form rest)))
|
||||||
((or ('struct . _)
|
((or ('struct . _)
|
||||||
('union . _)) (walk-struct form))
|
('union . _)) (walk-struct form))
|
||||||
(('enum . _) (walk-enum form))
|
(('enum . _) (walk-enum form))
|
||||||
|
|||||||
@@ -640,16 +640,22 @@
|
|||||||
(define (c-union . args) (apply c-struct/aux "union" args))
|
(define (c-union . args) (apply c-struct/aux "union" args))
|
||||||
(define (c-class . args) (apply c-struct/aux "class" args))
|
(define (c-class . args) (apply c-struct/aux "class" args))
|
||||||
|
|
||||||
|
;; MODIFIED FROM UPSTREAM fmt-c: an enum may also be named without
|
||||||
|
;; being defined -- `enum color m;' -- exactly as c-struct/aux
|
||||||
|
;; already allows `struct point p;'. Upstream assumed a value list
|
||||||
|
;; was always present and mapped over whatever stood in its place.
|
||||||
(define (c-enum x . o)
|
(define (c-enum x . o)
|
||||||
(define (c-enum-one x)
|
(define (c-enum-one x)
|
||||||
(if (pair? x) (cat (car x) " = " (c-expr (cadr x))) (dsp x)))
|
(if (pair? x) (cat (car x) " = " (c-expr (cadr x))) (dsp x)))
|
||||||
(let* ((name (if (null? o) (if (or (symbol? x) (string? x)) x #f) x))
|
(let* ((name (if (null? o) (if (or (symbol? x) (string? x)) x #f) x))
|
||||||
(vals (if name (car o) x)))
|
(vals (if name (if (null? o) #f (car o)) x)))
|
||||||
(c-wrap-stmt
|
(if vals
|
||||||
(cat
|
(c-wrap-stmt
|
||||||
(c-braced-block
|
(cat
|
||||||
(if name (cat "enum " name) (dsp "enum"))
|
(c-braced-block
|
||||||
(c-in-expr (apply c-begin (map c-enum-one vals))))))))
|
(if name (cat "enum " name) (dsp "enum"))
|
||||||
|
(c-in-expr (apply c-begin (map c-enum-one vals))))))
|
||||||
|
(c-wrap-stmt (cat "enum " name)))))
|
||||||
|
|
||||||
(define (c-attribute . args)
|
(define (c-attribute . args)
|
||||||
(cat "__attribute__ ((" (fmt-join c-expr args ", ") "))"))
|
(cat "__attribute__ ((" (fmt-join c-expr args ", ") "))"))
|
||||||
@@ -743,7 +749,13 @@
|
|||||||
(if (and (pair? (cadr type)) (eq? '%array (caadr type)))
|
(if (and (pair? (cadr type)) (eq? '%array (caadr type)))
|
||||||
(c-paren name)
|
(c-paren name)
|
||||||
name))))
|
name))))
|
||||||
((enum) (apply c-enum name (cdr type)))
|
;; MODIFIED FROM UPSTREAM fmt-c: upstream passed the
|
||||||
|
;; declarator's name to c-enum as the enum's tag, so
|
||||||
|
;; `(var m (enum color))' emitted `enum m {...}' and lost the
|
||||||
|
;; variable. Enums are laid out like structs: the type, then
|
||||||
|
;; the name being declared.
|
||||||
|
((enum)
|
||||||
|
(cat (apply c-enum (cdr type)) (if name (cat " " name) "")))
|
||||||
((struct union class)
|
((struct union class)
|
||||||
(cat (apply c-struct/aux (car type) (cdr type)) (if name (cat " " name) "")))
|
(cat (apply c-struct/aux (car type) (cdr type)) (if name (cat " " name) "")))
|
||||||
(else (fmt-join/last c-expr (lambda (x) (c-type x name)) type " "))))
|
(else (fmt-join/last c-expr (lambda (x) (c-type x name)) type " "))))
|
||||||
|
|||||||
@@ -83,7 +83,7 @@
|
|||||||
;; A variable becomes an `extern' declaration
|
;; A variable becomes an `extern' declaration
|
||||||
((var)
|
((var)
|
||||||
(cons (copy-form-source! form (cons 'extern (take (cdr form) 3))) acc))
|
(cons (copy-form-source! form (cons 'extern (take (cdr form) 3))) acc))
|
||||||
((define defmacro import include struct typedef union)
|
((define defmacro enum import include struct typedef union)
|
||||||
(cons (copy-form-source! form (cdr form)) acc))
|
(cons (copy-form-source! form (cdr form)) acc))
|
||||||
(else (sex-error form "pub must be followed by a definition" form))))
|
(else (sex-error form "pub must be followed by a definition" form))))
|
||||||
(else acc)))
|
(else acc)))
|
||||||
|
|||||||
@@ -141,6 +141,28 @@ compiles."
|
|||||||
(test-assert "a comment in a body stays in the body"
|
(test-assert "a comment in a body stays in the body"
|
||||||
(emits? (in-fn "(while (< a b) ;; inside\n (g 1))")
|
(emits? (in-fn "(while (< a b) ;; inside\n (g 1))")
|
||||||
"while (a < b) {")))
|
"while (a < b) {")))
|
||||||
|
|
||||||
|
(test-group "pub enum"
|
||||||
|
(test-assert "is emitted"
|
||||||
|
(emits? "(pub enum color (red green blue))" "enum color"))
|
||||||
|
(test-assert "with its values"
|
||||||
|
(emits? "(pub enum color (red green blue))" "red"))
|
||||||
|
(test-assert "and a non-pub enum still is too"
|
||||||
|
(emits? "(enum color (red green blue))" "enum color"))
|
||||||
|
;; Naming an enum as a type, rather than defining it, had no
|
||||||
|
;; walk-enum clause and died with `(match) no matching pattern'
|
||||||
|
(test-assert "and it can then be used as a type"
|
||||||
|
(emits? "(enum color (red green blue)) (fn f () void (var m (enum color) red))"
|
||||||
|
"enum color m = red"))
|
||||||
|
(test-assert "a malformed enum is rejected with its location"
|
||||||
|
(reports? "(enum)" "codegen.sex:1:"))
|
||||||
|
;; c-type handed the declarator's name to c-enum as the enum tag,
|
||||||
|
;; so this emitted `enum m { up, down }' with no variable at all
|
||||||
|
(test-assert "an anonymous enum keeps the variable"
|
||||||
|
(emits? "(fn f () void (var e (enum (up down)) up))" "} e = up"))
|
||||||
|
(test-assert "and a named definition keeps both"
|
||||||
|
(emits? "(fn f () void (var n (enum named (a b)) a))" "enum named{")))
|
||||||
|
|
||||||
;; `|', `||' and `|=' read as ordinary symbols -- our own reader has
|
;; `|', `||' and `|=' read as ordinary symbols -- our own reader has
|
||||||
;; no |symbol| syntax for them to collide with -- but fmt-c cannot
|
;; no |symbol| syntax for them to collide with -- but fmt-c cannot
|
||||||
;; dispatch on a symbol whose name it cannot write in Scheme source,
|
;; dispatch on a symbol whose name it cannot write in Scheme source,
|
||||||
|
|||||||
@@ -14,7 +14,7 @@
|
|||||||
|
|
||||||
SEXC ?= ../../sexc
|
SEXC ?= ../../sexc
|
||||||
|
|
||||||
EXPECTED = hello, world\nhello, sex\n2 greetings\ntext times
|
EXPECTED = hello, world\nhello, sex\n2 greetings\ntext times \nmood 1
|
||||||
|
|
||||||
check:
|
check:
|
||||||
@$(SEXC) greet.sex -c -o greet.o
|
@$(SEXC) greet.sex -c -o greet.o
|
||||||
|
|||||||
@@ -21,4 +21,6 @@
|
|||||||
(printf "%d greetings\n" greet-count)
|
(printf "%d greetings\n" greet-count)
|
||||||
(describe-fields greeting)
|
(describe-fields greeting)
|
||||||
(printf "\n")
|
(printf "\n")
|
||||||
|
(var m (enum mood) grumpy)
|
||||||
|
(printf "mood %d\n" m)
|
||||||
(return 0))
|
(return 0))
|
||||||
|
|||||||
@@ -11,6 +11,8 @@
|
|||||||
|
|
||||||
(pub struct greeting ((text (* const char)) (times int)))
|
(pub struct greeting ((text (* const char)) (times int)))
|
||||||
|
|
||||||
|
(pub enum mood (cheerful grumpy))
|
||||||
|
|
||||||
;;; Compile-time reflection across the module boundary: both the macro
|
;;; Compile-time reflection across the module boundary: both the macro
|
||||||
;;; and the struct it asks about are exported, and the importing unit
|
;;; and the struct it asks about are exported, and the importing unit
|
||||||
;;; has to know the struct's fields to expand this.
|
;;; has to know the struct's fields to expand this.
|
||||||
|
|||||||
Reference in New Issue
Block a user