husk-scheme 3.13 → 3.14
raw patch · 14 files changed
+341/−42 lines, 14 files
Files
- ChangeLog.markdown +20/−1
- hs-src/Language/Scheme/Core.hs +41/−1
- hs-src/Language/Scheme/Environments.hs +12/−1
- hs-src/Language/Scheme/Numerical.hs +39/−0
- hs-src/Language/Scheme/Parser.hs +38/−14
- hs-src/Language/Scheme/Primitives.hs +44/−5
- husk-scheme.cabal +2/−2
- lib/core.scm +77/−3
- lib/husk/random.scm +39/−0
- lib/husk/random.sld +7/−0
- lib/modules.scm +7/−0
- lib/scheme/base.sld +11/−11
- lib/scheme/char.sld +1/−1
- lib/scheme/inexact.sld +3/−3
ChangeLog.markdown view
@@ -1,4 +1,23 @@ +v3.14+--------++Made the following enhancements to improve R<sup>7</sup>RS support:++- Updated the parser for strings, symbols, and character literals. The reader now understands Unicode hex values, strings and symbols now allow mnemonic and numeric escape sequences, and the list of named characters has been extended.+- Added support for the `=>` syntax to the `case` conditional.+- Added `cond-expand` syntax to statically expand different expressions depending upon whether features are present in the Scheme implementation. This could help allow the same code to work in husk as well as other R<sup>7</sup>RS implementations.+- Added an optional second argument to `log` to allow specifying the base.+- Added the following functions: `nan?`, `finite?`, `infinite?`, `exact-integer?`, `exact?`, `inexact?`, `square`, `boolean=?`, `symbol=?`, `read-line`, `flush-output-port`, `eof-object`.+- Added support for `include`, `letrec*`, `syntax-error`, `unless`, and `when` syntax.++Added a library to compute simple random numbers, based on [this Stack Overflow answer](http://stackoverflow.com/a/14675103/101258):++ (import (husk random))+ (random num) ; Seed the RNG+ (random) ; Random number from 0 to 1+ (randint lo hi) ; Generate random integer between lo (optional) and hi+ v3.13 -------- @@ -109,7 +128,7 @@ v3.7 -------- -A major change for this release is the introduction of Scheme libraries using R7RS library syntax. For an example of how to use libraries, see `examples/hello-library/hello.scm` in the husk source tree. Note that since R7RS is not currently implemented by husk, the library system only has the built-in import `(r5rs base)` to allow you to import the standard husk R5RS environment. Also, please keep in mind this is still a beta feature that is not yet implemented by the compiler.+A major change for this release is the introduction of Scheme libraries using R<sup>7</sup>RS library syntax. For an example of how to use libraries, see `examples/hello-library/hello.scm` in the husk source tree. Note that since R<sup>7</sup>RS is not currently implemented by husk, the library system only has the built-in import `(r5rs base)` to allow you to import the standard husk R5RS environment. Also, please keep in mind this is still a beta feature that is not yet implemented by the compiler. This release also contains many improvements to the Haskell API:
hs-src/Language/Scheme/Core.hs view
@@ -67,11 +67,12 @@ import Data.Word import qualified System.Exit import System.IO+import qualified System.Info as SysInfo -- import Debug.Trace -- |husk version number version :: String-version = "3.13"+version = "3.14" -- |A utility function to display the husk console banner showBanner :: IO ()@@ -87,6 +88,20 @@ putStrLn " (c) 2010-2013 Justin Ethier " putStrLn $ " Version " ++ version ++ " " putStrLn " "++getHuskFeatures :: IO [LispVal]+getHuskFeatures = do+ -- TODO: windows posix+ return [ Atom "r7rs"+ , Atom "husk"+ , Atom $ "husk-" ++ version + , Atom $ SysInfo.arch+ , Atom $ SysInfo.os+ , Atom "full-unicode"+ , Atom "complex"+ , Atom "ratios"+ ]+ -- |Get the full path to a data file installed for husk getDataFileFullPath :: String -> IO String getDataFileFullPath s = PHS.getDataFileName s@@ -111,6 +126,17 @@ (Bool False, Bool True) -> return fileAsLib _ -> return filename +libraryExists :: [LispVal] -> IOThrowsError LispVal+libraryExists [p@(Pointer _ _)] = do+ p' <- recDerefPtrs p+ libraryExists [p']+libraryExists [(String filename)] = do+ fileAsLib <- liftIO $ getDataFileFullPath $ "lib/" ++ filename+ Bool exists <- fileExists [String filename]+ Bool existsLib <- fileExists [String fileAsLib]+ return $ Bool $ exists || existsLib+libraryExists _ = return $ Bool False+ -- |Register optional SRFI extensions registerExtensions :: Env -> (FilePath -> IO FilePath) -> IO () registerExtensions env getDataFileName = do@@ -1022,6 +1048,8 @@ srfi55 <- PHS.getDataFileName "lib/srfi/srfi-55.scm" -- (require-extension) -- Load standard library+ features <- getHuskFeatures+ _ <- evalString env $ "(define *features* '" ++ (show $ List features) ++ ")" _ <- evalString env $ "(load \"" ++ (escapeBackslashes stdlib) ++ "\")" -- Load (require-extension), which can be used to load other SRFI's@@ -1040,6 +1068,11 @@ "(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 []]]]+ _ <- evalLisp' metaEnv $ List [+ Atom "define", + Atom "library-exists?",+ List [Atom "quote", + IOFunc libraryExists]] #endif return env@@ -1066,6 +1099,8 @@ -- Load necessary libraries -- Unfortunately this adds them in the top-level environment (!!)+ features <- getHuskFeatures+ _ <- evalString env $ "(define *features* '" ++ (show $ List features) ++ ")" cxr <- PHS.getDataFileName "lib/cxr.scm" _ <- evalString env {-baseEnv-} $ "(load \"" ++ (escapeBackslashes cxr) ++ "\")" core <- PHS.getDataFileName "lib/core.scm"@@ -1089,6 +1124,11 @@ 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?",+ List [Atom "quote", + IOFunc libraryExists]] #endif return env
hs-src/Language/Scheme/Environments.hs view
@@ -32,6 +32,7 @@ ("open-output-file", makePort WriteMode), ("close-input-port", closePort), ("close-output-port", closePort),+ ("flush-output-port", flushOutputPort), ("input-port?", isInputPort), ("output-port?", isOutputPort), ("char-ready?", isCharReady),@@ -48,7 +49,8 @@ ("current-input-port", currentInputPort), ("current-output-port", currentOutputPort),- ("read", readProc),+ ("read", readProc True),+ ("read-line", readProc False), ("read-char", readCharProc hGetChar), ("peek-char", readCharProc hLookAhead), ("write", writeProc (\ port obj -> hPrint port obj)),@@ -221,15 +223,23 @@ ("integer->char", int2Char), ("char-upper", charUpper), ("char-lower", charLower),+ ("digit-value", charDigitValue), ("procedure?", isProcedure),+ ("nan?", isNumNaN),+ ("infinite?", isNumInfinite),+ ("finite?", isNumFinite),+ ("exact?", isNumExact),+ ("inexact?", isNumInexact), ("number?", isNumber), ("complex?", isComplex), ("real?", isReal), ("rational?", isRational), ("integer?", isInteger), ("eof-object?", isEOFObject),+ ("eof-object", eofObject), ("symbol?", isSymbol),+ ("symbol=?", isSymbolEq), ("symbol->string", symbol2String), ("char?", isChar), @@ -245,6 +255,7 @@ ("make-string", makeString), ("boolean?", isBoolean),+ ("boolean=?", isBooleanEq), ("husk-interpreter?", isInterpreter)]
hs-src/Language/Scheme/Numerical.hs view
@@ -62,6 +62,11 @@ , isInteger , isNumber , isFloatAnInteger+ , isNumNaN+ , isNumInfinite+ , isNumFinite+ , isNumExact+ , isNumInexact ) where import Language.Scheme.Types @@ -406,9 +411,13 @@ -- |Compute the log of a given number numLog :: [LispVal] -> ThrowsError LispVal numLog [(Number n)] = return $ Float $ log $ fromInteger n+numLog [Number n, Number base] = return $ Float $ logBase (fromInteger base) (fromInteger n) numLog [(Float n)] = return $ Float $ log n+numLog [Float n, Number base] = return $ Float $ logBase (fromInteger base) n numLog [(Rational n)] = return $ Float $ log $ fromRational n+numLog [Rational n, Number base] = return $ Float $ logBase (fromInteger base) (fromRational n) numLog [(Complex n)] = return $ Complex $ log n+numLog [Complex n, Number base] = return $ Complex $ logBase (fromInteger base) n numLog [x] = throwError $ TypeMismatch "number" x numLog badArgList = throwError $ NumArgs (Just 1) badArgList @@ -518,6 +527,36 @@ num2String [n@(Complex _)] = return $ String $ show n num2String [x] = throwError $ TypeMismatch "number" x num2String badArgList = throwError $ NumArgs (Just 1) badArgList+++isNumNaN :: [LispVal] -> ThrowsError LispVal+isNumNaN ([Float n]) = return $ Bool $ isNaN n+isNumNaN _ = return $ Bool False++isNumInfinite :: [LispVal] -> ThrowsError LispVal+isNumInfinite ([Float n]) = return $ Bool $ isInfinite n+isNumInfinite _ = return $ Bool False++isNumFinite :: [LispVal] -> ThrowsError LispVal+isNumFinite ([Number _]) = return $ Bool True+isNumFinite ([Float n]) = return $ Bool $ not $ isInfinite n+isNumFinite ([Complex _]) = return $ Bool True+isNumFinite ([Rational _]) = return $ Bool True+isNumFinite _ = return $ Bool False++isNumExact :: [LispVal] -> ThrowsError LispVal+isNumExact ([Number _]) = return $ Bool True+isNumExact ([Float _]) = return $ Bool False+isNumExact ([Complex _]) = return $ Bool False -- TODO: could be either+isNumExact ([Rational _]) = return $ Bool True+isNumExact _ = return $ Bool False++isNumInexact :: [LispVal] -> ThrowsError LispVal+isNumInexact n@([Number _]) = return $ Bool False+isNumInexact n@([Float _]) = return $ Bool True+isNumInexact n@([Complex _]) = return $ Bool True+isNumInexact n@([Rational _]) = return $ Bool False+isNumInexact _ = return $ Bool False -- |Predicate to determine if given value is a number isNumber :: [LispVal] -> ThrowsError LispVal
hs-src/Language/Scheme/Parser.hs view
@@ -48,7 +48,7 @@ import Control.Monad.Error import Data.Array import qualified Data.ByteString as BS-import qualified Data.Char as Char+import qualified Data.Char as DC import Data.Complex import qualified Data.Map import Data.Ratio@@ -128,13 +128,24 @@ parseChar = do _ <- try (string "#\\") c <- anyChar- r <- many (letter)+ r <- many (letter <|> digit) let pchr = c : r- return $ case pchr of- "space" -> Char ' '- "newline" -> Char '\n'- _ -> Char c-+ case pchr of+ "space" -> return $ Char ' '+ "newline" -> return $ Char '\n'+ "alarm" -> return $ Char '\a' + "backspace" -> return $ Char '\b' + "delete" -> return $ Char '\DEL'+ "escape" -> return $ Char '\ESC' + "null" -> return $ Char '\0' + "return" -> return $ Char '\n' + "tab" -> return $ Char '\t'+ _ -> case (c : r) of+ [c] -> return $ Char c+ ('x' : hexs) -> do+ rv <- parseHexScalar hexs+ return $ Char rv+ _ -> pzero -- |Parse an integer in octal notation, base 8 parseOctalNumber :: Parser LispVal@@ -154,8 +165,8 @@ sign <- many (oneOf "-") num <- many1 (oneOf "01") case (length sign) of- 0 -> return $ Number $ fst $ Numeric.readInt 2 (`elem` "01") Char.digitToInt num !! 0- 1 -> return $ Number $ fromInteger $ (*) (-1) $ fst $ Numeric.readInt 2 (`elem` "01") Char.digitToInt num !! 0+ 0 -> return $ Number $ fst $ Numeric.readInt 2 (`elem` "01") DC.digitToInt num !! 0+ 1 -> return $ Number $ fromInteger $ (*) (-1) $ fst $ Numeric.readInt 2 (`elem` "01") DC.digitToInt num !! 0 _ -> pzero -- |Parse an integer in hexadecimal notation, base 16@@ -279,11 +290,24 @@ parseEscapedChar = do _ <- char '\\' c <- anyChar- return $ case c of- 'n' -> '\n'- 't' -> '\t'- 'r' -> '\r'- _ -> c+ case c of+ 'a' -> return '\a'+ 'b' -> return '\b'+ 'n' -> return '\n'+ 't' -> return '\t'+ 'r' -> return '\r'+ 'x' -> do+ num <- many $ letter <|> digit+ _ <- char ';'+ parseHexScalar num+ _ -> return c++-- |Parse a hexidecimal scalar+parseHexScalar num = do+ let ns = Numeric.readHex num+ case ns of+ [] -> fail $ "Unable to parse hex value " ++ show num+ _ -> return $ DC.chr $ fst $ ns !! 0 -- |Parse a string parseString :: Parser LispVal
hs-src/Language/Scheme/Primitives.hs view
@@ -78,6 +78,7 @@ , charPredicate , charUpper , charLower+ , charDigitValue , char2Int , int2Char @@ -86,6 +87,8 @@ , isChar , isString , isBoolean + , isBooleanEq+ , isSymbolEq , isDottedList , isProcedure , isList @@ -111,6 +114,7 @@ -- ** Input / Output , makePort , closePort+ , flushOutputPort , currentOutputPort , currentInputPort , isOutputPort @@ -131,6 +135,7 @@ -- ** Time , currentTimestamp -- ** System+ , eofObject , system ) where@@ -216,6 +221,12 @@ currentOutputPort :: [LispVal] -> IOThrowsError LispVal currentOutputPort _ = return $ Port stdout +-- | Flush the given output port+flushOutputPort :: [LispVal] -> IOThrowsError LispVal+flushOutputPort [] = liftIO $ hFlush stdout >> (return $ Bool True)+flushOutputPort [Port port] = liftIO $ hFlush port >> (return $ Bool True)+flushOutputPort _ = return $ Bool False+ -- |Determine if the given objects is an input port -- -- LispVal Arguments:@@ -266,17 +277,20 @@ -- -- Returns: LispVal ---readProc :: [LispVal] -> IOThrowsError LispVal-readProc [] = readProc [Port stdin]-readProc [Port port] = do+readProc :: Bool -> [LispVal] -> IOThrowsError LispVal+readProc mode [] = readProc mode [Port stdin]+readProc mode [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+ liftThrows $ + case mode of+ True -> readExpr inpStr+ _ -> return $ String inpStr+readProc _ args@(_ : _) = throwError $ BadSpecialForm "" $ List args -- |Read character from port --@@ -1358,6 +1372,10 @@ isEOFObject ([EOF]) = return $ Bool True isEOFObject _ = return $ Bool False +-- | Return the EOF object+eofObject :: [LispVal] -> ThrowsError LispVal+eofObject _ = return $ EOF+ -- | Determine if given object is a symbol -- -- Arguments:@@ -1423,6 +1441,16 @@ charLower [Char c] = return $ Char $ toLower c charLower [notChar] = throwError $ TypeMismatch "char" notChar +charDigitValue :: [LispVal] -> ThrowsError LispVal+charDigitValue [Char c] = do+ -- This is not really good enough, since unicode chars+ -- are supposed to be processed, and r7rs does not+ -- spec hex chars, but it is a decent start for now...+ if isHexDigit c+ then return $ Number $ toInteger $ digitToInt c+ else return $ Bool False+charDigitValue [notChar] = throwError $ TypeMismatch "char" notChar+ -- | Convert from a charater to an integer -- -- Arguments:@@ -1489,6 +1517,17 @@ isBoolean ([Bool _]) = return $ Bool True isBoolean _ = return $ Bool False +isBooleanEq (Bool a : Bool b : bs)+ | a == b = isBooleanEq (Bool b : bs)+ | otherwise = return $ Bool False+isBooleanEq [Bool _] = return $ Bool True+isBooleanEq _ = return $ Bool False++isSymbolEq (Atom a : Atom b : bs)+ | a == b = isSymbolEq (Atom b : bs)+ | otherwise = return $ Bool False+isSymbolEq [Atom _] = return $ Bool True+isSymbolEq _ = return $ Bool False -- Utility functions data Unpacker = forall a . Eq a => AnyUnpacker (LispVal -> ThrowsError a)
husk-scheme.cabal view
@@ -1,5 +1,5 @@ Name: husk-scheme-Version: 3.13+Version: 3.14 Synopsis: R5RS Scheme interpreter, compiler, and library. Description: <<https://github.com/justinethier/husk-scheme/raw/master/docs/husk-scheme.png>>@@ -23,7 +23,7 @@ . * Standard library of Scheme functions, and support for many popular SRFI's .- 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 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 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.
lib/core.scm view
@@ -33,6 +33,7 @@ (define (sum . lst) (foldl + 0 lst)) (define (product . lst) (foldl * 1 lst))+(define (square z) (* z z)) ; Forms from R5RS for and/or (define-syntax and@@ -63,6 +64,8 @@ (define negative? (curry > 0)) (define (odd? num) (= (modulo num 2) 1)) (define (even? num) (= (modulo num 2) 0))+(define (exact-integer? num)+ (and (exact? num) (integer? num))) (define (length lst) (foldl (lambda (x y) (+ y 1)) 0 lst)) (define (reverse lst) (foldl (flip cons) '() lst))@@ -72,6 +75,13 @@ ((begin exp ...) ((lambda () exp ...))))) +(define-syntax include+ (syntax-rules ()+ ((include file1 file2 ...)+ (begin+ (load file1) + (load file2) ...))))+ ; ; ; NOTE: The below cond/case forms do NOT use begin to prevent@@ -125,12 +135,15 @@ ; Case ; Form from R5RS: (define-syntax case- (syntax-rules (else)+ (syntax-rules (else =>) ((case (key ...) clauses ...) (let ((atom-key (key ...))) (case atom-key clauses ...))) ((case key+ (else => result))+ (result key))+ ((case key (else result1 result2 ...)) (if #t ((lambda () result1 result2 ...)))) ;; Intentionally not using begin, see above ((case key@@ -138,6 +151,12 @@ (if (memv key '(atoms ...)) ((lambda () result1 result2 ...)))) ;; Intentionally not using begin, see above ((case key+ ((atoms ...) => result)+ clause clauses ...)+ (if (memv key '(atoms ...))+ (result key)+ (case key clause clauses ...)))+ ((case key ((atoms ...) result1 result2 ...) clause clauses ...) (if (memv key '(atoms ...))@@ -151,12 +170,18 @@ (else (my-mem-helper obj (cdr lst) cmp-proc)))) (define (memq obj lst) (my-mem-helper obj lst eq?)) (define (memv obj lst) (my-mem-helper obj lst eqv?))-(define (member obj lst) (my-mem-helper obj lst equal?))+(define (member obj lst . compare) + (if (pair? compare)+ (my-mem-helper obj lst (car compare))+ (my-mem-helper obj lst equal?))) (define (mem-helper pred op) (lambda (next acc) (if (and (not acc) (pred (op next))) next acc))) (define (assq obj alist) (foldl (mem-helper (curry eq? obj) car) #f alist)) (define (assv obj alist) (foldl (mem-helper (curry eqv? obj) car) #f alist))-(define (assoc obj alist) (foldl (mem-helper (curry equal? obj) car) #f alist))+(define (assoc obj alist . compare)+ (if (pair? compare)+ (foldl (mem-helper (curry (car compare) obj) car) #f alist)+ (foldl (mem-helper (curry equal? obj) car) #f alist))) ; SRFI 8 ; Reference implementation from: http://srfi.schemers.org/srfi-8/srfi-8.html@@ -555,3 +580,52 @@ (def-copy-in-place vector) ;; END +;; Macros from r7rs+(define-syntax when+ (syntax-rules ()+ ((when test result1 result2 ...)+ (if test+ (begin result1 result2 ...)))))+(define-syntax unless+ (syntax-rules ()+ ((unless test result1 result2 ...)+ (if (not test)+ (begin result1 result2 ...)))))+(define-syntax letrec*+ (syntax-rules ()+ ((letrec* ((var1 init1) ...) body1 body2 ...)+ (let ((var1 #f) ...)+ (set! var1 init1)+ ...+ (let () body1 body2 ...)))))+(define-syntax syntax-error+ (er-macro-transformer+ (lambda (expr rename compare)+ (apply error (cdr expr)))))+;;+;; SRFI-0 (cond-expand) from r7rs+;;+(define-syntax cond-expand+ (er-macro-transformer+ (lambda (expr rename compare)+ (define (identifier->symbol i) i)+ (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)))+ ((not) (not (check (cadr x))))+ ((library) (eval `(module-exists? ',(cadr x)) *meta-env*))+ (else (error "cond-expand: bad feature" x)))+ (memq (identifier->symbol x) *features*)))+ (let expand ((ls (cdr expr)))+ (cond ((null? ls)) ; (error "cond-expand: no expansions" expr)+ ((not (pair? (car ls))) (error "cond-expand: bad clause" (car ls)))+ ((eq? 'else (identifier->symbol (caar ls)))+ (if (pair? (cdr ls))+ (error "cond-expand: else in non-final position")+ `(,(rename 'begin) ,@(cdar ls))))+ ((check (caar ls)) `(,(rename 'begin) ,@(cdar ls)))+ (else (expand (cdr ls))))))))+;; END
+ lib/husk/random.scm view
@@ -0,0 +1,39 @@+;; This code is taken from:+;; http://stackoverflow.com/questions/14674165/scheme-generate-random+;;+;; NOTE: Random numbers such as these are good enough for +;; simple simulations, but beware they are not suitable for+;; cryptographic applications. +;; +;; For higher quality random number generators, see:+;; http://programmingpraxis.com/contents/themes/#Random%20Number%20Generators+;;++;; Calling (random) returns a random fraction between 0 (inclusive) and +;; 1 (exclusive). The random fractions cycle with period m. Calling +;; (random seed) resets the seed of the random number generator, so that two +;; random sequences starting from the same seed will be identical; dates in +;; the form YYYYMMDD make good seeds (that's Knuth's birthday above). If you +;; want to flip a coin, say: (if (< random 1/2) 'heads 'tails).+;;+;; You probably want to set the seed before using this, for example:+;;+;; (import (scheme time))+;; (random (current-second))+;;+(define random+ (let ((a 69069) (c 1) (m (expt 2 32)) (seed 19380110))+ (lambda new-seed+ (if (pair? new-seed)+ (begin (set! seed (car new-seed)))+ (begin (set! seed (modulo (+ (* seed a) c) m))))+ (/ seed m))))++;; (randint) returns a random integer on the range+;; lo (inclusive) to hi (exclusive); lo defaults to 0:+(define (randint . args)+ (cond ((= (length args) 1) (randint 0 (car args)))+ ((= (length args) 2)+ (inexact->exact+ (+ (car args) (floor (* (random) (- (cadr args) (car args)))))))+ (else (error 'randint "usage: (randint [lo] hi)"))))
+ lib/husk/random.sld view
@@ -0,0 +1,7 @@+(define-library (husk random)+ (export + random+ randint)+ (import (scheme r5rs))+ (include "random.scm"))+
lib/modules.scm view
@@ -59,6 +59,13 @@ (path (find-module-file file))) (if path (load path meta-env)))))) +(define (module-exists? name)+ (let* ((file (module-name->file name))+ (path (find-module-file file)))+ (if path+ (library-exists? path)+ #f)))+ (define (find-module name) (cond ((assoc name *modules*) => cdr)
lib/scheme/base.sld view
@@ -81,7 +81,7 @@ gcd ; JAE TODO: should import be included??? ;import- ;include+ include ;include-ci input-port? integer->char@@ -165,37 +165,37 @@ ;bytevector-u8-set! ;call-with-port ;close-port- ;cond-expand+ cond-expand ;current-error-port ;define ;define-record-type ;define-syntax ;define-values ;else- ;eof-object+ eof-object ;error-object-irritants ;error-object-message ;error-object? ;exact-integer-sqrt- ;exact-integer?- ;exact?+ exact-integer?+ exact? ;features ;file-error? ;floor-quotient ;floor-remainder ;floor/- ;flush-output-port+ flush-output-port ;get-output-bytevector ;get-output-string ;guard ;if- ;inexact?+ inexact? ;input-port-open? ;lambda ;let*-values ;let-syntax ;let-values- ;letrec*+ letrec* ;letrec-syntax list-copy ;list-set!@@ -215,13 +215,13 @@ ;read-bytevector ;read-bytevector! ;read-error?- ;read-line+ read-line ;read-string ;read-u8 ;set! ;set-car! ;set-cdr!- ;square+ square string->vector string-copy! ;string-fill!@@ -229,7 +229,7 @@ string-map ;string-set! ;symbol=?- ;syntax-error+ syntax-error ;syntax-rules ;textual-port? ;truncate-quotient
lib/scheme/char.sld view
@@ -22,7 +22,7 @@ ;char-upcase char-upper-case? char-whitespace?- ;digit-value+ digit-value string-ci<=? string-ci<? string-ci=?
lib/scheme/inexact.sld view
@@ -14,10 +14,10 @@ atan cos exp- ;TODO: finite?- ;TODO: infinite?+ finite?+ infinite? log- ;TODO: nan?+ nan? sin sqrt tan