diff options
| author | krasimir <krasimir@chalmers.se> | 2009-10-25 18:01:04 +0000 |
|---|---|---|
| committer | krasimir <krasimir@chalmers.se> | 2009-10-25 18:01:04 +0000 |
| commit | 6753fdae72dc6be7cdac5f2ec09fc42d8f0b4b2e (patch) | |
| tree | 1437f9438f352d159f5ff1a59b72ae9fd3af4c7d /src/GF/Compile/Concrete | |
| parent | d63be8ac7287a7c220f62701cb5b200ba57fbbeb (diff) | |
strip some redundant constructors from GF.Grammar.Grammar
Diffstat (limited to 'src/GF/Compile/Concrete')
| -rw-r--r-- | src/GF/Compile/Concrete/AppPredefined.hs | 1 | ||||
| -rw-r--r-- | src/GF/Compile/Concrete/Compute.hs | 11 | ||||
| -rw-r--r-- | src/GF/Compile/Concrete/TypeCheck.hs | 2 |
3 files changed, 3 insertions, 11 deletions
diff --git a/src/GF/Compile/Concrete/AppPredefined.hs b/src/GF/Compile/Concrete/AppPredefined.hs index 154d76821..95effb51d 100644 --- a/src/GF/Compile/Concrete/AppPredefined.hs +++ b/src/GF/Compile/Concrete/AppPredefined.hs @@ -136,7 +136,6 @@ trm2str :: Term -> Err Term trm2str t = case t of R ((_,(_,s)):_) -> trm2str s T _ ((_,s):_) -> trm2str s - TSh _ ((_,s):_) -> trm2str s V _ (s:_) -> trm2str s C _ _ -> return $ t K _ -> return $ t diff --git a/src/GF/Compile/Concrete/Compute.hs b/src/GF/Compile/Concrete/Compute.hs index 5a232a2a4..dc4937509 100644 --- a/src/GF/Compile/Concrete/Compute.hs +++ b/src/GF/Compile/Concrete/Compute.hs @@ -311,20 +311,15 @@ computeTermOpt rec gr = comput True where -- course-of-values table: look up by index, no pattern matching needed - V ptyp ts -> case v' of - Val _ _ i -> comp g $ ts !! i - _ -> do + V ptyp ts -> do vs <- allParamValues gr ptyp 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 -> do - let v2 = case v' of - Val te _ _ -> te - _ -> v' - case matchPattern cc v2 of + case matchPattern cc v' of Ok (c,g') -> comp (g' ++ g) c - _ | isCan v2 -> Bad (render (text "missing case" <+> ppTerm Unqualified 0 v2 <+> text "in" <+> ppTerm Unqualified 0 t)) + _ | isCan v' -> Bad (render (text "missing case" <+> ppTerm Unqualified 0 v' <+> text "in" <+> ppTerm Unqualified 0 t)) _ -> return $ S t' v' -- if v' is not canonical S (T i cs) e -> prawitz g i (flip S v') cs e diff --git a/src/GF/Compile/Concrete/TypeCheck.hs b/src/GF/Compile/Concrete/TypeCheck.hs index e5d2a9160..0d72b3c67 100644 --- a/src/GF/Compile/Concrete/TypeCheck.hs +++ b/src/GF/Compile/Concrete/TypeCheck.hs @@ -90,8 +90,6 @@ inferLType gr g trm = case trm of checkError (text "cannot infer type of canonical constant" <+> ppTerm Unqualified 0 trm) ] - Val _ ty i -> termWith trm $ return ty - Vr ident -> termWith trm $ checkLookup ident g Typed e t -> do |
