From f03bd62d1c6ce8a03400d8403a0ebc890a5252cd Mon Sep 17 00:00:00 2001 From: "Mike D. Lowis" Date: Thu, 13 Jun 2013 22:26:18 -0400 Subject: [PATCH] Added Sconstruct file instead of premake --- .gitignore | 1 + SConstruct | 38 +++++++++ source/compiler/sclpl-cc.scm | 158 +++++++++++++++++++++++++++++++++++ 3 files changed, 197 insertions(+) create mode 100644 SConstruct create mode 100644 source/compiler/sclpl-cc.scm diff --git a/.gitignore b/.gitignore index 2976eda..2a3ff3d 100644 --- a/.gitignore +++ b/.gitignore @@ -9,3 +9,4 @@ cscope.out *.d Makefile +.sconsign.dblite diff --git a/SConstruct b/SConstruct new file mode 100644 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 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") + -- 2.52.0