diff --git a/Eval.hs b/Eval.hs index 90f24e30ad735197d56b5d2086d8df6ff5521f19..17148aba5ffc5c79f164a30de9247528b6b18390 100644 --- a/Eval.hs +++ b/Eval.hs @@ -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 diff --git a/Interpreter.hs b/Interpreter.hs index 6d77627c9c06f5c2f15c97861172af5d1d5a4a8a..6fd85bbc1622dde79a6e56882c139c6ab9529638 100644 --- a/Interpreter.hs +++ b/Interpreter.hs @@ -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" diff --git a/Lexer.x b/Lexer.x index bdec949699d531f9d9b42b6300aa1cd01e8c62e4..1cab7571e7ce16a73be0c93358d4a0f99d13ab28 100644 --- a/Lexer.x +++ b/Lexer.x @@ -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 diff --git a/P42.csv b/P42.csv new file mode 100644 index 0000000000000000000000000000000000000000..ae56f619e71099db05328103bf595edc62b35956 --- /dev/null +++ b/P42.csv @@ -0,0 +1,5 @@ +David , Beckham +Pele , +Diego , Maradona +Cristiano, Ronaldo +Ronaldinho , \ No newline at end of file diff --git a/Parser.y b/Parser.y index 0fdabac071d6388a40e15463f77481c0d2f45012..39c3dafaac67d43faa0971b7b4828fbd9c2ac65a 100644 --- a/Parser.y +++ b/Parser.y @@ -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 diff --git a/solutions/pr3.cql b/solutions/pr3.cql index 6b3ab9c6841539f132dfd7cf50d808f8048ed76b..5dc784d5397ce53d453b08192bebe247592cdfa1 100644 --- a/solutions/pr3.cql +++ b/solutions/pr3.cql @@ -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 diff --git a/solutions/pr4.cql b/solutions/pr4.cql index b69b87904c44e219df79f4aab05ceb291f0d57dc..d8425281c1a50055894782a4635d172cf2c5f008 100644 --- a/solutions/pr4.cql +++ b/solutions/pr4.cql @@ -1,5 +1,5 @@ .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 diff --git a/solutions/pr5.cql b/solutions/pr5.cql index f1b16e1c1c76cd73807201d9648fdf71663943dd..f34636ec2f22bd74a8f39567878a1dec46232c78 100644 --- a/solutions/pr5.cql +++ b/solutions/pr5.cql @@ -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