husk-scheme 3.1 → 3.2
raw patch · 7 files changed
+84/−98 lines, 7 files
Files
- README.markdown +8/−1
- hs-src/Language/Scheme/Core.hs +5/−44
- hs-src/Language/Scheme/Macro.hs +1/−1
- hs-src/Language/Scheme/Parser.hs +62/−45
- hs-src/shell.hs +1/−1
- husk-scheme.cabal +1/−1
- stdlib.scm +6/−5
README.markdown view
@@ -31,8 +31,10 @@ - Hash tables, as specified by [SRFI 69](http://srfi.schemers.org/srfi-69/srfi-69.html) -husk scheme is available under the [MIT license](http://www.opensource.org/licenses/mit-license.php).+And the following R<sup>7</sup>RS draft features: +- Nested block comments using `#|` and `|#`+ Installation ------------ husk may be easily installed using [cabal](http://www.haskell.org/cabal/) - just run the following command:@@ -97,6 +99,11 @@ The `examples` directory contains example scheme programs. Patches are welcome; please send via pull request on github.++License+-------++husk scheme is available under the [MIT license](http://www.opensource.org/licenses/mit-license.php). Credits -------
hs-src/Language/Scheme/Core.hs view
@@ -148,7 +148,11 @@ eval env cont val@(Number _) = continueEval env cont val eval env cont val@(Bool _) = continueEval env cont val eval env cont val@(HashTable _) = continueEval env cont val-eval env cont val@(Vector _) = continueEval env cont val+eval env cont val@(Vector _) = do+ -- TODO: Issue #35 - not good enough to just return, need to ensure only constants (?) are part+ -- of the vector+ continueEval env cont val+-- throwError $ Default $ "Illegal expression (should be quoted): " ++ show val eval env cont (Atom a) = continueEval env cont =<< getVar env a -- Quote an expression by simply passing along the value@@ -262,49 +266,6 @@ case result of Bool True -> macroEval e conseq >>= eval e c _ -> continueEval e c $ Nil "" -- Unspecified return value per R5RS--{- OBSOLETE:--- TODO: convert cond to a derived form (scheme macro)--- TODO: is the 'bound' code below good enough? need to test w/else redefined.--- if not good enough, may just need to go all the way and rewrite all of this as a macro!-eval env cont args@(List (Atom "cond" : clauses)) = do- bound <- liftIO $ isBound env "cond"- if bound- then prepareApply env cont args -- if is bound to a variable in this scope; call into it- else if length clauses == 0- then throwError $ BadSpecialForm "No matching clause" $ String "cond"- else do- case (clauses !! 0) of- List [test, Atom "=>", expr] -> eval env (makeCPSWArgs env cont cpsAlt [test]) expr- List (Atom "else" : _) -> eval env (makeCPSWArgs env cont cpsResult clauses) $ Bool True- List (cond : _) -> eval env (makeCPSWArgs env cont cpsResult clauses) cond- badType -> throwError $ TypeMismatch "clause" badType- where- { - If a condition is true, evaluate that condition's expressions.- Otherwise just pick up at the next condition... - }- cpsResult :: Env -> LispVal -> LispVal -> Maybe [LispVal] -> IOThrowsError LispVal- cpsResult e cnt result (Just (c : cs)) =- case result of- Bool True -> evalCond e cnt c- _ -> eval env cnt $ List $ (Atom "cond" : cs)- cpsResult _ _ _ _ = throwError $ Default "Unexpected error in cond"-- -- Helper function for evaluating 'cond'- evalCond :: Env -> LispVal -> LispVal -> IOThrowsError LispVal- evalCond e c (List [_, expr]) = eval e c expr- evalCond e c (List (_ : expr)) = eval e c $ List (Atom "begin" : expr)- evalCond _ _ badForm = throwError $ BadSpecialForm "evalCond: Unrecognized special form" badForm-- -- Alternate "=>" form: expr was evaluated, now eval test- cpsAlt :: Env -> LispVal -> LispVal -> Maybe [LispVal] -> IOThrowsError LispVal- cpsAlt e c expr (Just [test]) = eval e (makeCPSWArgs e c cpsAltEvaled [expr]) test- cpsAlt _ _ _ _ = throwError $ Default "Unexpected error in cond"-- -- Alternate "=>" form: both test/expr are evaluated, now eval the form itself- cpsAltEvaled :: Env -> LispVal -> LispVal -> Maybe [LispVal] -> IOThrowsError LispVal- cpsAltEvaled _ c test (Just [expr]) = apply c expr [test]- cpsAltEvaled _ _ _ _ = throwError $ Default "Unexpected error in cond"--} eval env cont fargs@(List (Atom "begin" : funcs)) = do bound <- liftIO $ isBound env "begin"
hs-src/Language/Scheme/Macro.hs view
@@ -41,7 +41,7 @@ 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...+--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 http://community.schemewiki.org/?scheme-faq-macros -}
hs-src/Language/Scheme/Parser.hs view
@@ -23,18 +23,36 @@ import Numeric import Ratio import Text.ParserCombinators.Parsec hiding (spaces)+import Text.Parsec.Language+import qualified Text.Parsec.Token as P -symbol :: Parser Char-symbol = oneOf "!$%&|*+-/:<=>?@^_~"+lispDef :: LanguageDef ()+lispDef + = emptyDef + { P.commentStart = "#|"+ , P.commentEnd = "|#"+ , P.commentLine = ";"+ , P.nestedComments = True+ , P.identStart = letter <|> symbol+ , P.identLetter = letter <|> digit <|> symbol+ , P.reservedNames = []+ , P.caseSensitive = True+ } -spaces :: Parser ()-spaces = skipMany1 space+lexer = P.makeTokenParser lispDef+dot = P.dot lexer+parens = P.parens lexer+identifier = P.identifier lexer+-- TODO: typedef. starting point was: whiteSpace :: CharParser ()+whiteSpace = P.whiteSpace lexer+lexeme = P.lexeme lexer +symbol :: Parser Char+symbol = oneOf "!$%&|*+-/:<=>?@^_~."+ parseAtom :: Parser LispVal parseAtom = do- first <- letter <|> symbol <|> (oneOf ".")- rest <- many (letter <|> digit <|> symbol <|> (oneOf "."))- let atom = first : rest+ atom <- identifier if atom == "." then pzero -- Do not match this form else return $ Atom atom@@ -109,7 +127,7 @@ - -} parseRealNumber :: Parser LispVal parseRealNumber = do- sign <- many (oneOf "-")+ sign <- many (oneOf "-+") num <- many1 (digit) _ <- char '.' frac <- many1 (digit)@@ -126,7 +144,12 @@ -- 'e' -> return $ Float $ numbr _ -> return $ Float $ numbr return $ Float $ fst $ Numeric.readFloat dec !! 0 -}- 1 -> return $ Float $ (*) (-1.0) $ fst $ Numeric.readFloat dec !! 0++-- TODO: this is a hack, but need to support the + sign as well as the minus.++ 1 -> if sign == "-" + then return $ Float $ (*) (-1.0) $ fst $ Numeric.readFloat dec !! 0+ else return $ Float $ fst $ Numeric.readFloat dec !! 0 _ -> pzero parseRationalNumber :: Parser LispVal@@ -180,86 +203,80 @@ parseVector :: Parser LispVal parseVector = do- vals <- sepBy parseExpr spaces+ vals <- sepBy parseExpr whiteSpace return $ Vector (listArray (0, (length vals - 1)) vals) parseList :: Parser LispVal-parseList = liftM List $ sepBy parseExpr spaces+parseList = liftM List $ sepBy parseExpr whiteSpace+-- TODO: wanted to use endBy (or a variant) above, but it causes an error such that dotted lists are not parsed parseDottedList :: Parser LispVal parseDottedList = do- phead <- endBy parseExpr spaces- ptail <- char '.' >> spaces >> parseExpr+ phead <- endBy parseExpr whiteSpace+ ptail <- dot >> parseExpr --char '.' >> whiteSpace >> parseExpr return $ DottedList phead ptail parseQuoted :: Parser LispVal parseQuoted = do- _ <- char '\''+ _ <- lexeme $ char '\'' x <- parseExpr return $ List [Atom "quote", x] parseQuasiQuoted :: Parser LispVal parseQuasiQuoted = do- _ <- char '`'+ _ <- lexeme $ char '`' x <- parseExpr return $ List [Atom "quasiquote", x] parseUnquoted :: Parser LispVal parseUnquoted = do- _ <- try (char ',')+ _ <- try (lexeme $ char ',') x <- parseExpr return $ List [Atom "unquote", x] parseUnquoteSpliced :: Parser LispVal parseUnquoteSpliced = do- _ <- try (string ",@")+ _ <- try (lexeme $ string ",@") x <- parseExpr return $ List [Atom "unquote-splicing", x] --{- Comment parser-FUTURE: this is a hack, it should really not return anything...-a better solution might be to use a tokenizer as a-parser instead; need to investigate eventually. -}-parseComment :: Parser LispVal-parseComment = do- _ <- char ';'- _ <- many (noneOf ("\n"))- return $ Nil ""-- parseExpr :: Parser LispVal parseExpr =- try (parseComplexNumber)- <|> try (parseRationalNumber)- <|> parseComment- <|> try (parseRealNumber)- <|> try (parseNumber)- <|> parseChar+ try (lexeme parseComplexNumber)+ <|> try (lexeme parseRationalNumber)+ <|> try (lexeme parseRealNumber)+ <|> try (lexeme parseNumber)+ <|> lexeme parseChar <|> parseUnquoteSpliced- <|> do _ <- try (string "#(")+ <|> do _ <- try (lexeme $ string "#(") x <- parseVector- _ <- char ')'+ _ <- lexeme $ char ')' return x <|> try (parseAtom)- <|> parseString- <|> parseBool+ <|> lexeme parseString+ <|> lexeme parseBool <|> parseQuoted <|> parseQuasiQuoted <|> parseUnquoted- <|> do _ <- char '('- x <- try parseList <|> parseDottedList- _ <- char ')'- return x+ <|> try (parens parseList)+ <|> parens parseDottedList <?> "Expression" +mainParser :: Parser LispVal+mainParser = do+ _ <- whiteSpace+ x <- parseExpr+-- FUTURE? (seemed to break test cases, but is supposed to be best practice?) eof+ return x+ readOrThrow :: Parser a -> String -> ThrowsError a readOrThrow parser input = case parse parser "lisp" input of Left err -> throwError $ Parser err Right val -> return val readExpr :: String -> ThrowsError LispVal-readExpr = readOrThrow parseExpr+readExpr = readOrThrow mainParser readExprList :: String -> ThrowsError [LispVal]-readExprList = readOrThrow (endBy parseExpr spaces)+readExprList = readOrThrow (endBy mainParser whiteSpace)+
hs-src/shell.hs view
@@ -67,7 +67,7 @@ putStrLn " | | | | |_| \\__ \\ < /// \\\\\\ \\__ \\ (__| | | | __/ | | | | | __/ " putStrLn " |_| |_|\\__,_|___/_|\\_\\ /// \\\\\\ |___/\\___|_| |_|\\___|_| |_| |_|\\___| " putStrLn " "- putStrLn " husk Scheme Interpreter Version 3.1 "+ putStrLn " husk Scheme Interpreter Version 3.2 " 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.1+Version: 3.2 Synopsis: R5RS Scheme interpreter program and library. Description: A dialect of R5RS Scheme written in Haskell. Provides advanced features including continuations, non-hygienic macros, a Haskell FFI,
stdlib.scm view
@@ -327,7 +327,7 @@ (define hash-table-walk (lambda (ht proc) (map - (lambda (kv) (proc (car kv) (cdr kv)))+ (lambda (kv) (proc (car kv) (car (reverse kv)))) (hash-table->alist ht)))) (define (hash-table-update! hash-table key function)@@ -349,10 +349,11 @@ lst) ht)) --; FUTURE: Issue #11: hash-table-fold-;(define (hash-table-fold hash-table f init-value)-; TBD)+(define (hash-table-fold hash-table f acc-in)+ (let ((acc acc-in))+ (hash-table-walk hash-table + (lambda (key value) (set! acc (f key value acc))))+ acc)) ; FUTURE: Issue #10: from numeric section -