Skip to content

GitLab

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 69416607 authored by pm3g19's avatar pm3g19
Browse files

before User defined functions change

parent 96af91ae
Expand all Hide whitespace changes
Inline Side-by-side
Showing with 897 additions and 437 deletions
A.csv
View file @ 69416607
patryk,malinowski
maram, jones
jeffrey,sylvester
Steven , Steve , Butcher
Dudley , Dudley , Timms
Gillian , Gillian , Carter
\ No newline at end of file
Eval.hs
View file @ 69416607
......@@ -13,8 +13,8 @@ addVar = notImplemented
debug x = trace ("{{" ++ x ++ "}}")
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 -> case func of
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
......@@ -24,16 +24,16 @@ eval env expr = let (eval', evalFull') = (eval env, evalFull env) in case expr o
(Set records:_) = inputSets
(lambda:_) = args
IsEqual -> let (e1:e2:_) = args in -- TODO not sufficent.
Boolean (eval' e1 == eval' e2)
IsEqual -> let (e1:e2:_) = args' in -- TODO not sufficent.
Boolean (e1 == e2)
XProduct -> let ((Set l1): (Set l2):_) = map eval' inputSets in
XProduct -> let ((Set l1): (Set l2):_) = inputSets' in
Set $ [ x `concatRecord` y | x <- l1, y <- l2]
RecordIndex -> let (Record recordData:Int index:_) = (map eval' args) in
RecordIndex -> let (Record recordData:Int index:_) = args' in
recordData !! (index - 1)
RecordSelect -> debug (show expr) $ Record filteredList
RecordSelect -> Record filteredList
where
(Record recordData: indexes) = map eval' args --
indexesRaw = map (\(Int i) -> i - 1) indexes
......@@ -50,7 +50,6 @@ eval env expr = let (eval', evalFull') = (eval env, evalFull env) in case expr o
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)
......@@ -67,14 +66,17 @@ eval env expr = let (eval', evalFull') = (eval env, evalFull env) in case expr o
(Var name) -> eval' $ findVar env name
(Let _ expr) -> expr
(Let _ _ expr) -> expr
(If cond e1 e2) -> case eval' cond of
(Boolean True) -> e1
(Boolean False) -> e2
control@(Control lastResult exprs) -> if null exprs then lastResult else
let (newEnv, newControl) = evalControl1 env control in
eval newEnv newControl
(Record exprs) -> Record $ map eval' exprs
_ -> expr
evalControl1 :: Environment -> Expr -> (Environment, Expr)
......@@ -82,10 +84,11 @@ evalControl1 env (Control last (currentExpr:exprs)) = (newEnv, Control newLast e
where
newLast = eval env $ case currentExpr of
(FuncCall func [] args) -> FuncCall func [last] args
(Let False _ _) -> last
_ -> currentExpr
newEnv = case currentExpr of
(Let var expr) -> (var,expr):env
(Let _ var expr) -> (var,expr):env
_ -> env
evalFull = eval
......@@ -94,6 +97,6 @@ evalFull = eval
--TODO implement properly
concatRecord (Record r1) (Record r2) = Record (r1 ++ r2)
listStartsWith, isSubList :: [a] -> [a] -> Bool
listStartsWith, isSubList :: Eq a => [a] -> [a] -> Bool
listStartsWith = notImplemented -- check if first list starts with second list
isSubList = notImplemented -- check if first list contains second list anywhere in it
\ No newline at end of file
isSubList main sub = sub `isInfixOf` main-- check if first list contains second list anywhere in it
\ No newline at end of file
Interpreter.hs
View file @ 69416607
......@@ -16,8 +16,9 @@ main = do
args <- getArgs
case args of
(srcname:_) -> interpret srcname
--_ -> interpret "solutions/pr3.cql"
_ -> interpret "sampleprogram.txt"
_ -> interpret "solutions/pr3.cql"
--_ -> interpret "extra-problems/ex1.cql"
--_ -> interpret "sampleprogram.txt"
interpret :: FilePath -> IO () -- the main function, takes in file name, prints out result
......
Lexer.x
View file @ 69416607
......@@ -29,6 +29,8 @@ then {\p s -> TokenThen p }
\.out {\p s -> TokenOutSet p }
\[ {\p s -> TokenLeftSqBracket p }
\] {\p s -> TokenRightSqBracket p }
\{ {\p s -> TokenLeftBrace p }
\} {\p s -> TokenRightBrace p }
"->" {\p s -> TokenArrow p }
"==" {\p s -> TokenisEqual p }
"/=" {\p s -> TokenisNotEqual p }
......@@ -49,6 +51,8 @@ $upper[$alpha]* {\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) }
AND {\p s -> TokenBoolAND p }
OR {\p s -> TokenBoolOR p }
{
......@@ -66,6 +70,8 @@ data Token =
TokenString AlexPosn String |
TokenLeftSqBracket AlexPosn |
TokenRightSqBracket AlexPosn |
TokenLeftBrace AlexPosn |
TokenRightBrace AlexPosn |
TokenArrow AlexPosn |
TokenisEqual AlexPosn |
TokenisNotEqual AlexPosn |
......@@ -86,7 +92,9 @@ data Token =
TokenIf AlexPosn |
TokenElse AlexPosn |
TokenThen AlexPosn |
TokenEqual AlexPosn
TokenEqual AlexPosn |
TokenBoolAND AlexPosn |
TokenBoolOR AlexPosn
deriving (Eq, Show)
......@@ -104,6 +112,7 @@ pos token = case token of
(TokenFalse p ) -> p
(TokenString p _) -> p
(TokenLeftSqBracket p ) -> p
(TokenLeftBrace p ) -> p
(TokenRightSqBracket p ) -> p
(TokenArrow p ) -> p
(TokenisEqual p ) -> p
......
Parser.hs
View file @ 69416607
This diff is collapsed.
Parser.y
View file @ 69416607
......@@ -22,6 +22,8 @@ import CSV
false { TokenFalse _ }
Str { TokenString _ $$ }
'[' { TokenLeftSqBracket _ }
'{' { TokenLeftBrace _ }
'}' { TokenRightBrace _ }
']' { TokenRightSqBracket _ }
"->" { TokenArrow _ }
"==" { TokenisEqual _ }
......@@ -48,64 +50,63 @@ import CSV
else { TokenElse _}
then { TokenThen _}
'=' { TokenEqual _}
or { TokenBoolAND _ }
and { TokenBoolOR _ }
%left FUNCCALL
%right INDEX
--%right map filter FUNCCALL
%right "->"
%left "/=" "==" ';'
%nonassoc '('
%%
Prog : in SetDecls out SetFuncCalls {($2,$4)}
%%
Prog : in SetDecls out Instructions {($2,$4)}
SetDecl : SetName':'Nat {$1}
SetDecls : SetDecl {[$1]}
| SetDecls','SetDecl {$3:$1}
SetNames : SetName {[$1]}
| SetName ',' SetNames { $1:$3 }
VarNames : VarName {[$1]}
| VarName ',' VarNames {$1:$3}
SetFuncCalls : SetFuncCall';' {[$1]}
| SetFuncCall';' SetFuncCalls {$1:$3}
SetFuncCall : filter '['SetName']' '('Expr')' {FuncCall (PredefFunc Filter) [Var $3] [$6]}
| filter '('Expr')' {FuncCall (PredefFunc Filter) [] [$3]}
--| map '['SetName']' '('Expr')' {FuncCall (PredefFunc Map) [Var $3] [$6]}
| map '('Expr')' {FuncCall (PredefFunc Map) [] [$3]}
| SetName x SetName {FuncCall (PredefFunc XProduct) (map Var [$1, $3]) []}
| let VarName '=' Expr {Let $2 $4}
Expr : Expr "==" Expr {FuncCall (PredefFunc IsEqual) [] [$1, $3]}
| Expr'['Nat']' {FuncCall (PredefFunc RecordIndex) [] [$1, Types.Int $3]}
| Expr'['Nat','Nats']' {FuncCall (PredefFunc RecordSelect) [] ($1:(map Types.Int ($3:$5))) }
| Function'('Exprs')' {FuncCall $1 [] $3}
Instructions : Expr ';' {[$1]}
| Expr';' Instructions {$1:$3}
Expr :
Expr '('Exprs')' %prec FUNCCALL {FuncCall $1 [] $3}
| Expr '{' Exprs '}' '('Exprs')' {FuncCall $1 $3 $6}
| Expr "==" Expr {FuncCall (PredefFunc IsEqual) [] [$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]}
| Expr'['Expr','Exprs']' {FuncCall (PredefFunc RecordSelect) [] ($1:$3:$5) }
| '['Exprs']' {Record $2}
| Str {Types.String $ stripWhitespace $1}
| '\\' '(' VarNames ')' "->" Expr { FuncDef [] $3 $6 }
| if Expr then Expr else Expr {If $2 $4 $6}
| Str {Types.String $ stripWhitespace $1}
| if Expr then Expr else Expr {If $2 $4 $6}
| let SetName '=' Expr {Let True $2 $4}
| let VarName '=' Expr {Let False $2 $4}
| VarName {Var $1}
| Record {$1}
| true {Boolean True}
| false {Boolean False}
| '(' Expr ')' {$2}
--TODO brackets
Function : PredefFunc {PredefFunc $1}
| VarName { Var $1}
| SetName {Var $1}
| Nat {Types.Int $1}
| PredefFunc {PredefFunc $1}
| Expr or Expr {FuncCall (PredefFunc Or) [] [$1,$3]}
| Expr and Expr {FuncCall (PredefFunc And) [] [$1,$3]}
PredefFunc : isEmpty {IsEmpty}
| filter {Filter}
| contains {Contains}
| isEmpty {IsEmpty}
| map {Map}
| and {And}
| or {Or}
-- | zip {Zip}
-- | Map
-- | Mapr
SetNames : SetName {[$1]}
| SetName ',' SetNames { $1:$3 }
Record : '['Exprs']' {Record $2}
VarNames : VarName {[$1]}
| VarName ',' VarNames {$1:$3}
Exprs : Expr {[$1]}
| Expr','Exprs {$1:$3}
......
solutions/pr3.cql
View file @ 69416607
......@@ -3,7 +3,7 @@ P: 4,
Q: 4
.out
P x Q;
filter(\r -> r[4] == r[5]);
let func f(x,y) = if (empty(x)) then y else x;
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
let S = P x Q;
filter(\(r) -> r[4] == 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
solutions/pr5.cql
View file @ 69416607
......@@ -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