From 402a113b567a96eef61946552b68df6ac6eb6712 Mon Sep 17 00:00:00 2001
From: aarne <aarne@cs.chalmers.se>
Date: Tue, 20 Jun 2006 08:38:44 +0000
Subject: made -fcfg default parser; added lexer textvars

---
 src/GF/Grammar/LookAbs.hs | 5 +++++
 src/GF/Grammar/Macros.hs  | 4 ++++
 2 files changed, 9 insertions(+)

(limited to 'src/GF/Grammar')

diff --git a/src/GF/Grammar/LookAbs.hs b/src/GF/Grammar/LookAbs.hs
index 0c86ae3e9..5bd4c1e41 100644
--- a/src/GF/Grammar/LookAbs.hs
+++ b/src/GF/Grammar/LookAbs.hs
@@ -21,6 +21,7 @@ module GF.Grammar.LookAbs (GFCGrammar,
 		lookupRef,
 		refsForType,
 		funRulesOf,
+		hasHOAS,
 		allCatsOf,
 		allBindCatsOf,
 		funsForType,
@@ -130,6 +131,10 @@ funRulesOf gr =
                  mtype m == MTAbstract,
                  (f, C.AbsFun typ _) <- tree2list (jments m)]
 
+-- testing for higher-order abstract syntax
+hasHOAS :: GFCGrammar -> Bool
+hasHOAS gr = any isHigherOrderType [t | (_,t) <- funRulesOf gr] where
+
 allCatsOf :: GFCGrammar -> [(Cat,Context)]
 allCatsOf gr = 
   [((i,c),cont) | (i, ModMod m) <- modules gr,
diff --git a/src/GF/Grammar/Macros.hs b/src/GF/Grammar/Macros.hs
index e7d073382..a3cad8bae 100644
--- a/src/GF/Grammar/Macros.hs
+++ b/src/GF/Grammar/Macros.hs
@@ -136,6 +136,10 @@ isRecursiveType t = errVal False $ do
   (cc,c) <- catSkeleton t -- thus recursivity on Cat level
   return $ any (== c) cc
 
+isHigherOrderType :: Type -> Bool
+isHigherOrderType t = errVal True $ do  -- pessimistic choice
+  co <- contextOfType t
+  return $ not $ null [x | (x,Prod _ _ _) <- co]
 
 contextOfType :: Type -> Err Context
 contextOfType typ = case typ of
-- 
cgit v1.2.3