husk-scheme 2.1 → 2.2

raw patch · 6 files changed

+62/−21 lines, 6 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

+ Language.Scheme.Types: EOF :: LispVal

Files

README.markdown +1/−1
hs-src/Language/Scheme/Core.hs +19/−2
hs-src/Language/Scheme/Macro.hs +38/−16
hs-src/Language/Scheme/Types.hs +2/−0
hs-src/shell.hs +1/−1
husk-scheme.cabal +1/−1

README.markdown view

@@ -82,7 +82,7 @@  husk scheme is developed by [Justin Ethier](http://github.com/justinethier). -The interpreter is based on the code from the book [Write Yourself a Scheme in 48 Hours](http://en.wikibooks.org/wiki/Write_Yourself_a_Scheme_in_48_Hours) written by Jonathan Tang and hosted / maintained by Wikibooks.+The interpreter is based on code from the book [Write Yourself a Scheme in 48 Hours](http://en.wikibooks.org/wiki/Write_Yourself_a_Scheme_in_48_Hours) written by Jonathan Tang and hosted / maintained by Wikibooks.  If you would like to request changes, report bug fixes, or contact me, visit the project web site at [GitHub](http://github.com/justinethier/husk-scheme).

hs-src/Language/Scheme/Core.hs view

@@ -30,6 +30,7 @@ import List import IO hiding (try) import System.Directory (doesFileExist)+import System.IO.Error --import Debug.Trace  {-| Evaluate a string containing Scheme code.@@ -626,12 +627,23 @@  readProc :: [LispVal] -> IOThrowsError LispVal readProc [] = readProc [Port stdin]-readProc [Port port] = (liftIO $ hGetLine port) >>= liftThrows . readExpr+readProc [Port port] = do+    input <-  liftIO $ try (liftIO $ hGetLine port)+    case input of+        Left e -> if isEOFError e+                     then return $ EOF+                     else throwError $ Default "I/O error reading from port" -- FUTURE: ioError e+        Right inpStr -> do +            liftThrows $ readExpr inpStr  readProc args@(_ : _) = throwError $ BadSpecialForm "" $ List args  writeProc :: [LispVal] -> IOThrowsError LispVal writeProc [obj] = writeProc [obj, Port stdout]-writeProc [obj, Port port] = liftIO $ hPrint port obj >> (return $ Nil "")+writeProc [obj, Port port] = do+    output <- liftIO $ try (liftIO $ hPrint port obj)+    case output of+        Left e -> throwError $ Default "I/O error writing to port"+        Right _ -> return $ Nil "" writeProc other = if length other == 2                      then throwError $ TypeMismatch "(value port)" $ List other                       else throwError $ NumArgs 2 other@@ -729,6 +741,7 @@               ("integer?", isInteger),               ("list?", unaryOp isList),               ("null?", isNull),+              ("eof-object?", isEOFObject),               ("symbol?", isSymbol),               ("symbol->string", symbol2String),               ("string->symbol", string2Symbol),@@ -1049,6 +1062,10 @@ isNull :: [LispVal] -> ThrowsError LispVal isNull ([List []]) = return $ Bool True isNull _ = return $ Bool False++isEOFObject :: [LispVal] -> ThrowsError LispVal+isEOFObject ([EOF]) = return $ Bool True+isEOFObject _ = return $ Bool False  isSymbol :: [LispVal] -> ThrowsError LispVal isSymbol ([Atom _]) = return $ Bool True

hs-src/Language/Scheme/Macro.hs view

@@ -36,6 +36,7 @@ import Language.Scheme.Types import Language.Scheme.Variables import Control.Monad.Error+import Data.Array --import Debug.Trace -- Only req'd to support trace, can be disabled at any time...  -- Nice FAQ regarding macro's, points out some of the limitations of current implementation@@ -66,16 +67,14 @@   rest <- mapM (macroEval env) xs   return $ List $ first : rest +-- Inspect code for macro's ----- FUTURE: Issue #4--- equivalent matches/transforms for vectors, and what about dotted lists?+-- Only a list form is required because a pattern may only consist+-- of a list here. From the spec: ----- macroEval env (Vector v) = do--- macroEval env (DottedList ls l) = do+-- "The <pattern> in a <syntax rule> is a list <pattern> that +--  begins with the keyword for the macro." ----- but first, need to confirm such syntax is even allowed---- Inspect code for macro's macroEval env lisp@(List (Atom x : xs)) = do   isDefined <- liftIO $ isNamespacedBound env macroNamespace x   if isDefined@@ -147,7 +146,11 @@ loadLocal localEnv identifiers pattern input hasEllipsis outerHasEllipsis = do    case (pattern, input) of -       -- Future: vector+       -- For vectors, just use list match for now, since vector input matching just requires a+       -- subset of that behavior. Should be OK since parser would catch problems with trying+       -- to add pair syntax to a vector declaration.+       ((Vector p), (Vector i)) -> do+         loadLocal localEnv identifiers (List $ elems p) (List $ elems i) False outerHasEllipsis         ((DottedList ps p), (DottedList is i)) -> do          result <- loadLocal localEnv  identifiers (List ps) (List is) False outerHasEllipsis@@ -266,11 +269,9 @@                           _ -> throwError $ Default "Unexpected error in checkLocal (Atom)"                 else defineVar localEnv pattern (List [val]) --- FUTURE: Issue #4 - vector support. And what the heck are these next two lines doing here? :)------ , load into localEnv in some (all?) cases?: eqv [(Atom arg1), (Atom arg2)] = return $ Bool $ arg1 == arg2--- : eqv [(Vector arg1), (Vector arg2)] = eqv [List $ (elems arg1), List $ (elems arg2)] ---+checkLocal localEnv identifiers hasEllipsis pattern@(Vector _) input@(Vector _) = +  loadLocal localEnv identifiers pattern input False hasEllipsis+ checkLocal localEnv identifiers hasEllipsis pattern@(DottedList _ _) input@(DottedList _ _) =    loadLocal localEnv identifiers pattern input False hasEllipsis --  throwError $ BadSpecialForm "Test" input@@ -329,8 +330,27 @@                   Nil _ -> return lst                   _ -> throwError $ BadSpecialForm "Macro transform error" $ List [lst, (List l), Number $ toInteger ellipsisIndex] --- FUTURE: issue #4 - vector transform (and taking vectors into account in other cases as well???)+transformRule localEnv ellipsisIndex (List result) transform@(List ((Vector v) : ts)) (List ellipsisList) = do+  if macroElementMatchesMany transform+     then do +             -- Idea here is that we need to handle case where you have (vector ...) - EG: (#(var step) ...)+             curT <- transformRule localEnv (ellipsisIndex + 1) (List []) (List $ elems v) (List result)+             case curT of+               Nil _ -> if ellipsisIndex == 0+                                -- First time through and no match ("zero" case). Use tail to move past the "..."+                           then transformRule localEnv 0 (List $ result) (List $ tail ts) (List [])  +                                -- Done with zero-or-more match, append intermediate results (ellipsisList) and move past the "..."+                           else transformRule localEnv 0 (List $ ellipsisList ++ result) (List $ tail ts) (List [])+               List t -> transformRule localEnv (ellipsisIndex + 1) (List $ result ++ [asVector t]) transform (List ellipsisList)+               _ -> throwError $ Default "Unexpected error in transformRule"+     else do lst <- transformRule localEnv ellipsisIndex (List []) (List $ elems v) (List ellipsisList)+             case lst of+                  List l -> do+                      transformRule localEnv ellipsisIndex (List $ result ++ [asVector l]) (List ts) (List ellipsisList)+                  Nil _ -> return lst+                  _     -> throwError $ BadSpecialForm "transformRule: Macro transform error" $ List [(List ellipsisList), lst, (List [Vector v]), Number $ toInteger ellipsisIndex] + where asVector lst = (Vector $ (listArray (0, length lst - 1)) lst)  transformRule localEnv ellipsisIndex (List result) transform@(List (dl@(DottedList _ _) : ts)) (List ellipsisList) = do   if macroElementMatchesMany transform@@ -463,7 +483,8 @@     initializePatternVars localEnv src identifiers $ List ps     initializePatternVars localEnv src identifiers p --- FUTURE: Issue #4: vector+initializePatternVars localEnv src identifiers (Vector v) = do+    initializePatternVars localEnv src identifiers $ List $ elems v  initializePatternVars localEnv src identifiers (Atom pattern) =          -- FUTURE:@@ -502,7 +523,8 @@         Bool False -> lookupPatternVarSrc localEnv p         _ -> return result --- FUTURE: Issue #4: vector+lookupPatternVarSrc localEnv (Vector v) = do+    lookupPatternVarSrc localEnv $ List $ elems v  lookupPatternVarSrc localEnv (Atom pattern) =       do isDefined <- liftIO $ isNamespacedBound localEnv "src" pattern

hs-src/Language/Scheme/Types.hs view

@@ -141,6 +141,7 @@                         -- FUTURE: stack (for dynamic wind)                        }          -- ^Continuation+ 	| EOF  	| Nil String          -- ^Internal use only; do not use this type directly. @@ -214,6 +215,7 @@ -- |Create a textual description of a 'LispVal' showVal :: LispVal -> String showVal (Nil _) = ""+showVal (EOF) = "#!EOF" showVal (String contents) = "\"" ++ contents ++ "\"" showVal (Char chr) = [chr] showVal (Atom name) = name

hs-src/shell.hs view

@@ -52,7 +52,7 @@   putStrLn " | | | | |_| \\__ \\   <    /// \\\\\\   \\__ \\ (__| | | |  __/ | | | | |  __/ "   putStrLn " |_| |_|\\__,_|___/_|\\_\\  ///   \\\\\\  |___/\\___|_| |_|\\___|_| |_| |_|\\___| "   putStrLn "                                                                         "-  putStrLn " husk Scheme Interpreter                                     Version 2.1 "+  putStrLn " husk Scheme Interpreter                                     Version 2.2 "   putStrLn " (c) 2010 Justin Ethier              github.com/justinethier/husk-scheme "   putStrLn "                                                                         "

husk-scheme.cabal view

@@ -1,5 +1,5 @@ Name:                husk-scheme-Version:             2.1+Version:             2.2 Synopsis:            R5RS Scheme interpreter program and library. Description:         Husk is a dialect of Scheme written in Haskell that implements                       a subset of the R5RS standard. Advanced R5RS features are