summaryrefslogtreecommitdiff
path: root/src/GF/Compile/Concrete
diff options
context:
space:
mode:
authorkrasimir <krasimir@chalmers.se>2009-10-25 18:01:04 +0000
committerkrasimir <krasimir@chalmers.se>2009-10-25 18:01:04 +0000
commit6753fdae72dc6be7cdac5f2ec09fc42d8f0b4b2e (patch)
tree1437f9438f352d159f5ff1a59b72ae9fd3af4c7d /src/GF/Compile/Concrete
parentd63be8ac7287a7c220f62701cb5b200ba57fbbeb (diff)
strip some redundant constructors from GF.Grammar.Grammar
Diffstat (limited to 'src/GF/Compile/Concrete')
-rw-r--r--src/GF/Compile/Concrete/AppPredefined.hs1
-rw-r--r--src/GF/Compile/Concrete/Compute.hs11
-rw-r--r--src/GF/Compile/Concrete/TypeCheck.hs2
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