Add homework 3 solution for CS325
This commit is contained in:
parent
1c4bb29fdd
commit
d9544398b9
95
code/cs325-langs/sols/hw3.lang
Normal file
95
code/cs325-langs/sols/hw3.lang
Normal file
@ -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;
|
||||
}
|
||||
@ -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
Normal file
461
code/cs325-langs/src/LanguageThree.hs
Normal file
@ -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
|
||||
@ -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]
|
||||
|
||||
@ -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…
Reference in New Issue
Block a user