module Main where
import System.IO
import Control.Monad
import Text.ParserCombinators.Parsec
import Text.ParserCombinators.Parsec.Expr
import Text.ParserCombinators.Parsec.Language
import qualified Text.ParserCombinators.Parsec.Token as Token
--import qualified Text.Parsec.Token as P
data BExpr = BoolConst Bool
| Not BExpr
| BBinary BBinOp BExpr BExpr
| RBinary RBinOp AExpr AExpr
deriving (Show)
data BBinOp = And | Or deriving (Show)
data RBinOp = Greater | Less deriving (Show)
data AExpr = Var String
| IntConst Integer
| Neg AExpr
| ABinary ABinOp AExpr AExpr
deriving (Show)
data DataType = Int Integer
| Double Integer
| Void String
| Char Char
deriving(Show)
data ABinOp = Add
| Subtract
| Multiply
| Divide
deriving (Show)
data Stmt = Seq [Stmt]
| Assign String AExpr
| If BExpr Stmt Stmt
| While BExpr Stmt
| Skip
deriving (Show)
lenguageDef = emptyDef {
Token.commentStart = "/"
, Token.commentEnd = "/"
, Token.commentLine = "//"
, Token.identStart = letter
, Token.identLetter = alphaNum
, Token.reservedNames = [ "if"
--, "then"
, "else"
, "while"
, "do"
, "skip"
, "true"
, "false"
, "not"
, "and"
, "or"
, "void"
, "int"
, "char"
, "double"
]
, Token.reservedOpNames = ["+", "-", "*", "/", ":="
, "<", ">", "and", "or", "not"
]
}
lexer = Token.makeTokenParser lenguageDef
identifier = Token.identifier lexer -- parses an identifier
reserved = Token.reserved lexer -- parses a reserved name
reservedOp = Token.reservedOp lexer -- parses an operator
parens = Token.parens lexer -- parses surrounding parenthesis:
-- parens p
-- takes care of the parenthesis and
-- uses p to parse what's inside them
braces = Token.braces lexer
integer = Token.integer lexer -- parses an integer
semi = Token.semi lexer -- parses a semicolon
whiteSpace = Token.whiteSpace lexer -- parses whitespace
whileParser :: Parser Stmt
whileParser = whiteSpace >> statement
statement :: Parser Stmt
statement = parens statement
<|> sequenceOfStmt
sequenceOfStmt =
do list <- (sepBy1 statement' semi)
-- If there's only one statement return it without using Seq.
return $ if length list == 1 then head list else Seq list
statement' :: Parser Stmt
statement' = ifStmt
<|> whileStmt
<|> skipStmt
<|> assignStmt
ifStmt :: Parser Stmt
ifStmt =
do reserved "if"
cond <- bExpression
reserved "else"
stmt1 <- statement
return $ If cond stmt1 stmt1
whileStmt :: Parser Stmt
whileStmt =
do reserved "while"
cond <- bExpression
reserved "do"
stmt <- statement
return $ While cond stmt
assignStmt :: Parser Stmt
assignStmt =
do var <- identifier
reservedOp "="
expr <- aExpression
return $ Assign var expr
skipStmt :: Parser Stmt
skipStmt = reserved "skip" >> return Skip
aExpression :: Parser AExpr
aExpression = buildExpressionParser aOperators aTerm
bExpression :: Parser BEx
aOperators = [ [Prefix (reservedOp "-" >> return (Neg )) ]
, [Infix (reservedOp "*" >> return (ABinary Multiply)) AssocLeft,
Infix (reservedOp "/" >> return (ABinary Divide )) AssocLeft]
, [Infix (reservedOp "+" >> return (ABinary Add )) AssocLeft,
Infix (reservedOp "-" >> return (ABinary Subtract)) AssocLeft]
]
bOperators = [ [Prefix (reservedOp "not" >> return (Not )) ]
, [Infix (reservedOp "and" >> return (BBinary And )) AssocLeft,
Infix (reservedOp "or" >> return (BBinary Or )) AssocLeft]
]
aTerm = parens aExpression
<|> liftM Var identifier
<|> liftM IntConst integer
bTerm = parens bExpression
<|> (reserved "true" >> return (BoolConst True ))
<|> (reserved "false" >> return (BoolConst False))
<|> rExpression
rExpression =
do a1 <- aExpression
op <- relation
a2 <- aExpression
return $ RBinary op a1 a2
relation = (reservedOp ">" >> return Greater)
<|> (reservedOp "<" >> return Less)
parseString :: String -> Stmt
parseString str =
case parse whileParser "" str of
Left e -> error $ show e
Right r -> r
parseFile :: String -> IO Stmt
parseFile file =
do program <- readFile file
case parse whileParser "" program of
Left e -> print e >> fail "parse error"
Right r -> return r
--ast <- parseFile "../PD2019/prueba1.txt" parseString
main :: IO ()
main = return ()
Hi everyone, I am new to haskell and I have a question please :pray: I have a type family
data family Chronon :: k
and a type class
class ChrononOps t where
(<) :: t -> t -> Bool
and I am wondering if there is away to only allow family instances of Chronon to be potential instances of ChrononOps :pray:
Hello, can anyone help me out with this?
choose :: PickingMonad m => [a] -> m a
choose = undefined
- choose xs should run without error for any non-empty list xs :: [a] (for the empty list it can do anything)
- in the case of the monad m = IO, choose xs should run in time proportional to the length of xs
- in the case of the monad m = Dist, choose xs :: Dist a should compute a (not necessarily normalised)
distribution where each value in xs is assigned a probability proportional to the number of times it occurs in xs.
That is, prob xs x should be equal to k / n, where k = length [y | y <- xs, x == y] and n = length xs.
I have written the code in the way like this, not sure if its correct concept, but i get errors.
choose :: PickingMonad m => [a] -> m a
choose [] = error "Error"
choose xs = do
let n = length xs
i <- getRandomR (0, n-1)
return (xs !! i)
main :: IO ()
main = do
putStrLn "----------Menú Parser---------\n Choose an Option :\n\n1-Enter functional files.\n2-Enter Not functional files\n3-Salir del Programa.\n------------------------------"
button <- getLine
case button of
"1" -> do
putStrLn "----------Menú Parser---------\nChoose an Option:\n\n1-Run File funcionalTest1.\n2-Run File funcionalTest2.\n3-Run File funcionalTest3.\n4-Run File funcionalTest4.\n5-Run File funcionalTest5.\n6-Exit the program\n------------------------------"
button2 <-getLine
case button2 of
"1" -> do
parsed <- PP.parserFile $ "./foldertFunctional/funcionalTest1.lua"
putStrLn $ show parsed
"2" -> do
parsed <- PP.parserFile $ "./foldertFunctional/funcionalTest2.lua"
putStrLn $ show parsed
"3" -> do
parsed <- PP.parserFile $ "./foldertFunctional/funcionalTest3.lua"
putStrLn $ show parsed
"4" -> do
parsed <- PP.parserFile $ "./foldertFunctional/funcionalTest4.lua"
putStrLn $ show parsed
"5" -> do
parsed <- PP.parserFile $ "./foldertFunctional/funcionalTest5.lua"
putStrLn $ show parsed
"6" -> exitSuccess
_ -> putStrLn "This option not exists"
"2" -> do
putStrLn "----------Menú Parser---------\nChoose an option:\n\n1-Run File noFuncionalTest1.\n2-Run File noFuncionalTest2.\n3-Run File noFuncionalTest3.\n4-Run File noFuncionalTest4.\n5-Run File noFuncionalTest5.\n6-Exit the program\n------------------------------"
button2 <-getLine
case button2 of
"1" -> do
parsed <- PP.parserFile $ "./folderNotFunctional/noFuncionalTest1.lua"
putStrLn $ show parsed
"2" -> do
parsed <- PP.parserFile $ "./folderNotFunctional/noFuncionalTest2.lua"
putStrLn $ show parsed
"3" -> do
parsed <- PP.parserFile $ "./folderNotFunctional/noFuncionalTest3.lua"
putStrLn $ show parsed
"4" -> do
parsed <- PP.parserFile $ "./folderNotFunctional/noFuncionalTest4.lua"
putStrLn $ show parsed
"5" -> do
parsed <- PP.parserFile $ "./folderNotFunctional/noFuncionalTest5.lua"
putStrLn $ show parsed
"6" -> exitSuccess
_ -> putStrLn "This option not exists"
"3" -> exitSuccess
_ -> putStrLn "This option not exists"
powHashToTargetWords :: Digest Blake2s_256 -> IO TargetWords
powHashToTargetWords h = BA.withByteArray h $ \ptr -> TargetWords
<$> peekWord64OffLe ptr 0
<*> peekWord64OffLe ptr 8
<*> peekWord64OffLe ptr 16
<*> peekWord64OffLe ptr 24
{-# INLINE powHashToTargetWords #-}
stack install cryptonite
stack repl
:browse
:i Blake2s_256
import Data.ByteArray
:i withByteArray
...
withByteArray :: ba -> (GHC.Ptr.Ptr p -> IO a) -> IO a
Just proving I can produce a function that meets the type signature:
λ> data TargetWords = TargetWords Int Int Int Int deriving Show
λ> readInt :: IO Int ; readInt = getLine >>= \x -> return $ read x
Prelude Crypto.Hash Data.ByteArray BA
λ> :{
powHashToTargetWords :: Digest Blake2s_256 -> IO TargetWords
powHashToTargetWords h = BA.withByteArray h $ \ptr -> TargetWords <$> readInt <*> readInt <*> readInt <*> readInt
:}
The point of that was to show that the applicative is because peekWord64OffLe has a type of IO Int. (or perhaps IO #Int64, etc) I thought the applicative syntax (where <$> = fmap and <*> is a "compose" operator for a multiple-argument applicative functor) might be confusing you; it confused me for a moment (since I'm rusty at Haskell and haven't used applicatives very much.)
λ> import Control.Applicative
Prelude Control.Applicative
λ> :i liftA2
type Applicative :: (* -> *) -> Constraint
class Functor f => Applicative f where
...
liftA2 :: (a -> b -> c) -> f a -> f b -> f c
...
-- Defined in ‘GHC.Base’
Prelude Control.Applicative
λ> readInt = getLine >>= return . read :: IO Int
λ> liftA2 (+) readInt readInt
1<enter>
2<enter>
3 [IO output]
λ> (+) <$> readInt <*> readInt
1<enter>
2<enter>
3 [IO output]
Hey all. I'm just using Haskell VSCode plugin 1.8.0 with HLS 1.6.1.0 underneath. When I use the "Find All References" it correctly only selected references with the exact name, but when I right click and click "Change All Occurrences" it doesn't just change references to that name but all names that have that name as a substring?
Given the "Find All References" works correctly I figure I'm doing something wrong because HLS is clearly capable of finding, and hence presumably changing the correct set of references.
Hi!
I have a problem with injectivity of injective type families, here it's:
> :info F
type F :: * -> *
type family F t where = r | r -> t
. . .
> f :: forall a b . (F a ~ F b) => a :~: b; f = Refl
<interactive>: error:
• Could not deduce: a ~ b
from the context: F a ~ F b
Why so? Shouldn't it be injective by definition?
mainApp :: IO ()
mainApp = do
installHandler sigPIPE Ignore Nothing
queue <- newTBMQueueIO 16
concurrently_
(mqttWatch queue `finally` atomically (closeTBMQueue queue))
(eventProcess queue)
eventProcess :: TBMQueue Int -> IO ()
eventProcess queue =
forever $ do
putStrLn $ "connecting to adb shell with command: " ++ adbConnectCommand
withProcessTerm adbProcCfg $ \adbProc ->
eventSendLoop queue (getStdin adbProc)
putStrLn "Lost connection to adb shell subprocess. Sleeping..."
sleep 10
where adbConnectCommand = defaultAdbConnectCommand
adbProcCfg = setStdin createPipe
$ setStdout createPipe
$ setStderr closed
$ shell adbConnectCommand
eventSendLoop :: TBMQueue Int -> Handle -> IO ()
eventSendLoop queue outHandle = forever $ do
mEventCode <- atomically $ readTBMQueue queue
case mEventCode of
Nothing -> return ()
Just eventCode -> do
let cmd = eventCodeToEventCmd inputDevice eventCode
putStrLn $ "adb shell cmd: " ++ cmd
hPutStrLn outHandle cmd
hFlush outHandle
where inputDevice = defaultInputDevice
eventProcess :: TBMQueue Int -> IO ()
eventProcess queue =
catch (
do
putStrLn $ "connecting to adb shell with command: " ++ adbConnectCommand
withProcessTerm adbProcCfg $ \adbProc ->
eventSendLoop queue (getStdin adbProc))
(\e -> if ioe_type e == ResourceVanished
then do
putStrLn "Lost connection to adb shell subprocess. Sleeping..."
sleep 10
eventProcess queue
else throw e)
where adbConnectCommand = defaultAdbConnectCommand
adbProcCfg = setStdin createPipe
$ setStdout createPipe
$ setStderr closed
$ shell adbConnectCommand
Hi,
I have a question that i want to ask to the community.
Why on the foldl, the input function type is not a -> b -> b
like in foldr but it is b -> a -> b.
I can implement foldl with a function of the type a -> b -> b as
input. like below.
myFoldl :: (a -> b -> b) -> b -> [a] -> b
myFoldl f z [] = z
myFoldl f z (x:xs) = myFoldl f (f x z) xs
Why foldr and foldl not differ only on the the way of recursion
call of the fold function? What is the impact/advantage of using a function of type b -> a -> b
Monad transformers. The documentations says:
A monad transformer makes a new monad out of an existing monad, such that computations of the old monad may be embedded in the new one.
What is the new monad, the existing monad, and the old monad?
In case of newtype MaybeT m a = MaybeT { runMaybeT :: m (Maybe a) }
:
Is m
the existing mondad, and Maybe
the old monad? What is the new monad? MaybeT m
?