Commit 3f39c806 authored by pm3g19's avatar pm3g19
Browse files

Code solves all problems (yay!)


Co-authored-by: mnay1u19's avatarMaram Al Yahyai (mnay1u19) <mnay1u19@soton.ac.uk>
parent afca0b6c
......@@ -6,56 +6,70 @@ import Data.List
import Debug.Trace
eval, evalFull :: Environment -> Expr -> Expr --only focus on one expression
findVar :: Environment -> SymbolName -> Expr
findVar e v = fromJust $ lookup v e
findVar :: Environment -> SymbolName -> Maybe Expr
findVar e v = lookup v e
addVar :: Environment -> SymbolName -> Expr -> Environment
addVar = notImplemented
debug x = trace ("{{" ++ x ++ "}}")
eval env expr = traceShow expr $ let (eval', evalFull') = (eval env, evalFull env) in case expr of -- evaluates expression to weak-head normal form (i.e. top level data structure is not a FuncCall)
FuncCall func inputSets args -> let (inputSets', args') = (map eval' inputSets, map eval' args) in case func of
(PredefFunc f) -> case f of
Filter -> let (Set inputRecords,predicate) = (eval' $ head inputSets, eval' $ head args) in
Set $ filter ((==Boolean True).(\r -> eval' $ FuncCall predicate [] [r])) $ map eval' inputRecords
Map -> Set (map (\record -> eval' $ FuncCall lambda [] [record]) records)
where
(Set records:_) = inputSets
(lambda:_) = args
eval env expr = let (eval', evalFull') = (eval env, evalFull env) in case expr of -- evaluates expression to weak-head normal form (i.e. top level data structure is not a FuncCall)
FuncCall func inputSets args -> let (func', inputSets', args') = (eval' func, map eval' inputSets, map eval' args) in case func' of
(PredefFunc f) -> case f of
Filter -> case (inputSets', args') of
([Set inputRecords], [predicate]) -> let func = (\r -> eval' $ FuncCall predicate [] [r]) in
Set $ filter ((==Boolean True).func) inputRecords
_ -> error "Filter argument error"
Map -> case(inputSets', args') of
([Set records], [lambda]) -> Set (map (\record -> eval' $ FuncCall lambda [] [record]) records)
_ -> error "Map argument error"
IsEqual -> let (e1:e2:_) = args' in -- TODO not sufficent.
Boolean (e1 == e2)
XProduct -> let ((Set l1): (Set l2):_) = inputSets' in
Set $ [ x `concatRecord` y | x <- l1, y <- l2]
XProduct -> case inputSets' of
[(Set l1), (Set l2)] -> Set $ [ x `concatRecord` y | x <- l1, y <- l2]
_ -> error "X product takes in two sets"
(BooleanFunc op) -> case args' of
[Boolean e1, Boolean e2] -> Boolean (e1 `op` e2)
_ -> error "Boolean function takes in two arguments."
RecordIndex -> let (Record recordData:Int index:_) = args' in
RecordIndex -> eval' $ let (Record recordData:Int index:_) = args' in
recordData !! (index - 1)
RecordSelect -> Record filteredList
where
(Record recordData: indexes) = map eval' args --
indexesRaw = map (\(Int i) -> i - 1) indexes
filteredList = map (recordData!!) indexesRaw
{-numberedElems = zip [1..] recordData :: [(Int, Expr)]
filtered = filter ((`elem` indexesRaw).fst) numberedElems :: [(Int, Expr)]
filteredList = map snd filtered :: [Expr]-}
--TODO CBH
RecordSelect -> case args' of
(Record recordData: indexes ) -> Record filteredList
where
indexesRaw = map checkInt indexes
filteredList = map (eval'.(recordData!!)) indexesRaw
checkInt (Int i) = i - 1
checkInt _ = error "Arguments to index record must be integers"
{-numberedElems = zip [1..] recordData :: [(Int, Expr)]
filtered = filter ((`elem` indexesRaw).fst) numberedElems :: [(Int, Expr)]
filteredList = map snd filtered :: [Expr]-}
IsEmpty -> case eval' (head args) of
IsEmpty -> case head args' of
(String a) -> Boolean $ null a
_ -> error "IsEmpty operates on a string"
NotEmpty -> case head args' of
(String a) -> Boolean $ (not.null) a
_ -> error "notEmpty operates on a string"
Contains -> case args of
(mainString:containsWhat:_) -> case (eval' mainString , eval' containsWhat) of
(String a, String b) -> Boolean $ b `isSubList` a
Plus -> let (e1:e2:_) = args in case (eval' e1, eval' e2) of
(String a, String b) -> String (a ++ b)
(Record a, Record b) -> Record (a ++ b)
_ -> error "eval error"
Contains -> case args' of
[String a, String b] -> Boolean $ b `isSubList` a
_ -> error "Arguments to 'Contains' must be two strings."
Plus -> case args' of
[String a, String b] -> String (a ++ b)
[Record a, Record b] -> Record (a ++ b)
_ -> error "Arguments to '+' must either be two strings or two records"
Not -> case args' of
[Boolean exp1] -> Boolean $ not exp1
--implement later
--(Map) -> Set $ (map (\r -> FuncCall predicate [] [r]) inputRecords)
(FuncDef setParams argParams body) -> eval newEnv body
......@@ -63,12 +77,14 @@ eval env expr = traceShow expr $ let (eval', evalFull') = (eval env, evalFull en
newEnv = let (setEnv, argsEnv) = (zip setParams inputSets, zip argParams args) in setEnv ++ argsEnv ++ env
--newEnv = foldl (\env entry@(name, expr) -> addVar env name expr) env --adds entries to environment
-- TODO FIX
(Var name) -> eval' $ findVar env name
(Var name) -> case findVar env name of
(Just value) -> eval' value
Nothing -> error $ "Variable " ++ name ++ " not found."
(Let _ _ expr) -> expr
(If cond e1 e2) -> case eval' cond of
(If cond e1 e2) -> eval' $ case eval' cond of
(Boolean True) -> e1
(Boolean False) -> e2
......@@ -79,6 +95,7 @@ eval env expr = traceShow expr $ let (eval', evalFull') = (eval env, evalFull en
(Record exprs) -> Record $ map eval' exprs
_ -> expr
evalControl1 :: Environment -> Expr -> (Environment, Expr)
evalControl1 env (Control last (currentExpr:exprs)) = (newEnv, Control newLast exprs)
where
......
......@@ -16,8 +16,8 @@ main = do
args <- getArgs
case args of
(srcname:_) -> interpret srcname
_ -> interpret "solutions/pr3.cql"
--_ -> interpret "extra-problems/ex1.cql"
_ -> interpret "solutions/pr4.cql"
--_ -> interpret "extra-problems/pr3.cql"
--_ -> interpret "sampleprogram.txt"
......
......@@ -21,6 +21,7 @@ isEmpty {\p s -> TokenIsEmpty p }
filter {\p s -> TokenFilter p }
true {\p s -> TokenTrue p }
false {\p s -> TokenFalse p }
not {\p s -> TokenNot p }
let {\p s -> TokenLet p }
if {\p s -> TokenIf p }
else {\p s -> TokenElse p }
......@@ -47,7 +48,7 @@ x {\p s -> TokenXProduct p }
xx {\p s -> TokenXXProduct p }
map {\p s -> TokenMap p }
$lower [$lower $digit \_ \']* {\p s -> TokenVarName p s }
$upper[$alpha]* {\p s -> TokenSetName p s }
$upper[$alpha $digit \_ \']* {\p s -> TokenSetName p s }
--$posDigit$digit* {\p s -> TokenPosNat p (read s) }
$digit+ {\p s -> TokenNat p (read s) }
\"[$alpha $digit]+\" {\p s -> TokenString p (init.tail $ s) }
......@@ -67,11 +68,12 @@ data Token =
TokenVarName AlexPosn String |
TokenTrue AlexPosn |
TokenFalse AlexPosn |
TokenNot AlexPosn |
TokenString AlexPosn String |
TokenLeftSqBracket AlexPosn |
TokenRightSqBracket AlexPosn |
TokenLeftBrace AlexPosn |
TokenRightBrace AlexPosn |
TokenLeftBrace AlexPosn |
TokenRightBrace AlexPosn |
TokenArrow AlexPosn |
TokenisEqual AlexPosn |
TokenisNotEqual AlexPosn |
......@@ -110,6 +112,7 @@ pos token = case token of
(TokenVarName p _) -> p
(TokenTrue p ) -> p
(TokenFalse p ) -> p
(TokenNot p ) -> p
(TokenString p _) -> p
(TokenLeftSqBracket p ) -> p
(TokenLeftBrace p ) -> p
......
David , Beckham
Pele ,
Diego , Maradona
Cristiano, Ronaldo
Ronaldinho ,
\ No newline at end of file
......@@ -40,7 +40,7 @@ import CSV
map { TokenMap _ }
xx { TokenXXProduct _ }
-- mapr { TokenMapr _ }
-- '!' { TokenNot _ }
not { TokenNot _ }
-- zip { TokenZip _ }
contains { TokenContains _ }
-- isSubstring { TokenIsSubstring _ }
......@@ -56,8 +56,12 @@ import CSV
%left FUNCCALL
%right INDEX
--%right map filter FUNCCALL
%right map filter FUNCCALL
%left '+'
%left '=='
%left or
%left and
%%
......@@ -74,6 +78,7 @@ Expr :
Expr '('Exprs')' %prec FUNCCALL {FuncCall $1 [] $3}
| Expr '{' Exprs '}' '('Exprs')' {FuncCall $1 $3 $6}
| Expr "==" Expr {FuncCall (PredefFunc IsEqual) [] [$1, $3]}
-- | Expr "/=" Expr {FuncCall (PredefFunc IsNotEqual) [] [$1, $3]}
| Expr x Expr {FuncCall (PredefFunc XProduct) [$1, $3] []}
| Expr '+' Expr {FuncCall (PredefFunc Plus) [$1, $3] []}
| Expr'['Expr']' %prec INDEX {FuncCall (PredefFunc RecordIndex) [] [$1, $3]}
......@@ -81,23 +86,26 @@ Expr :
| '['Exprs']' {Record $2}
| Str {Types.String $ stripWhitespace $1}
| '\\' '(' VarNames ')' "->" Expr { FuncDef [] $3 $6 }
| if Expr then Expr else Expr {If $2 $4 $6}
| if '('Expr')' then Expr else Expr {If $3 $6 $8}
| let SetName '=' Expr {Let True $2 $4}
| let VarName '=' Expr {Let False $2 $4}
| VarName {Var $1}
| SetName {Var $1}
| Nat {Types.Int $1}
| true {Boolean True}
| PredefFunc {PredefFunc $1}
| Expr or Expr {FuncCall (PredefFunc Or) [] [$1,$3]}
| Expr and Expr {FuncCall (PredefFunc And) [] [$1,$3]}
| Expr or Expr {booleanExpr (||) $1 $3}
| Expr and Expr {booleanExpr (&&) $1 $3}
PredefFunc : isEmpty {IsEmpty}
| filter {Filter}
| contains {Contains}
| isEmpty {IsEmpty}
-- | nEmpty {IsEmpty}
| map {Map}
| and {And}
| or {Or}
| not {Not}
-- | and {And}
-- | or {Or}
-- | zip {Zip}
-- | Mapr
......
......@@ -3,7 +3,7 @@ P: 4,
Q: 4
.out
let S = P x Q;
filter(\(r) -> r[4] == r[5]);
let f = \(a,y) -> if isEmpty(a) then y else a;
P x Q;
filter(\(r) -> r[1] == r[5]);
let f = \(a,y) -> if (isEmpty(a)) then y else a;
map (\(r) -> [r[1], f(r[2], r[6]), f(r[3], r[7]), f(r[4], r[8])]);
\ No newline at end of file
.in
A:2
P42 :2
.out
filter (\(r) -> notEmpty(r[2]))
\ No newline at end of file
filter (\(r) -> not(isEmpty(r[2]) ) );
\ No newline at end of file
......@@ -2,4 +2,4 @@
A:1
.out
map{A}(\r -> [r[1],"0",r[1]]);
\ No newline at end of file
map{A}(\(r) -> [r[1],"0",r[1]] );
\ No newline at end of file
Supports Markdown
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment