From 84c61a970f5954e4b5b0650a60e5a634d6dfed5f Mon Sep 17 00:00:00 2001 From: "Mike D. Lowis" Date: Sun, 14 Jul 2013 20:11:57 -0400 Subject: [PATCH] added desugaring for begin blocks with expressions and definition syntax for functions --- source/compiler/desugar.scm | 24 ++++++++++++++++++++++++ source/compiler/main.scm | 4 ++-- 2 files changed, 26 insertions(+), 2 deletions(-) create mode 100644 source/compiler/desugar.scm diff --git a/source/compiler/desugar.scm b/source/compiler/desugar.scm new file mode 100644 index 0000000..e5df8fb --- /dev/null +++ b/source/compiler/desugar.scm @@ -0,0 +1,24 @@ +(declare (unit desugar) (uses core-forms)) + +(define (desugar frm) + (if (not (pair? frm)) frm + (case (car frm) + [(def) (desugar-def frm)] + [(begin) (desugar-begin frm)] + [else (map desugar frm)]))) + +(define (desugar-def frm) + (if (and (>= (length frm) 3) (pair? (cadr frm))) + (let* [(args* (cadr frm)) + (name (car args*)) + (args (cdr args*))] + (list 'def name + (append (list 'func args) (cddr frm)))) + (map desugar frm))) + +(define (desugar-begin frm) + (define defs (map desugar (cdr frm))) + (if (not (list-of? defs definition?)) + (list (append (list 'lambda '()) defs)) + (cons 'begin defs))) + diff --git a/source/compiler/main.scm b/source/compiler/main.scm index 964babb..8b42f72 100644 --- a/source/compiler/main.scm +++ b/source/compiler/main.scm @@ -1,4 +1,4 @@ -(declare (uses library eval core-forms srfi-13 extras)) +(declare (uses library eval core-forms desugar srfi-13 extras)) (define (compile-file fname) (define ofname (get-output-file-name fname)) @@ -15,7 +15,7 @@ (map core-form->scheme (read-forms (open-input-file fname)))) (define (read-forms port) - (define form (read port)) + (define form (desugar (read port))) (if (eof-object? form) '() (let [(errs (core-syntax-errors form))] -- 2.52.0