X-Git-Url: http://git.nomeata.de/?p=darcs-mirror-sem_syn.git;a=blobdiff_plain;f=BundledCode.hs;h=3c31e9bd1caf76210f8d3c3573576e4d5b50f10d;hp=ec9af88f7d71b40fa0fccb2d0a6e1c6af788a063;hb=3a0331645eb149263c0d495744398eab99eda386;hpb=4a8f857370dc0b969728163c9a41a3347dca30db diff --git a/BundledCode.hs b/BundledCode.hs index ec9af88..3c31e9b 100644 --- a/BundledCode.hs +++ b/BundledCode.hs @@ -4,6 +4,6 @@ module BundledCode where import Data.ByteString.Lazy.Char8 bUtilCode :: ByteString -bUtilCode = "{-# OPTIONS -XRank2Types -XCPP -XScopedTypeVariables #-}\nmodule BUtil where\n\nimport qualified Data.IntMap as IntMap \nimport Control.Monad \n\nimport System.IO.Unsafe\n\nimport Control.Exception\n\ndata Nat = S Nat | Z deriving (Eq)\n\ninstance Show Nat where\n show = show . fromNat\n\ninstance Num Nat where\n (+) = error \"No operators defined for Nat\"\n (*) = error \"No operators defined for Nat\"\n abs = error \"No operators defined for Nat\"\n signum = error \"No operators defined for Nat\"\n fromInteger n | n < 0 = error \"Nat cannot be negative\"\n | n >= 0 = toNat n\n\ntoNat x = if x == 0 then \n Z\n else \n S (toNat \$ x-1)\n\nfromNat Z = 0\nfromNat (S x) = 1 + fromNat x\n\nfromDistinctList = IntMap.fromList \n\ngen_put_bias :: Bias \n -> (forall a. [a] -> [a]) \n -> (Nat -> Nat -> Maybe Nat) \n -> [a] -> [a] \n -> Maybe [Maybe a]\ngen_put_bias bias get sput s v =\n do { let ls = length s \n ; let g = fromDistinctList (zip (bias ls) s)\n ; l' <- maybe (fail \"...\")\n return\n (sput (toNat ls) (toNat (length v)))\n ; let t = bias (fromNat l')\n ; let h = fromDistinctList (zip (get t) v)\n ; let h'= IntMap.union h g \n ; return (map (flip IntMap.lookup h') t) }\n\nwithDefaultBias put bias d s v =\n do { s' <- put bias s v \n ; return (map (maybe d id) s') }\n\nwithDefault put d s v =\n do { s' <- put s v \n ; return (map (maybe d id) s') }\n\ngen_put_dbias :: Bias -> (forall a. [a] -> [a]) \n -> (Nat -> Nat -> Maybe Nat)\n -> a -> [a] -> [a] -> Maybe [a]\ngen_put_dbias bias get sput d s v =\n do { s' <- gen_put_bias bias get sput s v\n ; return (map (maybe d id) s') }\n\ncastError :: a -> Maybe a \ncastError f = unsafePerformIO \$ \n do { r <- try (evaluate f)\n ; case r of\n#if __GLASGOW_HASKELL__ >= 610 \n Left (e::SomeException) -> return \$ Nothing \n#else\n Left e -> return \$ Nothing \n#endif\n Right r -> return \$ Just \$ r }\n\ntype Bias = Int -> [ Int ]\nrear l = [ 0 .. l - 1 ]\nfront l = reverse [ 0 .. l - 1 ]\nmiddle l = [1,3..l] + (reverse [2,4..l])\nborders l = (reverse [1,3..l])+[2,4..l]\n" +bUtilCode = "{-# OPTIONS -XRank2Types -XCPP -XScopedTypeVariables #-}\nmodule BUtil where\n\nimport qualified Data.IntMap as IntMap \nimport Control.Monad \n\nimport System.IO.Unsafe\n\nimport Control.Exception\n\ndata Nat = S Nat | Z deriving (Eq)\n\ninstance Show Nat where\n show = show . fromNat\n\ninstance Num Nat where\n (+) = error \"No operators defined for Nat\"\n (*) = error \"No operators defined for Nat\"\n abs = error \"No operators defined for Nat\"\n signum = error \"No operators defined for Nat\"\n fromInteger n | n < 0 = error \"Nat cannot be negative\"\n | n >= 0 = toNat n\n\ntoNat x = if x == 0 then \n Z\n else \n S (toNat \$ x-1)\n\nfromNat Z = 0\nfromNat (S x) = 1 + fromNat x\n\nfromDistinctList = IntMap.fromList \n\ngen_put_bias :: Bias \n -> (forall a. [a] -> [a]) \n -> (Nat -> Nat -> Maybe Nat) \n -> [a] -> [a] \n -> Maybe [Maybe a]\ngen_put_bias bias get sput s v =\n do { let ls = length s \n ; let g = fromDistinctList (zip (bias ls) s)\n ; l' <- maybe (fail \"...\")\n return\n (sput (toNat ls) (toNat (length v)))\n ; let t = bias (fromNat l')\n ; let h = fromDistinctList (zip (get t) v)\n ; let h'= IntMap.union h g \n ; return (map (flip IntMap.lookup h') t) }\n\nwithDefaultBias put bias d s v =\n do { s' <- put bias s v \n ; return (map (maybe d id) s') }\n\nwithDefault put d s v =\n do { s' <- put s v \n ; return (map (maybe d id) s') }\n\ngen_put_dbias :: Bias -> (forall a. [a] -> [a]) \n -> (Nat -> Nat -> Maybe Nat)\n -> a -> [a] -> [a] -> Maybe [a]\ngen_put_dbias bias get sput d s v =\n do { s' <- gen_put_bias bias get sput s v\n ; return (map (maybe d id) s') }\n\ncastError :: a -> Maybe a \ncastError f = unsafePerformIO \$ \n do { r <- try (evaluate f)\n ; case r of\n#if __GLASGOW_HASKELL__ >= 610 \n Left (e::SomeException) -> return \$ Nothing \n#else\n Left e -> return \$ Nothing \n#endif\n Right r -> return \$ Just \$ r }\n\ntype Bias = Int -> [ Int ]\nrear l = [ 0 .. l - 1 ]\nfront l = reverse [ 0 .. l - 1 ]\nmiddle l = [1,3..l] ++ (reverse [2,4..l])\nborders l = (reverse [1,3..l])++[2,4..l]\n"