From d0c1fa9deade12b48110213b2efb5d9da8c7982a Mon Sep 17 00:00:00 2001
From: "Mike D. Lowis" <mike@mdlowis.com>
Date: Thu, 17 Jan 2013 12:20:26 -0500
Subject: [PATCH] Started implementation of typed lisp intermediate language

---
 src/sclpl/Makefile      |  4 ++--
 src/sclpl/src/main.scm  | 42 +++++++++++++++++++++++++++++++++++++++--
 src/sclpl/src/sclpl.scm |  8 --------
 3 files changed, 42 insertions(+), 12 deletions(-)
 delete mode 100644 src/sclpl/src/sclpl.scm

diff --git a/src/sclpl/Makefile b/src/sclpl/Makefile
index 311b872..a8fe4a0 100644
--- a/src/sclpl/Makefile
+++ b/src/sclpl/Makefile
@@ -16,7 +16,7 @@ flist = $(shell env find $(1) -name "*.$(strip $(2))" -print)
 # Project and Artifact Names
 #---------------------------
 BIN_NAME    = sclpl
-TEST_RUNNER = sclpl-test
+TEST_RUNNER = $(BIN_NAME)-test
 
 # File and Directory Settings
 #----------------------------
@@ -45,7 +45,7 @@ TEST_INCS = -I inc
 # Compiler and Linker Options
 #----------------------------
 CSC = csc
-CSCFLAGS = -c -explicit-use
+CSCFLAGS = -c -explicit-use -compile-syntax
 
 # Build Rules
 #------------
diff --git a/src/sclpl/src/main.scm b/src/sclpl/src/main.scm
index 8c87260..205cf19 100644
--- a/src/sclpl/src/main.scm
+++ b/src/sclpl/src/main.scm
@@ -1,4 +1,42 @@
-(declare (uses sclpl))
+(declare (uses library))
 
-(interpret (current-input-port))
+(define primitive-types '(Num Char String))
+
+(define (literal e)
+  (if (not (or (number? e) (char? e) (string? e) (symbol? e)))
+      (syn-error e "Not a recognized literal type")))
+
+(define (prim-type e)
+  (if (or (not (symbol? e))
+          (not (member e primitive-types)))
+    (syn-error e "Not a recognized primitive type")))
+
+(define (typed-sym sym)
+  (if (not (pair? sym))
+      (syn-error sym "Expected a type/symbol pair"))
+  (if (not (symbol? (car sym)))
+      (syn-error sym "Expected a symbol name"))
+  (prim-type (cdr sym)))
+
+(define (list-of-types lst)
+  (if (null? lst) lst
+      (begin (typed-sym (car lst))
+             (list-of-types (cdr lst)))))
+
+(define (definition e)
+  (if (or (not (list? e))
+          (< (length e) 3))
+    (syn-error e "Definitions require a type and a body or value"))
+  (if (list? (cadr e)) (list-of-types (cadr e)) (typed-sym (cadr e))))
+
+
+
+(define (syn-error expr msg)
+  (print (string-append "Error: " msg))
+  (display "\n")
+  (pretty-print expr)
+  (exit 1))
+
+; Main
+;------------------------------------------------------------------------------
 
diff --git a/src/sclpl/src/sclpl.scm b/src/sclpl/src/sclpl.scm
deleted file mode 100644
index 0efa496..0000000
--- a/src/sclpl/src/sclpl.scm
+++ /dev/null
@@ -1,8 +0,0 @@
-(declare (unit sclpl) (uses library))
-
-(define (interpret port)
-  (define expression (read port))
-  (print (eval expression))
-  (if (not (null? expression))
-      (interpret port)))
-
-- 
2.54.0