diff --git a/src/Eval.hs b/src/Eval.hs
index a081f997b22b268a621178fcc8651fa5dae7a597..5e1e941b3c27ea0b03b2e1d35438d86aeb20ecf4 100644
--- a/src/Eval.hs
+++ b/src/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/src/Lexer.x b/src/Lexer.x
index 1cab7571e7ce16a73be0c93358d4a0f99d13ab28..d710ded231e57e00a80a818915f55ce721b20348 100644
--- a/src/Lexer.x
+++ b/src/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 }
@@ -36,7 +38,7 @@ then {\p s -> TokenThen p }
"==" {\p s -> TokenisEqual 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,17 @@ 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 }
{
@@ -96,7 +102,13 @@ data Token =
TokenThen AlexPosn |
TokenEqual AlexPosn |
TokenBoolAND AlexPosn |
- TokenBoolOR AlexPosn
+ TokenBoolOR AlexPosn |
+ TokenLen AlexPosn |
+ TokenWithout AlexPosn |
+ TokenSplit AlexPosn |
+ TokenReverse AlexPosn |
+ TokenGthan AlexPosn |
+ TokenLthan AlexPosn
deriving (Eq, Show)
@@ -138,4 +150,10 @@ 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
}
\ No newline at end of file
diff --git a/src/Parser.y b/src/Parser.y
index 39c3dafaac67d43faa0971b7b4828fbd9c2ac65a..0ba42b8e6b5884e5a3f23d291722e0335c0ebc85 100644
--- a/src/Parser.y
+++ b/src/Parser.y
@@ -50,18 +50,28 @@ import CSV
else { TokenElse _}
then { TokenThen _}
'=' { TokenEqual _}
- or { TokenBoolAND _ }
- and { TokenBoolOR _ }
+ and { TokenBoolAND _ }
+ or { TokenBoolOR _ }
+ length { TokenLen _}
+ '!' { TokenWithout _}
+ split {TokenSplit _}
+ reverse {TokenReverse _}
+ '>' {TokenGthan _}
+ '<' {TokenLthan _}
-%left FUNCCALL
-%right INDEX
-%right map filter FUNCCALL
-%left '+'
-%left '=='
+%left "->"
%left or
%left and
+%left '<' '>'
+%left '+'
+%left "=="
+%left Str
+%left FUNCCALL
+%left PAREN
+%left '[' '(' '{'
+%nonassoc ';'
%%
@@ -72,21 +82,24 @@ 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 '('Exprs')' %prec FUNCCALL {FuncCall $1 [] $3}
+ | Expr '{' Exprs '}' '('Exprs')' %prec FUNCCALL {FuncCall $1 $3 $6}
| Expr "==" Expr {FuncCall (PredefFunc IsEqual) [] [$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 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 +109,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/src/Types.hs b/src/Types.hs
index 9e5d4bc63b6fbfdda69415d9187cc54b7e1e0103..473898f9046ec79ad4ac2c6c652ee600f6e69920 100644
--- a/src/Types.hs
+++ b/src/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