forked from GitHub/gf-core
Ints n
This commit is contained in:
@@ -15,16 +15,18 @@ isInPredefined = err (const True) (const False) . typPredefined
|
||||
typPredefined :: Ident -> Err Type
|
||||
typPredefined c@(IC f) = case f of
|
||||
"Int" -> return typePType
|
||||
"Ints" -> return $ mkFunType [cnPredef "Int"] typePType
|
||||
"PBool" -> return typePType
|
||||
"PFalse" -> return $ cnPredef "PBool"
|
||||
"PTrue" -> return $ cnPredef "PBool"
|
||||
"dp" -> return $ mkFunType [cnPredef "Int",typeTok] typeTok
|
||||
"drop" -> return $ mkFunType [cnPredef "Int",typeTok] typeTok
|
||||
"eqInt" -> return $ mkFunType [cnPredef "Int",cnPredef "Int"] (cnPredef "PBool")
|
||||
"lessInt"-> return $ mkFunType [cnPredef "Int",cnPredef "Int"] (cnPredef "PBool")
|
||||
"eqStr" -> return $ mkFunType [typeTok,typeTok] (cnPredef "PBool")
|
||||
"length" -> return $ mkFunType [typeTok] (cnPredef "Int")
|
||||
"occur" -> return $ mkFunType [typeTok,typeTok] (cnPredef "PBool")
|
||||
"plus" -> return $ mkFunType [cnPredef "Int",cnPredef "Int"] (cnPredef "PInt")
|
||||
"plus" -> return $ mkFunType [cnPredef "Int",cnPredef "Int"] (cnPredef "Int")
|
||||
---- "read" -> (P : Type) -> Tok -> P
|
||||
---- "show" -> (P : Type) -> P -> Tok
|
||||
"take" -> return $ mkFunType [cnPredef "Int",typeTok] typeTok
|
||||
@@ -51,6 +53,7 @@ appPredefined t = case t of
|
||||
("eqStr",K s, K t) -> if s == t then predefTrue else predefFalse
|
||||
("occur",K s, K t) -> if substring s t then predefTrue else predefFalse
|
||||
("eqInt",EInt i, EInt j) -> if i==j then predefTrue else predefFalse
|
||||
("lessInt",EInt i, EInt j) -> if i<j then predefTrue else predefFalse
|
||||
("plus", EInt i, EInt j) -> EInt $ i+j
|
||||
("show", _, t) -> K $ prt t
|
||||
("read", _, K s) -> str2tag s --- because of K, only works for atomic tags
|
||||
|
||||
@@ -78,6 +78,8 @@ lookupFirstTag gr m c = do
|
||||
|
||||
allParamValues :: SourceGrammar -> Type -> Err [Term]
|
||||
allParamValues cnc ptyp = case ptyp of
|
||||
App (Q (IC "Predef") (IC "Ints")) (EInt n) ->
|
||||
return [EInt i | i <- [0..n]]
|
||||
QC p c -> lookupParamValues cnc p c
|
||||
RecType r -> do
|
||||
let (ls,tys) = unzip r
|
||||
|
||||
@@ -272,3 +272,15 @@ string2var :: String -> Ident
|
||||
string2var s = case s of
|
||||
c:'_':i -> identV (readIntArg i,[c]) ---
|
||||
_ -> zIdent s
|
||||
|
||||
-- reindex variables so that they tell nesting depth level
|
||||
|
||||
reindexTerm :: Term -> Term
|
||||
reindexTerm = qualif (0,[]) where
|
||||
qualif dg@(d,g) t = case t of
|
||||
Abs x b -> let x' = ind x d in Abs x' $ qualif (d+1, (x,x'):g) b
|
||||
Prod x a b -> let x' = ind x d in Prod x' (qualif dg a) $ qualif (d+1, (x,x'):g) b
|
||||
Vr x -> Vr $ look x g
|
||||
_ -> composSafeOp (qualif dg) t
|
||||
look x = maybe x id . lookup x --- if x is not in scope it is unchanged
|
||||
ind x d = identC $ prIdent x ++ "_" ++ show d
|
||||
|
||||
@@ -271,6 +271,7 @@ typeStrs = srt "Strs"
|
||||
|
||||
typeString = constPredefRes "String"
|
||||
typeInt = constPredefRes "Int"
|
||||
typeInts i = App (constPredefRes "Ints") (EInt i)
|
||||
|
||||
constPredefRes s = Q (IC "Predef") (zIdent s)
|
||||
|
||||
|
||||
@@ -79,6 +79,7 @@ isInConstantForm trm = case trm of
|
||||
R r -> all (isInConstantForm . snd . snd) r
|
||||
K _ -> True
|
||||
Alias _ _ t -> isInConstantForm t
|
||||
EInt _ -> True
|
||||
_ -> False ---- isInArgVarForm trm
|
||||
|
||||
varsOfPatt :: Patt -> [Ident]
|
||||
|
||||
Reference in New Issue
Block a user