summaryrefslogtreecommitdiff
path: root/src/GF/Grammar
diff options
context:
space:
mode:
Diffstat (limited to 'src/GF/Grammar')
-rw-r--r--src/GF/Grammar/LookAbs.hs13
-rw-r--r--src/GF/Grammar/TC.hs2
-rw-r--r--src/GF/Grammar/TypeCheck.hs4
-rw-r--r--src/GF/Grammar/Values.hs9
4 files changed, 24 insertions, 4 deletions
diff --git a/src/GF/Grammar/LookAbs.hs b/src/GF/Grammar/LookAbs.hs
index 43a8c580a..3cd8999ce 100644
--- a/src/GF/Grammar/LookAbs.hs
+++ b/src/GF/Grammar/LookAbs.hs
@@ -75,13 +75,20 @@ isPrimitiveFun gr (m,c) = case lookupAbsDef gr m c of
lookupRef :: GFCGrammar -> Binds -> Term -> Err Val
lookupRef gr binds at = case at of
- Q m f -> lookupFunType gr m f >>= return . vClos
- Vr i -> maybeErr ("unknown variable" +++ prt at) $ lookup i binds
- _ -> prtBad "cannot refine with complex term" at ---
+ Q m f -> lookupFunType gr m f >>= return . vClos
+ Vr i -> maybeErr ("unknown variable" +++ prt at) $ lookup i binds
+ EInt _ -> return valAbsInt
+ K _ -> return valAbsString
+ _ -> prtBad "cannot refine with complex term" at ---
refsForType :: (Val -> Type -> Bool) -> GFCGrammar -> Binds -> Val -> [(Term,Val)]
refsForType compat gr binds val =
+ -- bound variables
[(vr i, t) | (i,t) <- binds, Ok ty <- [val2exp t], compat val ty] ++
+ -- integer and string literals
+ [(EInt i, val) | val == valAbsInt, i <- [0,1,2,5,11,1978]] ++
+ [(K s, val) | val == valAbsString, s <- ["foo", "NN", "x"]] ++
+ -- functions defined in the current abstract syntax
[(qq f, vClos t) | (f,t) <- funsForType compat gr val]
diff --git a/src/GF/Grammar/TC.hs b/src/GF/Grammar/TC.hs
index 88e66379c..b031fa080 100644
--- a/src/GF/Grammar/TC.hs
+++ b/src/GF/Grammar/TC.hs
@@ -119,6 +119,8 @@ inferExp th tenv@(k,rho,gamma) e = case e of
Vr x -> mkAnnot (AVr x) $ noConstr $ lookupVar gamma x
Q m c -> mkAnnot (ACn (m,c)) $ noConstr $ lookupConst th (m,c)
QC m c -> mkAnnot (ACn (m,c)) $ noConstr $ lookupConst th (m,c) ----
+ EInt i -> return (AInt i, valAbsInt, [])
+ K i -> return (AStr i, valAbsString, [])
Sort _ -> return (AType, vType, [])
App f t -> do
(f',w,csf) <- inferExp th tenv f
diff --git a/src/GF/Grammar/TypeCheck.hs b/src/GF/Grammar/TypeCheck.hs
index 45a0d7c36..53bf426c8 100644
--- a/src/GF/Grammar/TypeCheck.hs
+++ b/src/GF/Grammar/TypeCheck.hs
@@ -162,6 +162,10 @@ aexp2tree (aexp,cs) = do
ACn c v -> do
v' <- whnf v ----
return ([],AtC c,v',[])
+ AInt i -> do
+ return ([],AtI i,valAbsInt,[])
+ AStr s -> do
+ return ([],AtL s,valAbsString,[])
AMeta m v -> do
v' <- whnf v ----
return ([],AtM m,v',[])
diff --git a/src/GF/Grammar/Values.hs b/src/GF/Grammar/Values.hs
index 9df2fc13e..4d787488d 100644
--- a/src/GF/Grammar/Values.hs
+++ b/src/GF/Grammar/Values.hs
@@ -31,11 +31,18 @@ type MetaSubst = [(MetaSymb,Val)]
-- for TC
+valAbsInt, valAbsString :: Val
+valAbsInt = VCn (cPredefAbs, cInt)
+valAbsString = VCn (cPredefAbs, cString)
+
vType :: Val
vType = VType
-cType :: Ident
+cType,cPredefAbs,cInt,cString :: Ident
cType = identC "Type" --- #0
+cPredefAbs = identC "PredefAbs"
+cInt = identC "Int"
+cString = identC "String"
eType :: Exp
eType = Sort "Type"