refresh compilation phase in the new format

2 files changed, 29 insertions, 3 deletions

diff --git a/src/GF/Devel/Grammar/Lookup.hs b/src/GF/Devel/Grammar/Lookup.hs
index 3980577df..756345f2e 100644
--- a/src/GF/Devel/Grammar/Lookup.hs
+++ b/src/GF/Devel/Grammar/Lookup.hs
@@ -9,6 +9,7 @@ import GF.Infra.Ident
 
 import GF.Data.Operations
 
+import Control.Monad (liftM)
 import Data.Map
 import Data.List (sortBy) ----
 
@@ -39,11 +40,26 @@ lookupLincat :: GF -> Ident -> Ident -> Err Term
 lookupLincat = lookupJField jtype
 
 lookupOperType :: GF -> Ident -> Ident -> Err Term
-lookupOperType = lookupJField jtype 
+lookupOperType gr m c = do
+  ju <- lookupJudgement gr m c
+  case jform ju of
+    JParam -> return typePType
+    _ -> case jtype ju of
+      Meta _ -> fail "no type given"
+      ty -> return ty
+---- can't be just lookupJField jtype 
 
 lookupOperDef :: GF -> Ident -> Ident -> Err Term
 lookupOperDef = lookupJField jdef
 
+lookupOverload :: GF -> Ident -> Ident -> Err [([Type],(Type,Term))]
+lookupOverload gr m c = do
+  tr <- lookupJField jdef gr m c
+  case tr of
+    Overload tysts -> return 
+      [(lmap snd args,(val,tr)) | (ty,tr) <- tysts, let (args,val) = prodForm ty]
+    _   -> Bad $ prt c +++ "is not an overloaded operation"
+
 lookupParams :: GF -> Ident -> Ident -> Err [(Ident,Context)]
 lookupParams gf m c = do
   ty <- lookupJField jtype gf m c
@@ -56,8 +72,14 @@ lookupParamValues :: GF -> Ident -> Ident -> Err [Term]
 lookupParamValues gf m c = do
   d <- lookupJField jdef gf m c
   case d of
-    V _ ts -> return ts
-    _ -> raise "no parameter values"
+    ---- V _ ts -> return ts
+    _ -> do
+      ps <- lookupParams gf m c
+      liftM concat $ mapM mkPar ps
+ where
+   mkPar (f,co) = do
+     vs <- liftM combinations $ mapM (\ (_,ty) -> allParamValues gf ty) co
+     return $ lmap (mkApp (QC m f)) vs
 
 allParamValues :: GF -> Type -> Err [Term]
 allParamValues cnc ptyp = case ptyp of
@@ -95,4 +117,5 @@ mlookup = Data.Map.lookup
 
 raiseIdent msg i = raise (msg +++ prIdent i)
 
+lmap = Prelude.map
 
diff --git a/src/GF/Devel/Grammar/Macros.hs b/src/GF/Devel/Grammar/Macros.hs
index 51c1669f4..db84fc7a4 100644
--- a/src/GF/Devel/Grammar/Macros.hs
+++ b/src/GF/Devel/Grammar/Macros.hs
@@ -163,6 +163,9 @@ typePType = Sort "PType"
 typeStr :: Type
 typeStr = Sort "Str"
 
+typeTok :: Type      ---- deprecated
+typeTok = Sort "Tok"  
+
 cPredef :: Ident
 cPredef = identC "Predef"