forked from alex-eg/sex
semen: extract counting header length into a function
This commit is contained in:
13
semen.scm
13
semen.scm
@@ -144,12 +144,15 @@
|
|||||||
(define (comment-form? f)
|
(define (comment-form? f)
|
||||||
(and (pair? f) (eq? (car f) 'comment)))
|
(and (pair? f) (eq? (car f) 'comment)))
|
||||||
|
|
||||||
|
(define (fn-header-length fn-form)
|
||||||
|
(if (memq (first fn-form) '(pub extern)) 5 4))
|
||||||
|
|
||||||
(define (strip-fn-header-comments fn-form)
|
(define (strip-fn-header-comments fn-form)
|
||||||
;; Remove comment forms from the function header
|
;; Remove comment forms from the function header
|
||||||
;; ([pub|extern] fn name arglist rettype) so the positional accessors
|
;; ([pub|extern] fn name arglist rettype) so the positional accessors
|
||||||
;; below are not shifted. Comments in the body are left in place as
|
;; below are not shifted. Comments in the body are left in place as
|
||||||
;; ordinary statements and preserved into the generated C.
|
;; ordinary statements and preserved into the generated C.
|
||||||
(let ((header-count (if (memq (car fn-form) '(pub extern)) 5 4)))
|
(let ((header-count (fn-header-length fn-form)))
|
||||||
;; This always rebuilds the list, so the location has to be carried
|
;; This always rebuilds the list, so the location has to be carried
|
||||||
;; over explicitly -- otherwise every function loses it
|
;; over explicitly -- otherwise every function loses it
|
||||||
(copy-form-source!
|
(copy-form-source!
|
||||||
@@ -265,13 +268,9 @@ Returns #f if the form is not a function, returns the form otherwise"
|
|||||||
"Returns all except body"
|
"Returns all except body"
|
||||||
(assert (sex-fn? fn-form)
|
(assert (sex-fn? fn-form)
|
||||||
(fmt #f "Form " fn-form " is not a function"))
|
(fmt #f "Form " fn-form " is not a function"))
|
||||||
(if (sex-fn-public? fn-form)
|
(take fn-form (fn-header-length fn-form)))
|
||||||
(take fn-form 5)
|
|
||||||
(take fn-form 4)))
|
|
||||||
|
|
||||||
(define (sex-fn-body fn-form)
|
(define (sex-fn-body fn-form)
|
||||||
(assert (sex-fn? fn-form)
|
(assert (sex-fn? fn-form)
|
||||||
(fmt #f "Form " fn-form " is not a function"))
|
(fmt #f "Form " fn-form " is not a function"))
|
||||||
(if (sex-fn-public? fn-form)
|
(drop fn-form (fn-header-length fn-form)))
|
||||||
(drop fn-form 5)
|
|
||||||
(drop fn-form 4)))
|
|
||||||
|
|||||||
Reference in New Issue
Block a user