summaryrefslogtreecommitdiff
path: root/src/GF/Compile/Update.hs
diff options
context:
space:
mode:
authorkrasimir <krasimir@chalmers.se>2009-05-22 18:54:51 +0000
committerkrasimir <krasimir@chalmers.se>2009-05-22 18:54:51 +0000
commit41b263cf6aa38e7c6ef090c0fa18949b86eec62c (patch)
tree9e604716ed1455238c3c49cf8add777c0cdf74d4 /src/GF/Compile/Update.hs
parent7a204376c91ea9647ec4418cfcd3ed0dd7891fae (diff)
some work on evaluation with abstract expressions in PGF
Diffstat (limited to 'src/GF/Compile/Update.hs')
-rw-r--r--src/GF/Compile/Update.hs14
1 files changed, 11 insertions, 3 deletions
diff --git a/src/GF/Compile/Update.hs b/src/GF/Compile/Update.hs
index 0893db561..ec5161403 100644
--- a/src/GF/Compile/Update.hs
+++ b/src/GF/Compile/Update.hs
@@ -163,7 +163,7 @@ extendMod gr isCompl (name,cond) base old new = foldM try new $ Map.toList old
(b,n') = case info of
ResValue _ -> (True,n)
ResParam _ -> (True,n)
- AbsFun _ Nothing -> (True,n)
+ AbsFun _ _ Nothing -> (True,n)
AnyInd b k -> (b,k)
_ -> (False,n) ---- canonical in Abs
@@ -171,8 +171,8 @@ unifyAnyInfo :: Ident -> Info -> Info -> Err Info
unifyAnyInfo m i j = case (i,j) of
(AbsCat mc1 mf1, AbsCat mc2 mf2) ->
liftM2 AbsCat (unifMaybe mc1 mc2) (unifConstrs mf1 mf2) -- adding constrs
- (AbsFun mt1 md1, AbsFun mt2 md2) ->
- liftM2 AbsFun (unifMaybe mt1 mt2) (unifAbsDefs md1 md2) -- adding defs
+ (AbsFun mt1 ma1 md1, AbsFun mt2 ma2 md2) ->
+ liftM3 AbsFun (unifMaybe mt1 mt2) (unifAbsArrity ma1 ma2) (unifAbsDefs md1 md2) -- adding defs
(ResParam mt1, ResParam mt2) -> liftM ResParam $ unifMaybe mt1 mt2
(ResValue mt1, ResValue mt2) ->
@@ -203,6 +203,14 @@ unifMaybe (Just p1) (Just p2)
| p1==p2 = return (Just p1)
| otherwise = fail ""
+unifAbsArrity :: Maybe Int -> Maybe Int -> Err (Maybe Int)
+unifAbsArrity Nothing Nothing = return Nothing
+unifAbsArrity (Just a ) Nothing = return (Just a )
+unifAbsArrity Nothing (Just a ) = return (Just a )
+unifAbsArrity (Just a1) (Just a2)
+ | a1==a2 = return (Just a1)
+ | otherwise = fail ""
+
unifAbsDefs :: Maybe [Equation] -> Maybe [Equation] -> Err (Maybe [Equation])
unifAbsDefs Nothing Nothing = return Nothing
unifAbsDefs (Just _ ) Nothing = fail ""