husk-scheme 3.4 → 3.4.1
raw patch · 5 files changed
+61/−8 lines, 5 files
Files
- README.markdown +1/−1
- hs-src/Language/Scheme/Core.hs +18/−2
- hs-src/Language/Scheme/Macro.hs +40/−3
- hs-src/shell.hs +1/−1
- husk-scheme.cabal +1/−1
README.markdown view
@@ -8,7 +8,7 @@ Feature List -------------husk includes the following features from R<sup>5</sup>RS:+husk includes most features from R<sup>5</sup>RS, 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
hs-src/Language/Scheme/Core.hs view
@@ -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)]+
hs-src/Language/Scheme/Macro.hs view
@@ -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
hs-src/shell.hs view
@@ -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 " "
husk-scheme.cabal view
@@ -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,