Administrator approval is now required for registering new accounts. If you are registering a new account, and are external to the University, please ask the repository owner to contact ServiceLine to request your account be approved. Repository owners must include the newly registered email address, and specific repository in the request for approval.

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
Markdown is supported
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