alex-eg
b1744bb6af
Introducing Sex SEMantic ENgine: the semen. Also split reader to other file (it can be replaced in the future). Macro expansion inside Sex code doesn't work yet, and it must be done in semen, not during fmt-c generation as before.
129 lines
3.1 KiB
Scheme
129 lines
3.1 KiB
Scheme
;;; Sex fmt-c output writer
|
|
|
|
(declare (unit fmt-c-writer)
|
|
(uses fmt-c
|
|
semen))
|
|
|
|
(import (chicken string)
|
|
brev-separate
|
|
fmt
|
|
regex
|
|
srfi-1 ; lists
|
|
srfi-13 ; strings
|
|
)
|
|
|
|
(define (unkebabify sym)
|
|
(case sym
|
|
((-) sym)
|
|
((--) sym)
|
|
((->) sym)
|
|
((-=) sym)
|
|
(else
|
|
(string->symbol
|
|
(string-substitute "-(?!>)" "_"
|
|
(symbol->string sym) #t)))))
|
|
|
|
(define (atom-to-fmt-c atom)
|
|
(case atom
|
|
((fn) '%fun)
|
|
((prototype) '%prototype)
|
|
((var) '%var)
|
|
((begin) '%block-begin)
|
|
((define) '%define)
|
|
((pointer) '%pointer)
|
|
((array) '%array)
|
|
((attribute) '%attribute)
|
|
((@) 'vector-ref)
|
|
((include) '%include)
|
|
((cast) '%cast)
|
|
;; uh things we do for c89 compatibility
|
|
((bool) 'int)
|
|
((true) 1)
|
|
((false) 0)
|
|
(else
|
|
(if (symbol? atom)
|
|
(unkebabify atom)
|
|
atom))))
|
|
|
|
(define (make-field-access form)
|
|
(assert
|
|
(= 2 (length form)) "Wrong field access format")
|
|
(unkebabify
|
|
(string->symbol
|
|
(fmt #f (cadr form) (car form)))))
|
|
|
|
(define (walk-generic form acc)
|
|
(cond
|
|
((null? form) (cons '() acc))
|
|
|
|
;; vector, e.g. {}-initializer
|
|
((vector? form)
|
|
(cons
|
|
(list->vector
|
|
(car (walk-generic (vector->list form) (list))))
|
|
acc))
|
|
|
|
;; atom (hopefully)
|
|
((not (list? form)) (cons (atom-to-fmt-c form) acc))
|
|
|
|
;; another special case - field access
|
|
((and (symbol? (car form))
|
|
(char=? #\. (string-ref (symbol->string (car form)) 0)))
|
|
(cons (make-field-access form) acc))
|
|
|
|
;; toplevel, or a start of a regular list form
|
|
(else
|
|
(let ((new-acc (list)))
|
|
(cons (fold-right
|
|
walk-generic
|
|
new-acc
|
|
form)
|
|
acc)))))
|
|
|
|
(define (normalize-fn-form form)
|
|
;; (fn ret-type name arglist body) -> normal function
|
|
;; (fn ret-type name arglist) -> prototype
|
|
(if (>= (length form) 5)
|
|
form
|
|
(cons 'prototype (cdr form))))
|
|
|
|
(define (walk-function form static)
|
|
(if static
|
|
(walk-generic (list 'static (normalize-fn-form form))
|
|
(list))
|
|
(walk-generic (normalize-fn-form (cdr form))
|
|
(list))))
|
|
|
|
(define (walk-extern form)
|
|
(case (cadr form)
|
|
((fn)
|
|
(list (cons 'extern (walk-function form #f))))
|
|
((var)
|
|
(list (cons 'extern (walk-generic (cdr form) (list)))))
|
|
(else (error "Extern what?"))))
|
|
|
|
(define (walk-public form)
|
|
(case (cadr form)
|
|
((fn)
|
|
(walk-function form #f))
|
|
((var)
|
|
(walk-generic (list 'static (cdr form)) (list)))
|
|
((define defmacro import include struct typedef union var)
|
|
;; ignore here, used in generating public interface
|
|
(process-toplevel-form (cdr form)))
|
|
(else
|
|
(error "Pub what?" (cadr form)))))
|
|
|
|
(define (process-toplevel-form form)
|
|
;; todo: rewrite to match
|
|
(case (car form)
|
|
((fn) (walk-function form #t))
|
|
((extern) (walk-extern form))
|
|
((pub) (walk-public form))
|
|
(else (walk-generic form (list)))))
|
|
|
|
(define (emit-c sex-forms)
|
|
(for-each (lambda (form)
|
|
(fmt #t (c-expr (car (process-toplevel-form form))) nl))
|
|
sex-forms))
|