From d38f56b02557cdd26cd8a82f1f1d1dae61f47667 Mon Sep 17 00:00:00 2001 From: aarne Date: Thu, 4 Dec 2008 17:02:24 +0000 Subject: fixed a Compute bug due to failure to match typed record values with untyped record patterns --- src/GF/Compile/Compute.hs | 11 ++++++++++- 1 file changed, 10 insertions(+), 1 deletion(-) (limited to 'src/GF/Compile/Compute.hs') diff --git a/src/GF/Compile/Compute.hs b/src/GF/Compile/Compute.hs index f35e7c6a9..3c7c061fc 100644 --- a/src/GF/Compile/Compute.hs +++ b/src/GF/Compile/Compute.hs @@ -33,6 +33,8 @@ import GF.Grammar.AppPredefined import Data.List (nub,intersperse) import Control.Monad (liftM2, liftM) +----import Debug.Trace ---- + -- | computation of concrete syntax terms into normal form -- used mainly for partial evaluation computeConcrete :: SourceGrammar -> Term -> Err Term @@ -309,7 +311,7 @@ computeTermOpt rec gr = comput True where -- course-of-values table: look up by index, no pattern matching needed V ptyp ts -> do vs <- allParamValues gr ptyp - case lookup v' (zip vs [0 .. length vs - 1]) of + case lookupR v' (zip vs [0 .. length vs - 1]) of Just i -> comp g $ ts !! i _ -> return $ S t' v' -- if v' is not canonical T _ cc -> case matchPattern cc v' of @@ -321,6 +323,13 @@ computeTermOpt rec gr = comput True where S (V i cs) e -> prawitzV g i (flip S v') cs e _ -> returnC $ S t' v' + --- needed to match records with and without type information + ---- todo: eliminate linear search in a list of records! + lookupR v vs = case v of + R rs -> lookup ([(x,y) | (x,(_,y)) <- rs]) + [([(x,y) | (x,(_,y)) <- rs],v) | (R rs,v) <- vs] + _ -> lookup v vs + -- case-expand tables -- if already expanded, don't expand again compTable g t = case t of -- cgit v1.2.3