From: Mike D. Lowis <mike.lowis@gentex.com>
Date: Mon, 17 Jun 2013 22:11:42 +0000 (-0400)
Subject: Functioning REPL for core syntax
X-Git-Url: https://git.mdlowis.com/?a=commitdiff_plain;h=0dc23ac407b274c56ffa2ba228397336b9c75cdc;p=proto%2Fsclpl.git

Functioning REPL for core syntax
---

diff --git a/SConstruct b/SConstruct
index 035a6fb..bd5a2a6 100644
--- a/SConstruct
+++ b/SConstruct
@@ -2,36 +2,39 @@
 # Environment Setup and Utilities
 #------------------------------------------------------------------------------
 
+import platform
 import fnmatch
 import os
-import platform
 
 # Helper function for recursively finding files
-def find_files(dir,pattern):
+def find_files(path,pattern):
     matches = []
-    for root, dirnames, filenames in os.walk(dir):
-        for filename in fnmatch.filter(filenames, pattern):
+    for root, dirs, files in os.walk(path):
+        for filename in fnmatch.filter(files, pattern):
             matches.append(os.path.join(root, filename))
     return matches
 
 # Scheme Source Compiler
 scheme_compiler = Builder(
-    action     = 'csc -c -o $TARGET $SOURCE',
-    suffix     = '.o',
-    src_suffix = '.scm',
+    action        = 'csc $CCFLAGS -c -o $TARGET $SOURCE',
+    suffix        = '.o',
+    src_suffix    = '.scm',
     single_source = True
 )
 
 # Scheme Binary Linker
 scheme_linker = Builder(
-    action  = 'csc -o $TARGET $SOURCE',
-    suffix = "$PROGSUFFIX",
+    action      = 'csc $LDFLAGS -o $TARGET $SOURCES',
+    suffix      = "$PROGSUFFIX",
+    src_suffix  = '.o',
     src_builder = [ scheme_compiler ]
 )
 
 # Create the Environment for this project
 env = Environment(
-        ENV = os.environ,
+        ENV      = os.environ,
+        CCFLAGS  = [ '-explicit-use' ],
+        LDFLAGS  = [],
         BUILDERS = { 'SchemeProgram': scheme_linker }
 )
 
diff --git a/source/compiler/sclpl-cc.scm b/source/compiler/core-forms.scm
similarity index 77%
rename from source/compiler/sclpl-cc.scm
rename to source/compiler/core-forms.scm
index 6432150..f43269a 100644
--- a/source/compiler/sclpl-cc.scm
+++ b/source/compiler/core-forms.scm
@@ -1,4 +1,4 @@
-(use srfi-1)
+(declare (unit core-forms) (uses srfi-1))
 
 ; Formal Syntax
 ;------------------------------------------------------------------------------
@@ -7,16 +7,16 @@
 ;
 ; Form ::= Definition | Expression
 ;
-; Definition ::= '(:def' Variable Expression ')'
-;              | '(:begin' Definition* ')'
+; Definition ::= '(def' Variable Expression ')'
+;              | '(begin' Definition* ')'
 ;
 ; Expression ::= Constant
 ;              | Variable
-;              | '(:quote' Datum ')'
-;              | '(:func' ArgList Expression Expression* ')'
-;              | '(:if' Expression Expression Expression ')'
-;              | '(:set' Variable Expression ')'
-;              | '(:apply' Expression Expression* ')'
+;              | '(quote' Datum ')'
+;              | '(func' ArgList Expression Expression* ')'
+;              | '(if' Expression Expression Expression ')'
+;              | '(set!' Variable Expression ')'
+;              | '(' Expression Expression* ')'
 ;
 ; Constant ::= Boolean
 ;            | Number
@@ -28,12 +28,26 @@
 ;
 
 (define (validate-form frm)
+  (if (definition? frm)
+      (validate-definition frm)
+      (validate-expression frm)))
+
+(define (validate-definition frm)
+  (if (and (list? frm) (not (null? frm)))
+      (case (car frm)
+            [(begin) (map validate-definition (cdr frm))]
+            [(def)   (if (not (def? frm))
+                         (syntx-err frm "Not a valid def expression"))]
+            [else    (syntx-err frm "Not a valid definition")])
+      (syntx-err frm "Not a valid definition")))
+
+(define (validate-expression frm)
   (if (and (list? frm) (not (null? frm)))
       (case (car frm)
             [(quote) (validate-quotation frm)]
             [(func)  (validate-func frm)]
             [(if)    (validate-if frm)]
-            [(set)   (validate-set frm)]
+            [(set!)   (validate-set frm)]
             [else    (validate-apply frm)])
       (validate-constant frm)))
 
@@ -104,7 +118,7 @@
 
 (define (set? frm)
   (and (list-of-length? frm 3)
-       (equal? 'set (car frm))
+       (equal? 'set! (car frm))
        (symbol? (cadr frm))
        (expression? (caddr frm))))
 
@@ -132,7 +146,7 @@
 (define (get-free-vars expr)
   (if (symbol? expr) expr
       (case (if (list? expr) (car expr) '())
-            [(def set)  (list (cadr expr) (get-free-vars (caddr expr)))]
+            [(def set!) (list (cadr expr) (get-free-vars (caddr expr)))]
             [(begin if) (map get-free-vars (cdr expr))]
             [(func)     (filter-vars (cadr expr) (map get-free-vars (cddr expr)))]
             [else       (map get-free-vars expr)])))
@@ -143,16 +157,8 @@
 ; Utility Procedures
 ;------------------------------------------------------------------------------
 (define (syntx-err frm msg)
+  (print "Error: " msg "\n")
   (pretty-print frm)
-  (error msg))
-
-; Compilation Procedures
-;------------------------------------------------------------------------------
-(define (compile-file file) '())
-
-(define (compile-port port) '())
-
-(define (translate-expr expr) '())
-
-(print "foo")
+  (display "\n")
+  (exit 1))
 
diff --git a/source/compiler/main.scm b/source/compiler/main.scm
new file mode 100644
index 0000000..0b0b43c
--- /dev/null
+++ b/source/compiler/main.scm
@@ -0,0 +1,20 @@
+(declare (uses library eval core-forms))
+
+(define (start-repl prt)
+  (display ":> ")
+  (let [(form (read prt))]
+       (validate-form form)
+       (print (eval (core-form->scheme form)
+              (interaction-environment))))
+  (start-repl prt))
+
+(define (core-form->scheme frm)
+  (if (and (list? frm) (not (null? frm)))
+      (case (car frm)
+            [(def)  (cons 'define (map core-form->scheme (cdr frm)))]
+            [(func) (cons 'lambda (map core-form->scheme (cdr frm)))]
+            [else   (map core-form->scheme frm)])
+      frm))
+
+(start-repl (current-input-port))
+