summaryrefslogtreecommitdiff
path: root/src/compiler/GF/Compile
diff options
context:
space:
mode:
authorkrasimir <krasimir@chalmers.se>2010-11-12 19:37:19 +0000
committerkrasimir <krasimir@chalmers.se>2010-11-12 19:37:19 +0000
commit115b4213d515ce308568fd71e362f6ce2881fb50 (patch)
tree246d76b05654b88d11bbfaf23dd67beb02dde21f /src/compiler/GF/Compile
parentb46442ab0b50fe58417b85d34a97a16e7b06de05 (diff)
operations in the abstract syntax
Diffstat (limited to 'src/compiler/GF/Compile')
-rw-r--r--src/compiler/GF/Compile/CheckGrammar.hs8
-rw-r--r--src/compiler/GF/Compile/GrammarToPGF.hs4
-rw-r--r--src/compiler/GF/Compile/Rename.hs4
-rw-r--r--src/compiler/GF/Compile/Update.hs6
4 files changed, 11 insertions, 11 deletions
diff --git a/src/compiler/GF/Compile/CheckGrammar.hs b/src/compiler/GF/Compile/CheckGrammar.hs
index b6fb796d7..035b47238 100644
--- a/src/compiler/GF/Compile/CheckGrammar.hs
+++ b/src/compiler/GF/Compile/CheckGrammar.hs
@@ -94,7 +94,7 @@ checkCompleteGrammar gr (am,abs) (cm,cnc) = do
where
checkAbs js i@(c,info) =
case info of
- AbsFun (Just (L loc ty)) _ _
+ AbsFun (Just (L loc ty)) _ _ _
-> do let mb_def = do
let (cxt,(_,i),_) = typeForm ty
info <- lookupIdent i js
@@ -138,7 +138,7 @@ checkCompleteGrammar gr (am,abs) (cm,cnc) = do
checkCnc js i@(c,info) =
case info of
CncFun _ d pn -> case lookupOrigInfo gr (am,c) of
- Ok (_,AbsFun (Just (L _ ty)) _ _) ->
+ Ok (_,AbsFun (Just (L _ ty)) _ _ _) ->
do (cont,val) <- linTypeOfType gr cm ty
let linty = (snd (valCat ty),cont,val)
return $ updateTree (c,CncFun (Just linty) d pn) js
@@ -161,7 +161,7 @@ checkInfo ms (m,mo) c info = do
mkCheck loc "category" $
checkContext gr cont
- AbsFun (Just (L loc typ0)) ma md -> do
+ AbsFun (Just (L loc typ0)) ma md moper -> do
typ <- compAbsTyp [] typ0 -- to calculate let definitions
mkCheck loc "type of function" $
checkTyp gr typ
@@ -169,7 +169,7 @@ checkInfo ms (m,mo) c info = do
Just eqs -> mapM_ (\(L loc eq) -> mkCheck loc "definition of function" $
checkDef gr (m,c) typ eq) eqs
Nothing -> return ()
- return (AbsFun (Just (L loc typ)) ma md)
+ return (AbsFun (Just (L loc typ)) ma md moper)
CncFun linty@(Just (cat,cont,val)) (Just (L loc trm)) mpr -> chIn loc "linearization of" $ do
(trm',_) <- checkLType gr [] trm (mkFunType (map (\(_,_,ty) -> ty) cont) val) -- erases arg vars
diff --git a/src/compiler/GF/Compile/GrammarToPGF.hs b/src/compiler/GF/Compile/GrammarToPGF.hs
index 05ec88e72..211535b41 100644
--- a/src/compiler/GF/Compile/GrammarToPGF.hs
+++ b/src/compiler/GF/Compile/GrammarToPGF.hs
@@ -58,14 +58,14 @@ canon2pgf opts gr cgr@(M.MGrammar (am:cms)) = do
flags = Map.fromList [(mkCId f,C.LStr x) | (f,x) <- optionsPGF (M.flags abm)]
funs = Map.fromAscList [(i2i f, (mkType [] ty, mkArrity ma, mkDef pty, 0)) |
- (f,AbsFun (Just (L _ ty)) ma pty) <- Map.toAscList (M.jments abm)]
+ (f,AbsFun (Just (L _ ty)) ma pty _) <- Map.toAscList (M.jments abm)]
cats = Map.fromAscList [(i2i c, (snd (mkContext [] cont),catfuns c)) |
(c,AbsCat (Just (L _ cont))) <- Map.toAscList (M.jments abm)]
catfuns cat =
(map (\x -> (0,snd x)) . sortBy (compare `on` fst))
- [(loc,i2i f) | (f,AbsFun (Just (L loc ty)) _ _) <- tree2list (M.jments abm), snd (GM.valCat ty) == cat]
+ [(loc,i2i f) | (f,AbsFun (Just (L loc ty)) _ _ (Just True)) <- tree2list (M.jments abm), snd (GM.valCat ty) == cat]
mkConcr am cm@(lang,mo) = do
cnc <- convertConcrete opts gr am cm
diff --git a/src/compiler/GF/Compile/Rename.hs b/src/compiler/GF/Compile/Rename.hs
index a0ccdae12..5329a45aa 100644
--- a/src/compiler/GF/Compile/Rename.hs
+++ b/src/compiler/GF/Compile/Rename.hs
@@ -105,7 +105,7 @@ renameIdentTerm env@(act,imps) t =
info2status :: Maybe Ident -> (Ident,Info) -> StatusInfo
info2status mq (c,i) = case i of
- AbsFun _ _ Nothing -> maybe Con (curry QC) mq
+ AbsFun _ _ Nothing _ -> maybe Con (curry QC) mq
ResValue _ -> maybe Con (curry QC) mq
ResParam _ _ -> maybe Con (curry QC) mq
AnyInd True m -> maybe Con (const (curry QC m)) mq
@@ -141,7 +141,7 @@ renameInfo :: Status -> Ident -> Ident -> Info -> Check Info
renameInfo status m i info =
case info of
AbsCat pco -> liftM AbsCat (renPerh (renameContext status) pco)
- AbsFun pty pa ptr -> liftM3 AbsFun (renTerm pty) (return pa) (renMaybe (mapM (renLoc (renEquation status))) ptr)
+ AbsFun pty pa ptr poper -> liftM4 AbsFun (renTerm pty) (return pa) (renMaybe (mapM (renLoc (renEquation status))) ptr) (return poper)
ResOper pty ptr -> liftM2 ResOper (renTerm pty) (renTerm ptr)
ResOverload os tysts -> liftM (ResOverload os) (mapM (renPair (renameTerm status [])) tysts)
ResParam (Just pp) m -> do
diff --git a/src/compiler/GF/Compile/Update.hs b/src/compiler/GF/Compile/Update.hs
index e8f49ad0c..b5f301e8b 100644
--- a/src/compiler/GF/Compile/Update.hs
+++ b/src/compiler/GF/Compile/Update.hs
@@ -161,7 +161,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
@@ -169,8 +169,8 @@ unifyAnyInfo :: Ident -> Info -> Info -> Err Info
unifyAnyInfo m i j = case (i,j) of
(AbsCat mc1, AbsCat mc2) ->
liftM AbsCat (unifMaybeL mc1 mc2)
- (AbsFun mt1 ma1 md1, AbsFun mt2 ma2 md2) ->
- liftM3 AbsFun (unifMaybeL mt1 mt2) (unifAbsArrity ma1 ma2) (unifAbsDefs md1 md2) -- adding defs
+ (AbsFun mt1 ma1 md1 moper1, AbsFun mt2 ma2 md2 moper2) ->
+ liftM4 AbsFun (unifMaybeL mt1 mt2) (unifAbsArrity ma1 ma2) (unifAbsDefs md1 md2) (unifMaybe moper1 moper2) -- adding defs
(ResParam mt1 mv1, ResParam mt2 mv2) ->
liftM2 ResParam (unifMaybe mt1 mt2) (unifMaybe mv1 mv2)