[added prelude mail@stefanwehr.de**20050528074457] { hunk ./Builtins.hs 31 --- builtin operations +-- builtin operators hunk ./Error.hs 28 - debug_, info_, enableDebug, DebugLevel(..), + debug_, display_, enableDebug, DebugLevel(..), hunk ./Error.hs 105 - | Info + | Verbose hunk ./Error.hs 122 -info_ :: MonadIO m => Location -> String -> m () -info_ loc msg = genDebug Info loc msg +display_ :: MonadIO m => Location -> String -> m () +display_ loc msg = genDebug Verbose loc msg hunk ./KindInference.hs 31 +import Maybe ( mapMaybe ) hunk ./KindInference.hs 33 +import qualified PhracPrelude hunk ./KindInference.hs 55 +kindFunAppSpec = (RightAssoc, 2) + hunk ./KindInference.hs 58 - ppr = text . show + pprPrec _ Star = text "*" + pprPrec _ (KVar _) = text "?" + pprPrec prec (Kfun k1 k2) = + pprInfixOp prec kindFunAppSpec k1 (space <> text "->" <> space) k2 hunk ./KindInference.hs 119 -mgu k1 k2 = Right ("attempt to unify these two kinds: " ++ show k1 ++ - ", " ++ show k2) +mgu k1 k2 = Right ("attempt to unify these two kinds: " ++ showPpr k1 ++ + ", " ++ showPpr k2) hunk ./KindInference.hs 126 - show u ++ ", " ++ show k) + showPpr u ++ ", " ++ showPpr k) hunk ./KindInference.hs 312 - where insertBuiltin s = - let id = UniqIdents.builtinTypeId s - k = kindOfBuiltin s - in modifyEnv (insertType id k) hunk ./KindInference.hs 348 -kiClassHead (ClassDec name args constrs tsigs vsigs) = +kiClassHead (ClassDec name args constrs tsigs vsigs _) = hunk ./KindInference.hs 354 -kiTypeDefLhs (TypeDef name args alts) = +kiTypeDefLhs (TypeDef name args alts _) = hunk ./KindInference.hs 491 - let vars = vcat $ map printKind l + let vars = vcat $ mapMaybe printKind' l hunk ./KindInference.hs 502 + printKind' :: Pretty v => (v,Kind) -> Maybe Doc + printKind' (v,k) = + -- It's a hack not the print type variables starting with + -- `__'. But this prevents tests from breaking + -- just because of a change in the prelude. + if take 2 (show (ppr v)) == "__" + then Nothing + else Just $ ppr v <+> text "::" <+> ppr k hunk ./Main.hs 38 - +import qualified ParseSyntax as PS +import qualified AbstractSyntax as AS +import PhracPrelude + hunk ./Main.hs 64 -analyse ast flags = +analyse prog flags = hunk ./Main.hs 67 - in do symtab <- buildSymtab ast + in do symtab <- buildSymtab prog hunk ./Main.hs 74 - info "\n ==> WELL-FORMEDNESS 1 <==\n" - WF.check ast - - info "\n ==> KIND INFERENCE <==\n" - kindInference ast + let (bast, ast) = AS.splitProgram prog hunk ./Main.hs 76 - info "\n ==> WELL-FORMEDNESS 2 <==\n" - WF.checkAfterKindInference ast + display "\n ==> WELL-FORMEDNESS 1 <==\n" + WF.check prog + + display "\n ==> KIND INFERENCE <==\n" + kindInference prog hunk ./Main.hs 84 + + display "\n ==> WELL-FORMEDNESS 2 <==\n" + WF.checkAfterKindInference prog hunk ./Main.hs 88 - info "\n ==> TYPE INFERENCE <==\n" - tyEnv <- tiMain ast + display "\n ==> TYPE INFERENCE <==\n" + as <- tiMain emptyAssumps bast + -- start numbering type variables and type constructors from + -- scratch after typing the builtins. This prevents tests from + -- breaking when something is added to the prelude. + setFreshVarsPrefix "v" "C" + as' <- tiMain as ast hunk ./Main.hs 96 - do liftIO $ dump (dumpTypeInference tyEnv ast) + do liftIO $ dump (dumpTypeInference as' ast) + hunk ./Main.hs 100 + hunk ./Main.hs 140 - info "\n ==> LEXING <==\n" + display "\n ==> LEXING <==\n" hunk ./Main.hs 145 - info "\n ==> PARSING <==\n" + display "\n ==> PARSING <==\n" hunk ./Main.hs 149 + + parseSyntax' <- addBuiltins parseSyntax hunk ./Main.hs 153 - info "\n ==> SYNTAX TRANSFORMATION <==\n" - ast <- (transform parseSyntax) + display "\n ==> SYNTAX TRANSFORMATION <==\n" + wholeProg <- transform parseSyntax' + let (_, ast) = AS.splitProgram wholeProg hunk ./Main.hs 159 - analyse ast flags + analyse wholeProg flags hunk ./Main.hs 234 - , Option [] ["info"] (NoArg (DebugLevel Info)) "enable info messages" + , Option [] ["verbose"] (NoArg (DebugLevel Verbose)) + "be verbose (but not as much as with `--debug'" hunk ./ParseSyntax.hs 36 -import qualified Builtins hunk ./ParseSyntax.hs 69 +data Info = Info { info_builtin :: Bool, + info_toplevel :: Bool -- only relevant for bindings + -- more info to follow (line numbers etc.) + } + deriving (Read, Show, Eq, Gen.Data, Gen.Typeable) + +emptyInfo = Info { info_builtin = False, + info_toplevel = False } + hunk ./ParseSyntax.hs 83 - tydef_alts :: [DataConstructor] + tydef_alts :: [DataConstructor], + tydef_info :: Info hunk ./ParseSyntax.hs 96 - class_vsigs :: [VSig] + class_vsigs :: [VSig], + class_info :: Info hunk ./ParseSyntax.hs 112 - inst_valBinds :: [ValBind] + inst_valBinds :: [ValBind], + inst_info :: Info hunk ./ParseSyntax.hs 392 - vbind_exp :: Exp + vbind_exp :: Exp, + vbind_info :: Info hunk ./ParseSyntax.hs 481 - ppr (ClassInst name tys constrs tyBind valBinds) = + ppr (ClassInst name tys constrs tyBind valBinds _) = hunk ./ParseSyntax.hs 507 - ppr (ClassDec name params constrs tsigs vsigs) = + ppr (ClassDec name params constrs tsigs vsigs _) = hunk ./ParseSyntax.hs 513 - ppr (TypeDef name params alts) = + ppr (TypeDef name params alts _) = hunk ./ParseSyntax.hs 526 - ppr (ValBind x Nothing vars e) = + ppr (ValBind x Nothing vars e _) = hunk ./ParseSyntax.hs 528 - ppr (ValBind x (Just ty) vars e) = + ppr (ValBind x (Just ty) vars e _) = hunk ./ParseSyntax.hs 596 + +-- splits a program into the builtin and the non-builtin part +splitProgram :: Program -> (Program, Program) +splitProgram (Program tydefs classes insts binds) = + let (t1,t2) = split tydef_info tydefs + (c1,c2) = split class_info classes + (i1,i2) = split inst_info insts + (b1,b2) = split vbind_info binds + in (Program t1 c1 i1 b1, Program t2 c2 i2 b2) + where + split :: (a -> Info) -> [a] -> ([a], [a]) + split _ [] = ([], []) + split f (x:xs) = + let (b,n) = split f xs + in if info_builtin (f x) then (x:b, n) else (b, x:n) hunk ./Parser.y 106 - : 'data' tycon etyvars '=' talt talts ';' { TypeDef $2 (reverse $3) - ($5 : reverse $6) } + : 'data' tycon etyvars '=' talt talts ';' + { TypeDef $2 (reverse $3) ($5 : reverse $6) + emptyInfo { info_toplevel = True } + } hunk ./Parser.y 186 - : var vars '=' exp { ValBind $1 Nothing $2 $4 } + : var vars '=' exp { ValBind $1 Nothing $2 $4 + (emptyInfo { info_toplevel = True }) + } hunk ./Parser.y 198 - then ValBind $1 (Just (TypeScheme [{-fill later-}] $3)) $6 $8 + then ValBind $1 (Just (TypeScheme [{-fill later-}] $3)) $6 $8 emptyInfo hunk ./Parser.y 202 - | var vars '=' exp { ValBind $1 Nothing $2 $4 } + | var vars '=' exp { ValBind $1 Nothing $2 $4 emptyInfo } hunk ./ParserHelper.hs 33 -builtins = [TypeDef "Int" [] [], - TypeDef "Bool" [] [DataConstructor "False" [], - DataConstructor "True" []], - TypeDef "->" ["@a", "@b"] [], - TypeDef "Unit" [] [DataConstructor "()" []], - TypeDef "(,)" ["@a", "@b"] [DataConstructor "Pair" - [TyVar "@a", TyVar "@b"]]] - -addBuiltins (Program types classes insts binds) = - Program (builtins++types) classes insts binds - hunk ./ParserHelper.hs 35 - let p = Program types classes insts binds - in addBuiltins p + Program types classes insts binds hunk ./ParserHelper.hs 40 - binds = mapMaybe (\e -> case e of PrgBind d -> Just d; _ -> Nothing) l + binds = mapMaybe (\e -> case e of + PrgBind d + -> Just (d { vbind_info = + (vbind_info d) { info_toplevel + = True } }) + _ -> Nothing) l hunk ./ParserHelper.hs 49 - ClassDec i vs (map toClassConstraint cs) tsigs vsigs + ClassDec i vs (map toClassConstraint cs) tsigs vsigs + (emptyInfo { info_toplevel = True }) hunk ./ParserHelper.hs 69 - in ClassInst i ts cs assocs vals + in ClassInst i ts cs assocs vals (emptyInfo { info_toplevel = True }) addfile ./PhracPrelude.hs hunk ./PhracPrelude.hs 1 +-- +-- Copyright (C) 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 PhracPrelude ( + + addBuiltins + +) where + +import qualified Data.Generics as Gen +import Control.Exception ( evaluate ) + +import ParseSyntax +import Error +import Lexer +import Parser + +builtinInfo = emptyInfo { info_builtin = True, + info_toplevel = True } + +-- by convention, all type variables must start with `__'. This prevents +-- tests from breaking just because of changes to the prelude. + +builtinTypes = + [TypeDef "Int" [] [] builtinInfo, + TypeDef "->" ["__a", "__b"] [] builtinInfo, + TypeDef "Unit" [] [DataConstructor "()" []] builtinInfo, + TypeDef "(,)" ["__a", "__b"] [DataConstructor "Pair" + [TyVar "__a", TyVar "__b"]] builtinInfo + ] + +addBuiltinTypes (Program types classes insts binds) = + Program (builtinTypes ++ types) classes insts binds + +-- __TOPLEVEL_DIRECTORY__ is a m4 macro. +preludeFileName = __TOPLEVEL_DIRECTORY__ ++ "/PhracPrelude.phc" + +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) + let prelude = addBuiltinTypes parseSyntax + Program tydefs' classes' insts' binds' = + Gen.everywhere (Gen.mkT setBuiltin) + prelude + return (Program (tydefs'++tydefs) (classes'++classes) (insts'++insts) + (binds'++binds)) + where setBuiltin :: Info -> Info + setBuiltin info = info { info_builtin = True } + addfile ./PhracPrelude.phc hunk ./PhracPrelude.phc 1 + +-- NOTE: +-- +-- All variable names (except exported names) must start with `__'. +-- This prevents tests from breaking just because of changes to the prelude. + +data Bool = True | False; + +data List __a = Cons __a (List __a) + | Nil; + +undefined :: __a; +undefined = undefined; + +(++) :: List __a -> List __a -> List __a; +(++) __l1 __l2 = undefined; + +map :: (__a -> __b) -> List __a -> List __b; +map __f __l = + case __l of + Nil -> Nil; + Cons __x __l' -> Cons (__f __x) (map __f __l'); + ; hunk ./Symtab.hs 37 - instantiate, freshTypeVar, freshTyConstruct + instantiate, freshTypeVar, freshTyConstruct, setFreshVarsPrefix hunk ./Symtab.hs 60 - version :: UniqIdents.Version, -- next free version + nameSupply :: (UniqIdents.Version, -- next free version + String, -- prefix for type variables + String), -- prefix for type constructors hunk ./Symtab.hs 71 - version = UniqIdents.initialVersion - 1, + nameSupply = (UniqIdents.initialVersion - 1, "@v", "@c"), hunk ./Symtab.hs 194 +-- Sets the prefix used for generating fresh type and type constructor +-- variables. The new prefixes have to be different from the old ones. +-- Used to start name generation from scratch after prelude has been typed. +-- This is a bit a hack, I know, but otherwise tests would break if we +-- add anything to the prelude :-) +setFreshVarsPrefix :: String -> String -> ST () +setFreshVarsPrefix v c = + do (version, v', c') <- gets nameSupply + if v == v' || c == c' + then panic ("new prefixes for type and constructor variables not " ++ + "different from old prefixes!") + else modify (\s -> s { nameSupply = (UniqIdents.initialVersion - 1, + v, c) }) hunk ./Symtab.hs 209 - do cur <- gets version - modify (\s -> s { version = cur - 1 }) - let id = UniqIdents.mkTypeVar "v" cur + do (cur, v, c) <- gets nameSupply + modify (\s -> s { nameSupply = (cur - 1, v, c) }) + let id = UniqIdents.mkTypeVar v cur hunk ./Symtab.hs 222 - do cur <- gets version - modify (\s -> s { version = cur - 1 }) - let id = UniqIdents.mkTypeId "C" cur + do (cur, v, c) <- gets nameSupply + modify (\s -> s { nameSupply = (cur - 1, v, c) }) + let id = UniqIdents.mkTypeId c cur hunk ./Symtab.hs 226 - let tydef = TypeDef id args [] + let tydef = TypeDef id args [] (emptyInfo { info_builtin = True }) hunk ./SyntaxTransformation.hs 58 - info "rewriting type definitions ..." + display "rewriting type definitions ..." hunk ./SyntaxTransformation.hs 60 - info "rewriting class declarations ..." + display "rewriting class declarations ..." hunk ./SyntaxTransformation.hs 62 - info "rewriting instance declarations ..." + display "rewriting instance declarations ..." hunk ./SyntaxTransformation.hs 64 - info "rewriting bindings ..." + display "rewriting bindings ..." hunk ./SyntaxTransformation.hs 68 - addBuiltIns = - do mapM (\ (x,y) -> defineDataCon x y) Builtins.dataConstructors - mapM defineTypeCon Builtins.typeConstructors - defineTypeDef (TypeDef i _ _) = defineTypeCon i - defineClass cd@(ClassDec name _ _ tsigs valsigs) = + defineTypeDef (TypeDef i _ _ _) = defineTypeCon i + defineClass cd@(ClassDec name _ _ tsigs valsigs _) = hunk ./SyntaxTransformation.hs 73 - defineToplevelFunction (ValBind fn _ _ _) = defineValVar fn + defineToplevelFunction (ValBind fn _ _ _ _) = defineValVar fn + +rw_info :: Info -> AS.Info +rw_info (Info builtin toplevel) = AS.Info builtin toplevel hunk ./SyntaxTransformation.hs 82 -rw_typedef (TypeDef i args talts) = +rw_typedef (TypeDef i args talts info) = hunk ./SyntaxTransformation.hs 85 - talts' <- mapM rw_talt talts + talts' <- mapM (rw_talt $ info_builtin info) talts hunk ./SyntaxTransformation.hs 87 - return (AS.TypeDef uid args' talts') + return (AS.TypeDef uid args' talts' (rw_info info)) hunk ./SyntaxTransformation.hs 89 -rw_talt :: (DataConstructor) -> NA AS.DataConstructor -rw_talt (DataConstructor id args) = - do uid <- defineDataCon id (length args) +rw_talt :: Bool -> (DataConstructor) -> NA AS.DataConstructor +rw_talt builtin (DataConstructor id args) = + do uid <- defineDataCon id (length args) builtin hunk ./SyntaxTransformation.hs 100 -rw_classdec (ClassDec name params constrs tsigs vsigs) = +rw_classdec (ClassDec name params constrs tsigs vsigs info) = hunk ./SyntaxTransformation.hs 107 - return $ AS.ClassDec uid params' constrs' tsigs' vsigs' + return $ AS.ClassDec uid params' constrs' tsigs' vsigs' (rw_info info) hunk ./SyntaxTransformation.hs 141 -rw_classinst (ClassInst name params constrs tyBinds valBinds) = +rw_classinst (ClassInst name params constrs tyBinds valBinds info) = hunk ./SyntaxTransformation.hs 150 - return (AS.ClassInst uid params' constrs' tyBinds' valBinds') + return (AS.ClassInst uid params' constrs' tyBinds' valBinds' + (rw_info info)) hunk ./SyntaxTransformation.hs 156 - rw_classBind (ValBind id (Just _) params exp) = + rw_classBind (ValBind id (Just _) params exp _) = hunk ./SyntaxTransformation.hs 159 - rw_classBind (ValBind id Nothing params exp) = + rw_classBind (ValBind id Nothing params exp info) = hunk ./SyntaxTransformation.hs 165 - return (AS.ValBind uid Nothing params' exp') + return (AS.ValBind uid Nothing params' exp' (rw_info info)) hunk ./SyntaxTransformation.hs 275 - do (tg', arity) <- lookUpDataCon tg - vs <- mapM freshValVar (take arity $ repeat "v") + do (tg', arity, builtin) <- lookUpDataCon tg + let v = if builtin then "@v" else "v" + vs <- mapM freshValVar (take arity $ repeat v) hunk ./SyntaxTransformation.hs 285 - do (tg', arity) <- lookUpDataCon tg + do (tg', arity, _) <- lookUpDataCon tg hunk ./SyntaxTransformation.hs 311 - do (tg', arity) <- lookUpDataCon tg + do (tg', arity, _) <- lookUpDataCon tg hunk ./SyntaxTransformation.hs 343 -type BindTriple = (Maybe AS.TypeScheme, [AS.ValId], AS.Exp) +type BindTuple = (Maybe AS.TypeScheme, [AS.ValId], AS.Exp, AS.Info) hunk ./SyntaxTransformation.hs 345 -mkBind :: (AS.ValId, BindTriple) -> AS.ValBind -mkBind (name, (ty, params, e)) = AS.ValBind name ty params e +mkBind :: (AS.ValId, BindTuple) -> AS.ValBind +mkBind (name, (ty, params, e, info)) = AS.ValBind name ty params e info hunk ./SyntaxTransformation.hs 349 -defineBind (ValBind f _ _ _) = defineValVar f +defineBind (ValBind f _ _ _ _) = defineValVar f hunk ./SyntaxTransformation.hs 351 -rw_bind :: ValBind -> NA BindTriple -rw_bind (ValBind _ Nothing args e) = +rw_bind :: ValBind -> NA BindTuple +rw_bind (ValBind _ Nothing args e info) = hunk ./SyntaxTransformation.hs 357 - return (Nothing, args', e') -rw_bind (ValBind _ (Just ty) args e) = + return (Nothing, args', e', rw_info info) +rw_bind (ValBind _ (Just ty) args e info) = hunk ./SyntaxTransformation.hs 364 - return ((Just ty'), args', e') + return ((Just ty'), args', e', rw_info info) hunk ./SyntaxTransformation.hs 366 -rw_toplevelBind b@(ValBind f ty params e) = +rw_toplevelBind b@(ValBind f ty params e info) = hunk ./TypeInference.hs 31 -import Builtins hunk ./TypeInference.hs 247 - info ("typing explicitly typed binding " ++ showPpr' i) + display ("typing explicitly typed binding " ++ showPpr' i) hunk ./TypeInference.hs 285 - info ("typing implicitly typed bindings " ++ showCommaListed is) + display ("typing implicitly typed bindings " ++ showCommaListed is) hunk ./TypeInference.hs 324 - "constraints: " ++ showCommaListed constrs ++ "\n\n" ++ - (showTypeSigs (Map.assocs resAssumps)) ++ "\n\n") + "constraints: " ++ showCommaListed constrs) hunk ./TypeInference.hs 376 - collect as (ValBind id Nothing params e : rest) = + collect as (ValBind id Nothing params e _ : rest) = hunk ./TypeInference.hs 379 - collect as (ValBind id (Just t) params e : rest) = + collect as (ValBind id (Just t) params e _ : rest) = hunk ./TypeInference.hs 400 -tiMain :: Program -> ST Assumps -tiMain (Program _ classes instances valBinds) = +tiMain :: Assumps -> Program -> ST Assumps +tiMain initAs (Program _ classes instances valBinds) = hunk ./TypeInference.hs 405 - dumpAssumps as ++ "\n" ++ dumpConstraints ps) + dumpConstraints ps) hunk ./TypeInference.hs 412 - as = buildAssumps names schemes + as = buildAssumps names schemes `merge` initAs hunk ./TypeInference.hs 434 - do info ("checking methods of instance `" ++ showInstHead ci - ++ "'") + do display ("checking methods of instance `" ++ showInstHead ci + ++ "'") hunk ./TypeInference.hs 438 - checkMethod as ci (ValBind i _ params e) = + checkMethod as ci (ValBind i _ params e _) = hunk ./UniqIdents.hs 27 - isPairTypeConstructor, isFunTypeConstructor, - isBoolTypeConstructor, isIntTypeConstructor, - isUnitTypeConstructor, builtinTypeId, - + isPairTypeConstructor, isFunTypeConstructor, builtinTypeId, + hunk ./UniqIdents.hs 113 -isIntTypeConstructor (TypeId (Id v s)) = - v == 0 && s == Builtins.intTypeConstructor -isBoolTypeConstructor (TypeId (Id v s)) = - v == 0 && s == Builtins.boolTypeConstructor -isUnitTypeConstructor (TypeId (Id v s)) = - v == 0 && s == Builtins.unitTypeConstructor hunk ./UniqIdents.hs 134 - | DataCon DataId Int-- arity + | DataCon DataId Int{- arity -} Bool{- builtin -} hunk ./UniqIdents.hs 191 -defineDataCon :: ParseId -> Int -> NA DataId -defineDataCon id arity = defineValue DataId (flip DataCon arity) - NS.defGlobal "data constructor" id +defineDataCon :: ParseId -> Int -> Bool -> NA DataId +defineDataCon id arity b = defineValue DataId (\i -> DataCon i arity b) + NS.defGlobal "data constructor" id hunk ./UniqIdents.hs 231 -lookUpDataCon :: ParseId -> NA (DataId, Int) +lookUpDataCon :: ParseId -> NA (DataId, Int, Bool) hunk ./UniqIdents.hs 234 - DataCon uid i -> Just (uid, i) + DataCon uid i b -> Just (uid, i, b) hunk ./WellFormedness.hs 126 - do info "checking class declarations" + do display "checking class declarations" hunk ./WellFormedness.hs 129 - info "checking instance declarations" + display "checking instance declarations" hunk ./WellFormedness.hs 131 - info "checking bindings" + display "checking bindings" hunk ./WellFormedness.hs 133 - info "checking associated type applications" + display "checking associated type applications" hunk ./WellFormedness.hs 158 -checkClassContext (ClassDec id param constrs _ _) = +checkClassContext (ClassDec id param constrs _ _ _) = hunk ./WellFormedness.hs 174 -checkTypeSigs (ClassDec id classParams constrs tsigs _) = +checkTypeSigs (ClassDec id classParams constrs tsigs _ _) = hunk ./WellFormedness.hs 202 -checkMethodSigs (ClassDec id params _ _ msigs) = +checkMethodSigs (ClassDec id params _ _ msigs _) = hunk ./WellFormedness.hs 229 -checkInstanceDec ci@(ClassInst clazz tys constrs tyBinds methodBinds) = +checkInstanceDec ci@(ClassInst clazz tys constrs tyBinds methodBinds _) = hunk ./WellFormedness.hs 248 -checkConstructorBased (ClassInst clazz tys _ _ _) = +checkConstructorBased (ClassInst clazz tys _ _ _ _) = hunk ./WellFormedness.hs 266 -checkInstanceConstraints (ClassInst clazz _ constrs _ _) = +checkInstanceConstraints (ClassInst clazz _ constrs _ _ _) = hunk ./WellFormedness.hs 292 -checkIfAllAssocTypesAreDefined (ClassInst classId _ _ tyBinds _) = +checkIfAllAssocTypesAreDefined (ClassInst classId _ _ tyBinds _ _) = hunk ./WellFormedness.hs 310 -checkIfAllMethodsAreDefined (ClassInst classId _ _ _ vbinds) = +checkIfAllMethodsAreDefined (ClassInst classId _ _ _ vbinds _) = hunk ./WellFormedness.hs 455 -checkBind b@(ValBind i (Just (TypeScheme _ (QualifiedType cs _))) _ e) = +checkBind b@(ValBind i (Just (TypeScheme _ (QualifiedType cs _))) _ e _) = hunk ./pp/logpp 13 -exec m4 -s "--define=__orig_file__=\"$origName\"" "$macros" "$inName" > "$outName" +exec m4 -s "--define=__orig_file__=\"$origName\"" "--define=__TOPLEVEL_DIRECTORY__=\"`pwd`\"" "$macros" "$inName" > "$outName" hunk ./pp/macros.m4 8 -define(info, (info_ `SRC_LOC_'))dnl +define(display, (display_ `SRC_LOC_'))dnl hunk ./tests/ast/should_pass/000.out 1 -data Int = -data Bool = - False - | True -data -> @a @b = -data Unit = - () -data (,) @a[1] @b[1] = - Pair @a[1] @b[1] hunk ./tests/ast/should_pass/001.out 1 -data Int = -data Bool = - False - | True -data -> @a @b = -data Unit = - () -data (,) @a[1] @b[1] = - Pair @a[1] @b[1] hunk ./tests/ast/should_pass/002.out 1 -data Int = -data Bool = - False - | True -data -> @a @b = -data Unit = - () -data (,) @a[1] @b[1] = - Pair @a[1] @b[1] hunk ./tests/ast/should_pass/003.out 1 -data Int = -data Bool = - False - | True -data -> @a @b = -data Unit = - () -data (,) @a[1] @b[1] = - Pair @a[1] @b[1] hunk ./tests/ast/should_pass/004.out 1 -data Int = -data Bool = - False - | True -data -> @a @b = -data Unit = - () -data (,) @a[1] @b[1] = - Pair @a[1] @b[1] hunk ./tests/ast/should_pass/005.out 1 -data Int = -data Bool = - False - | True -data -> @a @b = -data Unit = - () -data (,) @a[1] @b[1] = - Pair @a[1] @b[1] hunk ./tests/ast/should_pass/006.out 1 -data Int = -data Bool = - False - | True -data -> @a @b = -data Unit = - () -data (,) @a[1] @b[1] = - Pair @a[1] @b[1] hunk ./tests/ast/should_pass/007.out 1 -data Int = -data Bool = - False - | True -data -> @a @b = -data Unit = - () -data (,) @a[1] @b[1] = - Pair @a[1] @b[1] hunk ./tests/ast/should_pass/007.phc 5 + hunk ./tests/fixed-assoc-types/should_fail/002.err 1 -attempt to unify these two kinds: Kfun Star Star, Star +attempt to unify these two kinds: * -> *, * hunk ./tests/fixed-assoc-types/should_fail/003.err 1 -attempt to unify these two kinds: Star, Kfun Star Star +attempt to unify these two kinds: *, * -> * hunk ./tests/kind-inference/should_fail/000.err 1 -attempt to unify these two kinds: Kfun Star (KVar 1), Star +attempt to unify these two kinds: * -> ?, * hunk ./tests/kind-inference/should_fail/001.err 1 -attempt to unify these two kinds: Star, Kfun Star Star +attempt to unify these two kinds: *, * -> * hunk ./tests/kind-inference/should_fail/002.err 1 -attempt to unify these two kinds: Star, Kfun Star Star +attempt to unify these two kinds: *, * -> * hunk ./tests/kind-inference/should_pass/000.out 1 -data Int = -data Bool = - False - | True -data -> @a @b = -data Unit = - () -data (,) @a[1] @b[1] = - Pair @a[1] @b[1] hunk ./tests/kind-inference/should_pass/000.out 3 -@a :: * -@b :: * hunk ./tests/kind-inference/should_pass/000.out 5 -@a[1] :: * -@b[1] :: * -Int :: * -Bool :: * --> :: * -> * -> * -Unit :: * -(,) :: * -> * -> * hunk ./tests/kind-inference/should_pass/001.out 1 -data Int = -data Bool = - False - | True -data -> @a @b = -data Unit = - () -data (,) @a[1] @b[1] = - Pair @a[1] @b[1] hunk ./tests/kind-inference/should_pass/001.out 9 -@a :: * -@b :: * hunk ./tests/kind-inference/should_pass/001.out 12 -@a[1] :: * -@b[1] :: * -Int :: * -Bool :: * --> :: * -> * -> * -Unit :: * -(,) :: * -> * -> * hunk ./tests/kind-inference/should_pass/depGroups.out 1 -data Int = -data Bool = - False - | True -data -> @a @b = -data Unit = - () -data (,) @a[1] @b[1] = - Pair @a[1] @b[1] hunk ./tests/kind-inference/should_pass/depGroups.out 12 -@a :: * -@b :: * hunk ./tests/kind-inference/should_pass/depGroups.out 13 -@a[1] :: * -@b[1] :: * hunk ./tests/kind-inference/should_pass/depGroups.out 14 -Int :: * -Bool :: * --> :: * -> * -> * -Unit :: * -(,) :: * -> * -> * hunk ./tests/type-inference/should_fail/008.err 2 - infered signature: forall v[-4] . T v[-4] = Int, C v[-4] => v[-4] -> Int + infered signature: forall v[-3] . T v[-3] = Int, C v[-3] => v[-3] -> Int hunk ./tests/type-inference/should_fail/008.phc 5 -undefined = undefined; - hunk ./tests/type-inference/should_fail/012.err 2 -{Assumptions: {f = Int, foo = forall a . C a => a -> Int}} hunk ./tests/type-inference/should_fail/013.err 2 -{Assumptions: {bar = Int, foo = forall a[1] . C a[1] => a[1] -> Int}} hunk ./tests/type-inference/should_fail/017.err 2 -{Assumptions: {bar = v[-2] -> T v[-2], foo = forall b . D b => b -> T b}} hunk ./tests/type-inference/should_fail/ambiguous2.err 1 -ambiguous signature for `foo': forall v[-3] . T v[-4] = v[-4], C v[-4] => v[-3] -> Int +ambiguous signature for `foo': forall v[-2] . T v[-3] = v[-3], C v[-3] => v[-2] -> Int hunk ./tests/type-inference/should_fail/ambiguous2.phc 5 -undefined = undefined; - hunk ./tests/type-inference/should_pass/019.out 1 -undefined :: forall v[-1] . v[-1] hunk ./tests/type-inference/should_pass/019.out 2 -bar :: forall v[-3] . T v[-3] = Int, C v[-3] => v[-3] -> Int +bar :: forall v[-2] . T v[-2] = Int, C v[-2] => v[-2] -> Int hunk ./tests/type-inference/should_pass/019.phc 5 -undefined = undefined; - hunk ./tests/type-inference/should_pass/020.out 1 -undefined :: forall v[-1] . v[-1] hunk ./tests/type-inference/should_pass/020.out 2 -foo :: forall v[-3] . v[-3] -> Int +foo :: forall v[-2] . v[-2] -> Int hunk ./tests/type-inference/should_pass/020.phc 5 -undefined = undefined; - }