[added interpreter; general debugging
mail@stefanwehr.de**20050531120439] {
adddir ./tests/interpreter
adddir ./tests/interpreter/should_fail
adddir ./tests/interpreter/should_pass
adddir ./tests/interpreter/should_pass/overloading
hunk ./Builtins.hs 123
-                    trueDataConstructor, falseDataConstructor]
+                    trueDataConstructor, falseDataConstructor,
+                    consDataConstructor, nilDataConstructor]
addfile ./Interpreter.hs
hunk ./Interpreter.hs 1
-
+{-# OPTIONS -fglasgow-exts #-}
+-- 
+-- Copyright (c) 2004-5 Don Stewart - http://www.cse.unsw.edu.au/~dons
+--               2005   Stefan Wehr - http://www.stefanwehr.de
+--
+-- This program is free software; you can redistribute it and/or
+-- modify it under the terms of the GNU General Public License as
+-- published by the Free Software Foundation; either version 2 of
+-- the License, or (at your option) any later version.
+-- 
+-- This program is distributed in the hope that it will be useful,
+-- but WITHOUT ANY WARRANTY; without even the implied warranty of
+-- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+-- General Public License for more details.
+-- 
+-- You should have received a copy of the GNU General Public License
+-- along with this program; if not, write to the Free Software
+-- Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
+-- 02111-1307, USA.
+-- 
+
+module Interpreter where
+
+import qualified List
+import qualified Map
+import Data.Generics as Gen
+
+import AbstractSyntax
+import Symtab
+import Error
+import Pretty
+import Builtins
+import UniqIdents ( builtinDataId, isMain )
+
+-- ---------------------------------------------------------------------
+-- 
+-- This type defines our environment. A map of variables to runtime Values.
+--
+type Env = Map.Map ValId Value
+
+emptyEnv = Map.empty
+
+lookupEnv :: ValId -> Env -> Value
+lookupEnv id env = 
+    case Map.lookup id env of
+      Nothing -> panic ("undefined variable: " ++ showPpr' id)
+      Just v -> v
+
+extendEnv :: ValId -> Value -> Env -> Env
+extendEnv = Map.insert
+
+extendEnv' :: [ValId] -> [Value] -> Env -> Env
+extendEnv' ids vs env = 
+    foldr (\ (k,v) m -> Map.insert k v m) env (zip ids vs)
+
+-- 
+-- Runtime values are a subset of expressions, these are bound to
+-- variables in the heap, and returned as the result of the interpreter.
+--
+data Value
+    = IntVal Integer
+    | CharVal Char
+    | DataVal DataId [Value]
+    | ClosVal Closure
+    | DictVal Env [(ValId, Method)]
+    | ThunkVal Env Exp
+      deriving (Show)
+
+data Closure = Closure Env [ValId] Exp
+             deriving (Show)
+
+
+dataSpec = (LeftAssoc, 1)
+
+printStringList :: Value -> String
+printStringList (DataVal _ (CharVal c : rest : [])) = c : printStringList rest
+printStringList (DataVal _ []) = ""
+
+instance Pretty Value where 
+    pprPrec _ (IntVal i) = text . show $ i
+    pprPrec _ (CharVal c) = text . show $ c
+    pprPrec prec d@(DataVal did (CharVal _ : _)) 
+        | did == consDataConstructorId = text $ show $ printStringList d
+    pprPrec prec (DataVal did vs) =
+        foldl (\x1 x2 -> pprInfixOp prec dataSpec x1 space x2)
+              (ppr did) vs
+    pprPrec prec (ClosVal c) = pprPrec prec c
+    pprPrec prec (DictVal env d) = pprPrec prec (Dictionary d)
+    pprPrec prec (ThunkVal env e) = 
+        text "<THUNK " <> ppr e <> text ">"
+
+instance Pretty Closure where
+    ppr (Closure env params exp) = 
+        text "<" <> dumpMap env $$ 
+        nest 4 (pprList " " params <+> text "->" <+> ppr exp) $$
+        text ">"
+
+-- ---------------------------------------------------------------------
+--
+--
+
+evalProgram :: Program -> ST Value
+evalProgram prog = 
+    do display ("starting interpreting program")
+       v <- eval emptyEnv $ Letrec (prog_bindings prog) (Var mainId)
+       forceAllThunks v
+    where
+    mainId = 
+        case List.find (isMain . vbind_name) (prog_bindings prog) of
+          Nothing -> phasefail ("no main function defined")
+          Just b ->
+            if not (null (vbind_params b))
+               then phasefail ("main function cannot take arguments")
+               else vbind_name b
+
+-- ---------------------------------------------------------------------
+-- Evaluate expressions
+
+forceAllThunks :: Value -> ST Value
+forceAllThunks iv@(IntVal _) = return iv
+forceAllThunks cv@(CharVal _) = return cv
+forceAllThunks (DataVal did vs) = 
+    do vs' <- mapM forceAllThunks vs
+       return (DataVal did vs')
+forceAllThunks dict@(DictVal _ _) = return dict
+forceAllThunks (ThunkVal env e) = 
+    do v <- eval env e
+       forceAllThunks v
+
+forceThunk :: Value -> ST Value
+forceThunk (ThunkVal env e) = 
+    do v <- eval env e
+       forceThunk v
+forceThunk v = return v
+
+evalStrict :: Env -> Exp -> ST Value
+evalStrict env exp = 
+    do v <- eval env exp
+       forceThunk v
+
+eval :: Env -> Exp -> ST Value
+eval env (Var x) = 
+    do debug "evalVar"
+       let v = lookupEnv x env
+       return v
+
+eval _ (Const (Number i)) = 
+    do debug "evalConstNumber"
+       return $ IntVal i
+
+eval _ (Const (Character c)) = 
+    do debug "evalConstCharacter"
+       return $ CharVal c
+
+eval env (Prim op [e1, e2]) =
+      do debug "evalPrimOp"
+         IntVal i <- evalStrict env e1
+         IntVal j <- evalStrict env e2
+         case op of
+           IntAddOp   -> return $ IntVal (i +  j)
+           IntSubOp   -> return $ IntVal (i -  j)
+           IntMulOp   -> return $ IntVal (i *  j)
+           IntRemOp   -> return $ IntVal (i `rem` j)
+           IntGtOp    -> return $ boolVal (i >  j)
+           IntGeOp    -> return $ boolVal (i >= j)
+           IntLtOp    -> return $ boolVal (i <  j)
+           IntLeOp    -> return $ boolVal (i <= j)
+           IntEqOp    -> return $ boolVal (i == j)
+           IntNeOp    -> return $ boolVal (i /= j)
+           IntQuotOp  
+             | j /= 0    -> return $ IntVal (i `quot` j)
+             | otherwise -> phasefail "divide by zero" 
+           _          -> panic ("unknown binary operator: " ++ showPpr' op)
+
+eval env (Prim IntNegOp [e]) = 
+    do debug "evalPrimNegOp"
+       IntVal i <- evalStrict env e
+       return $ IntVal (-i)
+
+eval _ op@(Prim _ _) = panic ("unknown primitive operator: " ++ showPpr' op)
+
+eval env (Con did es) = 
+    do debug "evalCon"
+       es' <- mapM (eval env) es
+       return $ DataVal did es'
+
+eval env e@(App e1 e2) = 
+    do debug "evalApp"
+       v1 <- evalStrict env e1
+       case v1 of
+         ClosVal (Closure fenv (p:ps) f) ->
+             do {-
+                let allVars = freeVars e2
+                    allKeys = Map.keys env
+                    diff = allVars List.\\ allKeys
+                if not (null diff)
+                   then panic ("about to construct inconsistent thunk\n" ++
+                               showPpr e ++ "\n" ++ showCommaListed diff)
+                   else return ()
+                -}
+                let fenv' = extendEnv p (ThunkVal env e2) fenv
+                if null ps -- saturated application
+                   then eval fenv' f
+                   else return $ ClosVal (Closure fenv' ps f)
+         ClosVal (Closure _ [] _) ->
+             panic ("closure with empty argument list")
+         v -> panic ("value of wrong type on lhs of application: " ++ 
+                     showPpr' v)
+    where var :: ValId -> [ValId]
+          var x = [x]
+
+eval env (Lam [] e) = 
+    do debug "evalLam[]"
+       eval env e
+
+eval env (Lam vs e) = 
+    do debug "evalLam"
+       return $ ClosVal (Closure env vs e)
+
+eval env (If e1 e2 e3) = 
+    do debug "evalIf"
+       v1 <- evalStrict env e1
+       case v1 of
+         (DataVal did []) | did == trueDataConstructorId -> eval env e2
+                          | did == falseDataConstructorId -> eval env e3
+                          | otherwise -> 
+                              panic ("wrong data constructor in if: " ++ 
+                                     showPpr' did)
+         v -> panic ("value of wrong type in if: " ++ showPpr' v)
+          
+
+{-
+  
+The recursive letrec is unrolled by the following trick:
+  
+Define the context L := letrec f1 x11 ... x1M = e1 
+                               ... 
+                               fN xN1 ... xNM' = eN 
+                        in []
+
+Now we can define a reduction rule as follows:
+
+L[e] --> (\f1 ... \fN . e) (\x11 ... \x1M . L[e1]) ... (\xN1 ... \xNM' . L[eN])
+
+Then we can evaluate the reduced expression instead of the original expression.
+
+-}
+eval env (Letrec binds e) = 
+    let bindIds = map vbind_name binds
+        params = map vbind_params binds
+        es = map vbind_exp binds
+        args = map (\ (ps, e') -> Lam ps (Letrec binds e')) (zip params es)
+        lambda = Lam bindIds e
+        nextE = foldl App lambda args
+        in do debug ("evalLetrec")
+              eval env nextE
+
+eval env (Case e alts) = 
+    do debug "evalCase"
+       v <- evalStrict env e
+       case v of
+         DataVal did vs ->
+             let alt = findAlt did alts
+                 env' = extendEnv' (alt_params alt) vs env
+                 in eval env' (alt_exp alt)
+    where findAlt _ [] = phasefail ("pattern match failure")
+          findAlt did (a:as) | alt_name a == did = a
+                             | otherwise = findAlt did as
+
+eval env (Overloading dr@(DictionaryReference cid ts)) = 
+    do debug ("resolving dictionary reference " ++ showPpr' dr)
+       x <- findDictionaryExpression cid ts
+       case x of
+         Nothing -> panic ("cannot resolve dictionary reference " ++
+                           showPpr' dr)
+         Just e -> 
+             do debug ("dictionary reference " ++ showPpr' dr ++ " resolves to "
+                       ++ showPpr' e)
+                eval env e
+
+eval env (Overloading (DictionaryLookup id e)) = 
+    do debug ("dictionary lookup for " ++ showPpr' id ++ ", expression: " 
+              ++ showPpr e)
+       dict <- evalStrict env e
+       case dict of
+         d@(DictVal dictEnv l) ->
+             case List.lookup id l of
+               Just (Method m e') -> 
+                   do -- enter variables for context dictionaries into
+                      -- the environment
+                      let vs = map (\k -> lookupEnv k dictEnv) (map fst m)
+                          ks = map snd m
+                      eval (extendEnv' ks vs env) e'
+               Just (SuperMethod id' e') ->
+                   eval env (Overloading $ DictionaryLookup id' e')
+               Nothing -> panic ("method " ++ showPpr' id ++ 
+                                 " not found in dictionary " ++ showPpr d)
+         v -> panic ("expected dictionary, got: " ++ showPpr' v)
+
+eval env (Overloading (Dictionary l)) = return (DictVal env l)
+
+eval env (Overloading o) = 
+    panic ("unexpected overloading value: " ++ showPpr o)
+    
+eval env (Error s) = panic s
+
+--
+-- Helpers
+--
+
+boolVal :: Bool -> Value
+boolVal True = (DataVal trueDataConstructorId [])
+boolVal False = (DataVal falseDataConstructorId [])
+
+trueDataConstructorId = builtinDataId (fst trueDataConstructor)
+falseDataConstructorId = builtinDataId (fst falseDataConstructor)
+
+consDataConstructorId = builtinDataId (fst consDataConstructor)
+nilDataConstructorId = builtinDataId (fst nilDataConstructor)
hunk ./Main.hs 42
+import Interpreter
hunk ./Main.hs 93
+
hunk ./Main.hs 99
+
+               let prog' = AS.mergeProgram bast' ast'
+
hunk ./Main.hs 115
-                                                     dictExprs))
-                       liftIO $ dump (AS.prog_bindings ast')
+                                                     dictExprs)
+                                      $$
+                                      (vcat $ map ppr (AS.prog_bindings ast')))
+
+               when (not $ on DontRun) $
+                    do val <- evalProgram prog'
+                       liftIO $ putStrLn (showPpr val)
+
hunk ./Main.hs 175
-      parseSyntax' <- addBuiltins parseSyntax
+      parseSyntax' <- addBuiltins (if on NoPrelude then NoImplicitPrelude
+                                   else ImplicitPrelude)
+                        parseSyntax
hunk ./Main.hs 230
-    | ViaHaskell
-    | ViaInterp
-    | KeepTmpFiles
-    | OptGhc String
-    | CmpAbsSyn
+--    | ViaHaskell
+--    | ViaInterp
+--    | KeepTmpFiles
+--    | OptGhc String
+--    | CmpAbsSyn
hunk ./Main.hs 237
+    | DontRun
+    | NoPrelude 
hunk ./Main.hs 266
+    , Option []    ["dont-run"] (NoArg DontRun) 
+            "don't run the program"
+    , Option []    ["no-prelude"] (NoArg NoPrelude) 
+            "don't load the prelude"
hunk ./Makefile 25
+#HC_OPTS += -O
hunk ./Overloading.hs 126
-    methodEntry :: [ValId] -> ValBind -> (ValId, Exp)
+    methodEntry :: [ValId] -> ValBind -> (ValId, Method)
hunk ./Overloading.hs 128
-         let {- selfFun = Overloading $ 
-                       DictionaryReference (inst_class ci) (inst_types ci)
-             self = foldl App selfFun (map Var ctxParams) -}
-             e = foldl App (Lam (vbind_params bind) (vbind_exp bind))
-                           (map Var ctxParams)
-             in (vbind_name bind, e)
-    superEntries :: (ClassId, Exp) -> ST [(ValId, Exp)]
+         let n = length ctxParams
+             mapping = zip ctxParams (vbind_params bind)
+             restParams = drop n (vbind_params bind)
+             in (vbind_name bind, Method mapping (Lam restParams $ 
+                                                  vbind_exp bind))
+    superEntries :: (ClassId, Exp) -> ST [(ValId, Method)]
hunk ./Overloading.hs 136
-           return (map (\i -> (i, Overloading $ DictionaryLookup i e)) mids)
+           return (map (\i -> (i, SuperMethod i e)) mids)
hunk ./ParseSyntax.hs 416
-data Overloading = {- Placeholder for a class constraint. Printed <C t1 .. tN> -}
+data Overloading = --
+                   -- used only during transformation
+                   --
+                   -- Placeholder for a class constraint. Printed <C t1 .. tN>
hunk ./ParseSyntax.hs 427
+                   -- 
+                   -- used at runtime
+                   --
+                 | Dictionary [(ValId, Method)]
hunk ./ParseSyntax.hs 433
-                 | Dictionary [(ValId, Exp)]
hunk ./ParseSyntax.hs 435
+data Method = Method [(ValId, ValId)]  {- mapping from variable names used
+                                          for dictionaries providing evidence
+                                          for instance context constraints to
+                                          variables names used in the method
+                                          for these dictionaries. -}
+                     Exp
+            | SuperMethod ValId Exp
+              deriving (Read,Show,Eq, Gen.Data, Gen.Typeable) 
+
hunk ./ParseSyntax.hs 648
-        nest 4 (vcat (map (\ (n,e) -> ppr n <> text ":" <+> ppr e) l)) $$
+        nest 4 (vcat (map (\ (n,m) -> ppr n <> text ":" <+> ppr m) l)) $$
hunk ./ParseSyntax.hs 651
+instance Pretty Method where 
+    ppr (Method l e) = 
+        text "<" <> pprList ", " (map pprPair l) <> text "> " <> ppr e
+    ppr (SuperMethod id e) =
+        ppr id <> text "@" <> parens (ppr e)
+
hunk ./ParseSyntax.hs 681
+
+mergeProgram :: Program -> Program -> Program
+mergeProgram (Program ts1 cs1 is1 bs1) (Program ts2 cs2 is2 bs2) = 
+    Program (ts1++ts2) (cs1++cs2) (is1++is2) (bs1++bs2)
hunk ./ParserHelper.hs 99
+-- string contains leading and trailing double quote
hunk ./ParserHelper.hs 101
-mkStringList [] = Con (fst nilDataConstructor) []
-mkStringList (x:xs) = 
-    let l = mkStringList xs
-        in Con (fst consDataConstructor) [Const (Character x), l]
+mkStringList (_:s) = mk s
+    where 
+    mk (_:[]) = Con (fst nilDataConstructor) []
+    mk (x:xs) = 
+        let l = mk xs
+            in Con (fst consDataConstructor) [Const (Character x), l]
hunk ./PhracPrelude.hs 22
-  addBuiltins
+  addBuiltins, ImplicitPrelude(..),
hunk ./PhracPrelude.hs 55
-addBuiltins :: Program -> IO Program
-addBuiltins (Program tydefs classes insts binds) = 
-    do debug ("Prelude path: " ++ preludeFileName)
-       src <- readFile preludeFileName
-       debug "Lexing prelude ..."
-       tokens <- evaluate $ scan src       
-       debug "Parsing prelude ..."
-       parseSyntax <- evaluate (parse tokens)
+data ImplicitPrelude = ImplicitPrelude
+                     | NoImplicitPrelude
+                       deriving (Eq, Show)
+
+addBuiltins :: ImplicitPrelude -> Program -> IO Program
+addBuiltins impl (Program tydefs classes insts binds) = 
+    do parseSyntax <- if impl == NoImplicitPrelude
+                         then return (Program [] [] [] [])
+                         else loadPrelude
hunk ./PhracPrelude.hs 72
-
+          loadPrelude =
+              do debug ("Prelude path: " ++ preludeFileName)
+                 src <- readFile preludeFileName
+                 debug "Lexing prelude ..."
+                 tokens <- evaluate $ scan src       
+                 debug "Parsing prelude ..."
+                 evaluate (parse tokens)
hunk ./PhracPrelude.phc 58
-    show l = foldr (\__a __b -> if null __b then show __a
-                                else show __a ++ ", " ++ show __b) "" l;
+    show __l = 
+      let __f __l = 
+          (foldr (\__a __b -> if null __b then show __a
+                              else show __a ++ ", " ++ __b) "" __l);
+      in "[" ++ __f __l ++ "]";
hunk ./PhracPrelude.phc 66
-    show p = case p of Pair __f __s -> "(" ++ show __f ++ ", " ++ show __s ++ ")";;
+    show p = case p of Pair __f __s -> "(" ++ show __f ++ ", " 
+                                       ++ show __s ++ ")";;
hunk ./PhracPrelude.phc 73
+(||) :: Bool -> Bool -> Bool;
+(||) __b1 __b2 = if __b1 then True else __b2;
+
hunk ./PhracPrelude.phc 77
-(++) __l1 __l2 = undefined;
+(++) __l1 __l2 =
+    case __l1 of
+      Nil -> __l2;
+      Cons __x __l -> Cons __x (__l ++ __l2);
+    ;
+    
hunk ./PhracPrelude.phc 94
+foldr :: (__a -> __b -> __b) -> __b -> List __a -> __b;
hunk ./PhracPrelude.phc 104
+take :: Int -> List __a -> List __a;
+take __n __l = 
+    if __n <= 0 then Nil
+    else case __l of
+           Nil -> Nil;
+           Cons __x __l' -> Cons __x (take (__n - 1) __l');
+         ;
hunk ./Pretty.hs 24
-    printDoc, showPpr, showPpr', showList, showCommaListed, pprList,
+    printDoc, showPpr, showPpr', showList, showCommaListed, pprList, pprPair,
hunk ./Pretty.hs 77
+
+pprPair :: (Pretty p, Pretty q) => (p, q) -> Doc
+pprPair (p, q) = parens (ppr p <> comma <+> ppr q)
hunk ./Symtab.hs 40
-  replaceInstances, enterDictionaryExpression, getDictionaryExpressions
+  replaceInstances, enterDictionaryExpression, getDictionaryExpressions,
+  findDictionaryExpression
hunk ./Symtab.hs 230
+
+findDictionaryExpression :: ClassId -> [Type] -> ST (Maybe Exp)
+findDictionaryExpression cid ts = 
+    do m <- gets dictExprs
+       return $ Map.lookup (cid, ts) m
+         
hunk ./TypeInference.hs 278
-          transPH _ o = panic ("unexpected Overload value: " ++ showPpr' o)
+          transPH _ o = o 
hunk ./UniqIdents.hs 27
-  isPairTypeConstructor, isFunTypeConstructor, builtinTypeId,
+  isPairTypeConstructor, isFunTypeConstructor, builtinTypeId, builtinDataId,
+  isMain,
hunk ./UniqIdents.hs 118
+
+builtinDataId s = if s `elem` (map fst Builtins.dataConstructors)
+                     then DataId (Id 0 s)
+                     else panic ("Unknown builtin: " ++ s)
+
+isMain (ValId (Id _ s)) = s == "main"
hunk ./tests/ast/should_pass/Flag 1
---dump-ast --exit-after-dump
+--dump-ast --exit-after-dump --dont-run
hunk ./tests/examples/Flag 1
---dump-infer
+--dump-infer --dont-run
hunk ./tests/fixed-assoc-types/should_pass/Flag 1
---dump-infer
+--dump-infer --dont-run
hunk ./tests/fixed-assoc-types/should_pass/allow-diverge/Flag 1
---dump-infer --allow-diverging-tysyns
+--dump-infer --allow-diverging-tysyns --dont-run
addfile ./tests/interpreter/should_fail/000.err
hunk ./tests/interpreter/should_fail/000.err 1
+pattern match failure
addfile ./tests/interpreter/should_fail/000.phc
hunk ./tests/interpreter/should_fail/000.phc 1
+data T = D1 Int
+       | D2 Bool;
+
+main = case D1 42 of
+         D2 b -> b;
+;
addfile ./tests/interpreter/should_fail/Flag
hunk ./tests/interpreter/should_fail/Flag 1
+expect-fail --no-location
addfile ./tests/interpreter/should_pass/000.out
hunk ./tests/interpreter/should_pass/000.out 1
+5
addfile ./tests/interpreter/should_pass/000.phc
hunk ./tests/interpreter/should_pass/000.phc 1
+main = let f x = if x == 0 then 0 else 1 + g (x - 1);
+           g x = if x == 0 then 0 else 1 + f (x - 1);
+       in f 3 + g 2;
addfile ./tests/interpreter/should_pass/001.out
hunk ./tests/interpreter/should_pass/001.out 1
+64
addfile ./tests/interpreter/should_pass/001.phc
hunk ./tests/interpreter/should_pass/001.phc 1
+main = let x = f 0;
+           f y = if y == 0 then 1 else f (y - 1) * (x + 1);
+       in f 6;
addfile ./tests/interpreter/should_pass/002.out
hunk ./tests/interpreter/should_pass/002.out 1
+42
addfile ./tests/interpreter/should_pass/002.phc
hunk ./tests/interpreter/should_pass/002.phc 1
+data T = D1 Int
+       | D2 Bool;
+
+main = case D1 42 of
+         D1 i -> i;
+;
addfile ./tests/interpreter/should_pass/003.out
hunk ./tests/interpreter/should_pass/003.out 1
+"Hello World!"
addfile ./tests/interpreter/should_pass/003.phc
hunk ./tests/interpreter/should_pass/003.phc 1
+main = "Hello World!";
addfile ./tests/interpreter/should_pass/004.out
hunk ./tests/interpreter/should_pass/004.out 1
+D2 42 (D1 0)
addfile ./tests/interpreter/should_pass/004.phc
hunk ./tests/interpreter/should_pass/004.phc 1
+data T1 = D1 Int;
+
+data T2 = D2 Int T1;
+
+main = D2 42 (D1 0);
+
addfile ./tests/interpreter/should_pass/005.out
hunk ./tests/interpreter/should_pass/005.out 1
+Cons 1 ((Cons 2) ((Cons 3) ((Cons 4) ((Cons 5) Nil))))
addfile ./tests/interpreter/should_pass/005.phc
hunk ./tests/interpreter/should_pass/005.phc 1
+
+naturalNumbers = Cons 1 (map (\i -> i + 1) naturalNumbers);
+
+main = take 5 naturalNumbers;
addfile ./tests/interpreter/should_pass/006.out
hunk ./tests/interpreter/should_pass/006.out 1
+Cons 1 ((Cons 2) ((Cons 3) Nil))
addfile ./tests/interpreter/should_pass/006.phc
hunk ./tests/interpreter/should_pass/006.phc 1
+l1 = Cons 1 (Cons 2 Nil);
+l2 = Cons 3 Nil;
+
+main = l1 ++ l2;
addfile ./tests/interpreter/should_pass/007.out
hunk ./tests/interpreter/should_pass/007.out 1
+"Stefan Wehr"
addfile ./tests/interpreter/should_pass/007.phc
hunk ./tests/interpreter/should_pass/007.phc 1
+main = "Stefan" ++ " " ++ "Wehr";
addfile ./tests/interpreter/should_pass/overloading/000.out
hunk ./tests/interpreter/should_pass/overloading/000.out 1
+"(3, [a, b, c, b, c, c])"
addfile ./tests/interpreter/should_pass/overloading/000.phc
hunk ./tests/interpreter/should_pass/overloading/000.phc 1
+class C a where {
+  add :: a -> a -> a;
+  stop :: a -> Bool;
+  decr :: a -> a;
+}
+
+instance C Int where {
+  add i j = i + j;
+  stop i = i == 0;
+  decr i = if stop i then i else i - 1;
+}
+
+instance C (List a) where {
+  add l1 l2 = l1 ++ l2;
+  stop l = case l of 
+             Nil -> True;
+             Cons x l -> False;
+           ;
+  decr l = case l of 
+             Nil -> Nil;
+             Cons x l' -> l';
+           ;
+}
+
+f x = if stop x then x else add x (f (decr x));
+
+main = show (f 2, f "abc");
+--main = show (f "abc");
+--main = show (f 2);
addfile ./tests/interpreter/should_pass/overloading/001.out
hunk ./tests/interpreter/should_pass/overloading/001.out 1
+"([3, 2], 2)"
addfile ./tests/interpreter/should_pass/overloading/001.phc
hunk ./tests/interpreter/should_pass/overloading/001.phc 1
+g x = show (x, length x);
+
+main = g (Cons 3 (Cons 2 Nil));
addfile ./tests/interpreter/should_pass/overloading/002.out
hunk ./tests/interpreter/should_pass/overloading/002.out 1
+42
addfile ./tests/interpreter/should_pass/overloading/002.phc
hunk ./tests/interpreter/should_pass/overloading/002.phc 1
+class X a b where {
+  xfoo :: a -> b;
+}
+
+class X a b => C a b where {
+  cfoo :: a -> b -> b;
+}
+
+class Y a where {
+  yfoo :: a -> Int;
+}
+
+instance Y Bool where {
+  yfoo b = case b of True -> 1; False -> 0;;
+}
+
+instance X a Int where {
+  xfoo x = 21;
+}
+
+instance Y a => C a Int where {
+  cfoo x y = yfoo x + xfoo x + y;
+}
+
+
+f x = cfoo x 20;
+
+main = (f True);
+
+
addfile ./tests/interpreter/should_pass/overloading/003.out
hunk ./tests/interpreter/should_pass/overloading/003.out 1
+42
addfile ./tests/interpreter/should_pass/overloading/003.phc
hunk ./tests/interpreter/should_pass/overloading/003.phc 1
+class X a where {
+  getInt :: a -> Int;
+}
+
+instance X Bool where {
+  getInt b = case b of True -> 1; False -> 0;;
+}
+
+class C a where {
+  foo :: X b => b -> a;
+}
+
+instance C Int where {
+  foo x = getInt x;
+}
+
+bar x = foo x;
+
+main = bar True + 41;
addfile ./tests/interpreter/should_pass/overloading/004.phc
hunk ./tests/interpreter/should_pass/overloading/004.phc 1
+data D t = D t;
+
+class C1 a where {
+  bar1 :: a;
+}
+
+class C2 a where {
+  bar2 :: a;
+}
+
+class X a where {
+  foo :: C2 b => b -> a;
+}
+
+instance C1 a => X (D a) where {
+  foo x = undefined;
+}
+
+-- dict-X<D a>:
+--
+-- \d_C1 -> [("foo", (\d_C1' -> \d_C2 -> undefined) d_C1)]
+--
addfile ./tests/interpreter/should_pass/overloading/005.phc
hunk ./tests/interpreter/should_pass/overloading/005.phc 1
+class S a where {
+  foo :: a;
+}
+
+class S a => C a where {
+  bar :: a;
+}
+
+instance S Int where {
+  foo = 1;
+}
+
+instance S a => S (List a) where {
+  foo = undefined;
+}
+
+instance C (List Int) where {
+  bar = undefined;
+}
+
+-- dict-S<Int>:
+--
+-- [("foo", 1)]
+
+-- dict-S<List a>:
+--
+-- \d_S -> [("foo", (\d_S' -> undefined) d_S)]
+
+-- dict-C<List Int>:
+--
+-- [("bar", undefined),
+--  ("foo", foo@(dict-S<List a> dict-S<Int>))]
addfile ./tests/interpreter/should_pass/overloading/006.phc
hunk ./tests/interpreter/should_pass/overloading/006.phc 1
+class C a where {
+  foo :: a -> Int;
+  bar :: Int -> a;
+}
+
+instance C Int where {
+  foo i = bar i;
+  bar i = foo i;
+}
addfile ./tests/interpreter/should_pass/overloading/simple.out
hunk ./tests/interpreter/should_pass/overloading/simple.out 1
+42
addfile ./tests/interpreter/should_pass/overloading/simple.phc
hunk ./tests/interpreter/should_pass/overloading/simple.phc 1
+class C a where {
+  foo :: a -> a;
+}
+
+instance C Int where {
+  foo i = i + 1;
+}
+
+main = foo 41;
addfile ./tests/interpreter/should_pass/overloading/simple2.out
hunk ./tests/interpreter/should_pass/overloading/simple2.out 1
+D[1] 42
addfile ./tests/interpreter/should_pass/overloading/simple2.phc
hunk ./tests/interpreter/should_pass/overloading/simple2.phc 1
+data D a = D a;
+
+class C a where {
+  foo :: a -> a;
+}
+
+instance C Int where {
+  foo i = i + 1;
+}
+
+instance C a => C (D a) where {
+  foo x = case x of D y -> D (foo y);;
+}
+
+main = foo (D 41);
+
hunk ./tests/kind-inference/should_pass/Flag 1
---exit-after-dump --no-location --dump-kindinfer
+--exit-after-dump --no-location --dump-kindinfer --dont-run
hunk ./tests/multi-param-typeclasses/should_pass/Flag 1
---dump-infer
+--dump-infer --dont-run
addfile ./tests/multi-param-typeclasses/well-formed/should_pass/Flag
hunk ./tests/multi-param-typeclasses/well-formed/should_pass/Flag 1
+--dont-run
hunk ./tests/overloading-resolution/should_pass/002.out 4
-               cfoo: (\d[-20] x[1] y -> yfoo@(d[-20]) x[1] + xfoo@(dict-X<a[3], Int>) x[1] + y) d[-24]
+               cfoo: <(d[-24], d[-20])> \x[1] y -> yfoo@(d[-20]) x[1] + xfoo@(dict-X<a[3], Int>) x[1] + y
hunk ./tests/overloading-resolution/should_pass/002.out 9
-    xfoo: \x -> 42
+    xfoo: <> \x -> 42
hunk ./tests/overloading-resolution/should_pass/003.out 4
-    foo: \d[-12] x -> getInt@(d[-12]) x
+    foo: <> \d[-12] x -> getInt@(d[-12]) x
hunk ./tests/overloading-resolution/should_pass/004.out 3
-               foo: (\d[-5] d[-6] x -> undefined) d[-10]
+               foo: <(d[-10], d[-5])> \d[-6] x -> undefined
hunk ./tests/overloading-resolution/should_pass/005.out 3
-    bar: undefined
+    bar: <> undefined
hunk ./tests/overloading-resolution/should_pass/005.out 8
-              foo: (\d[-3] -> undefined) d[-8]
+              foo: <(d[-8], d[-3])> undefined
hunk ./tests/overloading-resolution/should_pass/005.out 12
-    foo: 1
+    foo: <> 1
hunk ./tests/overloading-resolution/should_pass/006.out 3
-    foo: \i -> bar@(dict-C<Int>) i
-    bar: \i[1] -> foo@(dict-C<Int>) i[1]
+    foo: <> \i -> bar@(dict-C<Int>) i
+    bar: <> \i[1] -> foo@(dict-C<Int>) i[1]
hunk ./tests/overloading-resolution/should_pass/Flag 1
---dump-over --dump-infer
+--dump-over --dump-infer --dont-run
hunk ./tests/type-inference/should_pass/Flag 1
---dump-infer
+--dump-infer --dont-run
addfile ./tests/well-formed/should_fail/missing_superclass_instance2.err
hunk ./tests/well-formed/should_fail/missing_superclass_instance2.err 1
+no instance for superclass C found when checking instance declaration X a[2] Int
addfile ./tests/well-formed/should_fail/missing_superclass_instance2.phc
hunk ./tests/well-formed/should_fail/missing_superclass_instance2.phc 1
+class C a where {
+}
+
+class C a => X a b where {
+}
+
+instance X a Int where {
+}
+
+main = 2;
hunk ./tests/well-formed/should_pass/000.out 1
+1
hunk ./tests/well-formed/should_pass/000.phc 15
-
+main = 1;
addfile ./tests/well-formed/should_pass/001.out
hunk ./tests/well-formed/should_pass/001.out 1
+2
addfile ./tests/well-formed/should_pass/001.phc
hunk ./tests/well-formed/should_pass/001.phc 1
+class C a where {
+}
+
+class C a => X a b where {
+}
+
+instance C a => X a Int where {
+}
+
+main = 2;
}