Added Sconstruct file instead of premake

diff --git a/.gitignore b/.gitignore
index 2976eda419cd315e690bb5c774ab1e67630d0184..2a3ff3d8b353db14af602edebe78a2e29b130386 100644 (file)
--- a/.gitignore
+++ b/.gitignore
@@ -9,3 +9,4 @@ cscope.out
 *.d
 
 Makefile
+.sconsign.dblite

diff --git a/SConstruct b/SConstruct
new file mode 100644 (file)
index 0000000..227c6e2
--- /dev/null
+++ b/SConstruct
@@ -0,0 +1,38 @@
+#------------------------------------------------------------------------------
+# Environment Setup and Utilities
+#------------------------------------------------------------------------------
+
+import fnmatch
+import os
+import platform
+
+# Helper function for recursively finding files
+def find_files(dir,pattern):
+    matches = []
+    for root, dirnames, filenames in os.walk(dir):
+        for filename in fnmatch.filter(filenames, pattern):
+            matches.append(os.path.join(root, filename))
+    return matches
+
+# Scheme program builder
+scheme_builder = Builder(
+    action = 'csc -o $TARGET $SOURCE',
+    suffix = '.exe' if (platform.system() == 'Windows') else ''
+)
+
+# Create the Environment for this project
+env = Environment(
+    ENV = os.environ,
+    BUILDERS = { 'SchemeProgram': scheme_builder }
+)
+
+#------------------------------------------------------------------------------
+# SCLPL Targets
+#------------------------------------------------------------------------------
+
+# SCLPL Compiler
+env.SchemeProgram(
+    target = 'sclpl-cc.exe',
+    source = find_files('source/compiler/','*.scm')
+)
+

diff --git a/source/compiler/sclpl-cc.scm b/source/compiler/sclpl-cc.scm
new file mode 100644 (file)
index 0000000..6432150
--- /dev/null
+++ b/source/compiler/sclpl-cc.scm
@@ -0,0 +1,158 @@
+(use srfi-1)
+
+; Formal Syntax
+;------------------------------------------------------------------------------
+;
+; Program ::= Form*
+;
+; Form ::= Definition | Expression
+;
+; 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* ')'
+;
+; Constant ::= Boolean
+;            | Number
+;            | Character
+;            | String
+;
+; ArgList ::= '(' Variable ')'
+;           | '(' Variable Variable '.' Variable ')'
+;
+
+(define (validate-form 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)]
+            [else    (validate-apply frm)])
+      (validate-constant frm)))
+
+(define (validate-quotation frm)
+  (if (not (quote? frm))
+      (syntx-err frm "Invalid quotation")))
+
+(define (validate-func frm)
+  (if (not (func? frm))
+      (syntx-err frm "Invalid function definition")))
+
+(define (validate-if frm)
+  (if (not (if? frm))
+      (syntx-err frm "Invalid if statement")))
+
+(define (validate-set frm)
+  (if (not (set? frm))
+      (syntx-err frm "Invalid assignment expression")))
+
+(define (validate-apply frm)
+  (if (not (apply? frm))
+      (syntx-err frm "Invalid application expression")))
+
+(define (validate-constant frm)
+  (if (not (constant? frm))
+      (syntx-err frm "Not a valid constant")))
+
+;------------------------------------------------------------------------------
+
+(define (form? frm)
+  (or (definition? frm) (expression? frm)))
+
+(define (definition? frm)
+  (or (def? frm) (begin? frm)))
+
+(define (def? frm)
+  (and (list-of-length? frm 3)
+       (equal? 'def (car frm))
+       (symbol? (cadr frm))
+       (expression? (caddr frm))))
+
+(define (begin? frm)
+  (and (list-of->=-length? frm 2)
+       (equal? 'begin (car frm))
+       (list-of? (cdr frm) definition?)))
+
+(define (expression? expr)
+  (if (constant? expr) #t
+      (and (list? expr)
+           (not (null? expr))
+           (case (car expr) [(begin def) #f]
+                            [else        #t]))))
+
+(define (quote? frm)
+  (and (list-of-length? frm 2)
+       (equal? 'quote (car frm))))
+
+(define (func? frm)
+  (and (list-of->=-length? frm 3)
+       (equal? 'func (car frm))
+       (list-of? (cadr frm) symbol?)
+       (list-of? (cddr frm) expression?)))
+
+(define (if? frm)
+  (and (list-of-length? frm 4)
+       (equal? 'if (car frm))
+       (list-of? (cdr frm) expression?)))
+
+(define (set? frm)
+  (and (list-of-length? frm 3)
+       (equal? 'set (car frm))
+       (symbol? (cadr frm))
+       (expression? (caddr frm))))
+
+(define (apply? frm)
+  (and (not (null? frm))
+       (list-of? frm expression?)))
+
+(define (constant? frm)
+  (or (number? frm) (string? frm) (symbol? frm) (char? frm) (boolean? frm)))
+
+; Utility Predicate Procedures
+;------------------------------------------------------------------------------
+(define (list-of? lst prdfn)
+  (if (not (list? lst)) #f
+      (if (null? lst) #t
+          (and (prdfn (car lst))
+               (list-of? (cdr lst) prdfn)))))
+
+(define (list-of->=-length? lst len)
+  (and (list? lst) (>= (length lst) len)))
+
+(define (list-of-length? lst len)
+  (and (list? lst) (= (length lst) len)))
+
+(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)))]
+            [(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)])))
+
+(define (filter-vars defd lst)
+  (filter (lambda (item) (not (member item defd))) lst))
+
+; Utility Procedures
+;------------------------------------------------------------------------------
+(define (syntx-err frm msg)
+  (pretty-print frm)
+  (error msg))
+
+; Compilation Procedures
+;------------------------------------------------------------------------------
+(define (compile-file file) '())
+
+(define (compile-port port) '())
+
+(define (translate-expr expr) '())
+
+(print "foo")
+