summaryrefslogtreecommitdiff
path: root/src/GF/Compile/AbsCompute.hs
diff options
context:
space:
mode:
authorkrasimir <krasimir@chalmers.se>2009-05-20 21:03:56 +0000
committerkrasimir <krasimir@chalmers.se>2009-05-20 21:03:56 +0000
commit7db4b641ce6abe90dd404459cd5eccb6e67f618c (patch)
treef708d2e7ed970d71655b66cac78c8b525b010cd9 /src/GF/Compile/AbsCompute.hs
parent401dfc28d62584178c1187c92dece8dd0832dcb4 (diff)
refactor the PGF.Expr type and the evaluation of abstract expressions
Diffstat (limited to 'src/GF/Compile/AbsCompute.hs')
-rw-r--r--src/GF/Compile/AbsCompute.hs9
1 files changed, 2 insertions, 7 deletions
diff --git a/src/GF/Compile/AbsCompute.hs b/src/GF/Compile/AbsCompute.hs
index 8546dc3bc..ce3528b68 100644
--- a/src/GF/Compile/AbsCompute.hs
+++ b/src/GF/Compile/AbsCompute.hs
@@ -42,7 +42,7 @@ computeAbsTerm :: Grammar -> Exp -> Err Exp
computeAbsTerm gr = computeAbsTermIn (lookupAbsDef gr) []
-- | a hack to make compute work on source grammar as well
-type LookDef = Ident -> Ident -> Err (Maybe Term)
+type LookDef = Ident -> Ident -> Err (Maybe [Equation])
computeAbsTermIn :: LookDef -> [Ident] -> Exp -> Err Exp
computeAbsTermIn lookd xs e = errIn ("computing" +++ prt e) $ compt xs e where
@@ -55,7 +55,7 @@ computeAbsTermIn lookd xs e = errIn ("computing" +++ prt e) $ compt xs e where
let vv' = yy ++ vv
aa' <- mapM (compt vv') aa
case look f of
- Just (Eqs eqs) -> tracd ("\nmatching" +++ prt f) $
+ Just eqs -> tracd ("\nmatching" +++ prt f) $
case findMatch eqs aa' of
Ok (d,g) -> do
--- let (xs,ts) = unzip g
@@ -67,19 +67,14 @@ computeAbsTermIn lookd xs e = errIn ("computing" +++ prt e) $ compt xs e where
do
let v = mkApp f aa'
return $ mkAbs yy $ v
- Just d -> tracd ("define" +++ prt t') $ do
- da <- compt vv' $ mkApp d aa'
- return $ mkAbs yy $ da
_ -> do
let t2 = mkAbs yy $ mkApp f aa'
tracd ("not defined" +++ prt_ t2) $ return t2
look t = case t of
(Q m f) -> case lookd m f of
- Ok (Just EData) -> Nothing -- canonical --- should always be QC
Ok md -> md
_ -> Nothing
- Eqs _ -> return t ---- for nested fn
_ -> Nothing
beta :: [Ident] -> Exp -> Exp