Commit db44722d authored by pm3g19's avatar pm3g19
Browse files

Actual original submission

parent 54752cc3
......@@ -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
......
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
--------------------------------------------
......
......@@ -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
......@@ -27,7 +27,7 @@ import CSV
']' { TokenRightSqBracket _ }
"->" { TokenArrow _ }
"==" { TokenisEqual _ }
"/=" { TokenisNotEqual _ }
"!=" { TokenisNotEqual _ }
'(' { TokenLeftBracket _ }
')' { TokenRightBracket _ }
';' { TokenSemiCol _ }
......@@ -50,18 +50,34 @@ 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
%left '<' '>'
%left '+'
%left "=="
%left Str
%left FUNCCALL
%left PAREN
%left '[' '(' '{'
%nonassoc ';'
%%
......@@ -72,21 +88,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 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 +116,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}
......
......@@ -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
Supports Markdown
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