husk-scheme 3.5.7 → 3.6
raw patch · 8 files changed
+554/−145 lines, 8 files
Files
- ChangeLog.markdown +18/−0
- README.markdown +2/−0
- hs-src/Language/Scheme/Compiler.hs +33/−12
- hs-src/Language/Scheme/Core.hs +82/−29
- hs-src/Language/Scheme/Primitives.hs +15/−7
- hs-src/Language/Scheme/Types.hs +69/−30
- hs-src/Language/Scheme/Variables.hs +325/−66
- husk-scheme.cabal +10/−1
ChangeLog.markdown view
@@ -1,3 +1,21 @@+v3.6+--------+Enhanced the variable storage model to correctly store references to objects. For example, consider the following:++ (define x (list 'a 'b 'c))+ (define y x)+ (set-cdr! x 4)++After executing this code, previous versions of husk assigned `(a b c)` to `y`. With this release, husk now evaluates `y` to the expected value of `(a . 4)`.++The more general problem is that certain data types denote a memory location which may be modified by mutator functions such as `set-cdr!`. This is discussed specifically in section 3.4 <b>Storage Model</b>:++>+> Variables and objects such as pairs, vectors, and strings implicitly denote locations or sequences of locations. A string, for example, denotes as many locations as there are characters in the string. (These locations need not correspond to a full machine word.) A new value may be stored into one of these locations using the string-set! procedure, but the string continues to denote the same locations as before.+> ++Internally husk uses Haskell data types, so the husk model differs slightly from the one in R<sup>5</sup>RS - references are used instead of individual memory locations. This has implications for the `set-car!` and `set-cdr!` special forms, where circular lists and similar low-level optimizations are not possible as Haskell lists are used instead of raw pointers. However, these issues aside, the enhanced storage model is a big step forward to bringing husk's variable support closer in line to that of other Schemes.+ v3.5.7 --------
README.markdown view
@@ -17,6 +17,8 @@ cabal update cabal install husk-scheme +More information is available on the [husk website](http://justinethier.github.com/husk-scheme).+ License ------- Copyright (C) 2010 [Justin Ethier](http://github.com/justinethier)
hs-src/Language/Scheme/Compiler.hs view
@@ -198,7 +198,17 @@ -- TODO: eval env cont val@(HashTable _) = continueEval env cont val compile _ v@(Vector _) copts = compileScalar (" return $ " ++ astToHaskellStr v) copts compile _ ht@(HashTable _) copts = compileScalar (" return $ " ++ astToHaskellStr ht) copts-compile _ (Atom a) copts = compileScalar (" getVar env \"" ++ a ++ "\"") copts +compile _ (Atom a) copts = do+ c <- return $ createAstCont copts "val" ""+ return [createAstFunc copts [+ AstValue $ " v <- getVar env \"" ++ a ++ "\"",+ AstValue $ " val <- return $ case v of",+ AstValue $ " List _ -> Pointer \"" ++ a ++ "\" env",+ AstValue $ " DottedList _ _ -> Pointer \"" ++ a ++ "\" env",+ AstValue $ " String _ -> Pointer \"" ++ a ++ "\" env",+ AstValue $ " Vector _ -> Pointer \"" ++ a ++ "\" env",+ AstValue $ " HashTable _ -> Pointer \"" ++ a ++ "\" env",+ AstValue $ " _ -> v"], c] compile _ (List [Atom "quote", val]) copts = compileScalar (" return $ " ++ astToHaskellStr val) copts @@ -430,10 +440,11 @@ compDefine <- compileExpr env i symDefine $ Just symMakeDefine compMakeDefine <- return $ AstFunction symMakeDefine " env cont idx _ " [ AstValue $ " tmp <- getVar env \"" ++ var ++ "\"",+ AstValue $ " derefValue <- recDerefPtrs tmp", -- TODO: not entirely correct below; should compile the character argument rather -- than directly inserting it into the compiled code...- AstValue $ " result <- substr (tmp, (" ++ astToHaskellStr(character) ++ "), idx)",- AstValue $ " _ <- setVar env \"" ++ var ++ "\" result",+ AstValue $ " result <- substr (derefValue, (" ++ astToHaskellStr(character) ++ "), idx)",+ AstValue $ " _ <- updateObject env \"" ++ var ++ "\" result", createAstCont copts "result" ""] return $ [entryPt] ++ compDefine ++ [compMakeDefine] @@ -457,7 +468,8 @@ -- Function to read existing var compGetVar <- return $ AstFunction symGetVar " env cont idx _ " [ AstValue $ " result <- getVar env \"" ++ var ++ "\"",- AstValue $ " " ++ symObj ++ " env cont result Nothing "]+ AstValue $ " derefValue <- recDerefPtrs result",+ AstValue $ " " ++ symObj ++ " env cont derefValue Nothing "] -- Compiled version of argObj compiledObj <- compileExpr env argObj symCompiledObj Nothing @@ -481,8 +493,8 @@ -- FUTURE: consider making these functions part of the runtime. compDoSet <- return $ AstValue $ "" ++ symDoSet ++ " :: Env -> LispVal -> LispVal -> Maybe [LispVal] -> IOThrowsError LispVal\n" ++- symDoSet ++ " e c obj (Just [List (_ : ls)]) = setVar e \"" ++ var ++ "\" (List (obj : ls)) >>= " ++ finalContinuation ++- symDoSet ++ " e c obj (Just [DottedList (_ : ls) l]) = setVar e \"" ++ var ++ "\" (DottedList (obj : ls) l) >>= " ++ finalContinuation +++ symDoSet ++ " e c obj (Just [List (_ : ls)]) = updateObject e \"" ++ var ++ "\" (List (obj : ls)) >>= " ++ finalContinuation +++ symDoSet ++ " e c obj (Just [DottedList (_ : ls) l]) = updateObject e \"" ++ var ++ "\" (DottedList (obj : ls) l) >>= " ++ finalContinuation ++ symDoSet ++ " _ _ _ _ = throwError $ InternalError \"Unexpected argument to " ++ symDoSet ++ "\"\n" -- Return a list of all the compiled code@@ -508,7 +520,8 @@ -- Function to read existing var compGetVar <- return $ AstFunction symGetVar " env cont idx _ " [ AstValue $ " result <- getVar env \"" ++ var ++ "\"",- AstValue $ " " ++ symObj ++ " env cont result Nothing "]+ AstValue $ " derefValue <- recDerefPtrs result",+ AstValue $ " " ++ symObj ++ " env cont derefValue Nothing "] -- Compiled version of argObj compiledObj <- compileExpr env argObj symCompiledObj Nothing @@ -532,8 +545,14 @@ -- FUTURE: consider making these functions part of the runtime. compDoSet <- return $ AstValue $ "" ++ symDoSet ++ " :: Env -> LispVal -> LispVal -> Maybe [LispVal] -> IOThrowsError LispVal\n" ++- symDoSet ++ " e c obj (Just [List (l : _)]) = (liftThrows $ cons [l, obj]) >>= setVar e \"" ++ var ++ "\" >>= " ++ finalContinuation ++- symDoSet ++ " e c obj (Just [DottedList (l : _) _]) = (liftThrows $ cons [l, obj]) >>= setVar e \"" ++ var ++ "\" >>= " ++ finalContinuation +++ symDoSet ++ " e c obj (Just [List (l : _)]) = do\n" +++ " l' <- recDerefPtrs l\n" +++ " obj' <- recDerefPtrs obj\n" +++ " (liftThrows $ cons [l', obj']) >>= updateObject e \"" ++ var ++ "\" >>= " ++ finalContinuation +++ symDoSet ++ " e c obj (Just [DottedList (l : _) _]) = do\n" +++ " l' <- recDerefPtrs l\n" +++ " obj' <- recDerefPtrs obj\n" +++ " (liftThrows $ cons [l', obj']) >>= updateObject e \"" ++ var ++ "\" >>= " ++ finalContinuation ++ symDoSet ++ " _ _ _ _ = throwError $ InternalError \"Unexpected argument to " ++ symDoSet ++ "\"\n" -- Return a list of all the compiled code@@ -557,7 +576,7 @@ -- Do actual update compiledUpdate <- return $ AstFunction symUpdateVec " env cont obj (Just [idx]) " [ AstValue $ " vec <- getVar env \"" ++ var ++ "\"",- AstValue $ " result <- updateVector vec idx obj >>= setVar env \"" ++ var ++ "\"",+ AstValue $ " result <- updateVector vec idx obj >>= updateObject env \"" ++ var ++ "\"", createAstCont copts "result" ""] return $ [entryPt, compiledIdxWrapper, compiledUpdate] ++ compiledIdx ++ compiledObj@@ -582,7 +601,8 @@ compiledUpdate <- return $ AstFunction symUpdateVec " env cont obj (Just [rkey]) " [ -- TODO: this should be more robust, than just assuming ht is a HashTable AstValue $ " HashTable ht <- getVar env \"" ++ var ++ "\"",- AstValue $ " result <- setVar env \"" ++ var ++ "\" (HashTable $ Data.Map.insert rkey obj ht) ",+ AstValue $ " HashTable ht' <- recDerefPtrs $ HashTable ht",+ AstValue $ " result <- updateObject env \"" ++ var ++ "\" (HashTable $ Data.Map.insert rkey obj ht') ", createAstCont copts "result" ""] return $ [entryPt, compiledIdxWrapper, compiledUpdate] ++ compiledIdx ++ compiledObj@@ -601,7 +621,8 @@ compiledUpdate <- return $ AstFunction symDoDelete " env cont rkey _ " [ -- TODO: this should be more robust, than just assuming ht is a HashTable AstValue $ " HashTable ht <- getVar env \"" ++ var ++ "\"",- AstValue $ " result <- setVar env \"" ++ var ++ "\" (HashTable $ Data.Map.delete rkey ht) ",+ AstValue $ " HashTable ht' <- recDerefPtrs $ HashTable ht",+ AstValue $ " result <- updateObject env \"" ++ var ++ "\" (HashTable $ Data.Map.delete rkey ht') ", createAstCont copts "result" ""] return $ [entryPt, compiledUpdate] ++ compiledIdx
hs-src/Language/Scheme/Core.hs view
@@ -44,10 +44,11 @@ import qualified Data.Map import qualified System.Exit import System.IO+-- import Debug.Trace -- |husk version number version :: String-version = "3.5.7"+version = "3.6" -- |A utility function to display the husk console banner showBanner :: IO ()@@ -89,7 +90,8 @@ @ -} evalString :: Env -> String -> IO String-evalString env expr = runIOThrowsREPL $ liftM show $ (liftThrows $ readExpr expr) >>= meval env (makeNullContinuation env)+evalString env expr = do+ runIOThrowsREPL $ liftM show $ (liftThrows $ readExpr expr) >>= evalLisp env -- |Evaluate a string and print results to console evalAndPrint :: Env -> String -> IO ()@@ -97,7 +99,9 @@ -- |Evaluate lisp code that has already been loaded into haskell evalLisp :: Env -> LispVal -> IOThrowsError LispVal-evalLisp env lisp = meval env (makeNullContinuation env) lisp+evalLisp env lisp = do+ v <- meval env (makeNullContinuation env) lisp+ recDerefPtrs v -- |A wrapper for macroEval and eval meval, mprepareApply :: Env -> LispVal -> LispVal -> IOThrowsError LispVal@@ -215,7 +219,19 @@ 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 (Atom a) = continueEval env cont =<< getVar env a+eval env cont val@(Pointer _ _) = continueEval env cont val+eval env cont (Atom a) = do+ v <- getVar env a+ val <- return $ case v of+#ifdef UsePointers+ List _ -> Pointer a env+ DottedList _ _ -> Pointer a env+ String _ -> Pointer a env+ Vector _ -> Pointer a env+ HashTable _ -> Pointer a env+#endif+ _ -> v+ continueEval env cont val -- Quote an expression by simply passing along the value eval env cont (List [Atom "quote", val]) = continueEval env cont val@@ -262,7 +278,8 @@ -- Finish unquoting a pair by combining both of the unquoted left/right hand sides. cpsUnquotePairFinish :: Env -> LispVal -> LispVal -> Maybe [LispVal] -> IOThrowsError LispVal- cpsUnquotePairFinish e c rx (Just [List rxs]) = do+ cpsUnquotePairFinish e c _rx (Just [List rxs]) = do+ rx <- recDerefPtrs _rx case rx of List [] -> continueEval e c $ List rxs List rxlst -> continueEval e c $ List $ rxs ++ rxlst@@ -475,11 +492,14 @@ else meval env (makeCPS env cont cpsStr) i where cpsStr :: Env -> LispVal -> LispVal -> Maybe [LispVal] -> IOThrowsError LispVal- cpsStr e c idx _ = (meval e (makeCPSWArgs e c cpsSubStr $ [idx]) =<< getVar e var) + cpsStr e c idx _ = do+ value <- getVar env var+ derefValue <- recDerefPtrs value+ meval e (makeCPSWArgs e c cpsSubStr $ [idx]) derefValue cpsSubStr :: Env -> LispVal -> LispVal -> Maybe [LispVal] -> IOThrowsError LispVal cpsSubStr e c str (Just [idx]) =- substr (str, character, idx) >>= setVar e var >>= continueEval e c+ substr (str, character, idx) >>= updateObject e var >>= continueEval e c cpsSubStr _ _ _ _ = throwError $ InternalError "Invalid argument to cpsSubStr" eval env cont args@(List [Atom "string-set!" , nonvar , _ , _ ]) = do@@ -497,7 +517,10 @@ bound <- liftIO $ isRecBound env "set-car!" if bound then prepareApply env cont args -- if is bound to a variable in this scope; call into it- else continueEval env (makeCPS env cont cpsObj) =<< getVar env var+ else do+ value <- getVar env var+ derefValue <- recDerefPtrs value+ continueEval env (makeCPS env cont cpsObj) derefValue where cpsObj :: Env -> LispVal -> LispVal -> Maybe [LispVal] -> IOThrowsError LispVal cpsObj _ _ obj@(List []) _ = throwError $ TypeMismatch "pair" obj@@ -506,8 +529,8 @@ cpsObj _ _ obj _ = throwError $ TypeMismatch "pair" obj cpsSet :: Env -> LispVal -> LispVal -> Maybe [LispVal] -> IOThrowsError LispVal- cpsSet e c obj (Just [List (_ : ls)]) = setVar e var (List (obj : ls)) >>= continueEval e c -- Wrong constructor? Should it be DottedList?- cpsSet e c obj (Just [DottedList (_ : ls) l]) = setVar e var (DottedList (obj : ls) l) >>= continueEval e c+ cpsSet e c obj (Just [List (_ : ls)]) = updateObject e var (List (obj : ls)) >>= continueEval e c -- Wrong constructor? Should it be DottedList?+ cpsSet e c obj (Just [DottedList (_ : ls) l]) = updateObject e var (DottedList (obj : ls) l) >>= continueEval e c cpsSet _ _ _ _ = throwError $ InternalError "Unexpected argument to cpsSet" eval env cont args@(List [Atom "set-car!" , nonvar , _ ]) = do bound <- liftIO $ isRecBound env "set-car!"@@ -524,7 +547,10 @@ bound <- liftIO $ isRecBound env "set-cdr!" if bound then prepareApply env cont args -- if is bound to a variable in this scope; call into it- else continueEval env (makeCPS env cont cpsObj) =<< getVar env var+ else do+ value <- getVar env var+ derefValue <- recDerefPtrs value --derefPtr value+ continueEval env (makeCPS env cont cpsObj) derefValue where cpsObj :: Env -> LispVal -> LispVal -> Maybe [LispVal] -> IOThrowsError LispVal cpsObj _ _ pair@(List []) _ = throwError $ TypeMismatch "pair" pair@@ -533,14 +559,22 @@ cpsObj _ _ pair _ = throwError $ TypeMismatch "pair" pair cpsSet :: Env -> LispVal -> LispVal -> Maybe [LispVal] -> IOThrowsError LispVal- cpsSet e c obj (Just [List (l : _)]) = (liftThrows $ cons [l, obj]) >>= setVar e var >>= continueEval e c- cpsSet e c obj (Just [DottedList (l : _) _]) = (liftThrows $ cons [l, obj]) >>= setVar e var >>= continueEval e c+ cpsSet e c obj (Just [List (l : _)]) = do+ l' <- recDerefPtrs l+ obj' <- recDerefPtrs obj+ (liftThrows $ cons [l', obj']) >>= updateObject e var >>= continueEval e c+ cpsSet e c obj (Just [DottedList (l : _) _]) = do+ l' <- recDerefPtrs l+ obj' <- recDerefPtrs obj+ (liftThrows $ cons [l', obj']) >>= updateObject e var >>= continueEval e c cpsSet _ _ _ _ = throwError $ InternalError "Unexpected argument to cpsSet" eval env cont args@(List [Atom "set-cdr!" , nonvar , _ ]) = do bound <- liftIO $ isRecBound env "set-cdr!" if bound then prepareApply env cont args -- if is bound to a variable in this scope; call into it- else throwError $ TypeMismatch "variable" nonvar+ else do+ -- TODO: eval nonvar, then can process it if we get a list+ throwError $ TypeMismatch "variable" nonvar eval env cont fargs@(List (Atom "set-cdr!" : args)) = do bound <- liftIO $ isRecBound env "set-cdr!" if bound@@ -562,7 +596,7 @@ cpsUpdateVec :: Env -> LispVal -> LispVal -> Maybe [LispVal] -> IOThrowsError LispVal cpsUpdateVec e c vec (Just [idx, obj]) =- updateVector vec idx obj >>= setVar e var >>= continueEval e c+ updateVector vec idx obj >>= updateObject e var >>= continueEval e c cpsUpdateVec _ _ _ _ = throwError $ InternalError "Invalid argument to cpsUpdateVec" eval env cont args@(List [Atom "vector-set!" , nonvar , _ , _]) = do @@ -586,14 +620,17 @@ cpsValue e c key _ = meval e (makeCPSWArgs e c cpsH $ [key]) rvalue cpsH :: Env -> LispVal -> LispVal -> Maybe [LispVal] -> IOThrowsError LispVal- cpsH e c value (Just [key]) = (meval e (makeCPSWArgs e c cpsEvalH $ [key, value]) =<< getVar e var) + cpsH e c value (Just [key]) = do+ v <- getVar e var+ derefVar <- recDerefPtrs v+ meval e (makeCPSWArgs e c cpsEvalH $ [key, value]) derefVar cpsH _ _ _ _ = throwError $ InternalError "Invalid argument to cpsH" cpsEvalH :: Env -> LispVal -> LispVal -> Maybe [LispVal] -> IOThrowsError LispVal cpsEvalH e c h (Just [key, value]) = do case h of HashTable ht -> do- setVar env var (HashTable $ Data.Map.insert key value ht) >>= meval e c+ updateObject env var (HashTable $ Data.Map.insert key value ht) >>= meval e c other -> throwError $ TypeMismatch "hash-table" other cpsEvalH _ _ _ _ = throwError $ InternalError "Invalid argument to cpsEvalH" eval env cont args@(List [Atom "hash-table-set!" , nonvar , _ , _]) = do@@ -614,13 +651,16 @@ else meval env (makeCPS env cont cpsH) rkey where cpsH :: Env -> LispVal -> LispVal -> Maybe [LispVal] -> IOThrowsError LispVal- cpsH e c key _ = (meval e (makeCPSWArgs e c cpsEvalH $ [key]) =<< getVar e var) + cpsH e c key _ = do+ value <- getVar e var+ derefValue <- recDerefPtrs value+ meval e (makeCPSWArgs e c cpsEvalH $ [key]) derefValue cpsEvalH :: Env -> LispVal -> LispVal -> Maybe [LispVal] -> IOThrowsError LispVal cpsEvalH e c h (Just [key]) = do case h of HashTable ht -> do- setVar env var (HashTable $ Data.Map.delete key ht) >>= meval e c+ updateObject env var (HashTable $ Data.Map.delete key ht) >>= meval e c other -> throwError $ TypeMismatch "hash-table" other cpsEvalH _ _ _ _ = throwError $ InternalError "Invalid argument to cpsEvalH" eval env cont args@(List [Atom "hash-table-delete!" , nonvar , _]) = do@@ -650,6 +690,9 @@ -- |A helper function for the special form /(vector-set!)/ updateVector :: LispVal -> LispVal -> LispVal -> IOThrowsError LispVal updateVector (Vector vec) (Number idx) obj = return $ Vector $ vec // [(fromInteger idx, obj)]+updateVector ptr@(Pointer _ _) i obj = do+ vec <- recDerefPtrs ptr+ updateVector vec i obj updateVector v _ _ = throwError $ TypeMismatch "vector" v {- Prepare for apply by evaluating each function argument,@@ -693,14 +736,16 @@ where cpsApply :: Env -> LispVal -> LispVal -> Maybe [LispVal] -> IOThrowsError LispVal cpsApply e c _ _ = doApply e c- doApply e c =+ doApply e c = do+ -- TODO (?): List dargs <- recDerefPtrs $ List args -- Deref any pointers case (toInteger $ length args) of 0 -> throwError $ NumArgs 1 [] 1 -> continueEval e c $ head args _ -> -- Pass along additional arguments, so they are available to (call-with-values) continueEval e (Continuation env ccont ncont (Just $ tail args) ndynwind) $ head args apply cont (IOFunc func) args = do- result <- func args+ List dargs <- recDerefPtrs $ List args -- Deref any pointers+ result <- func dargs case cont of Continuation cEnv _ _ _ _ -> continueEval cEnv cont result _ -> return result@@ -709,7 +754,8 @@ pass it as the first argument. -} func (cont : args) apply cont (PrimitiveFunc func) args = do- result <- liftThrows $ func args+ List dargs <- recDerefPtrs $ List args -- Deref any pointers+ result <- liftThrows $ func dargs case cont of Continuation cEnv _ _ _ _ -> continueEval cEnv cont result _ -> return result@@ -834,10 +880,16 @@ if null args then throwError $ NumArgs 2 args- else case head aRev of- List aLastElems -> do- apply cont func $ (init args) ++ aLastElems- other -> throwError $ TypeMismatch "List" other+ else applyArgs $ head aRev+ where + applyArgs aRev = do+ case aRev of+ List aLastElems -> do+ apply cont func $ (init args) ++ aLastElems+ Pointer pVar pEnv -> do+ value <- recDerefPtrs aRev+ applyArgs value+ other -> throwError $ TypeMismatch "List" other evalfuncApply (_ : args) = throwError $ NumArgs 2 args -- Skip over continuation argument evalfuncApply _ = throwError $ NumArgs 2 [] @@ -945,9 +997,10 @@ ("peek-char", readCharProc hLookAhead), ("write", writeProc (\ port obj -> hPrint port obj)), ("write-char", writeCharProc),- ("display", writeProc (\ port obj -> case obj of- String str -> hPutStr port str- _ -> hPutStr port $ show obj)),+ ("display", writeProc (\ port obj -> do+ case obj of+ String str -> hPutStr port str+ _ -> hPutStr port $ show obj)), -- From SRFI 96 ("file-exists?", fileExists),
hs-src/Language/Scheme/Primitives.hs view
@@ -1,3 +1,4 @@+{-# LANGUAGE CPP #-} {-# Language ExistentialQuantification #-} {- |@@ -120,7 +121,14 @@ import System.IO import System.Directory (doesFileExist, removeFile) import System.IO.Error+-- import Debug.Trace +#if __GLASGOW_HASKELL__ < 702+try' = try+#else+try' = tryIOError+#endif+ --------------------------------------------------- -- I/O Primitives -- These primitives all execute within the IO monad@@ -152,7 +160,7 @@ isCharReady :: [LispVal] -> IOThrowsError LispVal isCharReady [Port port] = do --liftM Bool $ liftIO $ hReady port- result <- liftIO $ try (liftIO $ hReady port)+ result <- liftIO $ try' (liftIO $ hReady port) case result of Left e -> if isEOFError e then return $ Bool False@@ -163,7 +171,7 @@ readProc :: [LispVal] -> IOThrowsError LispVal readProc [] = readProc [Port stdin] readProc [Port port] = do- input <- liftIO $ try (liftIO $ hGetLine port)+ input <- liftIO $ try' (liftIO $ hGetLine port) case input of Left e -> if isEOFError e then return $ EOF@@ -176,7 +184,7 @@ readCharProc func [] = readCharProc func [Port stdin] readCharProc func [Port port] = do liftIO $ hSetBuffering port NoBuffering- input <- liftIO $ try (liftIO $ func port)+ input <- liftIO $ try' (liftIO $ func port) liftIO $ hSetBuffering port LineBuffering case input of Left e -> if isEOFError e@@ -191,7 +199,7 @@ (Handle -> LispVal -> IO a) -> [LispVal] -> m LispVal -} writeProc func [obj] = writeProc func [obj, Port stdout] writeProc func [obj, Port port] = do- output <- liftIO $ try (liftIO $ func port obj)+ output <- liftIO $ try' (liftIO $ func port obj) case output of Left _ -> throwError $ Default "I/O error writing to port" Right _ -> return $ Nil ""@@ -202,7 +210,7 @@ writeCharProc :: [LispVal] -> IOThrowsError LispVal writeCharProc [obj] = writeCharProc [obj, Port stdout] writeCharProc [obj@(Char _), Port port] = do- output <- liftIO $ try (liftIO $ (hPutStr port $ show obj))+ output <- liftIO $ try' (liftIO $ (hPutStr port $ show obj)) case output of Left _ -> throwError $ Default "I/O error writing to port" Right _ -> return $ Nil ""@@ -218,7 +226,7 @@ fileExists args@(_ : _) = throwError $ NumArgs 1 args deleteFile [String filename] = do- output <- liftIO $ try(liftIO $ removeFile filename)+ output <- liftIO $ try' (liftIO $ removeFile filename) case output of Left _ -> return $ Bool False Right _ -> return $ Bool True@@ -341,7 +349,7 @@ hashTblRef [(HashTable ht), key@(_)] = do case Data.Map.lookup key ht of- Just val -> return $ val+ Just val -> return val Nothing -> throwError $ BadSpecialForm "Hash table does not contain key" key hashTblRef [(HashTable ht), key@(_), Func _ _ _ _] = do case Data.Map.lookup key ht of
hs-src/Language/Scheme/Types.hs view
@@ -14,15 +14,9 @@ -} module Language.Scheme.Types-{- (- Env--- , Environment- , parentEnv- , bindings+ ( Env (..) , nullEnv - , macroNamespace- , varNamespace- , LispError+ , LispError (..) , ThrowsError , trapError , extractValue @@ -30,23 +24,69 @@ , liftThrows , runIOThrowsREPL , runIOThrows - , LispVal+ , LispVal (+ Atom+ , List+ , DottedList+ , Vector+ , HashTable+ , Number+ , Float+ , Complex+ , Rational+ , String+ , Char+ , Bool+ , PrimitiveFunc+ , Func+ , params+ , vararg+ , body+ , closure+ , HFunc+ , hparams+ , hvararg+ , hbody+ , hclosure+ , IOFunc+ , EvalFunc+ , Pointer+ , pointerVar+ , pointerEnv+ , Opaque+ , Port+ , Continuation+ , contClosure+ , currentCont+ , nextCont+ , extraReturnArgs+ , dynamicWind+ , Syntax+ , synClosure+ , synRenameClosure+ , synDefinedInMacro+ , synIdentifiers+ , synRules+ , SyntaxExplicitRenaming+ , EOF+ , Nil) , toOpaque , fromOpaque- , DeferredCode- , DynamicWinders - , before - , after - , showDWVal + , DeferredCode (..)+ , DynamicWinders (..) , makeNullContinuation , makeCPS , makeCPSWArgs , eqv , eqvList , eqVal - , showVal- , unwordsList- ) -}+ , makeFunc+ , makeNormalFunc+ , makeVarargs+ , makeHFunc+ , makeNormalHFunc+ , makeHVarargs+ ) where import Control.Monad.Error import Data.Complex@@ -64,21 +104,16 @@ -- |A Scheme environment containing variable bindings of form @(namespaceName, variableName), variableValue@ data Env = Environment { parentEnv :: (Maybe Env), - bindings :: (IORef (Data.Map.Map (String, String) (IORef LispVal)))+ bindings :: (IORef (Data.Map.Map String (IORef LispVal))),+ pointers :: (IORef (Data.Map.Map String (IORef [LispVal]))) } -- |An empty environment nullEnv :: IO Env-nullEnv = do nullBindings <- newIORef $ Data.Map.fromList []- return $ Environment Nothing nullBindings---- Internal namespace for macros-macroNamespace :: [Char]-macroNamespace = "m"---- Internal namespace for variables-varNamespace :: [Char]-varNamespace = "v"+nullEnv = do + nullBindings <- newIORef $ Data.Map.fromList []+ nullPointers <- newIORef $ Data.Map.fromList []+ return $ Environment Nothing nullBindings nullPointers -- |Types of errors that may occur when evaluating Scheme code data LispError = NumArgs Integer [LispVal] -- ^Invalid number of function arguments@@ -194,13 +229,16 @@ | EvalFunc ([LispVal] -> IOThrowsError LispVal) {- ^Function within the IO monad with access to the current environment and continuation. -}+ | Pointer { pointerVar :: String+ ,pointerEnv :: Env } + -- ^Pointer to an environment variable. | Opaque Dynamic -- ^Opaque Haskell value. | Port Handle -- ^I/O port- | Continuation { closure :: Env -- Environment of the continuation+ | Continuation { contClosure :: Env -- Environment of the continuation , currentCont :: (Maybe DeferredCode) -- Code of current continuation- , nextCont :: (Maybe LispVal) -- Code to resume after body of cont+ , nextCont :: (Maybe LispVal) -- Code to resume after body of cont , extraReturnArgs :: (Maybe [LispVal]) -- Extra return arguments, to support (values) and (call-with-values) , dynamicWind :: (Maybe [DynamicWinders]) -- Functions injected by (dynamic-wind) }@@ -384,6 +422,7 @@ showVal (Port _) = "<IO port>" showVal (IOFunc _) = "<IO primitive>" showVal (EvalFunc _) = "<procedure>"+showVal (Pointer p _) = "<ptr " ++ p ++ ">" showVal (Opaque d) = "<Haskell " ++ show (dynTypeRep d) ++ ">" -- |Convert a list of Lisp objects into a space-separated string
hs-src/Language/Scheme/Variables.hs view
@@ -1,3 +1,5 @@+{-# LANGUAGE CPP #-}+ {- | Module : Language.Scheme.Variables Copyright : Justin Ethier@@ -19,57 +21,74 @@ , copyEnv , extendEnv , findNamespacedEnv+ , macroNamespace+ , varNamespace -- * Getters , getVar , getNamespacedVar -- * Setters , defineVar+ , defineNamespacedVar , setVar , setNamespacedVar- , defineNamespacedVar+ , updateObject + , updateNamespacedObject -- * Predicates , isBound , isRecBound , isNamespacedBound , isNamespacedRecBound + -- * Pointers+ , derefPtr+ , recDerefPtrs ) where import Language.Scheme.Types import Control.Monad.Error+import Data.Array import Data.IORef import qualified Data.Map-+-- import Debug.Trace --- TODO: convert from storing vars in a list to a more efficient--- data structure using Data.Map+-- Internal namespace for macros+macroNamespace :: [Char]+macroNamespace = "m" +-- Internal namespace for variables+varNamespace :: [Char]+varNamespace = "v" -{- Experimental code:+-- Experimental code: -- From: http://rafaelbarreto.com/2011/08/21/comparing-objects-by-memory-location-in-haskell/-import Foreign-isMemoryEquivalent :: a -> a -> IO Bool-isMemoryEquivalent obj1 obj2 = do- obj1Ptr <- newStablePtr obj1- obj2Ptr <- newStablePtr obj2- let result = obj1Ptr == obj2Ptr- freeStablePtr obj1Ptr- freeStablePtr obj2Ptr- return result+--+-- import Foreign+-- isMemoryEquivalent :: a -> a -> IO Bool+-- isMemoryEquivalent obj1 obj2 = do+-- obj1Ptr <- newStablePtr obj1+-- obj2Ptr <- newStablePtr obj2+-- let result = obj1Ptr == obj2Ptr+-- freeStablePtr obj1Ptr+-- freeStablePtr obj2Ptr+-- return result+-- +-- -- Using above, search an env for a variable definition, but stop if the upperEnv is+-- -- reached before the variable+-- isNamespacedRecBoundWUpper :: Env -> Env -> String -> String -> IO Bool+-- isNamespacedRecBoundWUpper upperEnvRef envRef namespace var = do +-- areEnvsEqual <- liftIO $ isMemoryEquivalent upperEnvRef envRef+-- if areEnvsEqual+-- then return False+-- else do+-- found <- liftIO $ isNamespacedBound envRef namespace var+-- if found+-- then return True +-- else case parentEnv envRef of+-- (Just par) -> isNamespacedRecBoundWUpper upperEnvRef par namespace var+-- Nothing -> return False -- Var never found+-- --- Using above, search an env for a variable definition, but stop if the upperEnv is--- reached before the variable-isNamespacedRecBoundWUpper :: Env -> Env -> String -> String -> IO Bool-isNamespacedRecBoundWUpper upperEnvRef envRef namespace var = do - areEnvsEqual <- liftIO $ isMemoryEquivalent upperEnvRef envRef- if areEnvsEqual- then return False- else do- found <- liftIO $ isNamespacedBound envRef namespace var- if found- then return True - else case parentEnv envRef of- (Just par) -> isNamespacedRecBoundWUpper upperEnvRef par namespace var- Nothing -> return False -- Var never found--}+-- |Create a variable's name in an environment using given arguments+getVarName :: String -> String -> String+getVarName namespace name = namespace ++ "_" ++ name -- |Show the contents of an environment printEnv :: Env -- ^Environment@@ -79,7 +98,7 @@ l <- mapM showVar $ Data.Map.toList binds return $ unlines l where - showVar ((_, name), val) = do+ showVar (name, val) = do v <- liftIO $ readIORef val return $ name ++ ": " ++ show v @@ -87,27 +106,29 @@ copyEnv :: Env -- ^ Source environment -> IO Env -- ^ A copy of the source environment copyEnv env = do+ ptrs <- liftIO $ readIORef $ pointers env+ ptrList <- newIORef ptrs+ binds <- liftIO $ readIORef $ bindings env--- bindingList <- mapM addBinding binds >>= newIORef- bindingListT <- mapM addBinding $ Data.Map.toList binds -- TODO: there is a more elegant way to write this here (and below, too)+ bindingListT <- mapM addBinding $ Data.Map.toList binds bindingList <- newIORef $ Data.Map.fromList bindingListT- return $ Environment (parentEnv env) bindingList -- TODO: recursively create a copy of parent also?- where addBinding ((namespace, name), val) = do --ref <- newIORef $ liftIO $ readIORef val- x <- liftIO $ readIORef val- ref <- newIORef x- return ((namespace, name), ref)+ return $ Environment (parentEnv env) bindingList ptrList+ where addBinding (name, val) = do + x <- liftIO $ readIORef val+ ref <- newIORef x+ return (name, ref) -- |Extend given environment by binding a series of values to a new environment.---- TODO: should be able to use Data.Map.fromList to ease construction of new Env extendEnv :: Env -- ^ Environment -> [((String, String), LispVal)] -- ^ Extensions to the environment -> IO Env -- ^ Extended environment-extendEnv envRef abindings = do bindinglistT <- (mapM addBinding abindings) -- >>= newIORef- bindinglist <- newIORef $ Data.Map.fromList bindinglistT- return $ Environment (Just envRef) bindinglist+extendEnv envRef abindings = do + bindinglistT <- (mapM addBinding abindings) -- >>= newIORef+ bindinglist <- newIORef $ Data.Map.fromList bindinglistT+ nullPointers <- newIORef $ Data.Map.fromList []+ return $ Environment (Just envRef) bindinglist nullPointers where addBinding ((namespace, name), val) = do ref <- newIORef val- return ((namespace, name), ref)+ return (getVarName namespace name, ref) -- |Recursively search environments to find one that contains the given variable. findNamespacedEnv @@ -144,7 +165,7 @@ -> String -- ^ Variable -> IO Bool -- ^ True if the variable is bound isNamespacedBound envRef namespace var = - (readIORef $ bindings envRef) >>= return . Data.Map.member (namespace, var)+ (readIORef $ bindings envRef) >>= return . Data.Map.member (getVarName namespace var) -- |Determine if a variable is bound in a given namespace -- or a parent of the given environment.@@ -173,7 +194,7 @@ getNamespacedVar envRef namespace var = do binds <- liftIO $ readIORef $ bindings envRef- case Data.Map.lookup (namespace, var) binds of+ case Data.Map.lookup (getVarName namespace var) binds of (Just a) -> liftIO $ readIORef a Nothing -> case parentEnv envRef of (Just par) -> getNamespacedVar par namespace var@@ -188,14 +209,6 @@ -> IOThrowsError LispVal -- ^ Value setVar envRef var value = setNamespacedVar envRef varNamespace var value --- |Bind a variable in the default namespace-defineVar- :: Env -- ^ Environment- -> String -- ^ Variable- -> LispVal -- ^ Value- -> IOThrowsError LispVal -- ^ Value-defineVar envRef var value = defineNamespacedVar envRef varNamespace var value- -- |Set a variable in a given namespace setNamespacedVar :: Env -- ^ Environment @@ -205,15 +218,136 @@ -> IOThrowsError LispVal -- ^ Value setNamespacedVar envRef namespace- var value = do env <- liftIO $ readIORef $ bindings envRef- case Data.Map.lookup (namespace, var) env of- (Just a) -> do -- vprime <- liftIO $ readIORef a- liftIO $ writeIORef a value- return value- Nothing -> case parentEnv envRef of- (Just par) -> setNamespacedVar par namespace var value- Nothing -> throwError $ UnboundVar "Setting an unbound variable: " var+ var value = do + _ <- updatePointers envRef namespace var + _setNamespacedVar envRef namespace var value +-- |An internal function that does the actual setting of a +-- variable, without all the extra code that keeps pointers+-- in sync when a variable is re-binded+--+-- Note this function still binds reverse pointers+-- for purposes of book-keeping.+_setNamespacedVar + :: Env -- ^ Environment + -> String -- ^ Namespace+ -> String -- ^ Variable+ -> LispVal -- ^ Value+ -> IOThrowsError LispVal -- ^ Value+_setNamespacedVar envRef+ namespace+ var value = do + -- Set the variable to its new value+ valueToStore <- getValueToStore namespace var envRef value+ _setNamespacedVarDirect envRef namespace var valueToStore++-- |Do the actual "set" operation, with NO pointer operations.+-- Only call this if you know what you are doing!+_setNamespacedVarDirect envRef+ namespace+ var valueToStore = do + env <- liftIO $ readIORef $ bindings envRef+ case Data.Map.lookup (getVarName namespace var) env of+ (Just a) -> do+ liftIO $ writeIORef a valueToStore+ return valueToStore+ Nothing -> case parentEnv envRef of+ (Just par) -> _setNamespacedVarDirect par namespace var valueToStore+ Nothing -> throwError $ UnboundVar "Setting an unbound variable: " var++-- |This helper function is used to keep pointers in sync when+-- a variable is bound to a different value.+updatePointers :: Env -> String -> String -> IOThrowsError LispVal+updatePointers envRef namespace var = do+ ptrs <- liftIO $ readIORef $ pointers envRef+ case Data.Map.lookup (getVarName namespace var) ptrs of+ (Just valIORef) -> do+ val <- liftIO $ readIORef valIORef+ case val of + -- If var has any pointers, then we need to + -- assign the first pointer to the old value+ -- of x, and the rest need to be updated to + -- point to that first var++ -- This is the first pointer to (the old) var+ (Pointer pVar pEnv : ps) -> do+ -- Since var is now fresh, reset its pointers list+ liftIO $ writeIORef valIORef []++ -- The first pointer now becomes the old var,+ -- so its pointers list should become ps+ movePointers pEnv namespace pVar ps++ -- Each ps needs to be updated to point to pVar+ -- instead of var+ pointToNewVar pEnv namespace pVar ps++ -- Set first pointer to existing value of var+ existingValue <- getNamespacedVar envRef namespace var+ _setNamespacedVar pEnv namespace pVar existingValue++ -- No pointers, so nothing to do+ [] -> return $ Nil ""+ _ -> throwError $ InternalError+ "non-pointer value found in updatePointers"+ Nothing -> return $ Nil ""+ where+ -- |Move the given pointers (ptr) to the list of+ -- pointers for variable (var)+ movePointers :: Env -> String -> String -> [LispVal] -> IOThrowsError LispVal+ movePointers envRef namespace var ptrs = do+ env <- liftIO $ readIORef $ pointers envRef+ case Data.Map.lookup (getVarName namespace var) env of+ Just ps' -> do+ -- Append ptrs to existing list of pointers to var+ ps <- liftIO $ readIORef ps'+ liftIO $ writeIORef ps' $ ps ++ ptrs+ return $ Nil ""+ Nothing -> do+ -- var does not have any pointers; create new list+ valueRef <- liftIO $ newIORef ptrs+ liftIO $ writeIORef (pointers envRef) (Data.Map.insert (getVarName namespace var) valueRef env)+ return $ Nil ""++ -- |Update each pointer's source to point to pVar+ pointToNewVar pEnv namespace pVar (Pointer v e : ps) = do+ _ <- _setNamespacedVarDirect e namespace v (Pointer pVar pEnv)+ pointToNewVar pEnv namespace pVar ps+ pointToNewVar pEnv namespace pVar [] = return $ Nil ""+ pointToNewVar pEnv namespace pVar _ = throwError $ InternalError "pointToNewVar"++-- |A wrapper for updateNamespaceObject that uses the variable namespace.+updateObject :: Env -> String -> LispVal -> IOThrowsError LispVal+updateObject env var value = + updateNamespacedObject env varNamespace var value++-- |This function updates the object that "var" refers to. If "var" is+-- a pointer, that means this function will update that pointer (or the last+-- pointer in the chain) to point to the given "value" object. If "var"+-- is not a pointer, the result is the same as a setVar (but without updating+-- any pointer references, see below).+--+-- Note this function only updates the object, it does not+-- update any associated pointers. So it should probably only be+-- used internally by husk, unless you really know what you are+-- doing!+updateNamespacedObject :: Env -> String -> String -> LispVal -> IOThrowsError LispVal+updateNamespacedObject env namespace var value = do+ varContents <- getNamespacedVar env namespace var+ obj <- findPointerTo varContents+ case obj of+ Pointer pVar pEnv -> do+ _setNamespacedVar pEnv namespace pVar value+ _ -> _setNamespacedVar env namespace var value++-- |Bind a variable in the default namespace+defineVar+ :: Env -- ^ Environment+ -> String -- ^ Variable+ -> LispVal -- ^ Value+ -> IOThrowsError LispVal -- ^ Value+defineVar envRef var value = defineNamespacedVar envRef varNamespace var value+ -- |Bind a variable in the given namespace defineNamespacedVar :: Env -- ^ Environment @@ -227,8 +361,133 @@ alreadyDefined <- liftIO $ isNamespacedBound envRef namespace var if alreadyDefined then setNamespacedVar envRef namespace var value >> return value- else liftIO $ do- valueRef <- newIORef value- env <- readIORef $ bindings envRef- writeIORef (bindings envRef) (Data.Map.insert (namespace, var) valueRef env) -- (((namespace, var), valueRef) : env)- return value+ else do+ --+ -- Future optimization:+ -- don't change anything if (define) is to existing pointer+ -- (IE, it does not really change anything)+ --+++ -- If we are assigning to a pointer, we need a reverse lookup to + -- note that the pointer "value" points to "var"+ -- + -- So run through this logic to figure out what exactly to store,+ -- both for bindings and for rev-lookup pointers+ valueToStore <- getValueToStore namespace var envRef value+ liftIO $ do+ -- Write new value binding+ valueRef <- newIORef valueToStore+ env <- readIORef $ bindings envRef+ writeIORef (bindings envRef) (Data.Map.insert (getVarName namespace var) valueRef env)+ return valueToStore++-- |An internal helper function to get the value to save to an env+-- based on the value passed to the define/set function. Normally this+-- is straightforward, but there is book-keeping involved if a+-- pointer is passed, depending on if the pointer resolves to an object.+getValueToStore :: String -> String -> Env -> LispVal -> IOThrowsError LispVal+getValueToStore namespace var env (Pointer p pEnv) = do+ addReversePointer namespace p pEnv namespace var env+getValueToStore _ _ _ value = return value++-- |Accept input for a pointer (ptrVar) and a variable that the pointer is going+-- to be assigned to. If that variable is an object then we setup a reverse lookup+-- for future book-keeping. Otherwise, we just look it up and return it directly, +-- no booking-keeping required.+addReversePointer :: String -> String -> Env -> String -> String -> Env -> IOThrowsError LispVal+addReversePointer namespace var envRef ptrNamespace ptrVar ptrEnvRef = do+ env <- liftIO $ readIORef $ bindings envRef+ case Data.Map.lookup (getVarName namespace var) env of+ (Just a) -> do+ v <- liftIO $ readIORef a+ if isObject v+ then do+ -- Store a reverse pointer for book keeping+ ptrs <- liftIO $ readIORef $ pointers envRef+ + -- Lookup ptr for var+ case Data.Map.lookup (getVarName namespace var) ptrs of+ -- Append another reverse ptr to this var+ -- FUTURE: make sure ptr is not already there, + -- before adding it to the list again?+ (Just valueRef) -> liftIO $ do+ value <- readIORef valueRef+ writeIORef valueRef (value ++ [Pointer ptrVar ptrEnvRef])+ return $ Pointer var envRef ++ -- No mapping, add the first reverse pointer+ Nothing -> liftIO $ do+ valueRef <- newIORef [Pointer ptrVar ptrEnvRef]+ writeIORef (pointers envRef) (Data.Map.insert (getVarName namespace var) valueRef ptrs)+ return $ Pointer var envRef -- Return non-reverse ptr to caller+ else return v -- Not an object, return value directly+ Nothing -> case parentEnv envRef of+ (Just par) -> addReversePointer namespace var par ptrNamespace ptrVar ptrEnvRef+ Nothing -> throwError $ UnboundVar "Getting an unbound variable: " var++-- |Return a value with a pointer dereferenced, if necessary+derefPtr :: LispVal -> IOThrowsError LispVal+-- Try dereferencing again if a ptr is found+--+-- Not sure if this is the best solution; it would be +-- nice if we did not have to worry about multiple levels+-- of ptrs, especially since I believe husk only needs to +-- have one level. but for now we will go with this to+-- move forward.+--+derefPtr (Pointer p env) = do+ result <- getVar env p+ derefPtr result+derefPtr v = return v++-- |Recursively process the given data structure, dereferencing+-- any pointers found along the way. +-- +-- This could potentially be expensive on large data structures +-- since it must walk the entire object.+recDerefPtrs :: LispVal -> IOThrowsError LispVal+#ifdef UsePointers+recDerefPtrs (List l) = do+ result <- mapM recDerefPtrs l+ return $ List result+recDerefPtrs (DottedList ls l) = do+ ds <- mapM recDerefPtrs ls+ d <- recDerefPtrs l+ return $ DottedList ds d+recDerefPtrs (Vector v) = do+ let vs = elems v+ ds <- mapM recDerefPtrs vs+ return $ Vector $ listArray (0, length vs - 1) ds+recDerefPtrs (HashTable ht) = do+ ks <- mapM recDerefPtrs $ map (\ (k, _) -> k) $ Data.Map.toList ht+ vs <- mapM recDerefPtrs $ map (\ (_, v) -> v) $ Data.Map.toList ht+ return $ HashTable $ Data.Map.fromList $ zip ks vs+#endif+recDerefPtrs (Pointer p env) = do+ result <- getVar env p+ recDerefPtrs result +recDerefPtrs v = return v++-- |A predicate to determine if the given lisp value +-- is an "object" that can be pointed to.+isObject :: LispVal -> Bool+isObject (List _) = True+isObject (DottedList _ _) = True+isObject (String _) = True+isObject (Vector _) = True+isObject (HashTable _) = True+isObject (Pointer _ _) = True+isObject _ = False++-- |Same as dereferencing a pointer, except we want the+-- last pointer to an object (if there is one) instead+-- of the object itself+findPointerTo :: LispVal -> IOThrowsError LispVal+findPointerTo ptr@(Pointer p env) = do+ result <- getVar env p+ case result of+ (Pointer _ _) -> findPointerTo result+ _ -> return ptr+findPointerTo v = return v+
husk-scheme.cabal view
@@ -1,5 +1,5 @@ Name: husk-scheme-Version: 3.5.7+Version: 3.6 Synopsis: R5RS Scheme interpreter, compiler, and library. Description: A dialect of R5RS Scheme written in Haskell. Provides advanced features including continuations, hygienic macros, a Haskell FFI,@@ -28,6 +28,10 @@ description: Turn off FFI to decrease build times and minimize executable sizes default: True +flag useptrs+ description: Turn off pointers to increase performance at the expense of severely restricting the functionality of mutable variables. Setting this flag to false will revert back to the behavior from previous versions of husk.+ default: True+ Library Build-Depends: base >= 2.0 && < 5, array, containers, haskeline, transformers, mtl, parsec, directory Extensions: ExistentialQuantification@@ -49,6 +53,9 @@ Exposed-Modules: Language.Scheme.FFI cpp-options: -DUseFfi + if flag(useptrs)+ cpp-options: -DUsePointers+ Executable huski Build-Depends: husk-scheme, base >= 2.0 && < 5, array, containers, haskeline, transformers, mtl, parsec, directory if flag(useffi)@@ -63,6 +70,8 @@ if flag(useffi) Build-Depends: ghc, ghc-paths cpp-options: -DUseFfi+ if flag(useptrs)+ cpp-options: -DUsePointers Extensions: ExistentialQuantification Main-is: huskc.hs Hs-Source-Dirs: hs-src/Compiler