Differences in pattern matching syntax?
Simon Peyton-Jones
simonpj at microsoft.com
Thu Jan 15 12:00:10 EST 2009
That's a big set of modules, and I don't have eclipsefp. It'd be much easier with a smaller test case.
But there may be no bug here. Compiling with -O certainly can give different space behaviour. And as I mentioned, there's one place where it really will generate different code.
Try this
a) Compile antecedent with -O. Does that make the two behave the same?
b) In Alterantive 1 change
Gc{} -> Tm (grspe r)
to
Gc{} -> let x = grspe r in r `seq` Tm r
Does that change anything?
Simon
| -----Original Message-----
| From: glasgow-haskell-users-bounces at haskell.org [mailto:glasgow-haskell-users-
| bounces at haskell.org] On Behalf Of Han Joosten
| Sent: 14 January 2009 10:31
| To: glasgow-haskell-users at haskell.org
| Subject: RE: Differences in pattern matching syntax?
|
|
| Hi,
|
| I do not use -O to compile, as far as I know. I use eclipsefp and I use the
| defaults from it.
| I will upload my modules as a zip file, so you can reproduce the error. It
| also contains a README.txt file that explains how to reproduce it.
| Hope that helps.
| http://www.nabble.com/file/p21439653/src.zip src.zip
|
|
| Simon Peyton-Jones wrote:
| >
| > I agree that's odd. Are you using -O? Can you give us a reproducible
| > test case?
| >
| > (The only think I can think is that the line
| > | Gc{} -> Tm (grspe r)
| > will build a thunk for (grspe r), and depending on the context I suppose
| > you might get a lot of those.)
| >
| > Thanks
| >
| > Simon
| >
| > | -----Original Message-----
| > | From: glasgow-haskell-users-bounces at haskell.org
| > [mailto:glasgow-haskell-users-
| > | bounces at haskell.org] On Behalf Of Han Joosten
| > | Sent: 12 January 2009 21:54
| > | To: glasgow-haskell-users at haskell.org
| > | Subject: Differences in pattern matching syntax?
| > |
| > |
| > | Hi,
| > |
| > | I have two alternatives to specify a specific function. They both
| > compile
| > | ok, but the first one crashes (Stack space overflow) while the second
| > one
| > | runs fine.
| > | I use GHC 6.10.1 on windowsXP
| > |
| > | Alternative 1:
| > | antecedent :: Rule -> Expression
| > | antecedent r = case r of
| > | Ru{} -> if (rrsrt r == AlwaysExpr) then error
| > ("(Module
| > | ADLdataDef:) illegal call to antecedent of rule "++show r)
| > | else
| > | rrant r
| > | Sg{} -> antecedent (srsig r)
| > | Gc{} -> Tm (grspe r)
| > | Fr{} -> frcmp r
| > |
| > | Alternative 2:
| > | antecedent :: Rule -> Expression
| > | antecedent r@(Ru AlwaysExpr _ _ _ _ _ _ _ _) = error ("(Module
| > ADLdef:)
| > | illegal call to antecedent of rule "++show r)
| > | antecedent (Ru _ a _ _ _ _ _ _ _) = a
| > | antecedent (Sg _ rule _ _ _ _ _) = antecedent rule
| > | antecedent (Gc _ d _ _ _ _ _) = Tm d
| > | antecedent (Fr _ _ e _) = e
| > |
| > | Both alternatives compile, but if i use Alternative 2, then my program
| > runs
| > | fine. If I use Alternative 1 instead, I get a stack space overflow.
| > |
| > | I would think that both alternatives would have the same semantics. So i
| > am
| > | surprised that one runs fine, while the other one crashes.
| > |
| > | Could anyone explain what is going on?
| > | Thanks!
| > |
| > | Han Joosten
| > |
| > | ----------------------------
| > | Might help, here is the data definition:
| > |
| > | data Rule =
| > | -- Ru c antc p cons cpu expla sgn nr pn
| > | Ru { rrsrt :: RuleType -- ^ One of the following:
| > | -- | Implication if this is
| > an
| > | implication;
| > | -- | Equivalence if this is
| > an
| > | equivalence;
| > | -- | AlwaysExpr if this is
| > an
| > | ALWAYS expression.
| > | , rrant :: Expression -- ^ Antecedent
| > | , rrfps :: FilePos -- ^ Position in the ADL file
| > | , rrcon :: Expression -- ^ Consequent
| > | , r_cpu :: Expressions -- ^ This is a list of
| > | subexpressions, which must be computed.
| > | , rrxpl :: String -- ^ Explanation
| > | , rrtyp :: (Concept,Concept) -- ^ Sign of this rule
| > | , runum :: Int -- ^ Rule number
| > | , r_pat :: String -- ^ Name of pattern in which it
| > was
| > | defined.
| > | }
| > | -- Sg p rule expla sgn nr pn signal
| > | | Sg { srfps :: FilePos -- ^ position in the ADL file
| > | , srsig :: Rule -- ^ the rule to be signalled
| > | , srxpl :: String -- ^ explanation
| > | , srtyp :: (Concept,Concept) -- ^ type
| > | , runum :: Int -- ^ rule number
| > | , r_pat :: String -- ^ name of pattern in which it
| > was
| > | defined.
| > | , srrel :: Declaration -- ^ the signal relation
| > | }
| > | -- Gc p antc cons cpu _ _ _
| > | | Gc { grfps :: FilePos -- ^ position in the ADL file
| > | , grspe :: Morphism -- ^ specific
| > | , grgen :: Expression -- ^ generic
| > | , r_cpu :: Expressions -- ^ This is a list of
| > | subexpressions, which must be computed.
| > | , grtyp :: (Concept,Concept) -- ^ declaration
| > | , runum :: Int -- ^ rule number
| > | , r_pat :: String -- ^ name of pattern in which it
| > was
| > | defined.
| > | }
| > | -- Fr t d expr pn -- represents an automatic computation, such as *
| > or +.
| > | | Fr { fraut :: AutType -- ^ the type of automatic
| > | computation
| > | , frdec :: Declaration -- ^ where the result is to be
| > | stored
| > | , frcmp :: Expression -- ^ expression to be computed
| > | , frpat :: String -- ^ name of pattern in which it
| > was
| > | defined.
| > | }
| > |
| > | --
| > | View this message in context:
| > http://www.nabble.com/Differences-in-pattern-matching-syntax--
| > | tp21416338p21416338.html
| > | Sent from the Haskell - Glasgow-haskell-users mailing list archive at
| > Nabble.com.
| > |
| > | _______________________________________________
| > | Glasgow-haskell-users mailing list
| > | Glasgow-haskell-users at haskell.org
| > | http://www.haskell.org/mailman/listinfo/glasgow-haskell-users
| >
| > _______________________________________________
| > Glasgow-haskell-users mailing list
| > Glasgow-haskell-users at haskell.org
| > http://www.haskell.org/mailman/listinfo/glasgow-haskell-users
| >
| >
|
| --
| View this message in context: http://www.nabble.com/Differences-in-pattern-matching-syntax--
| tp21416338p21439653.html
| Sent from the Haskell - Glasgow-haskell-users mailing list archive at Nabble.com.
|
| _______________________________________________
| Glasgow-haskell-users mailing list
| Glasgow-haskell-users at haskell.org
| http://www.haskell.org/mailman/listinfo/glasgow-haskell-users
More information about the Glasgow-haskell-users
mailing list