alex-eg/sex
1
0
Fork 1
Code Issues 3 Pull Requests 1 Actions Packages Projects 1 Releases Wiki Activity

add initial lambda support

Browse Source 
No closures for now, but solid groundwork is laid.
This commit was merged in pull request #11.
This commit is contained in:
alex-eg
2025-09-26 16:53:38 +03:00
committed by Pavel Kulyov
parent d87f0ba161
commit 442f663635
2 changed files with 91 additions and 14 deletions
Download Patch File Download Diff File Expand all files Collapse all files

31
example/lambdas.sex Normal file
View File

@@ -0,0 +1,31 @@
(include stdio.h)
(fn int sum ((int a) (int b))
(return (+ a b)))
(pub fn int main ()
(var int a 10)
(var int b 20)
(var (fn int ((int) (int))) sum-fn sum)
(var (fn int ((int) (int))) sum-lambda
(lambda int ((int a) (int b)) ()
(return (+ a b))))
(var (fn int ((int))) sum-lambda-2
(lambda int ((int a)) ()
(return (+ a 20))))
(printf "Hello from main fn!\n")
(printf "We will now perform some function calling.\n")
(printf "Calling fn ptr: %d\n" (sum-fn a b))
(printf "Calling lambda: %d\n" (sum-lambda a b))
(printf "Calling other lambda: %d\n" (sum-lambda-2 a))
(printf "Calling lambda inplace: %d\n" ((lambda int ((int a) (int b)) ()
(return (+ a b 100)))
a b))
(return 0))

74
semen.scm
View File

@@ -4,10 +4,13 @@
(uses sex-macros
sex-modules))
(import fmt
matchable ; pattern matching
srfi-1 ; list routines
)
(import
(chicken string)
fmt
matchable ; pattern matching
srfi-1 ; list routines
srfi-69 ; hash tables
)
;;; for lambda extraction, docstring processing, macro expansion,
;;; injection of module headers, i.e. all things that rearrange code
@@ -83,21 +86,24 @@
"Walk the form recursively and expand all macros, until none is left."
(semen-walk-form
form
(lambda (subform)
(lambda (subform env)
(if (sex-macro? subform)
(apply-macro subform)
subform))))
subform))
#f))
;;; TODO: for greater inspiration, see SBCL's walk.lisp
(define (semen-walk-form form walk-fn)
;;; TODO: for greater inspiration, see SBCL's walk.lisp and their
;;; template system. Maybe it is worth it to implement something
;;; similar here
(define (semen-walk-form form walk-fn env)
(if (atom? form) form
(let ((new-form (walk-fn form)))
(let ((new-form (walk-fn form env)))
(cond ((not (eq? form new-form))
(semen-walk-form new-form walk-fn))
(semen-walk-form new-form walk-fn env))
(else (recons
new-form
(semen-walk-form (car new-form) walk-fn)
(semen-walk-form (cdr new-form) walk-fn)))))))
(semen-walk-form (car new-form) walk-fn env)
(semen-walk-form (cdr new-form) walk-fn env)))))))
(define (recons old-cons new-car new-cdr)
(if (and (eq? new-car (car old-cons))
@@ -105,9 +111,49 @@
old-cons
(cons new-car new-cdr)))
;;; Fn processing
(define (process-fn sex-fn acc)
(let ((expanded (semen-macro-expand sex-fn)))
(cons expanded acc)))
(let* ((expanded (semen-macro-expand sex-fn))
(env (make-hash-table))
(processed
(semen-walk-form
expanded
semen-fn-walker
(begin
(set! (hash-table-ref env :fn-name) (sex-fn-name expanded))
(set! (hash-table-ref env :lambda-counter) 0)
(set! (hash-table-ref env :lambda-aux-code) (list))
env))))
(cons processed
(append (hash-table-ref env :lambda-aux-code) acc))))
(define (semen-fn-walker form env)
(if (eq? 'lambda (car form))
(let ((lambda-name (semen-make-lambda-name (hash-table-ref env :fn-name)
(hash-table-ref env :lambda-counter))))
(set! (hash-table-ref env :lambda-aux-code)
(cons (semen-make-aux-lambda-struct lambda-name form)
(hash-table-ref env :lambda-aux-code)))
(set! (hash-table-ref env :lambda-counter)
(+ (hash-table-ref env :lambda-counter) 1))
lambda-name)
form))
(define (semen-make-lambda-name enclosing-fn-name counter)
(string->symbol
(fmt #f "__lambda_" counter "_" enclosing-fn-name)))
(define (semen-make-aux-lambda-struct name form)
(match form
(('lambda ret-type arglist captures . body)
;; Captures are ignored for now, but
;; we'll need them for TODO: closures support
`(fn ,ret-type ,name ,arglist ,@body))
(else (assert #f (fmt #f "Malformed lambda " form)))))
;;; Struct
(define (process-struct sex-struct acc)
(cons sex-struct acc))