husk-scheme 3.14 → 3.15
raw patch · 19 files changed
+622/−86 lines, 19 files
Files
- ChangeLog.markdown +28/−0
- README.markdown +12/−8
- hs-src/Language/Scheme/Core.hs +11/−6
- hs-src/Language/Scheme/Environments.hs +14/−4
- hs-src/Language/Scheme/Macro.hs +2/−5
- hs-src/Language/Scheme/Primitives.hs +91/−10
- husk-scheme.cabal +12/−4
- lib/core.scm +154/−8
- lib/husk/pretty-print.sld +2/−1
- lib/husk/random.sld +1/−1
- lib/scheme/base.sld +14/−14
- lib/scheme/case-lambda.sld +16/−11
- lib/scheme/char.sld +2/−2
- lib/scheme/process-context.sld +3/−1
- lib/scheme/r5rs.sld +220/−9
- lib/scheme/time.sld +2/−2
- lib/srfi/1.sld +5/−0
- lib/srfi/2.sld +5/−0
- lib/srfi/69.sld +28/−0
ChangeLog.markdown view
@@ -1,3 +1,31 @@+v3.15+--------++The big change for this release is an online [User Manual](http://justinethier.github.io/husk-scheme/manual/index.html) based on the R<sup>7</sup>RS, that documents Husk's Scheme and Haskell APIs, and explains the Scheme language as implemented by Husk. This is going to be a work-in-progress but is mostly complete, and can be used immediately as a reference.++In addition, many smaller fixes and enhancements are included:++- Improved library support so that examples no longer require running in a special mode.+- Added missing functions to `(scheme base)`.+- Added support for the `(scheme case-lambda)` and `(scheme r5rs)` libraries.+- Added libraries for SRFI 1, 2, and 69 so that these features are available via `import`. + - For example: `(import (srfi 1))`.+- Added `exact-integer-sqrt` from R<sup>7</sup>RS, using the Chibi scheme reference implementation.+- Added `let-values` and `let*-values` from R<sup>7</sup>RS.+- Added the following I/O functions:+ - `binary-port?`+ - `close-port`+ - `input-port-open?`+ - `open-binary-input-file`+ - `open-binary-output-file`+ - `output-port-open?`+ - `read-bytevector`+ - `textual-port?`+ - `u8-ready?`+ - `write-bytevector`+- Allow character and string comparison predicates (such as `string=?` and `char=?`) to support more than two arguments.+- Fixed `cond-expand` to support `and` / `or` clauses.+- Renamed `char-upper` and `char-lower` to `char-upcase` and `char-downcase` to match the Scheme specs. v3.14 --------
README.markdown view
@@ -1,21 +1,23 @@ [<img src="https://github.com/justinethier/husk-scheme/raw/master/docs/husk-scheme.png" alt="husk-scheme">](http://justinethier.github.com/husk-scheme) -husk is a dialect of Scheme written in Haskell that implements a superset of the [R<sup>5</sup>RS standard](http://www.schemers.org/Documents/Standards/R5RS/HTML/). Advanced R<sup>5</sup>RS features are provided including continuations, hygienic macros, and a full numeric tower.+Husk is a dialect of Scheme written in Haskell that implements a superset of the [R<sup>5</sup>RS standard](http://www.schemers.org/Documents/Standards/R5RS/HTML/) and a large portion of the R<sup>7</sup>RS-small language. Advanced features are provided including continuations, hygienic macros, libraries, and a full numeric tower. -husk may be used as either a stand-alone interpreter or as an extension language within a larger Haskell application. By closely following the R<sup>5</sup>RS standard, the intent is to develop a Scheme that is as compatible as possible with other R<sup>5</sup>RS Schemes. husk is mature enough for use in production applications, however it is not optimized for performance-critical applications. +Husk may be used as either a stand-alone interpreter or as an extension language within a larger Haskell application. By closely following the R<sup>5</sup>RS standard, the intent is to develop a Scheme that is as compatible as possible with other R<sup>5</sup>RS Schemes. Husk is mature enough for use in production applications, however it is not optimized for performance-critical applications. Scheme is one of two main dialects of Lisp. Scheme follows a minimalist design philosophy: the core language consists of a small number of fundamental forms which may be used to implement other built-in forms. Scheme is an excellent language for writing small, elegant programs, and may also be used to write scripts or embed scripting functionality within a larger application. +More information is available on the [husk website](http://justinethier.github.com/husk-scheme).+ Installation -------------The [Glasgow Haskell Compiler](http://www.haskell.org/ghc/) (GHC) is required to build, install, and run husk. All recent versions of GHC are supported, including 7.0, 7.2, 7.4, and 7.6. The easiest way to get GHC is via the [Haskell Platform](http://hackage.haskell.org/platform/).+The [Glasgow Haskell Compiler](http://www.haskell.org/ghc/) (GHC) is required to build, install, and run Husk. All recent versions of GHC are supported, including 7.0, 7.2, 7.4, and 7.6. The easiest way to get GHC is via the [Haskell Platform](http://hackage.haskell.org/platform/). -husk may be installed using [cabal](http://www.haskell.org/cabal/):+Husk may be installed using [cabal](http://www.haskell.org/cabal/): cabal update cabal install husk-scheme -Before running husk you may also need to add the cabal executable directory to your path. On Linux this is `~/.cabal/bin`. Now you are ready to start up the interpreter:+Before running Husk you may also need to add the cabal executable directory to your path. On Linux this is `~/.cabal/bin`. Now you are ready to start up the interpreter: justin@my-pc$ huski _ _ __ _ @@ -34,15 +36,17 @@ huski> (hello) world -husk has been tested on Windows, Linux, and FreeBSD.+Husk has been tested on Windows, Linux, and FreeBSD. -More information is available on the [husk website](http://justinethier.github.com/husk-scheme).+Documentation+-------------+The online [user manual](http://justinethier.github.io/husk-scheme/manual/index.html) provides an overview of the Scheme language as implemented by Husk, instructions for using the Haskell API, an alphabetical index of Scheme functions, and more. License ------- Copyright (C) 2010 [Justin Ethier](http://github.com/justinethier) -husk scheme is available under the [MIT license](http://www.opensource.org/licenses/mit-license.php).+Husk scheme is available under the [MIT license](http://www.opensource.org/licenses/mit-license.php). 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.
hs-src/Language/Scheme/Core.hs view
@@ -72,7 +72,7 @@ -- |husk version number version :: String-version = "3.14"+version = "3.15" -- |A utility function to display the husk console banner showBanner :: IO ()@@ -1063,11 +1063,15 @@ _ <- evalString metaEnv $ "(load \"" ++ (escapeBackslashes metalib) ++ "\")" -- Load meta-env so we can find it later _ <- evalLisp' env $ List [Atom "define", Atom "*meta-env*", LispEnv metaEnv]- -- Load (r5rs base)- _ <- evalString metaEnv- "(add-module! '(scheme r5rs) (make-module #f (interaction-environment) '()))"+ -- Load base primitives+ _ <- evalLisp' metaEnv $ List [Atom "add-module!", List [Atom "quote", List [Atom "scheme"]], List [Atom "make-module", Bool False, LispEnv env {-baseEnv-}, List [Atom "quote", List []]]]+-- _ <- evalString metaEnv+-- "(add-module! '(scheme r5rs) (make-module #f (interaction-environment) '()))" timeEnv <- liftIO $ r7rsTimeEnv _ <- evalLisp' metaEnv $ List [Atom "add-module!", List [Atom "quote", List [Atom "scheme", Atom "time", Atom "posix"]], List [Atom "make-module", Bool False, LispEnv timeEnv, List [Atom "quote", List []]]]++ processContextEnv <- liftIO $ r7rsProcessContextEnv+ _ <- evalLisp' metaEnv $ List [Atom "add-module!", List [Atom "quote", List [Atom "scheme", Atom "process-context"]], List [Atom "make-module", Bool False, LispEnv processContextEnv, List [Atom "quote", List []]]] _ <- evalLisp' metaEnv $ List [ Atom "define", Atom "library-exists?",@@ -1078,6 +1082,9 @@ return env -- |Load the standard r7rs environment, including libraries+--+-- Note that the only difference between this and the r5rs equivalent is that+-- slightly less Scheme code is loaded initially. r7rsEnv :: IO Env r7rsEnv = do env <- r7rsEnv'@@ -1086,8 +1093,6 @@ return env -- |Load the standard r7rs environment------ TODO: This is just a stub, do not try using it yet! -- r7rsEnv' :: IO Env r7rsEnv' = do
hs-src/Language/Scheme/Environments.hs view
@@ -28,14 +28,22 @@ {- I/O primitives Primitive functions that execute within the IO monad -} ioPrimitives :: [(String, [LispVal] -> IOThrowsError LispVal)]-ioPrimitives = [("open-input-file", makePort ReadMode),- ("open-output-file", makePort WriteMode),+ioPrimitives = [("open-input-file", makePort openFile ReadMode),+ ("open-binary-input-file", makePort openBinaryFile ReadMode),+ ("open-output-file", makePort openFile WriteMode),+ ("open-binary-output-file", makePort openBinaryFile WriteMode),+ ("close-port", closePort), ("close-input-port", closePort), ("close-output-port", closePort), ("flush-output-port", flushOutputPort),+ ("textual-port?", isTextPort),+ ("binary-port?", isBinaryPort),+ ("input-port-open?", isInputPortOpen),+ ("output-port-open?", isOutputPortOpen), ("input-port?", isInputPort), ("output-port?", isOutputPort), ("char-ready?", isCharReady),+ ("u8-ready?", isCharReady), -- Good enough? -- The following optional procedures are NOT implemented: --@@ -52,9 +60,11 @@ ("read", readProc True), ("read-line", readProc False), ("read-char", readCharProc hGetChar),+ ("read-bytevector", readByteVector), ("peek-char", readCharProc hLookAhead), ("write", writeProc (\ port obj -> hPrint port obj)), ("write-char", writeCharProc),+ ("write-bytevector", writeByteVector), ("display", writeProc (\ port obj -> do case obj of String str -> hPutStr port str@@ -221,8 +231,8 @@ ("char-lower-case?", charPredicate Data.Char.isLower), ("char->integer", char2Int), ("integer->char", int2Char),- ("char-upper", charUpper),- ("char-lower", charLower),+ ("char-upcase", charUpper),+ ("char-downcase", charLower), ("digit-value", charDigitValue), ("procedure?", isProcedure),
hs-src/Language/Scheme/Macro.hs view
@@ -1230,12 +1230,9 @@ return $ appendNil (Matches.getData var ellipsisIndex) isImproperPattern isImproperInput - else if length v > 0 - then return var -- Just return the elements directly, so all can be appended- else return $ Nil "" -- A 0 match case, flag it to calling code+ else return var -- no ellipsis, just return elements directly, so all can be appended _ -> if ellipsisLevel > 0- then -- List req'd for 0-or-n match- throwError $ Default "Unexpected error processing data in transformRule" + then return var -- Let this pass, in case var is not involved in o-to-n match else return var else do -- Rename each encountered symbol, but the trick is that we want to give
hs-src/Language/Scheme/Primitives.hs view
@@ -117,13 +117,19 @@ , flushOutputPort , currentOutputPort , currentInputPort + , isTextPort+ , isBinaryPort , isOutputPort , isInputPort+ , isInputPortOpen+ , isOutputPortOpen , isCharReady , readProc , readCharProc + , readByteVector , writeProc , writeCharProc+ , writeByteVector , readContents , load , readAll@@ -180,11 +186,15 @@ -- -- Returns: Port ---makePort :: IOMode -> [LispVal] -> IOThrowsError LispVal-makePort mode [String filename] = liftM Port $ liftIO $ openFile filename mode-makePort mode [p@(Pointer _ _)] = recDerefPtrs p >>= box >>= makePort mode-makePort _ [] = throwError $ NumArgs (Just 1) []-makePort _ args@(_ : _) = throwError $ NumArgs (Just 1) args+makePort+ :: (FilePath -> IOMode -> IO Handle)+ -> IOMode+ -> [LispVal]+ -> IOThrowsError LispVal+makePort openFnc mode [String filename] = liftM Port $ liftIO $ openFnc filename mode+makePort fnc mode [p@(Pointer _ _)] = recDerefPtrs p >>= box >>= makePort fnc mode+makePort _ _ [] = throwError $ NumArgs (Just 1) []+makePort _ _ args@(_ : _) = throwError $ NumArgs (Just 1) args -- |Close the given port --@@ -227,6 +237,40 @@ flushOutputPort [Port port] = liftIO $ hFlush port >> (return $ Bool True) flushOutputPort _ = return $ Bool False +isTextPort :: [LispVal] -> IOThrowsError LispVal+isTextPort [Port port] = do+ val <- liftIO $ isTextPort' port+ return $ Bool val+isTextPort _ = return $ Bool False++isBinaryPort :: [LispVal] -> IOThrowsError LispVal+isBinaryPort [Port port] = do+ val <- liftIO $ isTextPort' port+ return $ Bool $ not val+isBinaryPort _ = return $ Bool False++-- | Determine if a file handle is in text mode+isTextPort' port = do+ textEncoding <- hGetEncoding port+ case textEncoding of+ Nothing -> return False+ _ -> return True+++isInputPortOpen :: [LispVal] -> IOThrowsError LispVal+isInputPortOpen [Port port] = do+ r <- liftIO $ hIsReadable port+ o <- liftIO $ hIsOpen port+ return $ Bool $ r && o+isInputPortOpen _ = return $ Bool False++isOutputPortOpen :: [LispVal] -> IOThrowsError LispVal+isOutputPortOpen [Port port] = do+ w <- liftIO $ hIsWritable port+ o <- liftIO $ hIsOpen port+ return $ Bool $ w && o+isOutputPortOpen _ = return $ Bool False+ -- |Determine if the given objects is an input port -- -- LispVal Arguments:@@ -314,6 +358,21 @@ return $ Char inpChr readCharProc _ args@(_ : _) = throwError $ BadSpecialForm "" $ List args +readByteVector :: [LispVal] -> IOThrowsError LispVal+readByteVector [Number n, Port port] = do+ input <- liftIO $ try' (liftIO $ BS.hGet port $ fromInteger n)+ case input of+ Left e -> if isEOFError e+ then return $ EOF+ else throwError $ Default "I/O error reading from port"+ Right inBytes -> do+ if BS.null inBytes+ then return $ EOF+ else return $ ByteVector inBytes+readByteVector args = if length args == 2+ then throwError $ TypeMismatch "(k port)" $ List args+ else throwError $ NumArgs (Just 2) args+ -- |Write to the given port -- -- LispVal Arguments:@@ -361,6 +420,18 @@ then throwError $ TypeMismatch "(character port)" $ List other else throwError $ NumArgs (Just 2) other +writeByteVector :: [LispVal] -> IOThrowsError LispVal+writeByteVector [obj, Port port] = do+ ByteVector bs <- recDerefPtrs obj -- Last opportunity to do this before writing+ output <- liftIO $ try' (liftIO $ BS.hPut port bs)+ case output of+ Left _ -> throwError $ Default "I/O error writing to port"+ Right _ -> return $ Nil ""+writeByteVector other = + if length other == 2+ then throwError $ TypeMismatch "(bytevector port)" $ List other+ else throwError $ NumArgs (Just 2) other+ -- |Determine if the given file exists -- -- Arguments:@@ -1239,7 +1310,7 @@ List l <- stringToList args return $ Vector $ listArray (0, length l - 1) l vectorToString :: [LispVal] -> IOThrowsError LispVal-vectorToString [p@(Pointer _ _)] = derefPtr p >>= box >>= listToString+vectorToString [p@(Pointer _ _)] = derefPtr p >>= box >>= vectorToString --vectorToString [(List [])] = return $ String "" --vectorToString [(List l)] = liftThrows $ buildString l vectorToString [(Vector v)] = do@@ -1542,11 +1613,21 @@ -- |Helper function to perform a binary logic operation on two LispVal arguments. boolBinop :: (LispVal -> ThrowsError a) -> (a -> a -> Bool) -> [LispVal] -> ThrowsError LispVal-boolBinop unpacker op args = if length args /= 2+boolBinop unpacker op args = if length args < 2 then throwError $ NumArgs (Just 2) args- else do left <- unpacker $ args !! 0- right <- unpacker $ args !! 1- return $ Bool $ left `op` right+ else do+ result <- cmp op (head args) (tail args)+ return $ Bool result+ where + cmp op b1 (b2 : bs) = do+ b1' <- unpacker b1+ b2' <- unpacker b2+ let result = op b1' b2'+ if result+ then cmp op b2 bs+ else return False+ cmp _ _ _ = return True+ -- |Perform the given function against a single LispVal argument unaryOp :: (LispVal -> ThrowsError LispVal) -> [LispVal] -> ThrowsError LispVal
husk-scheme.cabal view
@@ -1,11 +1,11 @@ Name: husk-scheme-Version: 3.14+Version: 3.15 Synopsis: R5RS Scheme interpreter, compiler, and library. Description: <<https://github.com/justinethier/husk-scheme/raw/master/docs/husk-scheme.png>> .- A dialect of R5RS Scheme written in Haskell. Advanced - features are provided including:+ Husk is a dialect of Scheme written in Haskell that implements a superset of + the R5RS standard. Advanced features are provided including: . * First-class continuations of unlimited extent .@@ -13,6 +13,8 @@ . * Low-level explicit renaming macros .+ * Library syntax from the R7RS standard+ . * A foreign function interface (FFI) to Haskell . * Full numeric tower providing support for real, rational, and complex numbers@@ -26,6 +28,12 @@ Husk may be used as either a stand-alone interpreter or as an extension language within a larger Haskell application. By closely following the R5RS standard, the intent is to develop a Scheme that is as compatible as possible with other R5RS Schemes. Husk is mature enough for use in production, however it is not optimized for performance-critical applications. . Scheme is one of two main dialects of Lisp. Scheme follows a minimalist design philosophy: the core language consists of a small number of fundamental forms which may be used to implement other built-in forms. Scheme is an excellent language for writing small, elegant programs, and may also be used to write scripts or embed scripting functionality within a larger application.+ .+ For documentation and examples, see + <http://justinethier.github.io/husk-scheme/documentation.html>.+ .+ For detailed information on each release, see + <http://justinethier.github.io/husk-scheme/news.html>. License: MIT License-file: LICENSE@@ -42,7 +50,7 @@ ChangeLog.markdown LICENSE AUTHORS-Data-Files: lib/*.scm lib/husk/*.sld lib/husk/*.scm lib/scheme/*.sld lib/srfi/*.scm+Data-Files: lib/*.scm lib/husk/*.sld lib/husk/*.scm lib/scheme/*.sld lib/srfi/*.scm lib/srfi/*.sld Source-Repository head Type: git
lib/core.scm view
@@ -14,10 +14,6 @@ (define (list . objs) objs) (define (id obj) obj) -; TODO: this is not flipping args. not part of R5RS, but -; as it is now, what is the point?-(define (flip func) (lambda (arg1 arg2) (func arg1 arg2)))- (define (curry func arg1) (lambda (arg) (apply func (cons arg1 (list arg))))) (define (compose f g) (lambda (arg) (f (apply g arg)))) @@ -35,6 +31,13 @@ (define (product . lst) (foldl * 1 lst)) (define (square z) (* z z)) +(define (exact-integer-sqrt x)+ (let ((res (sqrt x)))+ (if (exact? res)+ (values res 0)+ (let ((res (inexact->exact (truncate res))))+ (values res (- x (* res res)))))))+ ; Forms from R5RS for and/or (define-syntax and (syntax-rules ()@@ -68,7 +71,7 @@ (and (exact? num) (integer? num))) (define (length lst) (foldl (lambda (x y) (+ y 1)) 0 lst))-(define (reverse lst) (foldl (flip cons) '() lst))+(define (reverse lst) (foldl cons '() lst)) (define-syntax begin (syntax-rules ()@@ -565,6 +568,7 @@ ;; END ;; More functions from r7rs+(define (features) *features*) (define-syntax def-copy-in-place (er-macro-transformer (lambda (expr rename compare)@@ -580,6 +584,23 @@ (def-copy-in-place vector) ;; END +;; Simplified versions of every/any from SRFI-1+(define (any pred lst)+ (let any* ((l (map pred lst)))+ (cond+ ((null? l) #f) ; Empty list+ ((car l) #t) ; Done+ (else + (any* (cdr l))))))+(define (every pred lst)+ (let every* ((l (map pred lst)))+ (cond+ ((null? l) #t) ; Empty list+ ((car l)+ (every* (cdr l)))+ (else + #f))))+ ;; Macros from r7rs (define-syntax when (syntax-rules ()@@ -602,6 +623,132 @@ (er-macro-transformer (lambda (expr rename compare) (apply error (cdr expr)))))++(define-syntax+ let-values+ (syntax-rules+ ()+ ((let-values (binding ...) body0 body1 ...)+ (let-values+ "bind"+ (binding ...)+ ()+ ((lambda () body0 body1 ...))))+ ;(begin body0 body1 ...)))+ ((let-values "bind" () tmps body)+ (let tmps body))+ ((let-values+ "bind"+ ((b0 e0) binding ...)+ tmps+ body)+ (let-values+ "mktmp"+ b0+ e0+ ()+ (binding ...)+ tmps+ body))+ ((let-values+ "mktmp"+ ()+ e0+ args+ bindings+ tmps+ body)+ (call-with-values+ (lambda () e0)+ (lambda args+ (let-values "bind" bindings tmps body))))+ ((let-values+ "mktmp"+ (a . b)+ e0+ (arg ...)+ bindings+ (tmp ...)+ body)+ (let-values+ "mktmp"+ b+ e0+ (arg ... x)+ bindings+ (tmp ... (a x))+ body))+ ((let-values+ "mktmp"+ a+ e0+ (arg ...)+ bindings+ (tmp ...)+ body)+ (call-with-values+ (lambda () e0)+ ;(lambda (arg ... x)+ (lambda (arg ... . x)+ (let-values "bind" bindings (tmp ... (a x)) body))))))++(define-syntax let*-values+ (syntax-rules ()+ ((let*-values () body0 body1 ...)+ (let () body0 body1 ...))++ ((let*-values (binding0 binding1 ...)+ body0 body1 ...)+ (let-values (binding0)+ (let*-values (binding1 ...)+ body0 body1 ...)))))++;; TODO:+;; (define-syntax define-values+;; (syntax-rules ()+;; ((define-values () expr)+;; (define dummy+;; (call-with-values (lambda () expr)+;; (lambda args #f))))+;; +;; ((define-values (var) expr)+;; (define var expr))+;; +;; ((define-values (var0 var1 ... varn) expr)+;; ;(begin+;; ((lambda ()+;; (define var0+;; (call-with-values (lambda () expr)+;; list))+;; (define var1+;; (let ((v (cadr var0)))+;; (set-cdr! var0 (cddr var0))+;; v)) ...+;; (define varn+;; (let ((v (cadr var0)))+;; (set! var0 (car var0))+;; v)))))+;; +;; ; ((define-values (var0 var1 ... . varn) expr)+;; ; ;(begin+;; ; ((lambda ()+;; ; (define var0+;; ; (call-with-values (lambda () expr)+;; ; list))+;; ; (define var1+;; ; (let ((v (cadr var0)))+;; ; (set-cdr! var0 (cddr var0))+;; ; v)) ...+;; ; (define varn+;; ; (let ((v (cdr var0)))+;; ; (set! var0 (car var0))+;; ; v)))))+;; +;; ((define-values var expr)+;; (define var+;; (call-with-values (lambda () expr)+;; list)))))+ ;; ;; SRFI-0 (cond-expand) from r7rs ;;@@ -612,9 +759,8 @@ (define (check x) (if (pair? x) (case (car x)-; TODO: these fail because and/or not part of stdlib, but SRFI 1-; TODO: ((and) (every check (cdr x)))-; TODO: ((or) (any check (cdr x)))+ ((and) (every check (cdr x)))+ ((or) (any check (cdr x))) ((not) (not (check (cadr x)))) ((library) (eval `(module-exists? ',(cadr x)) *meta-env*)) (else (error "cond-expand: bad feature" x)))
lib/husk/pretty-print.sld view
@@ -1,4 +1,5 @@ (define-library (husk pretty-print) (export pretty-print)- (import (scheme r5rs))+ (import (scheme base)+ (scheme write)) (include "pp-sexp.scm"))
lib/husk/random.sld view
@@ -2,6 +2,6 @@ (export random randint)- (import (scheme r5rs))+ (import (scheme base)) (include "random.scm"))
lib/scheme/base.sld view
@@ -160,11 +160,11 @@ zero? ;=>- ;binary-port?- ;boolean=?+ binary-port?+ boolean=? ;bytevector-u8-set! ;call-with-port- ;close-port+ close-port cond-expand ;current-error-port ;define@@ -176,10 +176,10 @@ ;error-object-irritants ;error-object-message ;error-object?- ;exact-integer-sqrt+ exact-integer-sqrt exact-integer? exact?- ;features+ features ;file-error? ;floor-quotient ;floor-remainder@@ -190,11 +190,11 @@ ;guard ;if inexact?- ;input-port-open?+ input-port-open? ;lambda- ;let*-values+ let*-values ;let-syntax- ;let-values+ let-values letrec* ;letrec-syntax list-copy@@ -205,7 +205,7 @@ ;open-input-string ;open-output-bytevector ;open-output-string- ;output-port-open?+ output-port-open? ;parameterize ;peek-u8 ;port?@@ -224,30 +224,30 @@ square string->vector string-copy!- ;string-fill!+ string-fill! string-for-each string-map ;string-set! ;symbol=? syntax-error ;syntax-rules- ;textual-port?+ textual-port? ;truncate-quotient ;truncate-remainder ;truncate/ ;u8-ready?- ;unless+ unless ;unquote ;unquote-splicing vector->string vector-append vector-copy vector-copy!- ;vector-fill!+ vector-fill! vector-for-each vector-map ;vector-set!- ;when+ when ;with-exception-handler ;write-bytevector ;write-string
lib/scheme/case-lambda.sld view
@@ -25,19 +25,24 @@ ((cl (syntax-rules ::: () ((cl) (error "no matching clause"))- ((cl ((p :::) . body) . rest)+ ((cl ((p :::) body :::) rest :::)+ ;((cl ((p :::) . body) . rest) (if (= len (length '(p :::))) (apply (lambda (p :::)- . body)+ body :::)+ ;. body) args)- (cl . rest)))- ((cl ((p ::: . tail) . body)- . rest)- (if (>= len (length '(p :::)))- (apply- (lambda (p ::: . tail)- . body)- args)- (cl . rest))))))+ (cl rest :::)))+ ;(cl . rest)))+ ; TODO: for now, var-length arg support is broken+ ;((cl ((p ::: . tail) . body)+ ; . rest)+ ; (if (>= len (length '(p :::)))+ ; (apply+ ; (lambda (p ::: . tail)+ ; . body)+ ; args)+ ; (cl . rest)))+ ))) (cl (params body0 ...) ...))))))) ))
lib/scheme/char.sld view
@@ -15,11 +15,11 @@ char-ci=? char-ci>=? char-ci>?- ;char-downcase+ char-downcase ;char-foldcase char-lower-case? char-numeric?- ;char-upcase+ char-upcase char-upper-case? char-whitespace? digit-value
lib/scheme/process-context.sld view
@@ -9,7 +9,9 @@ (define-library (scheme process-context) (export -+ system+ exit-success+ exit-fail ; TODO: ; command-line ; emergency-exit
lib/scheme/r5rs.sld view
@@ -7,12 +7,223 @@ ;;; r7rs-small r5rs library ;;; --; TODO: well obviously this won't work, since it includes itself-; need a way to load r5rsEnv on demand. unfortunately the direct bindings-; null-env, etc are supposed to be in r5rs. so may need a husk-specific-; function to do it...-;-;(define-library (scheme r5rs)-; (export-all)-; (import (scheme r5rs)))+(define-library (scheme r5rs)+ (export+ * + ++ - + /+ < + <=+ = + >+ >= + abs+ acos + and+ angle + append+ apply + asin+ assoc + assq+ assv + atan+ begin + boolean?+ caaaar + caaadr+ caaar + caadar+ caaddr + caadr+ caar + cadaar+ cadadr + cadar+ caddar + cadddr+ caddr + cadr+ call-with-current-continuation+ call-with-input-file + call-with-output-file+ call-with-values + car+ case + cdaaar+ cdaadr + cdaar+ cdadar + cdaddr+ cdadr + cdar+ cddaar + cddadr+ cddar + cdddar+ cddddr + cdddr+ cddr + cdr+ ceiling + char->integer+ char-alphabetic? + char-ci<=?+ char-ci<? + char-ci=?+ char-ci>=? + char-ci>?+ char-downcase + char-lower-case?+ char-numeric? + char-ready?+ char-upcase + char-upper-case?+ char-whitespace? + char<=?+ char<? + char=?+ char>=? + char>?+ char? + close-input-port+ close-output-port + complex?+ cond + cons+ cos + current-input-port+ current-output-port + ;define+ ;define-syntax + delay+ denominator + display+ do + dynamic-wind+ eof-object? + eq?+ equal? + eqv?+ eval + even?+ exact->inexact + exact?+ exp + expt+ floor + for-each+ force + gcd+ ;if + imag-part+ inexact->exact + inexact?+ input-port? + integer->char+ integer? + interaction-environment+ ;lambda + lcm+ length + let+ let* + ;let-syntax+ letrec + ;letrec-syntax+ list + list->string+ list->vector + list-ref+ list-tail + list?+ load + log+ magnitude + make-polar+ make-rectangular + make-string+ make-vector + map+ max + member+ memq + memv+ min + modulo+ negative? + newline+ not + null-environment+ null? + number->string+ number? + numerator+ odd? + open-input-file+ open-output-file + or+ output-port? + pair?+ peek-char + positive?+ procedure? + quasiquote+ ;quote + quotient+ rational? + rationalize+ read + read-char+ real-part + real?+ remainder + reverse+ round+ ;scheme-report-environment+ ;set! + ;set-car!+ ;set-cdr! + sin+ sqrt + string+ string->list + string->number+ string->symbol + string-append+ string-ci<=? + string-ci<?+ string-ci=? + string-ci>=?+ string-ci>? + string-copy+ string-fill! + string-length+ string-ref + ;string-set!+ string<=? + string<?+ string=? + string>=?+ string>? + string?+ substring + symbol->string+ symbol? + tan+ truncate + values+ vector + vector->list+ vector-fill! + vector-length+ vector-ref + ;vector-set!+ vector? + ;optional in r5rs - with-input-from-file+ ;optional in r5rs - with-output-to-file + write+ write-char + zero?)+ (import (scheme)))
lib/scheme/time.sld view
@@ -13,9 +13,9 @@ current-jiffy jiffies-per-second) (import - (scheme r5rs) ; TODO: use proper r7rs library for inexact->exact!!!!!+ (scheme base) (scheme time posix)) (begin (define (jiffies-per-second) 10000) (define (current-jiffy)- (inexact->exact (* (jiffies-per-second) (current-second))))))+ (exact (* (jiffies-per-second) (current-second))))))
+ lib/srfi/1.sld view
@@ -0,0 +1,5 @@+(define-library (srfi 1)+ (export-all)+ (import (scheme base) + (scheme cxr))+ (include "srfi-1.scm"))
+ lib/srfi/2.sld view
@@ -0,0 +1,5 @@+(define-library (srfi 2)+ (export+ and-let*)+ (include "srfi-2.scm"))+
+ lib/srfi/69.sld view
@@ -0,0 +1,28 @@+(define-library (srfi 69)+ (export+ make-hash-table + hash-table? + alist->hash-table+ ;hash-table-equivalence-function + ;hash-table-hash-function+ hash-table-ref + ;hash-table-ref/default + ;hash-table-set! + ;TODO: should implement this: hash-table-delete! + hash-table-exists? + hash-table-update! + ;hash-table-update!/default+ hash-table-size + hash-table-keys + hash-table-values + hash-table-walk + hash-table-fold + hash-table->alist + hash-table-copy + hash-table-merge!+ ;hash + ;string-hash + ;string-ci-hash + ;hash-by-identity+ )+ (import (scheme)))