[added license information, README and the-like mail@stefanwehr.de**20050525051135] { hunk ./AUTHORS 1 -Don Stewart - http://www.cse.unsw.edu.au/~dons -Gabriele Keller - keller@cse.unsw.edu.au -Stefan Wehr - http://www.stefanwehr.de +Don Stewart - http://www.cse.unsw.edu.au/~dons +Gabriele Keller - keller@cse.unsw.edu.au +Stefan Wehr - http://www.stefanwehr.de hunk ./AbstractSyntax.hs 2 + +-- +-- 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. +-- + hunk ./Builtins.hs 4 +-- +-- 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. +-- + hunk ./DependAnalysis.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. +-- + +-- The code of this module is derived from Hatchet +-- (http://www.cs.mu.oz.au/~bjpop/hatchet.html) + hunk ./Entailment.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. +-- + hunk ./Error.hs 4 --- +-- 2005 Stefan Wehr - http://www.stefanwehr.de +-- hunk ./IdMap.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. +-- + hunk ./KindInference.hs 2 -{------------------------------------------------------------------------------- hunk ./KindInference.hs 3 - Copyright: The Hatchet Team (see file Contributors) +-- +-- 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. +-- hunk ./KindInference.hs 22 - Module: KindInference - - Description: Kind inference of data and class declarations. - Based very closely on type inference. - - Primary Authors: Bernie Pope - - Notes: See the file License for license information - --------------------------------------------------------------------------------} +-- The code of this module is derived from Hatchet +-- (http://www.cs.mu.oz.au/~bjpop/hatchet.html) hunk ./Kinds.hs 2 + +-- +-- 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. +-- + hunk ./Main.hs 3 --- +-- 2005 Stefan Wehr - http://www.stefanwehr.de +-- hunk ./Main.hs 100 - (flags',files) <- parseArgs args prog + (flags,files) <- parseArgs args prog hunk ./Main.hs 102 - let flags = Dump TypeInfer : flags' -- for now... + -- let flags = Dump TypeInfer : flags' -- for now... hunk ./Main.hs 227 + , Option [] ["no-location"] (NoArg NoLocation) + "do not print source file locations in error messages" ] + hunk ./Main.hs 238 - , Option [] ["no-location"] (NoArg NoLocation) - "do not print source file locations in error messages" hunk ./Main.hs 239 - , Option ['I'] ["interpreter"] (NoArg ViaInterp) "run interpreter" +-- , Option ['I'] ["interpreter"] (NoArg ViaInterp) "run interpreter" hunk ./Main.hs 241 - , Option [] ["keep-tmps"] (NoArg KeepTmpFiles) "keep temporary files" - , Option [] ["cmp-abssyn"] (NoArg CmpAbsSyn) "compare two syntax trees" - , Option [] ["opth"] ((ReqArg (\s->OptGhc s)) "flag") - "extra arguments to the Haskell compiler"] +-- , Option [] ["keep-tmps"] (NoArg KeepTmpFiles) "keep temporary files" +-- , Option [] ["cmp-abssyn"] (NoArg CmpAbsSyn) "compare two syntax trees" +-- , Option [] ["opth"] ((ReqArg (\s->OptGhc s)) "flag") +-- "extra arguments to the Haskell compiler"] hunk ./Makefile 33 -BIN= minhs +BIN= phrac hunk ./NameSpaces.hs 6 --- Adapted and modified by Stefan Wehr, May 2005 +-- Adapted by Stefan Wehr, May 2005 hunk ./ParseSyntax.hs 3 +-- +-- 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. +-- + hunk ./ParserHelper.hs 3 +-- +-- 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. +-- + hunk ./Pretty.hs 3 --- +-- 2005 Stefan Wehr - http://www.stefanwehr.de +-- hunk ./README 1 - hunk ./README 2 --- Interpreter/compiler for the MinHS language +- PHRaC - PLS Haskell-like ReseArch Compiler - hunk ./README 5 -This is an interpreter and compiler for the MinHS language, a language -based on MinML, as found in Bob Harper's book "Programming Languages : -Theory and Practice". MinHS differs from MinML in that its syntax is -based on that of Haskell, instead of ML, and it implements various -extensions to make the language more use friendly. - -More documentation can be found in the doc/ directory. - -Porting: -------- +At the moment, PHRaC is not a compiler but basically only a typechecker +for a Haskell-like language with associated type synonyms. hunk ./README 8 -It's GHC-specific Haskell, at least the haskell-backend generated code -is. The compiler itself isn't necessarily tied to GHC. It should work -on any platform with a recent GHC. Untested on < GHC 6.2, although -some attempts have been made to make it work with at least the 6.x -series. +See the directory tests/examples for some examples. hunk ./README 10 -It has been confirmed to work on ia64/linux and amd64/openbsd hunk ./README 12 --------- +--------- hunk ./README 24 + hunk ./README 27 -------- - - Usage: minhs [OPTION...] file - -v --version version string - --help this message - --dump-parsed dump the parsed code - --dump-haskell dump generated haskell - -H --haskell compile to Haskell - --keep-tmps keep temporary files - --optghc=flag extra arguments to GHC - -For example, to compile to a Haskell binary: +-------- hunk ./README 29 - minhs -H foo.mhs +Execute `phrac -h' to get a short description of the available commandline +options. hunk ./README 32 -will create the binary "foo" in the pwd. hunk ./README 33 +Porting: +-------- hunk ./README 36 +PHRaC was developed with GHC 6.4 under Linux x86. hunk ./Substitution.hs 5 +-- +-- 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. +-- + hunk ./Symtab.hs 4 +-- +-- 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. +-- + hunk ./SyntaxTransformation.hs 5 --- +-- Stefan Wehr - http://www.stefanwehr.de +-- hunk ./TyCheck.hs 1 --- --- Copyright (c) 2004-5 Don Stewart - http://www.cse.unsw.edu.au/~dons --- --- 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 TyCheck where -{- -import Syntax -import Ident -import Type -import Rename -import PrimOp --} - -tycheck = id rmfile ./TyCheck.hs hunk ./TyInfer.hs 1 --- --- Copyright (c) 2005 Gabriele Keller (keller@cse.unsw.edu.au) --- --- 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. --- - - --- TODO: --- - if constant predicate in constraints: this is ignored atm, instead of --- rejecting the program --- - type annotations atm completely ignored --- - mutually recursive functions are not handled properly: there is no --- dependency analysis and they are just typed in the order they appear --- --- --- - -module TyInfer where -{- -import Syntax -import Ident -import Type -import Maybe (isNothing) -import Rename -import PrimOp -import Pretty -import Text.PrettyPrint -import Error - --- hierarchical libs -import Data.Map (Map, empty, insert, lookup, fromList,delete, - toList, insertWith, toAscList) -import Data.Set (Set, emptySet, unitSet, mkSet, setToList, union, - intersection, toAscList, fromAscList, - unionManySets, minusSet, delFromSet, addToSet, - fromList, difference) - - -import Debug.Trace (trace) - -type TypeMap = Map Id Type - - -type TypeSubs = Map Id Type - - - --- -type Preds = Set Constraint -- set already takes care of - -- duplicated entries -type ConstraintSchemes = [ConstraintScheme] -- constraint schemes should be unique - - - --- Typecheck monad --- --------------- --- - -data TCState = TCState { - gamma :: TypeMap, -- type environment - uniqCnt :: Int, -- unique name supply - objsTC :: ObjectMap, -- object map passed in - -- from renamer - subsMap :: TypeSubs, - theta :: Preds, -- set of required - -- predicates (theta) - u :: Preds, -- pending equlity - -- constraints (u) - thetaP :: ConstraintSchemes -- set of given - -- predicates - } - - -newtype TC r = TC (TCState -> (r, TCState)) - -unTC:: TC r -> TCState -> (r, TCState) -unTC (TC m) = m - - -debug = False -- True -dTrace s res = if debug then (trace s res) else res - - -liftM:: (a-> b) -> TC(a) -> TC (b) -liftM f mval= - do - v <- mval - return (f v) --- --- - -showConstraint:: Constraint -> String -showConstraint cs = - (render (ppr cs)) ++ "\n" - - -showConstraintScheme cs = - (render (ppr cs)) ++ "\n" - - --- Operations on Theta --- - -extendTheta:: Constraint -> TC() -extendTheta cn = TC $ \s -> - ((), s {theta = addToSet (theta s) cn}) - - - - --- Operations on the constrain scheme --- -addThetaPConstr:: ConstraintScheme -> TC () -addThetaPConstr cn = TC $ \s -> - ((), s {thetaP = cn:(thetaP s)}) - - -dumpThetaP:: TC [ConstraintScheme] -dumpThetaP = TC $ \s -> - (thetaP s , s) - --- Given an associated type (at ts) try and find rule --- cs => (r_at r_ts) = mt with (at ts) ~s~ (r_at r_ts) --- return (s r_ts, s mt) - -findMatchThetaP:: (Id, [Type]) -> TC Type -findMatchThetaP (at, ts) = - do - cs <- dumpThetaP - check_all cs - where - check_all [] = return (TySyn at ts) - check_all (c:cs) = - do - trc <- tryRule c - case trc of - Nothing -> check_all cs - Just r -> return r - tryRule cscheme = - do - (c, cs) <- end_Constraint cscheme - case c of - EqCons mt1 mt2 -> - do - let msubst = match mt1 (UserCon at, ts) - case msubst of - Nothing -> return (Nothing) - Just subst -> return (Just (subst mt2)) - SimpleCons tc t -> return Nothing - -liftC:: Subst -> CSubst -liftC s (SimpleCons tc t) = SimpleCons tc (s t) -liftC s (EqCons t1 t2) = EqCons (s t1) (s t2) - - --- Operations on theta and u --- -addToThetaOrU:: Constraint -> TC () -addToThetaOrU c@(SimpleCons tc (TyVarTy i)) = TC $ \s -> - ((), s {theta = addToSet (theta s) c}) -addToThetaOrU c@(EqCons t1 t2) = TC $ \s -> - ((), s {u = addToSet (u s) c}) - - -dumpTheta:: TC [Constraint] -dumpTheta = TC $ \s -> - (setToList (theta s) , s) - -dumpU:: TC [Constraint] -dumpU = TC $ \s -> - (setToList (u s) , s) - - -showU:: TC String -showU = - do - uList <- dumpU - let strList = map (render.ppr) uList - let strList' = map (\s -> " " ++ s ++ "\n") strList - return ("U:\n" ++ (concat strList')) - -replaceTheta:: [Constraint] -> TC() -replaceTheta newpreds = TC $ \s -> - ((),s {theta = Data.Set.fromList newpreds}) - -replaceU:: [Constraint] -> TC() -replaceU newpreds = TC $ \s -> - ((),s {u = Data.Set.fromList newpreds}) - -showTheta:: TC (String) -showTheta = - do - uList <- dumpTheta - let strList = map (render.ppr) uList - let strList' = map (\s -> " " ++ s ++ "\n") strList - return ("Theta:\n" ++ (concat strList')) - - --- --- Ops for the substitution --- - --- apply variable substitution only once -applyVarSubst:: Id -> TC (Type) -applyVarSubst i = TC $ \s -> - case Data.Map.lookup i (subsMap s) of - Nothing -> (TyVarTy i, s) - Just ty -> (ty, s) - - -applyConstrSubst:: Constraint -> TC Constraint -applyConstrSubst (SimpleCons c t) = - do - t' <- applyTySubst t - return (SimpleCons c t') -applyConstrSubst (EqCons t1 t2) = - do - t1' <- applyTySubst t1 - t2' <- applyTySubst t2 - return (EqCons t1' t2') - -applyTySubst:: Type -> TC (Type) -applyTySubst t@(TyVarTy tv) = - do - t' <- applyVarSubst tv - t'' <- if t' == t then return t' - else applyTySubst t' - return (t'') - -applyTySubst (FunTy t1 t2) = - do - t1' <- applyTySubst t1 - t2' <- applyTySubst t2 - return (FunTy t1' t2') -applyTySubst (ForallTy tv t) = - do - rest <- removeTmpEnv tv - t' <- applyTySubst t - restoreEnv rest - return (ForallTy tv t') - -applyTySubst (TyApp t1 t2) = - do - t1' <- applyTySubst t1 - t2' <- applyTySubst t2 - return (TyApp t1' t2') -applyTySubst tc@(TyConstr _) = return tc -applyTySubst (ConstrTy (SimpleCons tc t1) t2) = - do - t1' <- applyTySubst t1 - t2' <- applyTySubst t2 - return (ConstrTy (SimpleCons tc t1') t2') -applyTySubst (ConstrTy (EqCons t1 t2) t3) = - do - t1' <- applyTySubst t1 - t2' <- applyTySubst t2 - t3' <- applyTySubst t3 - return (ConstrTy (EqCons t1' t2') t3') - -applyTySubst (TySyn i ts) = - do - ts' <- mapM applyTySubst ts - return (TySyn i ts') - -addSubst:: Id -> Type -> TC () -addSubst fromId toType = TC $ \s -> - ((), s {subsMap = insert fromId toType (subsMap s)}) - - - -showSubs:: TC (String) -showSubs = TC $ \s -> - ((++) "Substs: \n" $ concat $ map toMapStr (strList s), s) - where - mapList s = toList (subsMap s) - strList s = map (\(i,s) -> ((render $ ppr i), (render $ppr s))) (mapList s) - toMapStr (s1, s2) = " " ++ s1 ++ " |-> " ++ s2 ++ "\n" - - -newId :: TC Id -newId = TC $ \s -> - let - cnt = uniqCnt s - newId = mkId ("gen_tvar" ++ "'" ++ (show cnt)) - in (newId, s {uniqCnt = cnt + 1}) - - -lookupEnv:: Id -> TC (Type) -lookupEnv id = TC $ \s -> - case Data.Map.lookup id (gamma s) of - Nothing -> phasefail "TyInfer:" ("no type in env" ++ (show id)) - Just ty -> (ty, s) - - - -addToEnv:: Id -> Type -> TC () -addToEnv id ty = TC $ \s -> - ((), s {gamma = insert id ty (gamma s)}) - --- remove from environment temporarily, --- restoreEnv will add binding to environment again -removeTmpEnv:: Id -> TC (Maybe (Id, Type)) -removeTmpEnv i = TC $ \s -> - case Data.Map.lookup i (gamma s) of - Nothing -> (Nothing, s) - Just t -> (Just (i,t), s {gamma = delete i (gamma s)}) - -restoreEnv:: (Maybe (Id, Type)) -> TC () -restoreEnv Nothing = TC $ \s -> ((),s) -restoreEnv (Just (i,t)) = TC $ \s -> - ((), s {gamma = insert i t (gamma s)}) - - -freeVarEnv:: TC (Set TyVar) -freeVarEnv = TC $ \s -> - let types = map snd (Data.Map.toAscList (gamma s)) - freeVars = foldr union emptySet (map freeTyVar types) - in (freeVars, s) - -showEnv:: TC (String) -showEnv = TC $ \s -> - ( (++) "Env: \n" $ concat $ map toMapStr (strList s), s) - where - mapList s = toList (gamma s) - strList s = map (\(i,s) -> ((render $ ppr i), (render $ppr s))) (mapList s) - toMapStr (s1, s2) = " " ++ s1 ++ " |-> " ++ s2 ++ "\n" - - -instance Monad TC where - return r = TC $ \s -> (r, s) - m >>= n = TC $ \s -> let (r, s') = unTC m s in unTC (n r) s' - --- run a name analysis in a fresh NA environment --- - -runTC :: ObjectMap -> TC a -> (a, TypeMap) -runTC ob m = - let (r, s) = unTC m initTCState - in - (r, gamma s) - where - initTCState :: TCState - initTCState = - TCState Data.Map.empty 0 ob Data.Map.empty emptySet emptySet [] - - --- unifies two skolemised types --- precon: current substitution has to be applied before trying to unify --- not sure if we actually need to return the new type -unify:: Type -> Type -> TC () -unify (TyVarTy tv1) t = - do - tv <- addSubst tv1 t - return () - -unify t (TyVarTy tv1) = - do - tv <- addSubst tv1 t - return () - - -unify (FunTy t1 t2) (FunTy t1' t2') = - do - unify t1 t1' - t2_s <- applyTySubst t2 - t2_s' <- applyTySubst t2' - unify t2_s t2_s' - -unify (TyApp t1 t2) (TyApp t1' t2') = - do - unify t1 t1' - t2_s <- applyTySubst t2 - t2_s' <- applyTySubst t2' - unify t2 t2' - -unify (TyConstr tc1) (TyConstr tc2) = - if tc1 == tc2 - then return () - else phasefail "TyInfer:" ("Cannot unify " ++ (show tc1) ++ " and " ++ - (show tc2)) - -unify (ConstrTy _ _) _ = phasefail "TyInfer:" "Unify contr not yet impl" -unify _ (ConstrTy _ _) = phasefail "TyInfer:" "Unify contr not yet impl" - -unify t1 t2 = phasefail "TyInfer:" ("Cannot unify " ++ (show t1) ++ " and " ++ - (show t2)) - - - --- --- --- Look for Phi t Nothing Nothing and try to match SimpleCons tc t to --- constraint --- TODO: for assoc type: handle eq constraints, that is Phi t1 (Just t2) - -match:: Type -> (TyCon, [Type]) -> Maybe (Type -> Type) -match (FunTy _ _) _ = Nothing -match con (at, ts) | at' /= at = Nothing - | otherwise = matchTypes ts' ts - where - (at', ts') = splitConstr con - splitConstr (TyApp (TyConstr tc) t) = (tc, [t]) - splitConstr (TyApp t1 t2) = - let (tc,ts) = splitConstr t2 - in (tc, t1:ts) - splitConstr t = phasefail "TyInfer:" $ "match: Malformed type function head :" ++ show t - -matchTypes :: [Type] -> [Type] -> Maybe Subst -matchTypes [] [] = Just id -matchTypes (pat:pats) (t:ts) = - do - subst1 <- matchType pat t - subst2 <- matchTypes pats ts - return $ subst1 . subst2 -matchTypes _ _ = - phasefail "TyInfer:" "matchTypes: ATS used at different arities" - - -matchType:: Type -> Type -> Maybe (Type -> Type) -matchType (TyConstr tc1) (TyConstr tc2) - | tc1 == tc2 = Just id - | otherwise = Nothing -matchType (TyVarTy tv1) t = Just (tv1 |-> t) -matchType (FunTy t1 t2) (FunTy t1' t2') = - do - subs1 <- matchType t1 t1' - subs2 <- matchType t2 t2' - return (subs2 .subs1) -matchType (TyApp t1 t2) (TyApp t1' t2') = - do - subs1 <- matchType t1 t1' - subs2 <- matchType t2 t2' - return (subs2 .subs1) -matchType _ _ = Nothing - -type Subst = Type -> Type -type CSubst = Constraint -> Constraint - --- A single mapping --- -(|->) :: TyVar -> Type -> Subst -(a |-> t) t'@(TyConstr _) = t' -(a |-> t) t'@(TyVarTy b ) | a == b = t - | otherwise = t' -(a |-> t) (TyApp t1 t2) = TyApp ((a |-> t) t1) ((a |-> t) t2) -(a |-> t) (FunTy t1 t2) = FunTy ((a |-> t) t1) ((a |-> t) t2) - - --- Infer type of expression: returns inferred type and expression where --- type annotations have been added to every binding -tyInferExpr:: Exp -> TC (Exp, Type) -tyInferExpr e@(Var i) = - do - t <- lookupEnv i - t' <- forallElimType t - dTrace ("*tyInferExpr*" ++ (render $ ppr i) ++ "::" ++ - (render $ ppr t')++ "*\n") - return (e, t') - -tyInferExpr e@(Num _) = - return (e, TyConstr IntCon) - - -tyInferExpr (Prim op exprs) = - do - exprTys' <- mapM tyInferExpr exprs - ts <- mapM (uncurry unify) (zip (map snd exprTys') (argTypes (typeOfPrimOp op))) - return (Prim op (map fst exprTys'), resultType (typeOfPrimOp op)) - where - resultType t@(TyConstr _) = t - resultType (FunTy _ t) = resultType t - argTypes t@(TyConstr _) = [] - argTypes (FunTy t ts) = t : (argTypes ts) - - -tyInferExpr e@(Con tag []) - | tag == unitTag = return (e, TyConstr UnitCon) - | tag == falseTag = return (e, TyConstr BoolCon) - | tag == trueTag = return (e, TyConstr BoolCon) - -tyInferExpr e@(Con pairTag [e1, e2]) = - do - (e1', t1) <- tyInferExpr e1 - (e2', t2) <- tyInferExpr e2 - let pairType = (TyApp (TyApp (TyConstr PairCon) t1) t2) - return (Con pairTag [e1', e2'], pairType) - -tyInferExpr e@(Con tg@(Tag i _ _) args) = - do - t <- case args of - [] -> lookupEnv i - _ -> (liftM snd) $ tyInferExpr (foldr App (Con tg []) args) - t' <- forallElimType t - return (e,t') - -tyInferExpr (App ex1 ex2) = - do - (ex1', t1) <- tyInferExpr ex1 - (ex2', t2) <- tyInferExpr ex2 - newt <- newId - t1' <- applyTySubst t1 - let ft = FunTy t2 (TyVarTy newt) - addToThetaOrU (EqCons t1' ft) - new_u <- unifyC - replaceU new_u - newt' <- applyTySubst (TyVarTy newt) - return (App ex1' ex2', newt') - - -tyInferExpr (Lam ids expr) = - do - types <- mapM (\i -> newId) ids - let typePairs = zip ids types - mapM (\(i,t) -> addToEnv i (TyVarTy t)) typePairs - (e', t') <- tyInferExpr expr - types' <- mapM applyVarSubst types - let finalType = foldr FunTy t' (map TyVarTy types) - mapM removeTmpEnv types - return (Lam ids e', finalType) - -tyInferExpr (If ex1 ex2 ex3) = - do - (ex1', t1) <- tyInferExpr ex1 - unify t1 (TyConstr BoolCon) - (ex2', t2) <- tyInferExpr ex2 - (ex3', t3) <- tyInferExpr ex3 - t2' <- applyTySubst t2 - unify t2' t3 - -- todo: check: apply substitution to both branches? - t' <- applyTySubst t2 - return (If ex1' ex2' ex3', t') - -tyInferExpr (Let bnds exp) = - do - bnds' <- mapM tyInferBnd bnds - (exp', ty) <- tyInferExpr exp - mapM (\(Bind i _ _ _) -> removeTmpEnv i) bnds' - return (Let bnds' exp', ty) - where - tyInferBnd l@(Bind i Nothing [] exp) = - do - (exp', ty) <- tyInferExpr exp - addToEnv i ty - return (Bind i (Just ty) [] exp') - tyInferBnd bnd = - phasefail "TyInfer:" - ("let-expr with arguments: " ++ show bnd) - - -tyInferExpr (Letrec bnds exp) = - do - mapM addBndToEnv bnds - bndTy <- mapM tyInferRecBnd bnds - (exp', ty) <- tyInferExpr exp - mapM (\(Bind f _ _ _) -> removeTmpEnv f) bnds - return (Let bnds exp', ty) - -tyInferExpr e = phasefail "TyInfer:" ("Not yet implemented: " ++ - show e) - --- --- * infer type of function --- * simplify theta and U --- * add the relevant constraints of theta and U to inferred type --- and generalise it -tyInferRecBnd (Bind f Nothing args exp) = - do - -- add dummy type vars to env for arguments - -- and function - argTys <- mapM addNewTvToEnv args - fty <- addNewTvToEnv f - (exp', ty) <- tyInferExpr exp - ftype <- lookupEnv f - addToThetaOrU (EqCons ftype (mkFunTy ty argTys)) - new_u <- unifyC - replaceU new_u - let bnd = (Bind f Nothing args exp') - mapM (\(TyVarTy t) -> removeTmpEnv t)(fty:argTys) - mapM removeTmpEnv args - bnd' <- addTypeToBnd bnd - return bnd' - where - mkFunTy resT argts = foldr FunTy resT argts - -addBndToEnv (Bind f _ _ _) = - do nt <- newId - addToEnv f (TyVarTy nt) - -addNewTvToEnv f = - do - tv <- newId - addToEnv f (TyVarTy tv) - return (TyVarTy tv) - - --- \/ a_i. constr => tau ---> add [b_i/a_i] constr to --- theta, if simple constraint --- u, if eq constraint --- --- return [b_i/a_i]tau, b_i new --- todo: change name --- -forallElimType:: Type -> TC Type -forallElimType t = - do - tvPairs <- mapM mkIdPair ts - let newt = renameVars t' tvPairs - case newt of - (ConstrTy c restT) -> - do addToThetaOrU c - return restT - _ -> - return newt - where - mkIdPair id = - do - newId <- newId - return (id, newId) - - (t', ts) = stripQVars t - - stripQVars (ForallTy tv t) = - let (t', tvs) = stripQVars t - in (t', tv:tvs) - stripQVars t = (t, []) - - - --- rename ty ts: replace all occurences of map fst ts by --- the corresponding element of map snd ts --- -renameVars:: Type -> [(TyVar, TyVar)] -> Type -renameVars t@(TyVarTy tv) ts - | (Just s) <- Prelude.lookup tv ts = TyVarTy s - | True = t -renameVars (FunTy t1 t2) ts = - FunTy (renameVars t1 ts) (renameVars t2 ts) -renameVars (TyApp t1 t2) ts = - TyApp (renameVars t1 ts) (renameVars t2 ts) -renameVars t@(TyConstr tc) _ = - t -renameVars (ConstrTy c t) ts = - ConstrTy (renameVarsConstr c ts) (renameVars t ts) - where - renameVarsConstr (SimpleCons tc t) ts = - SimpleCons tc (renameVars t ts) - renameVarsConstr (EqCons t1 t2) ts = - EqCons (renameVars t1 ts) (renameVars t1 ts) -renameVars (TySyn i tys) ts = - TySyn i (map (\t -> renameVars t ts) tys ) -renameVars _ _ = phasefail "TyInfer:" "Not all quantifiers supposed to be in renamed type" - - - - -addTypeToBnd:: Bind -> TC Bind -addTypeToBnd (Bind f _ args ex) = - do - ty <- lookupEnv f - ty' <- applyTySubst ty - let freeTV = freeTyVar ty' - constrs <- dumpTheta - constrs2 <- mapM applyConstrSubst constrs - replaceTheta constrs2 - simplify - let constrs' = Data.Set.toAscList $ - Data.Set.fromAscList [c | c <- constrs2, containsFreeVar c freeTV] - eqConstrs <- dumpU - eqConstrs' <- mapM applyConstrSubst eqConstrs - let tyC = foldr ConstrTy ty' (constrs') - let freeTV' = freeTyVar tyC - gammaFreeVars <- freeVarEnv - let freeTV'' = difference freeTV' gammaFreeVars - let tyC' = forAllifyType tyC (setToList freeTV'') - addToEnv f tyC' - return (Bind f (Just tyC') args ex) - where - containsFreeVar:: Constraint -> Set TyVar -> Bool - containsFreeVar (SimpleCons tc t) ts = - not (intersection (freeTyVar t) ts == emptySet) - containsFreeVar (EqCons t1 t2) ts2 = - not (intersection (union (freeTyVar t1) (freeTyVar t2)) ts2 == emptySet) - --- Enter types of built in type constructors into environment -initEnv:: TC () -initEnv = return () - - --- TODO: handle tsigs --- --- enterClassDec:: ClassDec -> TC [()] -enterClassDec (ClassDec phi tsigs vsigs) = - do - mapM addVSig vsigs - where - typeToConstrType:: Type -> PhiConstr -> Type - typeToConstrType t (Phi c Nothing) = ConstrTy c t - typeToConstrType t (Phi c morePhi) = ConstrTy c (typeToConstrType t phi) - - addVSig:: VSig -> TC () - addVSig (VSig i t) = - let t' = (typeToConstrType t phi) - in addToEnv i (forAllifyType t' (setToList (freeTyVar t'))) - - - -enterInst:: ClassInst -> TC () -enterInst (ClassInst cs a bnds) = - do - addThetaPConstr cs - addThetaPConstr aConstr - where - assocToConstr:: AssocType -> ConstraintScheme - assocToConstr (AssocType tc t1 tvars t2) = - Simple $ Phi (EqCons (foldr TyApp t1 (map TyVarTy tvars)) t2) - Nothing - aConstr:: ConstraintScheme - aConstr = forAllifyConstrScheme (assocToConstr a) (forAllVars cs) - - forAllVars (Simple _) = [] - forAllVars (ForallQC tv cs) = tv : (forAllVars cs) - - forAllifyConstrScheme:: ConstraintScheme -> [TyVar] -> ConstraintScheme - forAllifyConstrScheme c ts = foldr ForallQC c ts - - --- enters type of constructors into environment -tyInferTypeDef:: TypeDef -> TC () -tyInferTypeDef (TypeDef tc args talts) = - do - let resultType = foldl TyApp (TyConstr tc) (map TyVarTy args) - mapM (tyInferTypeAlts resultType args) talts - return () - -tyInferTypeAlts:: Type -> [TyVar] -> (TyCon, [Type]) -> TC () -tyInferTypeAlts resultType typeArgs (tc@(UserCon i), args) = - do - let constrType = foldr FunTy resultType args - let constrType' = forAllifyType constrType typeArgs - addToEnv i constrType' - -elaborate :: (Program, ObjectMap) -> (Program, ObjectMap) -elaborate (Prg tdefs cldecs cinsts bnds, obmap) = - let - tfb bnds = - do - mapM tyInferTypeDef tdefs - --enterBuiltIns - mapM enterClassDec cldecs - mapM enterInst cinsts - bnds' <- mapM tyInferRecBnd bnds - constrs <- dumpTheta - constrs' <- mapM applyConstrSubst constrs - replaceTheta constrs' - simplify - -- debug stuff - uStr <- showU - mapStr <- showSubs - envStr <- showEnv - thetaStr <- showTheta - -- bnds'' <- mapM addTypeToBnd bnds' - --trace o - -- ("Final\n========\n" ++ mapStr ++ uStr ++ envStr ++ thetaStr) - return (bnds') - bnds' = runTC obmap (tfb bnds) - in (Prg tdefs cldecs cinsts (fst bnds'), obmap) - - --- Enter some built in type constructors and functions in gamma -enterBuiltIns:: TC() -enterBuiltIns = - do - id1 <- newId - let listTy = TyConstr (UserCon (mkId "List")) - let toListTy = ForallTy id1 (FunTy (TyVarTy id1) - (TyApp listTy (TyVarTy id1))) - addToEnv (mkId "mkList") toListTy - id2 <- newId - id3 <- newId - let id2T = TyVarTy id2 - let id3T = TyVarTy id3 - let ft = FunTy (FunTy id2T (FunTy id3T id3T)) - (FunTy id3T (FunTy (TyApp listTy id2T) id3T)) - let faFt = ForallTy id2 (ForallTy id3 ft) - addToEnv (mkId "foldr") faFt - return () - - --- Get rid of derivable constraints in theta: --- --- --- 1) get all constraints in constraint scheme list --- 2) compute set of 'end constraints' and associated remainders --- (end_constraints) --- 3) take constraint from theta and try to match it to end constraint, --- and try to derive associated remainders --- 4) Continue is empty or cannot be simplified further - - --- The phiconstraint returned in the list always have the form --- Phi (tc t) mt Nothing and therefore always correspond to --- a constraint of the form SimpleCon tc t or EqCons tc [t] mt --- --- -end_Constraint:: ConstraintScheme -> TC (Constraint, [Constraint]) -end_Constraint cs = - do p' <- forallElimCon p tvs - return (find_endcon p') - where - (tvs, p) = stripForallVars cs - p' = forallElimCon p tvs - find_endcon:: PhiConstr -> (Constraint, [Constraint]) - find_endcon p@(Phi c Nothing) = (c, []) - find_endcon (Phi c (Just p)) = - let (c', cs) = find_endcon p - in (c', (c:cs)) - - forallElimCon (Phi t@(SimpleCons tc t1) Nothing) tvs = - do t1' <- forallElimType (forAllifyType t1 tvs) - return (Phi (SimpleCons tc t1') Nothing) - forallElimCon (Phi t@(SimpleCons tc t1) (Just p)) tvs = - do t1' <- forallElimType (forAllifyType t1 tvs) - p' <- forallElimCon p tvs - return (Phi (SimpleCons tc t1') (Just p')) - forallElimCon (Phi (EqCons t1 t2) Nothing ) tvs = - do - t1' <- forallElimType (forAllifyType t1 tvs) - t2' <- forallElimType (forAllifyType t2 tvs) - return (Phi (EqCons t1' t2') Nothing) - forallElimCon _ _ = - phasefail "TyInfer:" "end_Constraint: eq constraint should be at the end of the chain??" - stripForallVars (Simple p) = ([], p) - stripForallVars (ForallQC tv cs) = - let (tvs, p) = stripForallVars cs - in (tv:tvs, p) - - - --- Tries to match a constraint c to the conclusion c' of a constraint sequence --- of the form c1 & c2 ... => c'. If match successful, returns instantiated --- cis --- -simp_singleCon:: Constraint -> (Constraint, [Constraint]) -> Maybe [Constraint] -simp_singleCon (SimpleCons tc1 t1) ((SimpleCons tc2 t2), cs) - | tc1 == tc2 = case msubst of - Nothing -> Nothing - Just sub -> Just (map (consTypeMap sub) cs) - | otherwise = Nothing - where - msubst = matchType t2 t1 - consTypeMap f (SimpleCons tc t) = SimpleCons tc (f t) - consTypeMap f (EqCons t1 t2) = EqCons (f t1) (f t2) --- TODO: check what kind of simplifications possible for EQ -simp_singleCon c1 c2 = Nothing - - -simp_constraints:: - [Constraint] -> [(Constraint, [Constraint])] -> ([Constraint], Bool) -simp_constraints [] gcons = ([], False) -simp_constraints rs [] = (rs, False) -simp_constraints rs@(rc:rcons) gs@(_:rgs) = - case simp_singleCon' rc gs of - Nothing -> let (cs, f) = (simp_constraints rcons gs) - in (rc:cs, f) - Just cons -> let (cs, _) = simp_constraints (cons ++ rcons) gs - in (cs, True) - where - simp_singleCon' r [] = Nothing - simp_singleCon' r (g:gs) = - case simp_singleCon r g of - Nothing -> simp_singleCon' r gs - mcons -> mcons - --- iterates over given constraint and class def set until constraints cannot --- be simplified any further -simp_constraints_it:: - [Constraint] -> [(Constraint, [Constraint])] -> [Constraint] -simp_constraints_it rcs gcs = - case simp_constraints rcs gcs of - (cs, True) -> simp_constraints_it cs gcs - (cs, False) -> cs - - --- Simplify global constraints --- --- if there are still ground contraints in the simplified set, it means we --- cannot find an instance for this class, and the program does not type check -simplify:: TC () -simplify = - do - constraints <- dumpTheta - thetaP <- dumpThetaP - gconstraints <- mapM end_Constraint thetaP - let simp_constraints = - simp_constraints_it constraints gconstraints - let unsolvable = or $ map isGroundConstraint simp_constraints - if unsolvable - then phasefail "TyInfer:" $ - "Cannot derive instance " ++ (render $ ppr simp_constraints) - else do - replaceTheta simp_constraints - return () - where - isGroundConstraint:: Constraint -> Bool - isGroundConstraint (SimpleCons tc t) = - (freeTyVar t) == emptySet - isGroundConstraint (EqCons t1 t2) = - ((freeTyVar t1) == emptySet) && - ((freeTyVar t2) == emptySet) - -norm :: Type -> TC Type -norm c@(TyConstr _) = return c -- con_R -norm v@(TyVarTy _) = return v -- var_R -norm (TyApp t1 t2) = -- app_R - do - ty1 <- norm t1 - ty2 <- norm t2 - return $ TyApp ty1 ty2 - -norm (FunTy t1 t2) = - do - ty1 <- norm t1 - ty2 <- norm t2 - return $ FunTy ty1 ty2 - - - -norm ty@(TySyn i ts) = - do - normTs <- mapM norm ts - i @@ normTs -- assoc type appl - where -- & red_R - at @@ ts = - do - ty' <- findMatchThetaP (at, ts) - if ty == ty' then return ty -- no change - else norm ty' -- continue - - -norm ty = phasefail "TyInfer:" $ "norm:" ++ (render $ ppr ty) - - --- Unification --- - - --- A single rewrite step on one equality constraints. --- --- thetaP :: [Scheme] --- tau1 :: Type --- tau2 :: Type --- --- --- u :: [Con] --- s :: Subst --- -unifyOne :: (Type, Type) -> TC (Maybe ([Constraint])) -unifyOne (t1, t2) - | t1 == t2 = return $ Just [] -unifyOne (t@(TyVarTy v), t2) = - do - t' <- applyTySubst t - t2' <- applyTySubst t2 - case t' of - (TyVarTy v') -> - if (notElem v' (setToList (freeTyVar t2'))) - then - do - addSubst v' t2' - return $ Just [] - else phasefail "TyInfer:" "unifyOne: rec occurence" - _ -> unifyOne (t', t2') - -unifyOne (t1, TyVarTy v) | (notElem v (setToList (freeTyVar t1))) = - unifyOne (TyVarTy v, t1) - -unifyOne ((TyApp t1l t1r), (TyApp t2l t2r)) = - return $ Just ([EqCons t1l t2l, EqCons t1r t2r]) - -unifyOne ((FunTy t1l t1r), (FunTy t2l t2r)) = - return $ Just ([EqCons t1l t2l, EqCons t1r t2r]) - -unifyOne ((TyConstr t1), (TyConstr t2)) - | t1 == t2 = return $ Just [] - -unifyOne (t1, t2) = - do - t1' <- norm t1 - t2' <- norm t2 - case (t1, t1 /= t1') of - (TySyn _ _, True) -> return $ Just ([EqCons t1' t2]) - (TyApp _ _, _ ) -> phasefail "TyInfer:" $ "unifyOne: no unifier:" ++ (show t1) - (TyConstr _, _ ) -> phasefail "TyInfer:" $ "unifyOne: no unifier:" ++ (show t1) - _ -> - case (t2, t2 /= t2') of - (TyApp _ _, _ ) -> phasefail "TyInfer:" $ "unifyOne: no unifier:" ++ (show t2) - (TyConstr _, _ ) -> phasefail "TyInfer:" $ "unifyOne: no unifier:" ++ (show t2) - (TySyn _ _, True) -> return $ Just ([EqCons t2' t1]) - _ -> return Nothing - - - - -unifyC :: TC ([Constraint]) -unifyC = - do - uStr <- showU - sStr <- showSubs - u <- dTrace ("*unifyC*: \n" ++ uStr ++ sStr ++ "*\n") dumpU - let eqs = [(t1, t2) | eq@(EqCons t1 t2) <- u] - eqs' <- mapM unifyOne eqs - let res = map choose (zip eqs' u) - - if (all isNothing eqs') - then return u - else - do - u' <- mapM applyConstrSubst (concat res) - replaceU u' - u'' <- unifyC - return (u'') - where - choose (Nothing, u) = [u] - choose (Just c, _) = c - --} + rmfile ./TyInfer.hs hunk ./TypeInference.hs 3 +-- +-- 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. +-- + hunk ./Unification.hs 4 +-- +-- 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. +-- + hunk ./UniqIdents.hs 4 +-- +-- 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. +-- + }