summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authoraarne <aarne@cs.chalmers.se>2008-06-03 11:59:00 +0000
committeraarne <aarne@cs.chalmers.se>2008-06-03 11:59:00 +0000
commitc161e0e4df906185521f75aebcd26b117f8ab48f (patch)
tree9a0440764802eea3e4de96f4c5df0709a3f4f28d
parent130a75a43a38ff8613f9b9c7c2eeefc87a7701c7 (diff)
possible to inherit an overload group without excluding+opening
-rw-r--r--src-3.0/GF/Compile/CheckGrammar.hs2
-rw-r--r--src-3.0/GF/Compile/Extend.hs2
-rw-r--r--src-3.0/GF/Grammar/Lookup.hs2
3 files changed, 4 insertions, 2 deletions
diff --git a/src-3.0/GF/Compile/CheckGrammar.hs b/src-3.0/GF/Compile/CheckGrammar.hs
index ce6800f28..40f165c4f 100644
--- a/src-3.0/GF/Compile/CheckGrammar.hs
+++ b/src-3.0/GF/Compile/CheckGrammar.hs
@@ -260,7 +260,7 @@ checkResInfo gr mo mm (c,info) = do
checkUniq xss = case xss of
x:y:xs
| x == y -> raise $ "ambiguous for type" +++
- prtType gr (mkFunType (init x) (last x))
+ prtType gr (mkFunType (tail x) (head x))
| otherwise -> checkUniq $ y:xs
_ -> return ()
diff --git a/src-3.0/GF/Compile/Extend.hs b/src-3.0/GF/Compile/Extend.hs
index 0dcde340a..8344a1696 100644
--- a/src-3.0/GF/Compile/Extend.hs
+++ b/src-3.0/GF/Compile/Extend.hs
@@ -94,6 +94,8 @@ extendAnyInfo isc n o i j =
liftM ResParam $ updn isc n mt1 mt2
(ResValue mt1, ResValue mt2) ->
liftM ResValue $ updn isc n mt1 mt2
+ (_, ResOverload ms t) | elem n ms ->
+ return $ ResOverload ms t
(ResOper mt1 m1, ResOper mt2 m2) -> ---- extendResOper n mt1 m1 mt2 m2
liftM2 ResOper (updn isc n mt1 mt2) (updn isc n m1 m2)
(CncCat mc1 mf1 mp1, CncCat mc2 mf2 mp2) ->
diff --git a/src-3.0/GF/Grammar/Lookup.hs b/src-3.0/GF/Grammar/Lookup.hs
index c8c07069b..6f4b5daa3 100644
--- a/src-3.0/GF/Grammar/Lookup.hs
+++ b/src-3.0/GF/Grammar/Lookup.hs
@@ -65,7 +65,7 @@ lookupResDefKind gr m c = look True m c where
CncCat _ _ _ -> liftM (flip (,) 1) $ lock c defLinType
CncFun (Just (cat,_)) (Yes tr) _ -> liftM (flip (,) 1) $ unlock cat tr
- CncFun _ (Yes tr) _ -> liftM (flip (,) 1) $ unlock c tr
+ CncFun _ (Yes tr) _ -> liftM (flip (,) 1) (return tr) ---- $ unlock c tr
AnyInd _ n -> look False n c
ResParam _ -> return (QC m c,2)