aparler/RosettaCodeData
1
0
Fork 0
Code Issues 12 Pull requests 3 Projects Releases Packages Wiki Activity Actions

Just another update

Browse source
This commit is contained in:
Ingy döt Net 2015-02-20 00:35:01 -05:00
parent a25938f123
commit 00a190b0a6
6591 changed files with 94363 additions and 23227 deletions
Download patch file Download diff file Expand all files Collapse all files

8
Task/Parsing-Shunting-yard-algorithm/Haskell/parsing-shunting-yard-algorithm-1.hs
View file

@ -15,13 +15,13 @@ isOp _ = False
simSYA xs = final ++ [lastStep]
where final = scanl f ([],[],"") xs
lastStep = (\(x,y,_) -> (reverse y ++ x, [], "")) $ last final
f (out,st,_) t | isOp t =
f (out,st,_) t | isOp t =
(reverse (takeWhile testOp st) ++ out
, (t:) $ (dropWhile testOp st), t)
| t == "(" = (out, "(":st, t)
| t == ")" = (reverse (takeWhile (/="(") st) ++ out,
| t == "(" = (out, "(":st, t)
| t == ")" = (reverse (takeWhile (/="(") st) ++ out,
tail $ dropWhile (/="(") st, t)
| True = (t:out, st, t)
| otherwise = (t:out, st, t)
where testOp x = isOp x && (leftAssoc t && prec t == prec x
|| prec t < prec x)

11
Task/Parsing-Shunting-yard-algorithm/Haskell/parsing-shunting-yard-algorithm-2.hs
View file

@ -1,6 +1,7 @@
{-# LANGUAGE LambdaCase #-}
import Control.Applicative
import Control.Lens
import Control.Monad
import Control.Monad.Error
import Control.Monad.State
import System.Console.Readline
@ -60,13 +61,11 @@ pushVal n = _1 %= (OutVal n:)
pushParen :: RPNComp ()
pushParen = _2 %= (Paren:)
--Run StateT. `process` is effectively foldM_ with the base case to
--format the output string
--Run StateT
toRPN :: [InToken] -> Either String [OutToken]
toRPN xs = evalStateT (process (return ()) xs) ([],[])
where process st [] = st >> get >>= \(a,b) -> (reverse a++) <$>
(mapM toOut b)
process st (x:xs) = process (st >> processToken x) xs
toRPN xs = evalStateT process ([],[])
where process = mapM_ processToken xs
>> get >>= \(a,b) -> (reverse a++) <$> (mapM toOut b)
toOut :: StackElem -> RPNComp OutToken
toOut (StOp o) = return $ OutOp o
toOut Paren = throwError "Unmatched left parenthesis"