Eval.hs 4.27 KB
Newer Older
1
2
3
module Eval where
import Types
import Debug
4
5
6
import Data.Maybe
import Data.List
import Debug.Trace
7

pm3g19's avatar
pm3g19 committed
8
eval, evalFull :: Environment -> Expr -> Expr --only focus on one expression
9
findVar :: Environment -> SymbolName -> Expr
10
findVar e v = fromJust $ lookup v e
11
addVar :: Environment -> SymbolName -> Expr -> Environment
12
addVar = notImplemented
13

14
15
debug x = trace ("{{" ++ x ++ "}}")

pm3g19's avatar
pm3g19 committed
16
17
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
18
        (PredefFunc f) -> case f of
19
            Filter -> let (Set inputRecords,predicate) = (eval' $ head inputSets, eval' $ head args) in
pm3g19's avatar
pm3g19 committed
20
                Set $ filter ((==Boolean True).(\r -> eval' $ FuncCall predicate [] [r])) $ map eval' inputRecords
21
              
pm3g19's avatar
pm3g19 committed
22
            Map -> Set (map (\record -> eval' $ FuncCall lambda [] [record]) records)
23
24
25
26
                where
                    (Set records:_) = inputSets
                    (lambda:_) = args

pm3g19's avatar
pm3g19 committed
27
28
            IsEqual -> let (e1:e2:_) = args' in -- TODO not sufficent.
                Boolean (e1 == e2)
29
            
pm3g19's avatar
pm3g19 committed
30
            XProduct -> let ((Set l1): (Set l2):_) = inputSets' in
31
                Set $ [ x `concatRecord` y | x <- l1, y <- l2]
32

pm3g19's avatar
pm3g19 committed
33
            RecordIndex -> let (Record recordData:Int index:_) = args' in
pm3g19's avatar
pm3g19 committed
34
                recordData !! (index - 1)
pm3g19's avatar
pm3g19 committed
35

pm3g19's avatar
pm3g19 committed
36
            RecordSelect -> Record filteredList
37
                where
pm3g19's avatar
pm3g19 committed
38
                    (Record recordData: indexes) = map eval' args -- 
pm3g19's avatar
pm3g19 committed
39
                    indexesRaw = map (\(Int i) -> i - 1) indexes
40
41
42
43
44
45
46
47
48
49
50
51

                    filteredList = map (recordData!!) indexesRaw
                    
                    {-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
                (String a) -> Boolean $ null a

            Contains -> case args of
                (mainString:containsWhat:_) -> case (eval' mainString , eval' containsWhat) of
pm3g19's avatar
pm3g19 committed
52
                    (String a, String b) -> Boolean $ b `isSubList` a
53
54
55
56
57
            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"

58
59
60

            --implement later
            --(Map) -> Set $ (map (\r -> FuncCall predicate [] [r]) inputRecords)
61
        (FuncDef setParams argParams body) -> eval newEnv body
62
            where
pm3g19's avatar
pm3g19 committed
63
                newEnv = let (setEnv, argsEnv) = (zip setParams inputSets, zip argParams args) in setEnv ++ argsEnv ++ env
64
65
                --newEnv = foldl (\env entry@(name, expr) -> addVar env name expr) env --adds entries to environment
                -- TODO FIX
66
    (Var name) -> eval' $ findVar env name
67

68

pm3g19's avatar
pm3g19 committed
69
    (Let _ _ expr) -> expr
70

pm3g19's avatar
pm3g19 committed
71
72
73
    (If cond e1 e2) -> case eval' cond of
        (Boolean True) -> e1
        (Boolean False) -> e2
74

pm3g19's avatar
pm3g19 committed
75
76
77
    control@(Control lastResult exprs) -> if null exprs then lastResult else 
        let (newEnv, newControl) =  evalControl1 env control in
            eval newEnv newControl
78

pm3g19's avatar
pm3g19 committed
79
    (Record exprs) -> Record $ map eval' exprs
80
    _ -> expr
81

pm3g19's avatar
pm3g19 committed
82
83
84
85
evalControl1 :: Environment -> Expr -> (Environment, Expr)
evalControl1 env (Control last (currentExpr:exprs)) = (newEnv, Control newLast exprs)
    where
        newLast = eval env $ case currentExpr of
86
            (FuncCall func [] args) -> FuncCall func [last] args
pm3g19's avatar
pm3g19 committed
87
            (Let False _ _) -> last
88
            _ -> currentExpr
pm3g19's avatar
pm3g19 committed
89

pm3g19's avatar
pm3g19 committed
90
        newEnv = case currentExpr of
pm3g19's avatar
pm3g19 committed
91
            (Let _ var expr) -> (var,expr):env
pm3g19's avatar
pm3g19 committed
92
93
            _ -> env

94
95
96
evalFull = eval
--evalFull env (Set xs) = Set (map (eval env) xs) -- evaluates expression fully (not just weak head normal form)
--evalFull _ e = e
pm3g19's avatar
pm3g19 committed
97
--TODO implement properly
98
concatRecord (Record r1) (Record r2) = Record (r1 ++ r2)
pm3g19's avatar
pm3g19 committed
99

pm3g19's avatar
pm3g19 committed
100
listStartsWith, isSubList :: Eq a => [a] -> [a] -> Bool
pm3g19's avatar
pm3g19 committed
101
listStartsWith = notImplemented -- check if first list starts with second list
pm3g19's avatar
pm3g19 committed
102
isSubList main sub = sub `isInfixOf` main-- check if first list contains second list anywhere in it