Add solutions for HW1 for CS325 madness

This commit is contained in:
Danila Fedorin 2019-12-27 23:20:37 -08:00
parent f74209c970
commit 75664e90bb
2 changed files with 453 additions and 0 deletions

View File

@ -0,0 +1,20 @@
qselect(xs,k) =
~xs -> {
pivot <- xs[0]!
left <- xs[#0 <= pivot]
right <- xs[#0 > pivot]
} ->
if k > |left| + 1 then qselect(right, k - |left| - 1)
else if k == |left| + 1 then [pivot]
else qselect(left, k);
_search(xs, k) =
if xs[1] == k then xs
else if xs[1] > k then _search(xs[0], k)
else _search(xs[2], k);
sorted(xs) = sorted(xs[0]) ++ [xs[1]] ++ sorted(xs[2]);
search(xs, k) = |_search(xs, k)| != 0;
insert(xs, k) = _insert(k, _search(xs, k));
_insert(k, xs) = if |xs| == 0 then xs << [] << k << [] else xs

View File

@ -0,0 +1,433 @@
module LanguageOne where
import qualified PythonAst as Py
import Data.Bifunctor
import Data.Char
import Data.Functor
import qualified Data.Map as Map
import Data.Maybe
import qualified Data.Set as Set
import Text.Parsec
import Text.Parsec.Char
import Text.Parsec.Combinator
import Control.Monad.State
{- Data Types -}
data PossibleType = List | Any deriving Eq
data SelectorMarker = None | Remove
data Op
= Add
| Subtract
| Multiply
| Divide
| Insert
| Concat
| LessThan
| LessThanEq
| GreaterThan
| GreaterThanEq
| Equal
| NotEqual
| And
| Or
data Selector = Selector String Expr
data Expr
= Var String
| IntLiteral Int
| ListLiteral [Expr]
| Split Expr [Selector] Expr
| IfElse Expr Expr Expr
| BinOp Op Expr Expr
| FunctionCall Expr [Expr]
| LengthOf Expr
| Random
| Access Expr Expr SelectorMarker
| Parameter Int
data Function = Function String [String] Expr
data Prog = Prog [Function]
{- Parser -}
type Parser = Parsec String (Maybe Int)
parseInt :: Parser Int
parseInt = read <$> (many1 digit <* spaces)
parseVar :: Parser String
parseVar =
do
c <- satisfy (\c -> (isLetter c && isLower c) || c == '_')
cs <- many (satisfy isLetter <|> digit)
spaces
let var = c:cs
if var `elem` ["if", "then", "else", "rand"]
then fail "reserved"
else return var
parseKwIf :: Parser ()
parseKwIf = string "if" $> ()
parseKwThen :: Parser ()
parseKwThen = string "then" $> ()
parseKwElse :: Parser ()
parseKwElse = string "else" $> ()
parseKwRand :: Parser Expr
parseKwRand = string "rand" $> Random
parseThis :: Parser Expr
parseThis =
do
char '&'
contextNum <- getState
spaces
return (Var $ "context_" ++ show contextNum)
parseList :: Parser Expr
parseList = ListLiteral <$>
do
char '[' >> spaces
es <- sepBy parseExpr (char ',' >> spaces)
spaces >> char ']' >> spaces
return es
parseSplit :: Parser Expr
parseSplit =
do
char '~' >> spaces
e <- parseExpr
spaces >> string "->"
spaces >> char '{'
contextNum <- getState
putState $ return $ 1 + fromMaybe (-1) contextNum
es <- many1 (spaces >> parseSelector)
putState contextNum
spaces >> char '}' >> spaces >> string "->" >> spaces
e' <- parseExpr
spaces
return $ Split e es e'
parseSelectorMarker :: Parser SelectorMarker
parseSelectorMarker = (char '!' >> return Remove) <|> return None
parseSelector :: Parser Selector
parseSelector =
do
name <- parseVar
spaces >> string "<-" >> spaces
expr <- parseExpr
spaces
return $ Selector name expr
parseIfElse :: Parser Expr
parseIfElse =
do
parseKwIf >> spaces
ec <- parseExpr
spaces >> parseKwThen >> spaces
et <- parseExpr
spaces >> parseKwElse >> spaces
ee <- parseExpr
spaces
return $ IfElse ec et ee
parseLength :: Parser Expr
parseLength =
do
char '|' >> spaces
e <- parseExpr
spaces >> char '|' >> spaces
return $ LengthOf e
parseParameter :: Parser Expr
parseParameter =
do
char '#'
d <- digit
spaces
return $ Parameter $ read [d]
parseParenthesized :: Parser Expr
parseParenthesized =
do
char '(' >> spaces
e <- parseExpr
spaces >> char ')' >> spaces
return e
parseBasicExpr :: Parser Expr
parseBasicExpr = choice
[ IntLiteral <$> parseInt
, parseThis
, parseList
, parseSplit
, parseLength
, parseParameter
, parseParenthesized
, Var <$> try parseVar
, parseKwRand
, parseIfElse
]
parsePostfix :: Parser (Expr -> Expr)
parsePostfix = parsePostfixAccess <|> parsePostfixCall
parsePostfixAccess :: Parser (Expr -> Expr)
parsePostfixAccess =
do
char '[' >> spaces
e <- parseExpr
spaces >> char ']' >> spaces
marker <- parseSelectorMarker
spaces
return $ \e' -> Access e' e marker
parsePostfixCall :: Parser (Expr -> Expr)
parsePostfixCall =
do
char '(' >> spaces
es <- sepBy parseExpr (char ',' >> spaces)
char ')' >> spaces
return $ flip FunctionCall es
parsePostfixedExpr :: Parser Expr
parsePostfixedExpr =
do
eb <- parseBasicExpr
spaces
ps <- many parsePostfix
return $ foldl (flip ($)) eb ps
parseOp :: String -> Op -> Parser Op
parseOp s o = try (string s) >> return o
parseLevel :: Parser Expr -> Parser Op -> Parser Expr
parseLevel pe po =
do
start <- pe
spaces
ops <- many $ try $ do
op <- po
spaces
val <- pe
spaces
return (op, val)
spaces
return $ foldl (\l (o, r) -> BinOp o l r) start ops
parseExpr :: Parser Expr
parseExpr = foldl parseLevel parsePostfixedExpr
[ parseOp "*" Multiply, parseOp "/" Divide
, parseOp "+" Add, parseOp "-" Subtract
, parseOp "<<" Insert
, parseOp "++" Concat
, parseOp "<=" LessThanEq <|> parseOp ">=" GreaterThanEq <|>
parseOp "<" LessThan <|> parseOp ">" GreaterThan <|>
parseOp "==" Equal <|> parseOp "!=" NotEqual
, parseOp "&&" And <|> parseOp "||" Or
]
parseFunction :: Parser Function
parseFunction =
do
name <- parseVar
spaces >> char '(' >> spaces
vs <- sepBy parseVar (char ',' >> spaces)
spaces >> char ')' >> spaces >> char '=' >> spaces
body <- parseExpr
spaces
return $ Function name vs body
parseProg :: Parser Prog
parseProg = Prog <$> sepBy1 parseFunction (char ';' >> spaces)
parse :: SourceName -> String -> Either ParseError Prog
parse = runParser parseProg Nothing
{- "Type" checker -}
mergePossibleType :: PossibleType -> PossibleType -> PossibleType
mergePossibleType List _ = List
mergePossibleType _ List = List
mergePossibleType _ _ = Any
getPossibleType :: String -> Expr -> PossibleType
getPossibleType s (Var s') = if s == s' then List else Any
getPossibleType _ (ListLiteral _) = List
getPossibleType s (Split _ _ e) = getPossibleType s e
getPossibleType s (IfElse i t e) =
foldl1 mergePossibleType $ map (getPossibleType s) [i, t, e]
getPossibleType _ (BinOp Insert _ _) = List
getPossibleType _ (BinOp Concat _ _) = List
getPossibleType _ _ = Any
{- Translator -}
type Translator = Control.Monad.State.State (Map.Map String [String], Int)
currentTemp :: Translator String
currentTemp = do
(_, t) <- get
return $ "temp" ++ show t
incrementTemp :: Translator String
incrementTemp = do
(vs, t) <- get
put (vs, t+1)
return $ "temp" ++ show t
hasLambda :: Expr -> Bool
hasLambda (ListLiteral es) = any hasLambda es
hasLambda (Split e ss r) =
hasLambda e || any (\(Selector _ e') -> hasLambda e') ss || hasLambda r
hasLambda (IfElse i t e) = hasLambda i || hasLambda t || hasLambda e
hasLambda (BinOp o l r) = hasLambda l || hasLambda r
hasLambda (FunctionCall e es) = any hasLambda $ e : es
hasLambda (LengthOf e) = hasLambda e
hasLambda (Access e _ _) = hasLambda e
hasLambda Parameter{} = True
hasLambda _ = False
translate :: Prog -> [Py.PyStmt]
translate p = fst $ runState (translateProg p) (Map.empty, 0)
translateProg :: Prog -> Translator [Py.PyStmt]
translateProg (Prog fs) = concat <$> traverse translateFunction fs
translateFunction :: Function -> Translator [Py.PyStmt]
translateFunction (Function n ps ex) = do
let createIf p = Py.BinOp Py.Equal (Py.Var p) (Py.ListLiteral [])
let createReturn p = Py.IfElse (createIf p) [Py.Return (Py.Var p)] [] Nothing
let fastReturn = [createReturn p | p <- take 1 ps, getPossibleType p ex == List]
(ss, e) <- translateExpr ex
return $ return $ Py.FunctionDef n ps $ fastReturn ++ ss ++ [Py.Return e]
translateSelector :: Selector -> Translator Py.PyStmt
translateSelector (Selector n e) =
let
cacheCheck = Py.NotIn (Py.StrLiteral n) (Py.Var "cache")
cacheAccess = Py.Access (Py.Var "cache") [Py.StrLiteral n]
cacheSet = Py.Assign (Py.AccessPat (Py.Var "cache") [Py.StrLiteral n])
body e' = [ Py.IfElse cacheCheck [cacheSet e'] [] Nothing, Py.Return cacheAccess]
in
do
(ss, e') <- translateExpr e
vs <- gets fst
let callPrereq p = Py.Standalone $ Py.FunctionCall (Py.Var p) []
let prereqs = maybe [] (map callPrereq) $ Map.lookup n vs
return $ Py.FunctionDef n [] $ ss ++ prereqs ++ body e'
translateExpr :: Expr -> Translator ([Py.PyStmt], Py.PyExpr)
translateExpr (Var s) = do
vs <- gets fst
let sVar = Py.Var s
let expr = if Map.member s vs then Py.FunctionCall sVar [] else sVar
return ([], expr)
translateExpr (IntLiteral i) = return ([], Py.IntLiteral i)
translateExpr (ListLiteral l) = do
tl <- mapM translateExpr l
return (concatMap fst tl, Py.ListLiteral $ map snd tl)
translateExpr (Split e ss e') = do
vs <- gets fst
let cacheAssign = Py.Assign (Py.VarPat "cache") (Py.DictLiteral [])
let cacheStmt = [ cacheAssign | Map.size vs == 0 ]
let vnames = map (\(Selector n es) -> n) ss
let prereqs = snd $ foldl (\(ds, m) (Selector n es) -> (n:ds, Map.insert n ds m)) ([], Map.empty) ss
modify $ first $ Map.union prereqs
fs <- mapM translateSelector ss
(sts, te) <- translateExpr e'
modify $ first $ const vs
return (cacheStmt ++ fs ++ sts, te)
translateExpr (IfElse i t e) = do
temp <- incrementTemp
let tempPat = Py.VarPat temp
(ists, ie) <- translateExpr i
(tsts, te) <- translateExpr t
(ests, ee) <- translateExpr e
let thenSts = tsts ++ [Py.Assign tempPat te]
let elseSts = ests ++ [Py.Assign tempPat ee]
let newIf = Py.IfElse ie thenSts [] $ Just elseSts
return (ists ++ [newIf], Py.Var temp)
translateExpr (BinOp o l r) = do
(lsts, le) <- translateExpr l
(rsts, re) <- translateExpr r
(opsts, oe) <- translateOp o le re
return (lsts ++ rsts ++ opsts, oe)
translateExpr (FunctionCall f ps) = do
(fsts, fe) <- translateExpr f
tps <- mapM translateExpr ps
return (fsts ++ concatMap fst tps, Py.FunctionCall fe $ map snd tps)
translateExpr (LengthOf e) =
second (Py.FunctionCall (Py.Var "len") . return) <$> translateExpr e
translateExpr (Access e Random m) = do
temp <- incrementTemp
(sts, ce) <- translateExpr e
let lenExpr = Py.FunctionCall (Py.Var "len") [Py.Var temp]
let randExpr = Py.FunctionCall (Py.Var "randint") [ Py.IntLiteral 0, lenExpr ]
return (sts, singleAccess ce randExpr m)
translateExpr (Access c i m) = do
(csts, ce) <- translateExpr c
(ists, ie) <- translateExpr i
temp <- incrementTemp
if hasLambda i
then return (csts ++ ists ++ [createFilterLambda temp ie m], Py.FunctionCall (Py.Var temp) [ce])
else return (csts ++ ists, singleAccess ce ie m)
translateExpr (Parameter i) = return $ ([], Py.Var $ "arg" ++ show i)
translateExpr _ = fail "Invalid expression"
singleAccess :: Py.PyExpr -> Py.PyExpr -> SelectorMarker -> Py.PyExpr
singleAccess c i None = Py.Access c [i]
singleAccess c i Remove = Py.FunctionCall (Py.Member c "pop") [i]
createFilterLambda :: String -> Py.PyExpr -> SelectorMarker -> Py.PyStmt
createFilterLambda s e None = Py.FunctionDef s ["arg"]
[ Py.Assign (Py.VarPat "out") (Py.ListLiteral [])
, Py.For (Py.VarPat "arg0") (Py.Var "arg")
[ Py.IfElse e
[ Py.Standalone $ Py.FunctionCall (Py.Member (Py.Var "out") "append")
[ Py.Var "arg0" ]
]
[]
Nothing
]
, Py.Return $ Py.Var "out"
]
createFilterLambda s e Remove = Py.FunctionDef s ["arg"]
[ Py.Assign (Py.VarPat "i") $ Py.IntLiteral 0
, Py.Assign (Py.VarPat "out") (Py.ListLiteral [])
, Py.While (Py.BinOp Py.LessThan (Py.Var "i") $ Py.FunctionCall (Py.Var "len") [Py.Var "arg"])
[ Py.IfElse e
[ Py.Standalone $ Py.FunctionCall (Py.Member (Py.Var "out") "append")
[ singleAccess (Py.Var "arg") (Py.Var "i") Remove
]
]
[]
Nothing
, Py.Assign (Py.VarPat "i") (Py.BinOp Py.Add (Py.Var "i") (Py.IntLiteral 1))
]
, Py.Return $ Py.Var "out"
]
translateOp :: Op -> Py.PyExpr -> Py.PyExpr -> Translator ([Py.PyStmt], Py.PyExpr)
translateOp Add l r = return ([], Py.BinOp Py.Add l r)
translateOp Subtract l r = return ([], Py.BinOp Py.Subtract l r)
translateOp Multiply l r = return ([], Py.BinOp Py.Multiply l r)
translateOp Divide l r = return ([], Py.BinOp Py.Divide l r)
translateOp LessThan l r = return ([], Py.BinOp Py.LessThan l r)
translateOp LessThanEq l r = return ([], Py.BinOp Py.LessThanEq l r)
translateOp GreaterThan l r = return ([], Py.BinOp Py.GreaterThan l r)
translateOp GreaterThanEq l r = return ([], Py.BinOp Py.GreaterThanEq l r)
translateOp Equal l r = return ([], Py.BinOp Py.Equal l r)
translateOp NotEqual l r = return ([], Py.BinOp Py.NotEqual l r)
translateOp And l r = return ([], Py.BinOp Py.And l r)
translateOp Or l r = return ([], Py.BinOp Py.Or l r)
translateOp Concat l r = return ([], Py.BinOp Py.Add l r)
translateOp Insert l r = do
temp <- incrementTemp
let assignStmt = Py.Assign (Py.VarPat temp) l
let appendFunc = Py.Member (Py.Var temp) "append"
let insertStmt = Py.Standalone $ Py.FunctionCall appendFunc [r]
return ([assignStmt, insertStmt], Py.Var temp)