summaryrefslogtreecommitdiff
path: root/src/compiler/GF/Compile
diff options
context:
space:
mode:
Diffstat (limited to 'src/compiler/GF/Compile')
-rw-r--r--src/compiler/GF/Compile/Compute/ConcreteNew.hs8
-rw-r--r--src/compiler/GF/Compile/Compute/Predef.hs9
-rw-r--r--src/compiler/GF/Compile/ConcreteToHaskell.hs2
-rw-r--r--src/compiler/GF/Compile/GenerateBC.hs2
-rw-r--r--src/compiler/GF/Compile/GrammarToPGF.hs6
-rw-r--r--src/compiler/GF/Compile/PGFtoHaskell.hs8
-rw-r--r--src/compiler/GF/Compile/PGFtoJS.hs5
-rw-r--r--src/compiler/GF/Compile/TypeCheck/RConcrete.hs10
-rw-r--r--src/compiler/GF/Compile/TypeCheck/TC.hs4
9 files changed, 29 insertions, 25 deletions
diff --git a/src/compiler/GF/Compile/Compute/ConcreteNew.hs b/src/compiler/GF/Compile/Compute/ConcreteNew.hs
index 5183ebf32..54e57478e 100644
--- a/src/compiler/GF/Compile/Compute/ConcreteNew.hs
+++ b/src/compiler/GF/Compile/Compute/ConcreteNew.hs
@@ -33,7 +33,7 @@ nfx env@(GE _ _ _ loc) t = value2term loc [] # eval env t
eval :: GlobalEnv -> Term -> Err Value
eval ge t = ($[]) # value (toplevel ge) t
-apply env = apply' env
+--apply env = apply' env
--------------------------------------------------------------------------------
@@ -279,7 +279,7 @@ strsFromValue t = case t of
d0 <- strsFromValue d
v0 <- mapM (strsFromValue . fst) vs
c0 <- mapM (strsFromValue . snd) vs
- let vs' = zip v0 c0
+ --let vs' = zip v0 c0
return [strTok (str2strings def) vars |
def <- d0,
vars <- [[(str2strings v, map sstr c) | (v,c) <- zip vv c0] |
@@ -511,11 +511,11 @@ ix loc fn xs i =
else bugloc loc $ "(!!): index too large in "++fn++", "++show i++"<"++show n
where n = length xs
-infixl 1 #,<#,@@
+infixl 1 #,<# --,@@
f # x = fmap f x
mf <# mx = ap mf mx
-m1 @@ m2 = (m1 =<<) . m2
+--m1 @@ m2 = (m1 =<<) . m2
both f (x,y) = (,) # f x <# f y
diff --git a/src/compiler/GF/Compile/Compute/Predef.hs b/src/compiler/GF/Compile/Compute/Predef.hs
index ab74f1f63..0900f3665 100644
--- a/src/compiler/GF/Compile/Compute/Predef.hs
+++ b/src/compiler/GF/Compile/Compute/Predef.hs
@@ -2,7 +2,7 @@
{-# LANGUAGE TypeSynonymInstances, FlexibleInstances #-}
module GF.Compile.Compute.Predef(predef,predefName,delta) where
-import GF.Text.Pretty(render,hang)
+--import GF.Text.Pretty(render,hang)
import qualified Data.Map as Map
import Data.Array(array,(!))
import Data.List (isInfixOf)
@@ -146,11 +146,11 @@ norm v =
(VString s1,VString s2) -> VString (s1++" "++s2)
(v1,v2) -> VC v1 v2
_ -> v
-
+{-
strict v = case v of
VError err -> Left err
_ -> Right v
-
+-}
string s = case words s of
[] -> VString ""
ss -> foldr1 VC (map VString ss)
@@ -158,7 +158,8 @@ string s = case words s of
---
swap (x,y) = (y,x)
-
+{-
bug msg = ppbug msg
ppbug doc = error $ render $
hang "Internal error in Compute.Predef:" 4 doc
+-} \ No newline at end of file
diff --git a/src/compiler/GF/Compile/ConcreteToHaskell.hs b/src/compiler/GF/Compile/ConcreteToHaskell.hs
index 6dc572b39..ad4775697 100644
--- a/src/compiler/GF/Compile/ConcreteToHaskell.hs
+++ b/src/compiler/GF/Compile/ConcreteToHaskell.hs
@@ -126,7 +126,7 @@ toHaskell gId gr absname cenv (name,jment) =
[Right (cat,(Eqn (prefixIdent "lin" cat,lhs),coerce [] lincat rhs))]
where
Ok abstype = lookupFunType gr absname name
- (absctx,abscat,absargs) = typeForm abstype
+ (absctx,_abscat,_absargs) = typeForm abstype
e' = unAbs (length params) $
nf loc (mkAbs params (mkApp def (map Vr args)))
diff --git a/src/compiler/GF/Compile/GenerateBC.hs b/src/compiler/GF/Compile/GenerateBC.hs
index 35ae11f02..3e13ea9e8 100644
--- a/src/compiler/GF/Compile/GenerateBC.hs
+++ b/src/compiler/GF/Compile/GenerateBC.hs
@@ -149,7 +149,7 @@ compileFun gr eval st vs (Let (x, (_, e1)) e2) h0 bs args =
compileFun gr eval st vs e@(Glue e1 e2) h0 bs args =
let eval' st fun args = [PUSH_FRAME]++is++[EVAL fun' RecCall]
where
- (st1,is) = pushArgs (st+2) (reverse args)
+ (_st1,is) = pushArgs (st+2) (reverse args)
fun' = shiftIVal st fun
flatten (Glue e1 e2) h0 bs =
diff --git a/src/compiler/GF/Compile/GrammarToPGF.hs b/src/compiler/GF/Compile/GrammarToPGF.hs
index 39202de4c..cd2e6b8ce 100644
--- a/src/compiler/GF/Compile/GrammarToPGF.hs
+++ b/src/compiler/GF/Compile/GrammarToPGF.hs
@@ -177,8 +177,8 @@ genCncCats gr am cm cdefs =
(index',cats) = mkCncCats index cdefs
in (index', (i2i id,cc) : cats)
| otherwise =
- let cc@(C.CncCat s e _) = pgfCncCat gr lincat index
- (index',cats) = mkCncCats (e+1) cdefs
+ let cc@(C.CncCat _s e _) = pgfCncCat gr lincat index
+ (index',cats) = mkCncCats (e+1) cdefs
in (index', (i2i id,cc) : cats)
mkCncCats index (_ :cdefs) = mkCncCats index cdefs
@@ -303,6 +303,6 @@ genPrintNames cdefs =
flatten (Alts x _) = flatten x
flatten (C x y) = flatten x +++ flatten y
-mkArray lst = listArray (0,length lst-1) lst
+--mkArray lst = listArray (0,length lst-1) lst
mkMapArray map = array (0,Map.size map-1) [(v,k) | (k,v) <- Map.toList map]
mkSetArray set = listArray (0,Set.size set-1) [v | v <- Set.toList set]
diff --git a/src/compiler/GF/Compile/PGFtoHaskell.hs b/src/compiler/GF/Compile/PGFtoHaskell.hs
index 749ad24bc..f4cf66219 100644
--- a/src/compiler/GF/Compile/PGFtoHaskell.hs
+++ b/src/compiler/GF/Compile/PGFtoHaskell.hs
@@ -273,13 +273,13 @@ hSkeleton gr =
valtyps (_, (_,x)) (_, (_,y)) = compare x y
valtypg (_, (_,x)) (_, (_,y)) = x == y
jty (f,(ty,_,_,_)) = (f,catSkeleton ty)
-
+{-
updateSkeleton :: OIdent -> HSkeleton -> (OIdent, [OIdent]) -> HSkeleton
updateSkeleton cat skel rule =
case skel of
(cat0,rules):rr | cat0 == cat -> (cat0, rule:rules) : rr
(cat0,rules):rr -> (cat0, rules) : updateSkeleton cat rr rule
-
+-}
isListCat :: (OIdent, [(OIdent, [OIdent])]) -> Bool
isListCat (cat,rules) = "List" `isPrefixOf` cat && length rules == 2
&& ("Base"++c) `elem` fs && ("Cons"++c) `elem` fs
@@ -289,13 +289,13 @@ isListCat (cat,rules) = "List" `isPrefixOf` cat && length rules == 2
-- | Gets the element category of a list category.
elemCat :: OIdent -> OIdent
elemCat = drop 4
-
+{-
isBaseFun :: OIdent -> Bool
isBaseFun f = "Base" `isPrefixOf` f
isConsFun :: OIdent -> Bool
isConsFun f = "Cons" `isPrefixOf` f
-
+-}
baseSize :: (OIdent, [(OIdent, [OIdent])]) -> Int
baseSize (_,rules) = length bs
where Just (_,bs) = find (("Base" `isPrefixOf`) . fst) rules
diff --git a/src/compiler/GF/Compile/PGFtoJS.hs b/src/compiler/GF/Compile/PGFtoJS.hs
index 1d53cbc3b..050a3f658 100644
--- a/src/compiler/GF/Compile/PGFtoJS.hs
+++ b/src/compiler/GF/Compile/PGFtoJS.hs
@@ -51,11 +51,14 @@ concrete2js (c,cnc) =
JS.EInt (totalCats cnc)])
where
l = JS.IdentPropName (JS.Ident (showCId c))
+{-
litslins = [JS.Prop (JS.StringPropName "Int") (JS.EFun [children] [JS.SReturn $ new "Arr" [JS.EIndex (JS.EVar children) (JS.EInt 0)]]),
JS.Prop (JS.StringPropName "Float") (JS.EFun [children] [JS.SReturn $ new "Arr" [JS.EIndex (JS.EVar children) (JS.EInt 0)]]),
JS.Prop (JS.StringPropName "String") (JS.EFun [children] [JS.SReturn $ new "Arr" [JS.EIndex (JS.EVar children) (JS.EInt 0)]])]
+-}
cats (c,CncCat start end _) = JS.Prop (JS.IdentPropName (JS.Ident (showCId c))) (JS.EObj [JS.Prop (JS.IdentPropName (JS.Ident "s")) (JS.EInt start)
,JS.Prop (JS.IdentPropName (JS.Ident "e")) (JS.EInt end)])
+{-
mkStr :: String -> JS.Expr
mkStr s = new "Str" [JS.EStr s]
@@ -65,7 +68,7 @@ mkSeq xs = new "Seq" xs
argIdent :: Integer -> JS.Ident
argIdent n = JS.Ident ("x" ++ show n)
-
+-}
children :: JS.Ident
children = JS.Ident "cs"
diff --git a/src/compiler/GF/Compile/TypeCheck/RConcrete.hs b/src/compiler/GF/Compile/TypeCheck/RConcrete.hs
index 9d987d965..8913f7c5d 100644
--- a/src/compiler/GF/Compile/TypeCheck/RConcrete.hs
+++ b/src/compiler/GF/Compile/TypeCheck/RConcrete.hs
@@ -479,7 +479,7 @@ checkLType gr g trm typ0 = do
R r -> case typ of --- why needed? because inference may be too difficult
RecType rr -> do
- let (ls,_) = unzip rr -- labels of expected type
+ --let (ls,_) = unzip rr -- labels of expected type
fsts <- mapM (checkM r) rr -- check that they are found in the record
return $ (R fsts, typ) -- normalize record
@@ -556,10 +556,10 @@ checkLType gr g trm typ0 = do
termWith trm' $ checkEqLType gr g typ ty' trm'
where
justCheck g ty te = checkLType gr g ty te >>= return . fst
-
+{-
recParts rr t = (RecType rr1,RecType rr2) where
(rr1,rr2) = partition (flip elem (map fst t) . fst) rr
-
+-}
checkM rms (l,ty) = case lookup l rms of
Just (Just ty0,t) -> do
checkEqLType gr g ty ty0 t
@@ -747,12 +747,12 @@ ppType ty =
_ -> ppTerm Unqualified 0 ty
Prod _ x a b -> ppType a <+> "->" <+> ppType b
_ -> ppTerm Unqualified 0 ty
-
+{-
ppqType :: Type -> Type -> Doc
ppqType t u = case (ppType t, ppType u) of
(pt,pu) | render pt == render pu -> ppTerm Qualified 0 t
(pt,_) -> pt
-
+-}
checkLookup :: Ident -> Context -> Check Type
checkLookup x g =
case [ty | (b,y,ty) <- g, x == y] of
diff --git a/src/compiler/GF/Compile/TypeCheck/TC.hs b/src/compiler/GF/Compile/TypeCheck/TC.hs
index c5924d1bc..abcb24617 100644
--- a/src/compiler/GF/Compile/TypeCheck/TC.hs
+++ b/src/compiler/GF/Compile/TypeCheck/TC.hs
@@ -64,8 +64,8 @@ lookupVar g x = maybe (Bad (render ("unknown variable" <+> x))) return $ lookup
type TCEnv = (Int,Env,Env)
-emptyTCEnv :: TCEnv
-emptyTCEnv = (0,[],[])
+--emptyTCEnv :: TCEnv
+--emptyTCEnv = (0,[],[])
whnf :: Val -> Err Val
whnf v = ---- errIn ("whnf" +++ prt v) $ ---- debug
generated by cgit v1.2.3 (git 2.39.1) at 2026-05-20 17:31:07 +0000