forked from alex-eg/sex
add initial lambda support
No closures for now, but solid groundwork is laid.
This commit is contained in:
31
example/lambdas.sex
Normal file
31
example/lambdas.sex
Normal 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
74
semen.scm
@@ -4,10 +4,13 @@
|
|||||||
(uses sex-macros
|
(uses sex-macros
|
||||||
sex-modules))
|
sex-modules))
|
||||||
|
|
||||||
(import fmt
|
(import
|
||||||
matchable ; pattern matching
|
(chicken string)
|
||||||
srfi-1 ; list routines
|
fmt
|
||||||
)
|
matchable ; pattern matching
|
||||||
|
srfi-1 ; list routines
|
||||||
|
srfi-69 ; hash tables
|
||||||
|
)
|
||||||
|
|
||||||
;;; for lambda extraction, docstring processing, macro expansion,
|
;;; for lambda extraction, docstring processing, macro expansion,
|
||||||
;;; injection of module headers, i.e. all things that rearrange code
|
;;; 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."
|
"Walk the form recursively and expand all macros, until none is left."
|
||||||
(semen-walk-form
|
(semen-walk-form
|
||||||
form
|
form
|
||||||
(lambda (subform)
|
(lambda (subform env)
|
||||||
(if (sex-macro? subform)
|
(if (sex-macro? subform)
|
||||||
(apply-macro subform)
|
(apply-macro subform)
|
||||||
subform))))
|
subform))
|
||||||
|
#f))
|
||||||
|
|
||||||
;;; TODO: for greater inspiration, see SBCL's walk.lisp
|
;;; TODO: for greater inspiration, see SBCL's walk.lisp and their
|
||||||
(define (semen-walk-form form walk-fn)
|
;;; template system. Maybe it is worth it to implement something
|
||||||
|
;;; similar here
|
||||||
|
(define (semen-walk-form form walk-fn env)
|
||||||
(if (atom? form) form
|
(if (atom? form) form
|
||||||
(let ((new-form (walk-fn form)))
|
(let ((new-form (walk-fn form env)))
|
||||||
(cond ((not (eq? form new-form))
|
(cond ((not (eq? form new-form))
|
||||||
(semen-walk-form new-form walk-fn))
|
(semen-walk-form new-form walk-fn env))
|
||||||
(else (recons
|
(else (recons
|
||||||
new-form
|
new-form
|
||||||
(semen-walk-form (car new-form) walk-fn)
|
(semen-walk-form (car new-form) walk-fn env)
|
||||||
(semen-walk-form (cdr new-form) walk-fn)))))))
|
(semen-walk-form (cdr new-form) walk-fn env)))))))
|
||||||
|
|
||||||
(define (recons old-cons new-car new-cdr)
|
(define (recons old-cons new-car new-cdr)
|
||||||
(if (and (eq? new-car (car old-cons))
|
(if (and (eq? new-car (car old-cons))
|
||||||
@@ -105,9 +111,49 @@
|
|||||||
old-cons
|
old-cons
|
||||||
(cons new-car new-cdr)))
|
(cons new-car new-cdr)))
|
||||||
|
|
||||||
|
;;; Fn processing
|
||||||
|
|
||||||
(define (process-fn sex-fn acc)
|
(define (process-fn sex-fn acc)
|
||||||
(let ((expanded (semen-macro-expand sex-fn)))
|
(let* ((expanded (semen-macro-expand sex-fn))
|
||||||
(cons expanded acc)))
|
(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)
|
(define (process-struct sex-struct acc)
|
||||||
(cons sex-struct acc))
|
(cons sex-struct acc))
|
||||||
|
|||||||
Reference in New Issue
Block a user