Compare commits
2 Commits
1c4bb29fdd
...
a026e67a3b
Author | SHA1 | Date | |
---|---|---|---|
a026e67a3b | |||
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
|
type Parser a b = Parsec String a b
|
||||||
|
|
||||||
kw :: String -> Parser a ()
|
kw :: String -> Parser a ()
|
||||||
kw s = string s $> ()
|
kw s = try $ string s <* spaces $> ()
|
||||||
|
|
||||||
kwIf :: Parser a ()
|
kwIf :: Parser a ()
|
||||||
kwIf = kw "if"
|
kwIf = kw "if"
|
||||||
@ -19,6 +19,12 @@ kwThen = kw "then"
|
|||||||
kwElse :: Parser a ()
|
kwElse :: Parser a ()
|
||||||
kwElse = kw "else"
|
kwElse = kw "else"
|
||||||
|
|
||||||
|
kwElsif :: Parser a ()
|
||||||
|
kwElsif = kw "elsif"
|
||||||
|
|
||||||
|
kwWhile :: Parser a ()
|
||||||
|
kwWhile = kw "while"
|
||||||
|
|
||||||
kwState :: Parser a ()
|
kwState :: Parser a ()
|
||||||
kwState = kw "state"
|
kwState = kw "state"
|
||||||
|
|
||||||
@ -31,6 +37,21 @@ kwCombine = kw "combine"
|
|||||||
kwRand :: Parser a ()
|
kwRand :: Parser a ()
|
||||||
kwRand = kw "rand"
|
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 :: String -> op -> Parser a op
|
||||||
op s o = string s $> o
|
op s o = string s $> o
|
||||||
|
|
||||||
@ -47,6 +68,9 @@ var reserved =
|
|||||||
then fail "Can't use reserved keyword as identifier"
|
then fail "Can't use reserved keyword as identifier"
|
||||||
else return name
|
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 :: Char -> Char -> Parser a b -> Parser a b
|
||||||
surround c1 c2 pe =
|
surround c1 c2 pe =
|
||||||
do
|
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)]
|
| DictLiteral [(PyExpr, PyExpr)]
|
||||||
| Lambda [PyPat] PyExpr
|
| Lambda [PyPat] PyExpr
|
||||||
| Var String
|
| Var String
|
||||||
| Tuple [PyExpr]
|
| TupleLiteral [PyExpr]
|
||||||
| FunctionCall PyExpr [PyExpr]
|
| FunctionCall PyExpr [PyExpr]
|
||||||
| Access PyExpr [PyExpr]
|
| Access PyExpr [PyExpr]
|
||||||
| Ternary PyExpr PyExpr PyExpr
|
| Ternary PyExpr PyExpr PyExpr
|
||||||
@ -47,3 +47,6 @@ data PyStmt
|
|||||||
| FunctionDef String [String] [PyStmt]
|
| FunctionDef String [String] [PyStmt]
|
||||||
| Return PyExpr
|
| Return PyExpr
|
||||||
| Standalone 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
|
body = stmtBlock b
|
||||||
translateStmt (Return e) = ["return " ++ translateExpr e]
|
translateStmt (Return e) = ["return " ++ translateExpr e]
|
||||||
translateStmt (Standalone e) = [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 :: PyBinOp -> Int
|
||||||
precedence Add = 3
|
precedence Add = 3
|
||||||
@ -74,12 +79,12 @@ opString GreaterThan = ">"
|
|||||||
opString GreaterThanEq = ">="
|
opString GreaterThanEq = ">="
|
||||||
opString Equal = "=="
|
opString Equal = "=="
|
||||||
opString NotEqual = "!="
|
opString NotEqual = "!="
|
||||||
opString And = "and"
|
opString And = " and "
|
||||||
opString Or = "or"
|
opString Or = " or "
|
||||||
|
|
||||||
translateOp :: PyBinOp -> PyBinOp -> PyExpr -> String
|
translateOp :: PyBinOp -> PyBinOp -> PyExpr -> String
|
||||||
translateOp o o' =
|
translateOp o o' =
|
||||||
if precedence o < precedence o'
|
if precedence o > precedence o'
|
||||||
then parenth . translateExpr
|
then parenth . translateExpr
|
||||||
else translateExpr
|
else translateExpr
|
||||||
|
|
||||||
@ -109,7 +114,7 @@ translateExpr (Lambda ps e) = parenth (head ++ ": " ++ body)
|
|||||||
head = "lambda " ++ intercalate ", " (map translatePat ps)
|
head = "lambda " ++ intercalate ", " (map translatePat ps)
|
||||||
body = translateExpr e
|
body = translateExpr e
|
||||||
translateExpr (Var s) = s
|
translateExpr (Var s) = s
|
||||||
translateExpr (Tuple es) = list "(" ")" es
|
translateExpr (TupleLiteral es) = list "(" ")" es
|
||||||
translateExpr (FunctionCall f ps) = translateExpr f ++ list "(" ")" ps
|
translateExpr (FunctionCall f ps) = translateExpr f ++ list "(" ")" ps
|
||||||
translateExpr (Access (Var s) e) = s ++ list "[" "]" e
|
translateExpr (Access (Var s) e) = s ++ list "[" "]" e
|
||||||
translateExpr (Access e@Access{} i) = translateExpr e ++ list "[" "]" i
|
translateExpr (Access e@Access{} i) = translateExpr e ++ list "[" "]" i
|
||||||
|
295
content/blog/02_cs325_languages_hw3.md
Normal file
295
content/blog/02_cs325_languages_hw3.md
Normal file
@ -0,0 +1,295 @@
|
|||||||
|
---
|
||||||
|
title: A Language for an Assignment - Homework 3
|
||||||
|
date: 2020-01-02T22:17:43-08:00
|
||||||
|
tags: ["Haskell", "Python", "Algorithms"]
|
||||||
|
draft: true
|
||||||
|
---
|
||||||
|
|
||||||
|
It rained in Sunriver on New Year's Eve, and it continued to rain
|
||||||
|
for the next couple of days. So, instead of going skiing as planned,
|
||||||
|
to the dismay of my family and friends, I spent the majority of
|
||||||
|
those days working on the third language for homework 3. It
|
||||||
|
was quite the language, too - the homework has three problems, each of
|
||||||
|
which has a solution independent of the others. I invite you
|
||||||
|
to join me in my descent into madness as we construct another language.
|
||||||
|
|
||||||
|
### Homework 3
|
||||||
|
Let's take a look at the three homework problems. The first two are
|
||||||
|
related, but are solved using a different technique:
|
||||||
|
|
||||||
|
{{< codelines "text" "cs325-langs/hws/hw3.txt" 18 30 >}}
|
||||||
|
|
||||||
|
This problem requires us to find the `k` numbers closest to some
|
||||||
|
query (which I will call `n`) from a list `xs`. The list isn't sorted, and the
|
||||||
|
problem must run in linear time. Sorting the list would require
|
||||||
|
the standard
|
||||||
|
{{< sidenote "right" "n-note" "\(O(n\log n)\) time." >}}
|
||||||
|
The \(n\) in this expression is not the same as the query <code>n</code>,
|
||||||
|
but rather the length of the list. In fact, I have not yet assigned
|
||||||
|
the length of the input <code>xs</code> to any variable. If we say that
|
||||||
|
\(m\) is a number that denotes that length, the proper expression
|
||||||
|
for the complexity is \(O(m \log m)\).
|
||||||
|
{{< /sidenote >}} Thus, we have to take another route, which should
|
||||||
|
already be familiar: quickselect. Using quickselect, we can find the `k`th
|
||||||
|
closest number, and then collect all the numbers that are closer than the `kth`
|
||||||
|
closest number. So, we need a language that:
|
||||||
|
|
||||||
|
* Supports quickselect (and thus, list partitioning and recursion).
|
||||||
|
* Supports iteration, {{< sidenote "left" "iteration-note" "multiple times." >}}
|
||||||
|
Why would we need to iterate multiple times? Note that we could have a list
|
||||||
|
of numbers that are all the same, <code>[1,1,1,1,1]</code>. Then, we'll need
|
||||||
|
to know how many of the numbers <em>equally close</em> as the <code>k</code>th
|
||||||
|
element we need to include, which will require another pass through the list.
|
||||||
|
{{< /sidenote >}}
|
||||||
|
|
||||||
|
That's a good start. Let's take a look at the second problem:
|
||||||
|
|
||||||
|
{{< codelines "text" "cs325-langs/hws/hw3.txt" 33 47 >}}
|
||||||
|
|
||||||
|
This problem really is easier. We have to find the position of _the_ closest
|
||||||
|
element, and then try expand towards either the left or right, depending on
|
||||||
|
which end is better. This expansion will take several steps, and will
|
||||||
|
likely require a way to "look" at a given part of the list. So let's add two more
|
||||||
|
rules. We need a language that also:
|
||||||
|
|
||||||
|
* Supports looping control flow, such as `while`.
|
||||||
|
* {{< sidenote "right" "view-note" "Allows for a \"view\" into the list" >}}
|
||||||
|
We could, of course, simply use list indexing. But then, we'd just be making
|
||||||
|
a simple imperative language, and that's boring. So let's play around
|
||||||
|
with our design a little, and experimentally add such a "list view" component.
|
||||||
|
{{< /sidenote >}}
|
||||||
|
(like an abstraction over indexing).
|
||||||
|
|
||||||
|
This is shaping up to be a fun language. Let's take a look at the last problem:
|
||||||
|
{{< codelines "text" "cs325-langs/hws/hw3.txt" 50 64 >}}
|
||||||
|
|
||||||
|
This problem requires more iterations of a list. We have several
|
||||||
|
{{< sidenote "right" "cursor-note" "\"cursors\"" >}}
|
||||||
|
I always make the language before I write the post, since a lot of
|
||||||
|
design decisions change mid-implementation. I realize now that
|
||||||
|
"cursors" would've been a better name for this language feature,
|
||||||
|
but alas, it is too late.
|
||||||
|
{{< /sidenote >}} looking into the list, and depending if the values
|
||||||
|
at each of the cursors add up, we do or do not add a new tuple to a list. So,
|
||||||
|
two more requirements:
|
||||||
|
|
||||||
|
* The "cursors" must be able to interact.
|
||||||
|
* The language can represent {{< sidenote "left" "tuple-note" "tuples." >}}
|
||||||
|
We could, of course, hack some other way to return a list of tuples, but
|
||||||
|
it turns out tuples are pretty simple to implement, and help make for nicer
|
||||||
|
programming in our language.
|
||||||
|
{{< /sidenote >}}
|
||||||
|
|
||||||
|
I think we've gathered what we want from the homework. Let's move on to the
|
||||||
|
language!
|
||||||
|
|
||||||
|
### A Language
|
||||||
|
As is now usual, let's envision a solution to the problems in our language. There
|
||||||
|
are actually quite a lot of functions to look at, so let's see them one by one.
|
||||||
|
First, let's look at `qselect`.
|
||||||
|
|
||||||
|
{{< codelines "text" "cs325-langs/sols/hw3.lang" 1 19 >}}
|
||||||
|
|
||||||
|
After the early return, the first interesting part of the language is the
|
||||||
|
use of what I have decided to call a __list traverser__. The list
|
||||||
|
traverser is a __generalization of a list index__. Whenever we use a list
|
||||||
|
index variable, we generally use the following operations:
|
||||||
|
|
||||||
|
* __Initialize__: we set the list index to some initial value, such as 0.
|
||||||
|
* __Step__: If we're walking the list from left to right, we increment the index.
|
||||||
|
If we're walking the list from right to left, we decrement the index.
|
||||||
|
* __Validity Check__: We check if the index is still valid (that is, we haven't
|
||||||
|
gone past the edge of the list).
|
||||||
|
* __Access__: Get the element the cursor is pointing to.
|
||||||
|
|
||||||
|
A {{< sidenote "right" "cpp-note" "traverser declaration" >}}
|
||||||
|
A fun fact is that we've just rediscovered C++
|
||||||
|
<a href="http://www.cplusplus.com/reference/iterator/">iterators</a>. C++
|
||||||
|
containers and their iterators provide us with the operations I described:
|
||||||
|
|
||||||
|
We can initialize an iterator like <code>auto it = list.begin()</code>. We
|
||||||
|
can step the iterator using <code>it++</code>. We can check its validity
|
||||||
|
using <code>it != list.end()</code>, and access what it's pointing to using
|
||||||
|
<code>*it</code>. While C++ uses templates and inheritance for this,
|
||||||
|
we define a language feature specifically for lists.
|
||||||
|
|
||||||
|
{{< /sidenote >}} describes these operations. The declartion for the `bisector`
|
||||||
|
traverser creates a "cursor" over the list `xs`, that goes between the 0th
|
||||||
|
and last elements of `xs`. The declaration for the `pivot` traverser creates
|
||||||
|
a "cursor" over the list `xs` that jumps around random locations in the list.
|
||||||
|
|
||||||
|
The next interesting part of the language is a __traverser macro__. This thing,
|
||||||
|
that looks like a function call (but isn't), performs an operation on the
|
||||||
|
cursor. For instance, `pop!` removes the element at the cursor from the list,
|
||||||
|
whereas `bisect!` categorizes the remaining elements in the cursor's list
|
||||||
|
into two lists, using a boolean-returning lambda (written in Java syntax).
|
||||||
|
|
||||||
|
Note that this implementation of `qselect` takes a function `c`, which it
|
||||||
|
uses to judge the actual value of the number. This is because our `qselect`
|
||||||
|
won't be finding _the_ smallest number, but the number with the smallest difference
|
||||||
|
with `n`. `n` will be factored in via the function.
|
||||||
|
|
||||||
|
Next up, let's take a look at the function that uses `qselect`, `closestUnsorted`:
|
||||||
|
|
||||||
|
{{< codelines "text" "cs325-langs/sols/hw3.lang" 21 46 >}}
|
||||||
|
|
||||||
|
Like we discussed, it finds the `k`th closest element (calling it `min`),
|
||||||
|
and counts how many elements that are __equal__ need to be included,
|
||||||
|
by setting the number to `k` at first, and subtracting 1 for every number
|
||||||
|
it encounters that's closer than `min`. Notice that we use the `valid!` and
|
||||||
|
`step!` macros, which implement the opertions we described above. Notice
|
||||||
|
that the user doesn't deal with adding and subtracting numbers, and doing
|
||||||
|
comparisons. All they have to do is ask "am I still good to iterate?"
|
||||||
|
|
||||||
|
Next, let's take a look at `closestSorted`, which will require more
|
||||||
|
traverser macros.
|
||||||
|
|
||||||
|
{{< codelines "text" "cs325-langs/sols/hw3.lang" 48 70 >}}
|
||||||
|
|
||||||
|
The first new macro is `canstep!`. This macro just verifies that
|
||||||
|
the traverser can make another step. We need this for the "reverse" iterator,
|
||||||
|
which indicates the lower bound of the range of numbers we want to return,
|
||||||
|
because `subset!` (which itself is just Python's slice, like `xs[a:b]`), uses an inclusive bottom
|
||||||
|
index, and thus, we can't afford to step it before knowing that we can, and that
|
||||||
|
it's a better choice after the step.
|
||||||
|
|
||||||
|
Similarly, we have the `at!(t, i)` macro, which looks at the
|
||||||
|
traverser `t`, with offset `i`.
|
||||||
|
|
||||||
|
We have two loops. The first loop runs as long as we can expand the range in both
|
||||||
|
directions, and picks the better direction at each iteration. The second loop
|
||||||
|
runs as long as we still want more numbers, but have already hit the edge
|
||||||
|
of the list on the left or on the right.
|
||||||
|
|
||||||
|
Finally, let's look at the solution to `xyz`:
|
||||||
|
|
||||||
|
{{< codelines "text" "cs325-langs/sols/hw3.lang" 72 95 >}}
|
||||||
|
|
||||||
|
I won't go in depth, but notice that the expression in the `span` part
|
||||||
|
of the `traverser` declaration can access another traverser. We treat
|
||||||
|
as a feature the fact that this expression isn't immediately evaluated at the place
|
||||||
|
of the traverser declaration. Rather, every time that a comparison for a traverser
|
||||||
|
operation is performed, this expression is re-evaluated. This allows us to put
|
||||||
|
dynamic bounds on traversers `y` and `z`, one of which must not exceed the other.
|
||||||
|
|
||||||
|
This is more than enough to work with. Let's move on to the implementation.
|
||||||
|
|
||||||
|
#### Implementation
|
||||||
|
Again, let's not go too far into the details of implementing the language from scratch.
|
||||||
|
Instead, let's take a look into specific parts of the language that deserve attention.
|
||||||
|
|
||||||
|
##### Revenge of the State Monad
|
||||||
|
Our previous language was, indeed, a respite from complexity. Translation was
|
||||||
|
straightforward, and the resulting expressions and statements were plugged straight
|
||||||
|
into a handwritten AST. We cannot get away with this here; the language is powerful
|
||||||
|
enough to implement three list-based problems, which comes at the cost of increased
|
||||||
|
complexity.
|
||||||
|
|
||||||
|
We need, once again, to generate temporary variables. We also need to keep track of
|
||||||
|
which variables are traversers, and the properties of these traversers, throughout
|
||||||
|
each function of the language. We thus fall back to using `Control.Monad.State`:
|
||||||
|
|
||||||
|
{{< todo >}}Code for Translator Monad{{< /todo >}}
|
||||||
|
|
||||||
|
There's one part of the state tuple that we haven't yet explained: the list of
|
||||||
|
statements.
|
||||||
|
|
||||||
|
##### Generating Statements
|
||||||
|
Recall that our translation function for expressions in the first homework had the type:
|
||||||
|
|
||||||
|
```Haskell
|
||||||
|
translateExpr :: Expr -> Translator ([Py.PyStmt], Py.PyExpr)
|
||||||
|
```
|
||||||
|
|
||||||
|
We then had to use `do`-notation, and explicitly concatenate lists
|
||||||
|
of emitted statements. In this language, I took an alternative route: I made
|
||||||
|
the statements part of the state. They are thus implicitly generated and
|
||||||
|
stored in the monad, and expression generators don't have to worry about
|
||||||
|
concatenating them. When the program is ready to use the generated statements
|
||||||
|
(say, when an `if`-statement needs to use the statements emitted by the condition
|
||||||
|
expression), we retrieve them from the monad:
|
||||||
|
|
||||||
|
{{< todo >}}Code for getting statements{{< /todo >}}
|
||||||
|
|
||||||
|
##### Validating Traverser Declarations
|
||||||
|
We declare two separate types that hold traverser data. The first is a kind of "draft"
|
||||||
|
type, `TraverserData`. This record holds all possible configurations of a traverser
|
||||||
|
that occur as the program is iterating through the various `key: value` pairs in
|
||||||
|
the declaration. For instance, at the very beginning of processing a traverser declaration,
|
||||||
|
our program will use a "default" `TraverserData`, with all fields set to `Nothing` or
|
||||||
|
their default value. This value will then be modified by the first key/value pair,
|
||||||
|
changing, for instance, the list that the traverser operates on. This new modified
|
||||||
|
`TraverserData` will then be modified by the next key/value pair, and so on. This
|
||||||
|
is, effectively, a fold operation.
|
||||||
|
|
||||||
|
{{< todo >}}Code for TraverserData{{< /todo >}}
|
||||||
|
{{< todo >}}Maybe sidenote about fold?{{< /todo >}}
|
||||||
|
|
||||||
|
The data may not have all the required fields until the very end, and its type
|
||||||
|
reflects that: `Maybe String` here, `Maybe TraverserBounds` there. We don't
|
||||||
|
want to deal with unwrapping the `Maybe a` values every time we use the traverser,
|
||||||
|
especially if we've done so before. So, we define a `ValidTraverserData` record,
|
||||||
|
that does not have `Maybe` arguments, and thus, has all the required data. At the
|
||||||
|
end of a traverser declaration, we attempt to translate a `TraverserData` into
|
||||||
|
a `ValidTraverserData`, invoking `fail` if we can't, and storing the `ValidTraverserData`
|
||||||
|
into the state otherwise. Then, every time we retrieve a traverser from the state,
|
||||||
|
it's guaranteed to be valid, and we have to spend no extra work unpacking it. We
|
||||||
|
define a lookup monadic operation like this:
|
||||||
|
|
||||||
|
{{< todo >}}Code for getting ValidTraverserData{{< /todo >}}
|
||||||
|
|
||||||
|
##### Compiling Macros
|
||||||
|
I didn't call them macros for no reason. Clearly, we don't want to generate
|
||||||
|
code that
|
||||||
|
{{< sidenote "right" "increment-note" "calls functions only to increment an index." >}}
|
||||||
|
In fact, there's no easy way to do this at all. Python's integers (if we choose to
|
||||||
|
represent our traversers using integers), are immutable. Furthermore, unlike C++,
|
||||||
|
where passing by reference allows a function to change its parameters "outside"
|
||||||
|
the call, Python offers no way to reassign a different value to a variable given
|
||||||
|
to a function.
|
||||||
|
<br><br>
|
||||||
|
For an example use of C++'s pass-by-reference mechanic, consider <code>std::swap</code>:
|
||||||
|
it's a function, but it modifies the two variables given to it. There's no
|
||||||
|
way to generically implement such a function in Python.
|
||||||
|
{{< /sidenote >}} We also can't allow arbitrary expressions to serve as traversers:
|
||||||
|
our translator keeps some context about which variables are traversers, what their
|
||||||
|
bounds are, and how they behave. Thus, __calls to traverser macros are very much macros__:
|
||||||
|
they operate on AST nodes, and __require__ that their first argument is a variable,
|
||||||
|
named like the traverser. We use the `requireTraverser` monadic operation
|
||||||
|
to get the traverser associated with the given variable name, and then perform
|
||||||
|
the operation as intended. The `at!(t)` operation is straightforward:
|
||||||
|
|
||||||
|
{{< todo >}}Code for at!{{< /todo >}}
|
||||||
|
|
||||||
|
The `at!(t,i)` is less so, since it deals with the intricacies of accessing
|
||||||
|
the list at either a positive of negative offset, depending on the direction
|
||||||
|
of the traverser. We implement a function to properly generate an expression for the offset:
|
||||||
|
|
||||||
|
{{< todo >}}Code for traverserIncrement{{< /todo >}}
|
||||||
|
|
||||||
|
We then implement `at!(t,i)` as follows:
|
||||||
|
|
||||||
|
{{< todo >}}Code for at!{{< /todo >}}
|
||||||
|
|
||||||
|
The most complicated macro is `bisect!`. It must be able to step the traverser,
|
||||||
|
and also return a tuple of two lists that the bisection yields. We also
|
||||||
|
prefer that it didn't pollute the environment with extra variables. To
|
||||||
|
achieve this, we want `bisect!` to be a function call. We want this
|
||||||
|
function to implement the iteration and list construction.
|
||||||
|
|
||||||
|
`bisect!`, by definition, takes a lambda. This lambda, in our language, is declared
|
||||||
|
in the lexical scope in which `bisect!` is called. Thus, to guarantee correct translation,
|
||||||
|
we must do one of two things:
|
||||||
|
|
||||||
|
1. Translate 1-to-1, and create a lambda, passing it to a fixed `bisect` function declared
|
||||||
|
elsewhere.
|
||||||
|
2. Translate to a nested function declaration, inlining the lambda.
|
||||||
|
|
||||||
|
{{< todo >}}Maybe sidenote about inline?{{< /todo >}}
|
||||||
|
|
||||||
|
Since I quite like the idea of inlining a lambda, let's settle for that. To do this,
|
||||||
|
we pull a fresh temporary variable and declare a function, into which we place
|
||||||
|
the traverser iteration code, as well as the body of the lambda, with the variable
|
||||||
|
substituted for the list access expression. Here's the code:
|
||||||
|
|
||||||
|
{{< todo >}}Code for bisect!{{< /todo >}}
|
Loading…
Reference in New Issue
Block a user