Browse Source

Add homework 3 solution for CS325

margin-rework
Danila Fedorin 2 years ago
parent
commit
d9544398b9
  1. 95
      code/cs325-langs/sols/hw3.lang
  2. 26
      code/cs325-langs/src/CommonParsing.hs
  3. 461
      code/cs325-langs/src/LanguageThree.hs
  4. 5
      code/cs325-langs/src/PythonAst.hs
  5. 13
      code/cs325-langs/src/PythonGen.hs

95
code/cs325-langs/sols/hw3.lang

@ -0,0 +1,95 @@
function qselect(xs, k, c) {
if xs == [] {
return 0;
}
traverser bisector(list: xs, span: (0,len(xs)));
traverser pivot(list: xs, random: true);
let pivotE = pop!(pivot);
let (leftList, rightList) = bisect!(bisector, (x) -> c(x) < c(pivotE));
if k > len(leftList) + 1 {
return qselect(rightList, k - len(leftList) - 1, c);
} elsif k == len(leftList) + 1 {
return pivotE;
} else {
return qselect(leftList, k, c);
}
}
function closestUnsorted(xs, k, n) {
let min = qselect(list(xs), k, (x) -> abs(x - n));
let out = [];
let countEqual = k;
traverser iter(list: xs, span: (0, len(xs)));
while valid!(iter) {
if abs(at!(iter)-n) < abs(min-n) {
let countEqual = countEqual - 1;
}
step!(iter);
}
traverser iter(list: xs, span: (0, len(xs)));
while valid!(iter) {
if abs(at!(iter)-n) == abs(min-n) and countEqual > 0 {
let countEqual = countEqual - 1;
let out = out + [at!(iter)];
} elsif abs(at!(iter)-n) < abs(min-n) {
let out = out + [at!(iter)];
}
step!(iter);
}
return out;
}
function closestSorted(xs, k, n) {
let start = bisect(xs, n);
let counter = 0;
traverser left(list: xs, span: (0, start), reverse: true);
traverser right(list: xs, span: (start, len(xs)));
while counter != k and canstep!(left) and valid!(right) {
if abs(at!(left, 1) - n) < abs(at!(right) - n) {
step!(left);
} else {
step!(right);
}
let counter = counter + 1;
}
while counter != k and (canstep!(left) or valid!(right)) {
if canstep!(left) { step!(left); }
else { step!(right); }
let counter = counter + 1;
}
return subset!(left, right);
}
sorted function xyz(xs, k) {
traverser x(list: xs, span: (0,len(xs)));
let dest = [];
while valid!(x) {
traverser z(list: xs, span: (pos!(x)+2,len(xs)));
traverser y(list: xs, span: (pos!(x)+1,pos!(z)));
while valid!(y) and valid!(z) {
if at!(x) + at!(y) == at!(z) {
let dest = dest + [(at!(x), at!(y), at!(z))];
step!(z);
} elsif at!(x) + at!(y) > at!(z) {
step!(z);
} else {
step!(y);
}
}
step!(x);
}
return dest;
}

26
code/cs325-langs/src/CommonParsing.hs

@ -8,7 +8,7 @@ import Text.Parsec.Combinator
type Parser a b = Parsec String a b
kw :: String -> Parser a ()
kw s = string s $> ()
kw s = try $ string s <* spaces $> ()
kwIf :: Parser a ()
kwIf = kw "if"
@ -19,6 +19,12 @@ kwThen = kw "then"
kwElse :: Parser a ()
kwElse = kw "else"
kwElsif :: Parser a ()
kwElsif = kw "elsif"
kwWhile :: Parser a ()
kwWhile = kw "while"
kwState :: Parser a ()
kwState = kw "state"
@ -31,6 +37,21 @@ kwCombine = kw "combine"
kwRand :: Parser a ()
kwRand = kw "rand"
kwFunction :: Parser a ()
kwFunction = kw "function"
kwSorted :: Parser a ()
kwSorted = kw "sorted"
kwLet :: Parser a ()
kwLet = kw "let"
kwTraverser :: Parser a ()
kwTraverser = kw "traverser"
kwReturn :: Parser a ()
kwReturn = kw "return"
op :: String -> op -> Parser a op
op s o = string s $> o
@ -47,6 +68,9 @@ var reserved =
then fail "Can't use reserved keyword as identifier"
else return name
list :: Char -> Char -> Char -> Parser a b -> Parser a [b]
list co cc cd pe = surround co cc $ sepBy pe (char cd >> spaces)
surround :: Char -> Char -> Parser a b -> Parser a b
surround c1 c2 pe =
do

461
code/cs325-langs/src/LanguageThree.hs

@ -0,0 +1,461 @@
module LanguageThree where
import qualified CommonParsing as P
import qualified PythonAst as Py
import Control.Monad.State
import Data.Bifunctor
import Data.Foldable
import Data.Functor
import qualified Data.Map as Map
import Data.Maybe
import Text.Parsec hiding (State)
import Text.Parsec.Char
import Text.Parsec.Combinator
{- Data Types -}
data Op
= Add
| Subtract
| Multiply
| Divide
| LessThan
| LessThanEqual
| GreaterThan
| GreaterThanEqual
| Equal
| NotEqual
| And
| Or
data Expr
= TraverserCall String [Expr]
| FunctionCall String [Expr]
| BinOp Op Expr Expr
| Lambda [String] Expr
| Var String
| IntLiteral Int
| BoolLiteral Bool
| ListLiteral [Expr]
| TupleLiteral [Expr]
type Branch = (Expr, [Stmt])
data Stmt
= IfElse Branch [Branch] [Stmt]
| While Branch
| Traverser String [(String, Expr)]
| Let Pat Expr
| Return Expr
| Standalone Expr
data Pat
= VarPat String
| TuplePat [Pat]
data SortedMarker = Sorted | Unsorted deriving Eq
data Function = Function SortedMarker String [String] [Stmt]
data Prog = Prog [Function]
{- Parser -}
type Parser = Parsec String ()
parseVar :: Parser String
parseVar = P.var
[ "if", "elif", "else"
, "while", "let", "traverser"
, "function", "sort"
, "true", "false"
]
parseBool :: Parser Bool
parseBool = (string "true" $> True) <|> (string "false" $> False)
parseList :: Parser Expr
parseList = ListLiteral <$> P.list '[' ']' ',' parseExpr
parseTupleElems :: Parser [Expr]
parseTupleElems = P.list '(' ')' ',' parseExpr
parseTuple :: Parser Expr
parseTuple = do
es <- parseTupleElems
return $ case es of
e:[] -> e
_ -> TupleLiteral es
parseLambda :: Parser Expr
parseLambda = try $ do
vs <- P.list '(' ')' ',' parseVar
string "->" >> spaces
Lambda vs <$> parseExpr
parseCall :: Parser Expr
parseCall = try $ do
v <- parseVar
choice
[ TraverserCall v <$> (char '!' *> parseTupleElems)
, FunctionCall v <$> parseTupleElems
]
parseBasic :: Parser Expr
parseBasic = choice
[ IntLiteral <$> P.int
, BoolLiteral <$> parseBool
, try parseCall
, Var <$> parseVar
, parseList
, parseLambda
, parseTuple
]
parseExpr :: Parser Expr
parseExpr = P.precedence BinOp parseBasic
[ P.op "*" Multiply <|> P.op "/" Divide
, P.op "+" Add <|> P.op "-" Subtract
, P.op "==" Equal <|> P.op "!=" NotEqual <|>
try (P.op "<=" LessThanEqual) <|> P.op "<" LessThan <|>
try (P.op ">=" GreaterThanEqual) <|> P.op ">" GreaterThan
, P.op "and" And
, P.op "or" Or
]
parseBlock :: Parser [Stmt]
parseBlock = char '{' >> spaces >> many parseStmt <* char '}' <* spaces
parseBranch :: Parser Branch
parseBranch = (,) <$> (parseExpr <* spaces) <*> parseBlock
parseIf :: Parser Stmt
parseIf = do
i <- P.kwIf >> parseBranch
els <- many (P.kwElsif >> parseBranch)
e <- try (P.kwElse >> parseBlock) <|> return []
return $ IfElse i els e
parseWhile :: Parser Stmt
parseWhile = While <$> (P.kwWhile >> parseBranch)
parseTraverser :: Parser Stmt
parseTraverser = Traverser
<$> (P.kwTraverser *> parseVar)
<*> (P.list '(' ')' ',' parseKey) <* char ';' <* spaces
parseKey :: Parser (String, Expr)
parseKey = (,)
<$> (parseVar <* spaces <* char ':' <* spaces)
<*> parseExpr
parseLet :: Parser Stmt
parseLet = Let
<$> (P.kwLet >> parsePat <* char '=' <* spaces)
<*> parseExpr <* char ';' <* spaces
parseReturn :: Parser Stmt
parseReturn = Return <$> (P.kwReturn >> parseExpr <* char ';' <* spaces)
parsePat :: Parser Pat
parsePat = (VarPat <$> parseVar) <|> (TuplePat <$> P.list '(' ')' ',' parsePat)
parseStmt :: Parser Stmt
parseStmt = choice
[ parseTraverser
, parseLet
, parseIf
, parseWhile
, parseReturn
, Standalone <$> (parseExpr <* char ';' <* spaces)
]
parseFunction :: Parser Function
parseFunction = Function
<$> (P.kwSorted $> Sorted <|> return Unsorted)
<*> (P.kwFunction >> parseVar)
<*> (P.list '(' ')' ',' parseVar)
<*> parseBlock
parseProg :: Parser Prog
parseProg = Prog <$> many parseFunction
parse :: String -> String -> Either ParseError Prog
parse = runParser parseProg ()
{- Translation -}
data TraverserBounds = Range Py.PyExpr Py.PyExpr | Random
data TraverserData = TraverserData
{ list :: Maybe String
, bounds :: Maybe TraverserBounds
, rev :: Bool
}
data ValidTraverserData = ValidTraverserData
{ validList :: String
, validBounds :: TraverserBounds
, validRev :: Bool
}
type Translator = State (Map.Map String ValidTraverserData, [Py.PyStmt], Int)
getScoped :: Translator (Map.Map String ValidTraverserData)
getScoped = gets (\(m, _, _) -> m)
setScoped :: Map.Map String ValidTraverserData -> Translator ()
setScoped m = modify (\(_, ss, i) -> (m, ss, i))
scope :: Translator a -> Translator a
scope m = do
s <- getScoped
a <- m
setScoped s
return a
clearTraverser :: String -> Translator ()
clearTraverser s = modify (\(m, ss, i) -> (Map.delete s m, ss, i))
putTraverser :: String -> ValidTraverserData -> Translator ()
putTraverser s vtd = modify (\(m, ss, i) -> (Map.insert s vtd m, ss, i))
getTemp :: Translator String
getTemp = gets $ \(_, _, i) -> "temp" ++ show i
freshTemp :: Translator String
freshTemp = modify (second (+1)) >> getTemp
emitStatement :: Py.PyStmt -> Translator ()
emitStatement = modify . first . (:)
collectStatements :: Translator a -> Translator ([Py.PyStmt], a)
collectStatements t = do
modify (first $ const [])
a <- t
ss <- gets $ \(_, ss, _) -> ss
modify (first $ const [])
return (ss, a)
withdrawStatements :: Translator (Py.PyStmt) -> Translator [Py.PyStmt]
withdrawStatements ts =
(\(ss, s) -> ss ++ [s]) <$> (collectStatements ts)
requireTraverser :: String -> Translator ValidTraverserData
requireTraverser s = gets (\(m, _, _) -> Map.lookup s m) >>= handleMaybe
where
handleMaybe Nothing = fail "Invalid traverser"
handleMaybe (Just vtd) = return vtd
traverserIncrement :: Bool -> Py.PyExpr -> Py.PyExpr -> Py.PyExpr
traverserIncrement rev by e =
Py.BinOp op e (Py.BinOp Py.Multiply by (Py.IntLiteral 1))
where op = if rev then Py.Subtract else Py.Add
traverserValid :: Py.PyExpr -> ValidTraverserData -> Py.PyExpr
traverserValid e vtd =
case validBounds vtd of
Range f t ->
if validRev vtd
then Py.BinOp Py.GreaterThanEq e f
else Py.BinOp Py.LessThan e t
Random -> Py.BoolLiteral True
traverserStep :: String -> ValidTraverserData -> Py.PyStmt
traverserStep s vtd =
case validBounds vtd of
Range _ _ -> Py.Assign (Py.VarPat s) $ Py.BinOp op (Py.Var s) (Py.IntLiteral 1)
where op = if validRev vtd then Py.Subtract else Py.Add
Random -> traverserRandom s $ validList vtd
traverserRandom :: String -> String -> Py.PyStmt
traverserRandom s l =
Py.Assign (Py.VarPat s) $ Py.FunctionCall (Py.Var "random.randrange")
[Py.FunctionCall (Py.Var "len") [Py.Var l]]
hasVar :: String -> Py.PyPat -> Bool
hasVar s (Py.VarPat s') = s == s'
hasVar s (Py.TuplePat ps) = any (hasVar s) ps
hasVar s _ = False
substituteVariable :: String -> Py.PyExpr -> Py.PyExpr -> Py.PyExpr
substituteVariable s e (Py.BinOp o l r) =
Py.BinOp o (substituteVariable s e l) (substituteVariable s e r)
substituteVariable s e (Py.ListLiteral es) =
Py.ListLiteral $ map (substituteVariable s e) es
substituteVariable s e (Py.DictLiteral es) =
Py.DictLiteral $
map (first (substituteVariable s e) . second (substituteVariable s e)) es
substituteVariable s e (Py.Lambda ps e') =
Py.Lambda ps $ if any (hasVar s) ps then substituteVariable s e e' else e'
substituteVariable s e (Py.Var s')
| s == s' = e
| otherwise = Py.Var s'
substituteVariable s e (Py.TupleLiteral es) =
Py.TupleLiteral $ map (substituteVariable s e) es
substituteVariable s e (Py.FunctionCall e' es) =
Py.FunctionCall (substituteVariable s e e') $
map (substituteVariable s e) es
substituteVariable s e (Py.Access e' es) =
Py.Access (substituteVariable s e e') $
map (substituteVariable s e) es
substituteVariable s e (Py.Ternary i t e') =
Py.Ternary (substituteVariable s e i) (substituteVariable s e t)
(substituteVariable s e e')
substituteVariable s e (Py.Member e' m) =
Py.Member (substituteVariable s e e') m
substituteVariable s e (Py.In e1 e2) =
Py.In (substituteVariable s e e1) (substituteVariable s e e2)
substituteVariable s e (Py.NotIn e1 e2) =
Py.NotIn (substituteVariable s e e1) (substituteVariable s e e2)
substituteVariable s e (Py.Slice f t) =
Py.Slice (substituteVariable s e <$> f) (substituteVariable s e <$> t)
translateExpr :: Expr -> Translator Py.PyExpr
translateExpr (TraverserCall "pop" [Var s]) = do
l <- validList <$> requireTraverser s
return $ Py.FunctionCall (Py.Member (Py.Var l) "pop") [Py.Var s]
translateExpr (TraverserCall "pos" [Var s]) = do
requireTraverser s
return $ Py.Var s
translateExpr (TraverserCall "at" [Var s]) = do
l <- validList <$> requireTraverser s
return $ Py.Access (Py.Var l) [Py.Var s]
translateExpr (TraverserCall "at" [Var s, IntLiteral i]) = do
vtd <- requireTraverser s
return $ Py.Access (Py.Var $ validList vtd)
[traverserIncrement (validRev vtd) (Py.IntLiteral i) (Py.Var s)]
translateExpr (TraverserCall "step" [Var s]) = do
vtd <- requireTraverser s
emitStatement $ traverserStep s vtd
return $ Py.IntLiteral 0
translateExpr (TraverserCall "canstep" [Var s]) = do
vtd <- requireTraverser s
return $
traverserValid
(traverserIncrement (validRev vtd) (Py.IntLiteral 1) (Py.Var s)) vtd
translateExpr (TraverserCall "valid" [Var s]) = do
vtd <- requireTraverser s
return $ traverserValid (Py.Var s) vtd
translateExpr (TraverserCall "subset" [Var s1, Var s2]) = do
l1 <- validList <$> requireTraverser s1
l2 <- validList <$> requireTraverser s2
if l1 == l2
then return $ Py.Access (Py.Var l1) [Py.Slice (Just $ Py.Var s1) (Just $ Py.Var s2)]
else fail "Incompatible traversers!"
translateExpr (TraverserCall "bisect" [Var s, Lambda [x] e]) = do
vtd <- requireTraverser s
newTemp <- freshTemp
lambdaExpr <- translateExpr e
let access = Py.Access (Py.Var $ validList vtd) [Py.Var s]
let translated = substituteVariable x access lambdaExpr
let append s = Py.FunctionCall (Py.Member (Py.Var s) "append") [ access ]
let bisectStmt = Py.FunctionDef newTemp []
[ Py.Nonlocal [s]
, Py.Assign (Py.VarPat "l") (Py.ListLiteral [])
, Py.Assign (Py.VarPat "r") (Py.ListLiteral [])
, Py.While (traverserValid (Py.Var s) vtd)
[ Py.IfElse translated
[ Py.Standalone $ append "l" ]
[]
(Just [ Py.Standalone $ append "r" ])
, traverserStep s vtd
]
, Py.Return $ Py.TupleLiteral [Py.Var "l", Py.Var "r"]
]
emitStatement bisectStmt
return $ Py.FunctionCall (Py.Var newTemp) []
translateExpr (TraverserCall _ _) = fail "Invalid traverser operation"
translateExpr (FunctionCall f ps) = do
pes <- mapM translateExpr ps
return $ Py.FunctionCall (Py.Var f) pes
translateExpr (BinOp o l r) =
Py.BinOp (translateOp o) <$> translateExpr l <*> translateExpr r
translateExpr (Lambda ps e) =
Py.Lambda (map Py.VarPat ps) <$> translateExpr e
translateExpr (Var s) = return $ Py.Var s
translateExpr (IntLiteral i) = return $ Py.IntLiteral i
translateExpr (BoolLiteral b) = return $ Py.BoolLiteral b
translateExpr (ListLiteral es) = Py.ListLiteral <$> mapM translateExpr es
translateExpr (TupleLiteral es) = Py.TupleLiteral <$> mapM translateExpr es
applyOption :: TraverserData -> (String, Py.PyExpr) -> Maybe TraverserData
applyOption td ("list", Py.Var s) =
return $ td { list = Just s }
applyOption td ("span", Py.TupleLiteral [f, t]) =
return $ td { bounds = Just $ Range f t }
applyOption td ("random", Py.BoolLiteral True) =
return $ td { bounds = Just Random }
applyOption td ("reverse", Py.BoolLiteral b) =
return $ td { rev = b }
applyOption td _ = Nothing
translateOption :: (String, Expr) -> Translator (String, Py.PyExpr)
translateOption (s, e) = (,) s <$> translateExpr e
defaultTraverser :: TraverserData
defaultTraverser =
TraverserData { list = Nothing, bounds = Nothing, rev = False }
translateBranch :: Branch -> Translator (Py.PyExpr, [Py.PyStmt])
translateBranch (e, s) = (,) <$> translateExpr e <*>
(concat <$> mapM (withdrawStatements . translateStmt) s)
translateStmt :: Stmt -> Translator Py.PyStmt
translateStmt (IfElse i els e) = uncurry Py.IfElse
<$> (translateBranch i) <*> (mapM translateBranch els) <*> convertElse e
where
convertElse [] = return Nothing
convertElse es = Just . concat <$>
mapM (withdrawStatements . translateStmt) es
translateStmt (While b) = uncurry Py.While <$> translateBranch b
translateStmt (Traverser s os) =
foldlM applyOption defaultTraverser <$> mapM translateOption os >>= saveTraverser
where
saveTraverser :: Maybe TraverserData -> Translator Py.PyStmt
saveTraverser (Just (td@TraverserData { list = Just l, bounds = Just bs})) =
putTraverser s vtd $> translateInitialBounds s vtd
where
vtd = ValidTraverserData
{ validList = l
, validBounds = bs
, validRev = rev td
}
saveTraverser Nothing = fail "Invalid traverser (!)"
translateStmt (Let p e) = Py.Assign <$> translatePat p <*> translateExpr e
translateStmt (Return e) = Py.Return <$> translateExpr e
translateStmt (Standalone e) = Py.Standalone <$> translateExpr e
translateInitialBounds :: String -> ValidTraverserData -> Py.PyStmt
translateInitialBounds s vtd =
case (validBounds vtd, validRev vtd) of
(Random, _) -> traverserRandom s $ validList vtd
(Range l _, False) -> Py.Assign (Py.VarPat s) l
(Range _ r, True) -> Py.Assign (Py.VarPat s) r
translatePat :: Pat -> Translator Py.PyPat
translatePat (VarPat s) = clearTraverser s $> Py.VarPat s
translatePat (TuplePat ts) = Py.TuplePat <$> mapM translatePat ts
translateOp :: Op -> Py.PyBinOp
translateOp Add = Py.Add
translateOp Subtract = Py.Subtract
translateOp Multiply = Py.Multiply
translateOp Divide = Py.Divide
translateOp LessThan = Py.LessThan
translateOp LessThanEqual = Py.LessThanEq
translateOp GreaterThan = Py.GreaterThan
translateOp GreaterThanEqual = Py.GreaterThanEq
translateOp Equal = Py.Equal
translateOp NotEqual = Py.NotEqual
translateOp And = Py.And
translateOp Or = Py.Or
translateFunction :: Function -> [Py.PyStmt]
translateFunction (Function m s ps ss) = return $ Py.FunctionDef s ps $
[ Py.Standalone $ Py.FunctionCall (Py.Member (Py.Var p) "sort") []
| p <- take 1 ps, m == Sorted ] ++ stmts
where
stmts = concat $ evalState
(mapM (withdrawStatements . translateStmt) ss) (Map.empty, [], 0)
translate :: Prog -> [Py.PyStmt]
translate (Prog fs) =
(Py.FromImport "bisect" ["bisect"]) :
(Py.Import "random") : concatMap translateFunction fs

5
code/cs325-langs/src/PythonAst.hs

@ -24,7 +24,7 @@ data PyExpr
| DictLiteral [(PyExpr, PyExpr)]
| Lambda [PyPat] PyExpr
| Var String
| Tuple [PyExpr]
| TupleLiteral [PyExpr]
| FunctionCall PyExpr [PyExpr]
| Access PyExpr [PyExpr]
| Ternary PyExpr PyExpr PyExpr
@ -47,3 +47,6 @@ data PyStmt
| FunctionDef String [String] [PyStmt]
| Return PyExpr
| Standalone PyExpr
| Import String
| FromImport String [String]
| Nonlocal [String]

13
code/cs325-langs/src/PythonGen.hs

@ -46,6 +46,11 @@ translateStmt (FunctionDef s ps b) = block head body
body = stmtBlock b
translateStmt (Return e) = ["return " ++ translateExpr e]
translateStmt (Standalone e) = [translateExpr e]
translateStmt (Import s) = ["import " ++ s]
translateStmt (FromImport s ss) =
["from " ++ s ++ " import " ++ intercalate "," ss]
translateStmt (Nonlocal vs) =
["nonlocal " ++ intercalate "," vs]
precedence :: PyBinOp -> Int
precedence Add = 3
@ -74,12 +79,12 @@ opString GreaterThan = ">"
opString GreaterThanEq = ">="
opString Equal = "=="
opString NotEqual = "!="
opString And = "and"
opString Or = "or"
opString And = " and "
opString Or = " or "
translateOp :: PyBinOp -> PyBinOp -> PyExpr -> String
translateOp o o' =
if precedence o < precedence o'
if precedence o > precedence o'
then parenth . translateExpr
else translateExpr
@ -109,7 +114,7 @@ translateExpr (Lambda ps e) = parenth (head ++ ": " ++ body)
head = "lambda " ++ intercalate ", " (map translatePat ps)
body = translateExpr e
translateExpr (Var s) = s
translateExpr (Tuple es) = list "(" ")" es
translateExpr (TupleLiteral es) = list "(" ")" es
translateExpr (FunctionCall f ps) = translateExpr f ++ list "(" ")" ps
translateExpr (Access (Var s) e) = s ++ list "[" "]" e
translateExpr (Access e@Access{} i) = translateExpr e ++ list "[" "]" i

Loading…
Cancel
Save