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.
142 lines
4.3 KiB
Scheme
142 lines
4.3 KiB
Scheme
;;; Sex semantic engine
|
|
|
|
(declare (unit semen)
|
|
(uses sex-macros
|
|
sex-modules))
|
|
|
|
(import fmt
|
|
matchable ; pattern matching
|
|
srfi-1 ; list routines
|
|
)
|
|
|
|
;;; for lambda extraction, docstring processing, macro expansion,
|
|
;;; injection of module headers, i.e. all things that rearrange code
|
|
;;; structurally, add or remove forms
|
|
;;;
|
|
;;; The algorithm: feed toplevel forms to appropriate handlers, then
|
|
;;; append their return to the resulting list. Each handler can return
|
|
;;; multiple forms, e.g. lambdas collected from a function may result
|
|
;;; in auxiliary structures and functions.
|
|
(define (semen-process raw-sex-forms)
|
|
(semen-process-rec raw-sex-forms (list)))
|
|
|
|
(define (semen-process-rec forms acc)
|
|
(cond
|
|
((null? forms) (reverse acc))
|
|
((sex-macro? (car forms))
|
|
(semen-process-rec
|
|
(semen-apply-macro (car forms) (cdr forms))
|
|
acc))
|
|
(else
|
|
(semen-process-rec (cdr forms)
|
|
(match-sex-form (car forms) acc)))))
|
|
|
|
(define (semen-apply-macro macro-form rest-forms)
|
|
;; We want to replace macro with its expansion. The problem is,
|
|
;; top-level macro can return either a single form, or a list of
|
|
;; forms, when it for example generates some aux
|
|
;; structures/functions/typedefs.
|
|
;;
|
|
;; Single form we just cons to the top of rest-forms, but multiple
|
|
;; forms have to be appended to the rest-forms.
|
|
(let ((res (apply-macro macro-form)))
|
|
(if (list? (car res))
|
|
(append res rest-forms)
|
|
(cons res rest-forms))))
|
|
|
|
(define (match-sex-form sex-form acc)
|
|
(match sex-form
|
|
((or ('fn . _)
|
|
('pub 'fn . _)
|
|
('extern 'fn . _)) (process-fn sex-form acc))
|
|
((or ('struct . _)
|
|
('pub 'struct . _)) (process-struct sex-form acc))
|
|
((or ('union . _)
|
|
('pub 'union . _)) (process-struct sex-form acc))
|
|
((or ('var . _)
|
|
('pub 'var . _)
|
|
('extern 'var . _)) (process-global-var sex-form acc))
|
|
(('include _) (cons sex-form acc))
|
|
|
|
(('import . modules)
|
|
(semen-process-imports (get-public-forms modules) acc))
|
|
|
|
((or ('defmacro . rest)
|
|
('pub 'defmacro . rest)) (defmacro rest) acc)
|
|
|
|
(else (assert #f (fmt #f "Unknown top level form " sex-form)))))
|
|
|
|
(define (semen-process-imports module-public-forms acc)
|
|
;; Recursively process imports: register public macros, cons all
|
|
;; other public things to our acc
|
|
(if (null? module-public-forms) acc
|
|
(match (car module-public-forms)
|
|
(('defmacro . rest)
|
|
(defmacro rest)
|
|
(semen-process-imports (cdr module-public-forms) acc))
|
|
(else
|
|
(semen-process-imports (cdr module-public-forms)
|
|
(cons (car module-public-forms)
|
|
acc))))))
|
|
|
|
(define (process-fn sex-fn acc)
|
|
(cons sex-fn acc))
|
|
|
|
(define (process-struct sex-struct acc)
|
|
(cons sex-struct acc))
|
|
|
|
(define (process-global-var sex-var acc)
|
|
(cons sex-var acc))
|
|
|
|
;;; Utils
|
|
(define (non-empty-list? form)
|
|
(and (list? form)
|
|
(not (null? form))))
|
|
|
|
(define (sex-fn? form)
|
|
"The `form` must be toplevel.
|
|
Returns #f if the form is not a function, returns the form otherwise"
|
|
(match form
|
|
((fn . _) form)
|
|
((pub fn . _) form)
|
|
(else #f)))
|
|
|
|
(define (sex-fn-public? fn-form)
|
|
(eq? (car fn-form) 'pub))
|
|
|
|
(define (sex-fn-return-type fn-form)
|
|
(assert (sex-fn? fn-form)
|
|
(fmt #f "Form " fn-form " is not a function"))
|
|
(if (sex-fn-public? fn-form)
|
|
(third fn-form)
|
|
(second fn-form)))
|
|
|
|
(define (sex-fn-name fn-form)
|
|
(assert (sex-fn? fn-form)
|
|
(fmt #f "Form " fn-form " is not a function"))
|
|
(if (sex-fn-public? fn-form)
|
|
(fourth fn-form)
|
|
(third fn-form)))
|
|
|
|
(define (sex-fn-arglist fn-form)
|
|
(assert (sex-fn? fn-form)
|
|
(fmt #f "Form " fn-form " is not a function"))
|
|
(if (sex-fn-public? fn-form)
|
|
(fifth fn-form)
|
|
(fourth fn-form)))
|
|
|
|
(define (sex-fn-prototype fn-form)
|
|
"Returns all except body"
|
|
(assert (sex-fn? fn-form)
|
|
(fmt #f "Form " fn-form " is not a function"))
|
|
(if (sex-fn-public? fn-form)
|
|
(take fn-form 5)
|
|
(take fn-form 4)))
|
|
|
|
(define (sex-fn-body fn-form)
|
|
(assert (sex-fn? fn-form)
|
|
(fmt #f "Form " fn-form " is not a function"))
|
|
(if (sex-fn-public? fn-form)
|
|
(drop fn-form 5)
|
|
(drop fn-form 4)))
|