From 0098d2139364ba9d210fd3d5d3b363aed921fd36 Mon Sep 17 00:00:00 2001
From: p9malino26 <pm3g19@soton.ac.uk>
Date: Wed, 5 May 2021 21:38:56 +0100
Subject: [PATCH] Before first submission
---
Eval.hs | 39 +++++++++++++++++++++++++-----
Interpreter.hs | 20 +++++++---------
Lexer.x | 48 +++++++++++++++++++++++++++++++++----
Main.hs | 20 ++++++++++++++++
Makefile | 5 ++++
Parser.y | 64 +++++++++++++++++++++++++++++++++++---------------
Types.hs | 16 +++++++++++++
pr1.cql | 6 +++++
pr10.cql | 5 ++++
pr2.cql | 6 +++++
pr3.cql | 9 +++++++
pr4.cql | 6 +++++
pr5.cql | 5 ++++
pr6.cql | 9 +++++++
pr7.cql | 0
pr8.cql | 0
pr9.cql | 0
17 files changed, 217 insertions(+), 41 deletions(-)
create mode 100644 Main.hs
create mode 100644 Makefile
create mode 100644 pr1.cql
create mode 100644 pr10.cql
create mode 100644 pr2.cql
create mode 100644 pr3.cql
create mode 100644 pr4.cql
create mode 100644 pr5.cql
create mode 100644 pr6.cql
create mode 100644 pr7.cql
create mode 100644 pr8.cql
create mode 100644 pr9.cql
diff --git a/Eval.hs b/Eval.hs
index a081f99..5e1e941 100644
--- a/Eval.hs
+++ b/Eval.hs
@@ -34,12 +34,18 @@ eval env expr = let (eval', evalFull') = (eval env, evalFull env) in case expr o
[Set l1, Set l2] -> Set $ [ x `concatRecord` y | x <- l1, y <- l2]
_ -> error "X product takes in two sets"
+ (ComparisonFunc op) -> case args' of
+ [e1, e2] -> Boolean $ e1 `op` e2
+ _ -> error "Comparison must take in two arguments"
+
(BooleanFunc op) -> case args' of
[Boolean e1, Boolean e2] -> Boolean (e1 `op` e2)
- _ -> error "Boolean function takes in two arguments."
+ _ -> error "Boolean function AND/OR takes in two arguments."
- RecordIndex -> eval' $ case args' of
+ RecordIndex -> eval' $ case args' of --TODO rename
[Record recordData,Int index] -> recordData `listAtIndex` index
+ [String stringData,Int index] -> String [stringData `listAtIndex` index]
+
RecordSelect -> case args' of
(Record recordData: indexes ) -> Record filteredList
where
@@ -48,31 +54,52 @@ eval env expr = let (eval', evalFull') = (eval env, evalFull env) in case expr o
filteredList = map (eval'.listAtIndex recordData) indexesRaw
checkInt (Int i) = i
checkInt _ = error "Arguments to index record must be integers"
+
+ (String stringData: indexes ) -> String filteredList
+ where
+ indexesRaw = map checkInt indexes
+ --filteredList = map (eval'.(stringData !!)) indexesRaw
+ filteredList = map (listAtIndex stringData) indexesRaw
+ checkInt (Int i) = i
+ checkInt _ = error "Arguments to index list must be integers"
-
+
{-numberedElems = zip [1..] recordData :: [(Int, Expr)]
filtered = filter ((`elem` indexesRaw).fst) numberedElems :: [(Int, Expr)]
filteredList = map snd filtered :: [Expr]-}
+
+
IsEmpty -> case head args' of
(String a) -> Boolean $ null a
- _ -> error "IsEmpty operates on a string"
+ _ -> error "'isEmpty' operates on a string"
NotEmpty -> case head args' of
(String a) -> Boolean $ (not.null) a
- _ -> error "notEmpty operates on a string"
+ _ -> error "'notEmpty' operates on a string"
Contains -> case args' of
[String a, String b] -> Boolean $ b `isSubList` a
- _ -> error "Arguments to 'Contains' must be two strings."
+ _ -> 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"
+ Split -> case args' of
+ [String a, Int i] -> if (i <= length a) then splitRecord else error "Splitat: index outside of range"
+ where
+ splitRecord = let (s1, s2) = splitAt i a in Record [String s1, String s2]
+ _ -> error "'split' argument error"
+
Not -> case args' of
[Boolean exp1] -> Boolean $ not exp1
+
+ Length -> case args' of
+ [String a] -> Int $ length a
+ _ -> error "'length' only operates on a String"
+
(FuncDef setParams argParams body) -> eval newEnv body
where
newEnv = let (setEnv, argsEnv) = (zip setParams inputSets, zip argParams args) in setEnv ++ argsEnv ++ env
diff --git a/Interpreter.hs b/Interpreter.hs
index 23e4786..e090b50 100644
--- a/Interpreter.hs
+++ b/Interpreter.hs
@@ -1,13 +1,12 @@
+module Interpreter where
import Types
import Debug
import Eval
import System.IO
-import System.Environment
import CSV
import Lexer
import Parser
import Debug.Trace
-import Control.Exception
printErr s = hPutStrLn stderr ("[ERROR] " ++ s)
@@ -15,16 +14,15 @@ parse :: String -> Program
parse = parseSource.alexScanTokens
--outline
-main = do
- args <- getArgs
- case args of
- --("default":_) -> catch (interpret "/home/patryk/dev/plc/extra-problems/ex1.cql") (errorFunc)
- (srcname:_) -> catch (interpret srcname) (errorFunc)
+--main = do
+-- args <- getArgs
+-- case args of
+-- --("default":_) -> catch (interpret "/home/patryk/dev/plc/extra-problems/ex1.cql") (errorFunc)
+-- (srcname:_) -> catch (interpret srcname) (errorFunc)
--_ -> printErr "No source file specified."
- _ -> catch (interpret "/home/patryk/dev/plc/extra-problems/ex1.cql") (errorFunc)
+-- _ -> catch (interpret "/home/patryk/dev/plc/extra-problems/ex1.cql") (errorFunc)
+
-errorFunc :: ErrorCall -> IO ()
-errorFunc = printErr.show
interpret :: FilePath -> IO () -- the main function, takes in file name, prints out result
@@ -55,7 +53,7 @@ showFinal :: Expr -> IO ()
showFinal = (print2DList.sort2DListLex.setTo2DList)
setTo2DList :: Expr -> [[String]]
-setTo2DList (Set records) = traceShow records $ map (map (\(String s) -> s).(\(Record list) -> list)) records
+setTo2DList (Set records) = map (map (\(String s) -> s).(\(Record list) -> list)) records
--------------------------------------------
diff --git a/Lexer.x b/Lexer.x
index 1cab757..e07ab8d 100644
--- a/Lexer.x
+++ b/Lexer.x
@@ -26,6 +26,8 @@ let {\p s -> TokenLet p }
if {\p s -> TokenIf p }
else {\p s -> TokenElse p }
then {\p s -> TokenThen p }
+and {\p s -> TokenBoolAND p }
+or {\p s -> TokenBoolOR p }
\.in {\p s -> TokenInSet p }
\.out {\p s -> TokenOutSet p }
\[ {\p s -> TokenLeftSqBracket p }
@@ -34,9 +36,9 @@ then {\p s -> TokenThen p }
\} {\p s -> TokenRightBrace p }
"->" {\p s -> TokenArrow p }
"==" {\p s -> TokenisEqual p }
-"/=" {\p s -> TokenisNotEqual p }
+"!=" {\p s -> TokenisNotEqual p }
"+" {\p s -> TokenPlus p }
-\= {\p s -> TokenEqual p }
+\= {\p s -> TokenEqual p }
\( {\p s -> TokenLeftBracket p }
\) {\p s -> TokenRightBracket p }
\: {\p s -> TokenCol p }
@@ -47,13 +49,23 @@ then {\p s -> TokenThen p }
x {\p s -> TokenXProduct p }
xx {\p s -> TokenXXProduct p }
map {\p s -> TokenMap p }
+length {\p s -> TokenLen p }
+\! {\p s -> TokenWithout p }
+split {\p s -> TokenSplit p }
+reverse {\p s -> TokenReverse p }
+\> {\p s -> TokenGthan p }
+\< {\p s -> TokenLthan p }
$lower [$lower $digit \_ \']* {\p s -> TokenVarName 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) }
-AND {\p s -> TokenBoolAND p }
-OR {\p s -> TokenBoolOR p }
+isSublist {\p s -> TokenIsSubList p }
+startswith {\p s -> TokenStartsWith p }
+union {\p s -> TokenUnion p }
+i'section {\p s -> TokenISection p }
+difference {\p s -> TokenDifference p }
+
{
@@ -96,7 +108,20 @@ data Token =
TokenThen AlexPosn |
TokenEqual AlexPosn |
TokenBoolAND AlexPosn |
- TokenBoolOR AlexPosn
+ TokenBoolOR AlexPosn |
+ TokenLen AlexPosn |
+ TokenWithout AlexPosn |
+ TokenSplit AlexPosn |
+ TokenReverse AlexPosn |
+ TokenGthan AlexPosn |
+ TokenLthan AlexPosn |
+ TokenIsSubList AlexPosn |
+ TokenConcat AlexPosn |
+ TokenStartsWith AlexPosn |
+ TokenUnion AlexPosn |
+ TokenISection AlexPosn |
+ TokenDifference AlexPosn
+
deriving (Eq, Show)
@@ -138,4 +163,17 @@ pos token = case token of
(TokenIf p) -> p
(TokenThen p) -> p
(TokenEqual p) -> p
+ (TokenLen p) -> p
+ (TokenWithout p) -> p
+ (TokenSplit p) -> p
+ (TokenReverse p) -> p
+ (TokenGthan p) -> p
+ (TokenLthan p) -> p
+ (TokenIsSubList p) -> p
+ (TokenStartsWith p) -> p
+ (TokenConcat p) -> p
+ (TokenUnion p) -> p
+ (TokenISection p) -> p
+ (TokenDifference p) -> p
+
}
\ No newline at end of file
diff --git a/Main.hs b/Main.hs
new file mode 100644
index 0000000..bee36a8
--- /dev/null
+++ b/Main.hs
@@ -0,0 +1,20 @@
+module Main where
+
+import Interpreter
+import Control.Exception
+import System.Environment
+
+
+
+main :: IO ()
+
+
+main = do
+ args <- getArgs
+ case args of
+ --("default":_) -> catch (interpret "/home/patryk/dev/plc/extra-problems/ex1.cql") (errorFunc)
+ (srcname:_) -> catch (interpret srcname) (errorFunc)
+ _ -> printErr "No source file specified."
+
+errorFunc :: ErrorCall -> IO ()
+errorFunc = printErr.show
\ No newline at end of file
diff --git a/Makefile b/Makefile
new file mode 100644
index 0000000..fef60a0
--- /dev/null
+++ b/Makefile
@@ -0,0 +1,5 @@
+build:
+ alex Lexer.x
+ happy Parser.y
+ ghc -dynamic Main.hs
+ mv Main csvql
diff --git a/Parser.y b/Parser.y
index 39c3daf..29a8cf8 100644
--- a/Parser.y
+++ b/Parser.y
@@ -27,7 +27,7 @@ import CSV
']' { TokenRightSqBracket _ }
"->" { TokenArrow _ }
"==" { TokenisEqual _ }
- "/=" { TokenisNotEqual _ }
+ "!=" { TokenisNotEqual _ }
'(' { TokenLeftBracket _ }
')' { TokenRightBracket _ }
';' { TokenSemiCol _ }
@@ -50,18 +50,33 @@ import CSV
else { TokenElse _}
then { TokenThen _}
'=' { TokenEqual _}
- or { TokenBoolAND _ }
- and { TokenBoolOR _ }
+ and { TokenBoolAND _ }
+ or { TokenBoolOR _ }
+ length { TokenLen _}
+ '!' { TokenWithout _}
+ split {TokenSplit _}
+ reverse {TokenReverse _}
+ '>' {TokenGthan _}
+ '<' {TokenLthan _}
+ isSublist {TokenIsSubList _ }
+ startswith {TokenStartsWith _}
+ union {TokenUnion _ }
+ --i'section {TokenISection _ }
+ difference {TokenDifference _ }
+
-%left FUNCCALL
-%right INDEX
-%right map filter FUNCCALL
-%left '+'
-%left '=='
+%left "->"
%left or
%left and
+%nonassoc '<' '>'"=="
+%left '+'
+%left Str
+%left FUNCCALL
+%left PAREN
+%left '[' '(' '{'
+%nonassoc ';'
%%
@@ -72,21 +87,25 @@ SetDecls : SetDecl {[$1]}
| SetDecls','SetDecl {$3:$1}
Instructions : Expr ';' {[$1]}
- | Expr';' Instructions {$1:$3}
+ | 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 '('Exprs')' %prec FUNCCALL {FuncCall $1 [] $3}
+ | Expr '{' Exprs '}' '('Exprs')' %prec FUNCCALL {FuncCall $1 $3 $6}
+ | Expr "==" Expr {compareExpr (==) $1 $3}
+ | Expr "!=" Expr {compareExpr (/=) $1 $3}
+ | Expr '>' Expr {compareExpr (>) $1 $3}
+ | Expr '<' Expr {compareExpr (<) $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]}
- | 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 $3 $6 $8}
+ | Expr '+' Expr {FuncCall (PredefFunc Plus) [] [$1, $3]}
+ | Expr'['Expr']' {FuncCall (PredefFunc RecordIndex) [] [$1, $3]}
+ | Expr'['Expr','Exprs']' {FuncCall (PredefFunc RecordSelect) [] ($1:$3:$5) }
+ | '['Exprs']' {Record $2}
+ | '('Expr')' %prec PAREN {$2}
+ | Str {Types.String $ stripWhitespace $1}
+ | '\\' '(' VarNames ')' "->" Expr { FuncDef [] $3 $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}
@@ -96,14 +115,21 @@ Expr :
| PredefFunc {PredefFunc $1}
| Expr or Expr {booleanExpr (||) $1 $3}
| Expr and Expr {booleanExpr (&&) $1 $3}
+-- | length Expr {FuncCall (PredefFunc length) [] [$2]}
+-- | Expr contains Expr {FuncCall (PredefFunc contains) [] [$1, $3]}
+-- | Expr '!' Expr {FuncCall (PredefFunc without) [] [1, $3]}
+-- | split Expr Expr
PredefFunc : isEmpty {IsEmpty}
| filter {Filter}
| contains {Contains}
| isEmpty {IsEmpty}
+ | length {Length}
+ | split {Split}
-- | nEmpty {IsEmpty}
| map {Map}
| not {Not}
+-- | without {Without}
-- | and {And}
-- | or {Or}
-- | zip {Zip}
diff --git a/Types.hs b/Types.hs
index 9e5d4bc..473898f 100644
--- a/Types.hs
+++ b/Types.hs
@@ -12,9 +12,11 @@ data PredefFunc = XProduct | XXProduct | IsEqual | IsNotEqual | Plus --operators
| RecordIndex -- [] operator
| RecordSelect
| IsEmpty | NotEmpty | Contains -- string functions
+ | Split
| Length
| Not
| BooleanFunc (Bool -> Bool -> Bool)
+ | ComparisonFunc (Expr -> Expr -> Bool)
--TODO others:reverse
instance Show PredefFunc where
show XProduct = "XProduct"
@@ -32,6 +34,8 @@ instance Show PredefFunc where
show Length = "Length"
show Not = "Not"
show (BooleanFunc _) = "BooleanFunc"
+ show (ComparisonFunc _) = "CompFunc"
+ show (_) = "Unknown"
--n.b. these definitions do not enforce type checking! The use of any function or operator will be associated with a FuncCall.
@@ -58,6 +62,7 @@ data Expr = Control Expr [Expr] -- result of last computation, sequence of instr
-- | Nat Int
deriving (Show)
booleanExpr func e1 e2 = FuncCall (PredefFunc $ BooleanFunc func) [] [e1,e2]
+compareExpr func e1 e2 = FuncCall (PredefFunc $ ComparisonFunc func) [] [e1,e2]
instance Eq Expr where
--(Record r1) == (Record r2) = and (zipWith (==) r1 r2)
@@ -67,4 +72,15 @@ instance Eq Expr where
(Boolean b1) == (Boolean b2) = b1 == b2
(Int v1) == (Int v2) = v1 == v2
_ == _ = error "Comparison of incompatible types"
+
+instance Ord Expr where
+ --(String i) > (String j) = i > j
+ (String i) <= (String j) = i <= j
+
+ --(Int i) > (Int j) = i > j
+ (Int i) <= (Int j) = i <= j
+
+ --_ < _ = error "Invalid comparison"
+ --_ > _ = error "Invalid comparison"
+
data Parameter = NamedParam SymbolName | TupleMatch [SymbolName]
\ No newline at end of file
diff --git a/pr1.cql b/pr1.cql
new file mode 100644
index 0000000..f9bfb75
--- /dev/null
+++ b/pr1.cql
@@ -0,0 +1,6 @@
+.in
+A:2, # declare input files and their numbers of cols in .in section
+B:2
+
+.out # statements for the query are in .out section
+A x B; # returns the cartesian product of the two sets (conjunction)
\ No newline at end of file
diff --git a/pr10.cql b/pr10.cql
new file mode 100644
index 0000000..bb4e262
--- /dev/null
+++ b/pr10.cql
@@ -0,0 +1,5 @@
+.in
+B:1
+
+.out
+B;
\ No newline at end of file
diff --git a/pr2.cql b/pr2.cql
new file mode 100644
index 0000000..7411d32
--- /dev/null
+++ b/pr2.cql
@@ -0,0 +1,6 @@
+.in
+A:3
+
+.out
+filter( \(r) -> r[1] == r[2]);
+map (\(r) -> r[3,1]);
\ No newline at end of file
diff --git a/pr3.cql b/pr3.cql
new file mode 100644
index 0000000..5dc784d
--- /dev/null
+++ b/pr3.cql
@@ -0,0 +1,9 @@
+.in
+P: 4,
+Q: 4
+
+.out
+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/pr4.cql b/pr4.cql
new file mode 100644
index 0000000..28e6b58
--- /dev/null
+++ b/pr4.cql
@@ -0,0 +1,6 @@
+.in
+A:2
+
+.out
+filter (\(r) -> not(isEmpty(r[2]) ) );
+#filter (\(r) -> notEmpty(r[2]) );
\ No newline at end of file
diff --git a/pr5.cql b/pr5.cql
new file mode 100644
index 0000000..f34636e
--- /dev/null
+++ b/pr5.cql
@@ -0,0 +1,5 @@
+.in
+A:1
+
+.out
+map{A}(\(r) -> [r[1],"0",r[1]] );
\ No newline at end of file
diff --git a/pr6.cql b/pr6.cql
new file mode 100644
index 0000000..3938ff9
--- /dev/null
+++ b/pr6.cql
@@ -0,0 +1,9 @@
+.in
+P:3,
+Q:3,
+R:1,
+S:1,
+T:4
+
+.out
+P x Q x R x S x T;
\ No newline at end of file
diff --git a/pr7.cql b/pr7.cql
new file mode 100644
index 0000000..e69de29
diff --git a/pr8.cql b/pr8.cql
new file mode 100644
index 0000000..e69de29
diff --git a/pr9.cql b/pr9.cql
new file mode 100644
index 0000000..e69de29
--
GitLab