Permalink
Browse files

Merge

  • Loading branch information...
2 parents 0844fff + 8461388 commit ef304e15ae74bb13bdcbb432b18519b9b24a1a14 @bos committed Oct 25, 2011
View
@@ -1,4 +1,5 @@
\#.*
+\.(?:orig)$
~$
syntax: glob
.\#*
View
@@ -0,0 +1,2 @@
+59a7421ffa5c3b91ca34199ada587d3646a31498 github/master
+73534996e9bcde1f0fb97f21acfb3400e0c8680b default/master
View
@@ -0,0 +1,47 @@
+module DB where
+
+import Control.Exception
+
+data Connection
+data Transaction
+
+begin :: Connection -> IO Transaction
+begin conn = undefined
+
+commit :: Transaction -> IO ()
+commit txn = undefined
+
+rollback :: Transaction -> IO ()
+rollback txn = undefined
+
+oops conn = do
+ txn <- begin conn
+ throwIO (AssertionFailed "the weebles!")
+ commit txn
+
+withTxn :: Connection -> IO a -> IO a
+withTxn conn act = do
+ txn <- begin conn
+ r <- act `onException` rollback txn
+ commit txn
+ return r
+
+
+query :: Connection -> String -> IO [String]
+query = undefined
+
+oops2 conn = withTxn
+
+data Pool
+
+getConn :: Pool -> IO Connection
+getConn p = undefined
+
+returnConn :: Pool -> Connection -> IO ()
+returnConn p c = undefined
+
+withConn :: Pool -> (Connection -> IO a) -> IO a
+withConn pool act =
+ bracket (getConn pool) (returnConn pool) act
+
+evil pool = withConn pool return
View
@@ -0,0 +1,27 @@
+{-# LANGUAGE Rank2Types #-}
+
+module DB1 where
+
+import DB
+
+newtype DB c a = DB {
+ fromDB :: IO a
+ }
+
+instance Monad (DB c) where
+ DB a >>= m = DB (a >>= \b -> fromDB (m b))
+ return a = DB (return a)
+ fail s = DB (fail s)
+
+newtype SafeConn c = Safe Connection
+
+withConnection :: Pool -> (forall c. SafeConn c -> DB c a) -> IO a
+withConnection pool act =
+ withConn pool $ \conn ->
+ fromDB (act (Safe conn))
+
+safeQuery :: SafeConn c -> String -> DB c [String]
+safeQuery (Safe conn) str = DB (query conn str)
+
+withConnectio :: Pool -> (forall c. ((->) (SafeConn c) (DB c a))) -> IO a
+withConnectio = undefined
@@ -0,0 +1 @@
+include ../Lecture.mk
View
@@ -0,0 +1,13 @@
+data Expr = Num Int -- atom
+ | Str String -- atom
+ | Op BinOp Expr Expr -- compound
+ deriving (Show)
+
+data BinOp = Add | Concat
+ deriving (Show)
+
+interp x@(Num _) = x
+interp x@(Str _) = x
+interp (Op Add a b) = Num (i a + i b)
+ where i x = case interp x of Num a -> a
+interp (Op Concat (Str a) (Str b)) = Str (a ++ b)
View
@@ -0,0 +1,35 @@
+module Interp2
+ (
+ Expr,
+ num, str,
+ add, cat,
+ interp
+ ) where
+
+data Expr a = Num Int
+ | Str String
+ | Op BinOp (Expr a) (Expr a)
+ deriving (Show)
+
+data BinOp = Add | Concat
+ deriving (Show)
+
+interp :: Expr a -> Expr a
+interp x@(Num _) = x
+interp x@(Str _) = x
+interp (Op Add a b) = Num (i a + i b)
+ where i x = case interp x of Num a -> a
+interp (Op Concat a b) = Str (i a ++ i b)
+ where i x = case interp x of Str y -> y
+
+num :: Int -> Expr Int
+num = Num
+
+str :: String -> Expr String
+str = Str
+
+add :: Expr Int -> Expr Int -> Expr Int
+add = Op Add
+
+cat :: Expr String -> Expr String -> Expr String
+cat = Op Concat
View
@@ -0,0 +1,27 @@
+{-# LANGUAGE BangPatterns #-}
+
+import System.Random
+import Data.List (partition)
+import Control.Arrow ((***))
+
+montePi k g0 =
+ fin . (length *** length) .
+ partition (<=1) .
+ take k . tail . map fst .
+ iterate guess $ (undefined,g0)
+ where
+ fin (m,n) = 4 * fromIntegral m /
+ fromIntegral (m+n)
+
+guess :: (RandomGen g) => (Double,g) -> (Double,g)
+guess (_,g) = (z,g'')
+ where z = x^2 + y^2
+ (x,g') = random g
+ (y,g'') = random g'
+
+withGen :: (StdGen -> a) -> IO a
+withGen f = do
+ g <- getStdGen
+ let (g',g'') = split g
+ setStdGen g'
+ return (f g'')
View
@@ -0,0 +1,24 @@
+module Ref
+ (
+ Ref, newRef, readOnly,
+ readRef, writeRef
+ ) where
+
+import Data.IORef
+
+newtype Ref t a = Ref (IORef a)
+
+data ReadOnly
+data ReadWrite
+
+newRef :: a -> IO (Ref ReadWrite a)
+newRef a = Ref `fmap` newIORef a
+
+readRef :: Ref t a -> IO a
+readRef (Ref ref) = readIORef ref
+
+writeRef :: Ref ReadWrite a -> a -> IO ()
+writeRef (Ref ref) v = writeIORef ref v
+
+readOnly :: Ref t a -> Ref ReadOnly a
+readOnly (Ref ref) = Ref ref
View
@@ -0,0 +1,8 @@
+import Control.Monad.ST
+import Data.STRef
+
+whee :: Int -> ST s Int
+whee z = do
+ r <- newSTRef z
+ modifySTRef r (+1)
+ readSTRef r
View
@@ -0,0 +1,42 @@
+{-# LANGUAGE BangPatterns #-}
+
+module Vec (quicksort) where
+
+import qualified Data.Vector.Unboxed.Mutable as V
+import qualified Data.Vector.Unboxed as U
+import Data.List (partition)
+import Control.Monad.ST
+
+quicksort :: V.MVector s Int -> ST s ()
+quicksort vec = go 0 (V.length vec-1)
+ where
+ go left right
+ | left >= right = return ()
+ | otherwise = do
+ idx <- partition left right
+ ((left + right) `div` 2)
+ go left (idx-1)
+ go (idx+1) right
+
+ partition left right pivotIdx = do
+ pivot <- V.read vec pivotIdx
+ V.swap vec pivotIdx right
+ let loop i k
+ | i == right = V.swap vec k right >>
+ return k
+ | otherwise = do
+ v <- V.read vec i
+ if v < pivot
+ then V.swap vec i k >> loop (i+1) (k+1)
+ else loop (i+1) k
+ loop left left
+
+qsort (p:xs) = qsort lt ++ [p] ++ qsort ge
+ where (lt,ge) = partition (<p) xs
+qsort _ = []
+
+vsort :: U.Vector Int -> U.Vector Int
+vsort v = U.create $ do
+ vec <- U.thaw v
+ quicksort vec
+ return vec
Oops, something went wrong.

0 comments on commit ef304e1

Please sign in to comment.