diff --git a/README.markdown b/README.markdown
--- a/README.markdown
+++ b/README.markdown
@@ -8,7 +8,7 @@
Feature List
------------
-husk includes the following features from R5RS:
+husk includes most features from R5RS, including:
- Primitive data types and their standard forms, including string, char, numbers (integer, rational, floating point, and complex), list, pair, vector, and symbols
- Proper tail recursion
diff --git a/hs-src/Language/Scheme/Core.hs b/hs-src/Language/Scheme/Core.hs
--- a/hs-src/Language/Scheme/Core.hs
+++ b/hs-src/Language/Scheme/Core.hs
@@ -273,7 +273,9 @@
_ -> cpsUnquoteList e c (head unEvaled) (Just [List (tail unEvaled), List $ acc ++ [val] ])
cpsUnquoteFld _ _ _ _ = throwError $ InternalError "Unexpected parameters to cpsUnquoteFld"
--- TODO: let-syntax
+-- A rudimentary implementation of let-syntax
+eval env cont args@(List (Atom "let-syntax" : List bindings : body)) = do
+ -- TODO: check if let-syntax has been rebound?
--
-- high-level design
-- - use extendEnv to create a new environment
@@ -281,7 +283,20 @@
-- - pick up execution of the body, perhaps just like how it is
-- done today with a function body
--
+ bodyEnv <- liftIO $ extendEnv env []
+ _ <- loadMacros env bodyEnv bindings
+ continueEval bodyEnv (Continuation bodyEnv (Just $ SchemeBody body) (Just cont) Nothing Nothing) $ Nil ""
+eval env cont args@(List (Atom "letrec-syntax" : List bindings : body)) = do
+ -- TODO: check if letrec-syntax has been rebound?
+ bodyEnv <- liftIO $ extendEnv env []
+ -- A primitive means of implementing letrec, by simply assuming that each macro is defined in
+ -- the letrec's environment, instead of the parent env. Not sure if this is 100% correct but it
+ -- is good enough to pass the R5RS test case so it will be used as a rudimentary implementation
+ -- for now...
+ _ <- loadMacros bodyEnv bodyEnv bindings
+ continueEval bodyEnv (Continuation bodyEnv (Just $ SchemeBody body) (Just cont) Nothing Nothing) $ Nil ""
+
eval env cont args@(List [Atom "define-syntax", Atom keyword, (List (Atom "syntax-rules" : (List identifiers : rules)))]) = do
bound <- liftIO $ isRecBound env "define-syntax"
if bound
@@ -305,7 +320,7 @@
--
-- defEnv <- liftIO $ copyEnv env
_ <- defineNamespacedVar env macroNamespace keyword $ Syntax env identifiers rules
- return $ Nil "" -- Sentinel value
+ continueEval env cont $ Nil ""
eval env cont args@(List [Atom "if", predic, conseq, alt]) = do
bound <- liftIO $ isRecBound env "if"
@@ -964,3 +979,4 @@
("string-copy", stringCopy),
("boolean?", isBoolean)]
+
diff --git a/hs-src/Language/Scheme/Macro.hs b/hs-src/Language/Scheme/Macro.hs
--- a/hs-src/Language/Scheme/Macro.hs
+++ b/hs-src/Language/Scheme/Macro.hs
@@ -39,6 +39,7 @@
module Language.Scheme.Macro
(
macroEval
+ , loadMacros
) where
import Language.Scheme.Types
import Language.Scheme.Variables
@@ -564,6 +565,28 @@
let isQuasiQuoted = (a == "quasiquote")
isDefinedAsMacro <- liftIO $ isNamespacedRecBound useEnv macroNamespace a
+{-
+Some high-level design notes on how this could be made to work:
+
+Note from http://www.cs.indiana.edu/~dyb/pubs/LaSC-5-4-pp295-326.pdf
+
+Also, internal define-syntax forms may appear wherever internal define forms are
+permitted, in which case the definitions behave as if introduced by letrec-syntax
+
+so we could transform a letrec-syntax form into another using define-syntax.
+let-syntax could be handled in the same way, although we would need to walk
+the macro to ensure that none of the introduced macros reference each other.
+
+
+ if (startOfList) && a == "let-syntax" && not isQuoted -- TODO: letrec-syntax, and a better way to organize all this
+ then case ts of
+ List bindings : body -> do
+ bodyEnv <- liftIO $ extendEnv -- TODO: not sure about this... how will this work?
+ _ <- loadMacros env bodyEnv bindings
+ -- TODO: expand the macro body
+ -- TODO: error
+ else
+-}
if (startOfList) && a == "define-syntax" && not isQuoted
then case ts of
[Atom keyword, (List (Atom "syntax-rules" : (List identifiers : rules)))] -> do
@@ -739,7 +762,10 @@
curT <- transformRule defEnv outerEnv localEnv renameEnv cleanupEnv identifiers level idx (List []) (List l)
case (curT) of
Nil _ -> -- No match ("zero" case). Use tail to move past the "..."
- continueTransform defEnv outerEnv localEnv renameEnv cleanupEnv identifiers ellipsisLevel ellipsisIndex result $ tail ts
+ continueTransform defEnv outerEnv localEnv renameEnv cleanupEnv identifiers
+ ellipsisLevel
+ (init ellipsisIndex) -- Issue #56 - done w/ellip so no need for last idx
+ result $ tail ts
List _ -> transformRule defEnv outerEnv localEnv renameEnv cleanupEnv identifiers
ellipsisLevel -- Do not increment level, just wait until the next go-round when it will be incremented above
idx -- Must keep index since it is incremented each time
@@ -765,7 +791,7 @@
-- case (trace ("curT = " ++ show curT) curT) of
case curT of
Nil _ -> -- No match ("zero" case). Use tail to move past the "..."
- continueTransform defEnv outerEnv localEnv renameEnv cleanupEnv identifiers ellipsisLevel ellipsisIndex result $ tail ts
+ continueTransform defEnv outerEnv localEnv renameEnv cleanupEnv identifiers ellipsisLevel (init ellipsisIndex) result $ tail ts
List t -> transformRule defEnv outerEnv localEnv renameEnv cleanupEnv identifiers
ellipsisLevel -- Do not increment level, just wait until the next go-round when it will be incremented above
idx -- Must keep index since it is incremented each time
@@ -789,7 +815,7 @@
curT <- transformDottedList defEnv outerEnv localEnv renameEnv cleanupEnv identifiers level idx (List []) (List [dl])
case curT of
Nil _ -> -- No match ("zero" case). Use tail to move past the "..."
- continueTransform defEnv outerEnv localEnv renameEnv cleanupEnv identifiers ellipsisLevel ellipsisIndex result $ tail ts
+ continueTransform defEnv outerEnv localEnv renameEnv cleanupEnv identifiers ellipsisLevel (init ellipsisIndex) result $ tail ts
List t -> transformRule defEnv outerEnv localEnv renameEnv cleanupEnv identifiers
ellipsisLevel -- Do not increment level, just wait until next iteration where incremented above
idx -- Keep incrementing each time
@@ -1116,3 +1142,14 @@
asVector :: [LispVal] -> LispVal
asVector lst = (Vector $ (listArray (0, length lst - 1)) lst)
+-- |Helper function to load macros from a let*-syntax expression
+loadMacros :: Env -- ^ Parent environment containing the let*-syntax expression
+ -> Env -- ^ Environment of the let*-syntax body
+ -> [LispVal] -- ^ List containing syntax-rule definitions
+ -> IOThrowsError LispVal -- ^ A dummy value, unless an error is thrown
+loadMacros e be (List [Atom keyword, (List (Atom "syntax-rules" : (List identifiers : rules)))] : bs) = do
+ -- TODO: error checking
+ _ <- defineNamespacedVar be macroNamespace keyword $ Syntax e identifiers rules
+ loadMacros e be bs
+loadMacros e be [] = return $ Nil ""
+loadMacros _ _ form = throwError $ BadSpecialForm "Unable to evaluate form" $ List form
diff --git a/hs-src/shell.hs b/hs-src/shell.hs
--- a/hs-src/shell.hs
+++ b/hs-src/shell.hs
@@ -67,7 +67,7 @@
putStrLn " | | | | |_| \\__ \\ < /// \\\\\\ \\__ \\ (__| | | | __/ | | | | | __/ "
putStrLn " |_| |_|\\__,_|___/_|\\_\\ /// \\\\\\ |___/\\___|_| |_|\\___|_| |_| |_|\\___| "
putStrLn " "
- putStrLn " husk Scheme Interpreter Version 3.4 "
+ putStrLn " husk Scheme Interpreter Version 3.4.1 "
putStrLn " (c) 2010-2011 Justin Ethier github.com/justinethier/husk-scheme "
putStrLn " "
diff --git a/husk-scheme.cabal b/husk-scheme.cabal
--- a/husk-scheme.cabal
+++ b/husk-scheme.cabal
@@ -1,5 +1,5 @@
Name: husk-scheme
-Version: 3.4
+Version: 3.4.1
Synopsis: R5RS Scheme interpreter program and library.
Description: A dialect of R5RS Scheme written in Haskell. Provides advanced
features including continuations, hygienic macros, a Haskell FFI,