From 5283bb36d7a9355a7c78228a8116078a8ffb5a54 Mon Sep 17 00:00:00 2001 From: "Mike D. Lowis" Date: Fri, 9 Mar 2012 12:23:18 -0500 Subject: [PATCH] Updated parse-utils and added map support to scheme environment --- deps/parse-utils | 2 +- example.dl | 72 +++++++++++++--------- res/environment.scm | 141 ++++++++++++++++++++++++-------------------- 3 files changed, 121 insertions(+), 94 deletions(-) diff --git a/deps/parse-utils b/deps/parse-utils index 78ac356..73e5129 160000 --- a/deps/parse-utils +++ b/deps/parse-utils @@ -1 +1 @@ -Subproject commit 78ac3565dc1814885278bb9afd8844c73a02014b +Subproject commit 73e512953c2ed551b6ac9d5e33ffa37d27b6e24e diff --git a/example.dl b/example.dl index 4254f91..3691a0f 100644 --- a/example.dl +++ b/example.dl @@ -1,53 +1,56 @@ #------------------------------------------------------------------------------ -# Literals +# Literal Definition and Usage #------------------------------------------------------------------------------ -# VectorLiteral +# Nums +foo = 1 +foo = 1.0 + +# Char +foo = 'a' + +# String +foo = "some string" +foo = "12345"[2] + +# Symbol +foo = $some_symbol + +# Id +foo = bar +foo.bar = bar + +# Map +foo = { + $foo : 1 + 1, + $bar : 2 + 2, + $stuff : 3 + 3 +} + +# Vector foo = [] foo = [1] foo = [1,2,3] foo = foo[1] foo = [1,2,3,4,5][2] -# ListLiteral +# List foo = () foo = (1,2,3) foo = foo[1] foo = (1,2,3,4,5)[2] -# FuncLiteral +# Block foo = { 1 + 1 } foo = {|a| a + 1} foo = {|a,b| a + b } foo = foo(1,2) foo = ({|a,b| a + b })(1,2) -# ID -foo = bar -foo.bar = bar - -# NUM -foo = 1 -foo = 1.0 - -# CHAR -foo = 'a' - -# STRING -foo = "some string" -foo = "12345"[2] - -# SYMBOL -foo = $some_symbol - -# MAP -foo = { - $foo : 1 + 1, - $bar : 2 + 2, - $stuff : 3 + 3 -} +#------------------------------------------------------------------------------ +# Macro Definition and Usage +#------------------------------------------------------------------------------ -# Macro % if [ (Expression Block Block) : exec_if($1, $2, $3), (Expression Block) : exec_if($1, $2) @@ -64,3 +67,14 @@ if (1 == 1) { } + +#------------------------------------------------------------------------------ +# Delayed Evaluation +#------------------------------------------------------------------------------ + +% delay [ (Expression) : make_promise({ $1 }) ] +% force [ (Expression) : $1 ] + +foo = delay 1 + 1 +foo = force foo + diff --git a/res/environment.scm b/res/environment.scm index 499b6d7..c1cf5a6 100644 --- a/res/environment.scm +++ b/res/environment.scm @@ -15,12 +15,14 @@ (define FN_CALL apply) (define (ARRY_IDX coll idx) (cond - ((list? coll) - (list-ref coll idx)) - ((vector? coll) - (vector-ref coll idx)) - ((string? coll) - (string-ref coll idx)))) + ((list? coll) + (list-ref coll idx)) + ((vector? coll) + (vector-ref coll idx)) + ((hash-table? coll) + (hash-table-ref coll idx)) + ((string? coll) + (string-ref coll idx)))) ;------------------------------------------------------------------------------ ; Built-in datatype constructors @@ -35,6 +37,7 @@ ;------------------------------------------------------------------------------ (require-extension srfi-1) ; List library (require-extension srfi-13) ; String library +(require-extension srfi-69) ; Hash library (require-extension vector-lib) ; Vector library ;------------------------------------------------------------------------------ @@ -52,6 +55,7 @@ (define dl/Char 'dl/Char) (define dl/List 'dl/List) (define dl/Vector 'dl/Vector) +(define dl/Hash 'dl/Hash) (define dl/String 'dl/String) (define dl/Symbol 'dl/Symbol) (define dl/Block 'dl/Block) @@ -68,11 +72,13 @@ (define dl/list_map map) (define dl/vector_map vector-map) (define dl/string_map string-map) +(define dl/hash_map hash-table-map) ; for_each function definitions (define dl/list_for_each for-each) (define dl/vector_for_each vector-for-each) (define dl/string_for_each string-for-each) +(define dl/hash_for_each hash-table-for-each) ; any function definitions (define dl/list_any any) @@ -88,6 +94,7 @@ (define dl/list_fold fold) (define dl/vector_fold vector-fold) (define dl/string_fold string-fold) +(define dl/hash_table_fold hash-table-fold) ; fold_right function definitions (define dl/list_fold_right fold-right) @@ -103,100 +110,106 @@ (define dl/list_concat concatenate) (define dl/vector_concat vector-concatenate) (define dl/string_concat string-concatenate) +(define dl/hash_concat hash-table-merge) ; Define type symbols (define (dl/typeof var) (cond - ((number? var) dl/Num) - ((char? var) dl/Char) - ((list? var) dl/List) - ((vector? var) dl/Vector) - ((string? var) dl/String) - ((symbol? var) dl/Symbol) - ((procedure? var) dl/Block) )) + ((number? var) dl/Num) + ((char? var) dl/Char) + ((list? var) dl/List) + ((vector? var) dl/Vector) + ((hash-table? var) dl/Hash) + ((string? var) dl/String) + ((symbol? var) dl/Symbol) + ((procedure? var) dl/Block) )) (define (dl/assert cnd . msg) ; If condition is false - (if (not cnd) - ; If message is defined - (if (not (null? msg)) - ; Display the message - (error (car msg)) - ; Otherwise display a default message - (error "Assertion failed.") ))) - -(define (dl/exec_if a b . c) - (if a - ; call b as function - (b) - ; If c exists - (if (not (null? c)) - ; Call the head of c as a function - ((car c)) ))) + (if (not cnd) + ; If message is defined + (if (not (null? msg)) + ; Display the message + (error (car msg)) + ; Otherwise display a default message + (error "Assertion failed.") ))) + +(define (dl/exec_if a b . c) + (if a + ; call b as function + (b) + ; If c exists + (if (not (null? c)) + ; Call the head of c as a function + ((car c)) ))) (define (dl/map . args) (let ((ls (list-ref args 1))) - (cond - ((list? ls) (apply map args)) - ((vector? ls) (apply vector-map args)) - ((string? ls) (apply string-map args)) ))) + (cond + ((list? ls) (apply map args)) + ((vector? ls) (apply vector-map args)) + ((hash-table? ls) (apply hash-table-map args)) + ((string? ls) (apply string-map args)) ))) (define (dl/for_each . args) (let ((ls (list-ref args 1))) - (cond - ((list? ls) (apply for-each args)) - ((vector? ls) (apply vector-for-each args)) - ((string? ls) (apply string-for-each args)) ))) + (cond + ((list? ls) (apply for-each args)) + ((vector? ls) (apply vector-for-each args)) + ((hash-table? ls) (apply hash-table-for-each args)) + ((string? ls) (apply string-for-each args)) ))) (define (dl/any . args) (let ((ls (list-ref args 1))) - (cond - ((list? ls) (apply any args)) - ((vector? ls) (apply vector-any args)) - ((string? ls) (apply string-any args)) ))) + (cond + ((list? ls) (apply any args)) + ((vector? ls) (apply vector-any args)) + ((string? ls) (apply string-any args)) ))) (define (dl/for_all . args) (let ((ls (list-ref args 1))) - (cond - ((list? ls) (apply every args)) - ((vector? ls) (apply vector-every args)) - ((string? ls) (apply string-every args)) ))) + (cond + ((list? ls) (apply every args)) + ((vector? ls) (apply vector-every args)) + ((string? ls) (apply string-every args)) ))) (define (dl/fold_left . args) (let ((ls (list-ref args 2))) - (cond - ((list? ls) (apply fold args)) - ((vector? ls) (apply vector-fold args)) - ((string? ls) (apply string-fold args)) ))) + (cond + ((list? ls) (apply fold args)) + ((vector? ls) (apply vector-fold args)) + ((hash-table? ls) (apply hash-table-fold args)) + ((string? ls) (apply string-fold args)) ))) (define (dl/fold_right . args) (let ((ls (list-ref args 2))) - (cond - ((list? ls) (apply fold-right args)) - ((vector? ls) (apply vector-fold-right args)) - ((string? ls) (apply string-fold-right args)) ))) + (cond + ((list? ls) (apply fold-right args)) + ((vector? ls) (apply vector-fold-right args)) + ((string? ls) (apply string-fold-right args)) ))) (define (dl/append . args) (let ((ls (list-ref args 1))) - (cond - ((list? ls) (apply append args)) - ((vector? ls) (apply vector-append args)) - ((string? ls) (apply string-append args)) ))) + (cond + ((list? ls) (apply append args)) + ((vector? ls) (apply vector-append args)) + ((string? ls) (apply string-append args)) ))) (define (dl/concat . args) (let ((ls (list-ref args 1))) - (cond - ((list? ls) (apply concatenate args)) - ((vector? ls) (apply vector-concatenate args)) - ((string? ls) (apply string-concatenate args)) ))) + (cond + ((list? ls) (apply concatenate args)) + ((vector? ls) (apply vector-concatenate args)) + ((hash-table? ls) (apply hash-table-concatenate args)) + ((string? ls) (apply string-concatenate args)) ))) (define (error reason . args) (display "Error: ") (display reason) - (for-each (lambda (arg) + (for-each (lambda (arg) (display " ") - (write arg)) - args) + (write arg)) + args) (newline)) (define dl/error error) -- 2.49.0