added desugaring for begin blocks with expressions and definition syntax for functions

diff --git a/source/compiler/desugar.scm b/source/compiler/desugar.scm
new file mode 100644 (file)
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 964babb9bc311d971652d2d2c5cac6a579f80a6c..8b42f72c611ab2144fd6e4d34e4b105f97096edc 100644 (file)
--- 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))]