{-# LANGUAGE FlexibleContexts #-}
module GF.Compile.CFGtoPGF (cf2pgf) where

import GF.Grammar.CFG
import GF.Infra.UseIO

import PGF
import PGF.Internal

import qualified Data.Set as Set
import qualified Data.Map as Map
import qualified Data.IntMap as IntMap
import Data.Array.IArray
import Data.List

--------------------------
-- the compiler ----------
--------------------------

cf2pgf :: FilePath -> ParamCFG -> PGF
cf2pgf :: FilePath -> ParamCFG -> PGF
cf2pgf FilePath
fpath ParamCFG
cf =
 let pgf :: PGF
pgf = Map CId Literal -> CId -> Abstr -> Map CId Concr -> PGF
PGF Map CId Literal
forall k a. Map k a
Map.empty CId
aname (ParamCFG -> Abstr
cf2abstr ParamCFG
cf) (CId -> Concr -> Map CId Concr
forall k a. k -> a -> Map k a
Map.singleton CId
cname (ParamCFG -> Concr
cf2concr ParamCFG
cf))
 in PGF -> PGF
updateProductionIndices PGF
pgf
 where
   name :: FilePath
name = FilePath -> FilePath
justModuleName FilePath
fpath
   aname :: CId
aname = FilePath -> CId
mkCId (FilePath
name FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
"Abs")
   cname :: CId
cname = FilePath -> CId
mkCId FilePath
name

cf2abstr :: ParamCFG -> Abstr
cf2abstr :: ParamCFG -> Abstr
cf2abstr ParamCFG
cfg = Map CId Literal
-> Map CId (Type, Int, Maybe ([Equation], [[Instr]]), Double)
-> Map CId ([Hypo], [(Double, CId)], Double)
-> Abstr
Abstr Map CId Literal
aflags Map CId (Type, Int, Maybe ([Equation], [[Instr]]), Double)
forall a. Map CId (Type, Int, Maybe a, Double)
afuns Map CId ([Hypo], [(Double, CId)], Double)
forall a. Map CId ([a], [(Double, CId)], Double)
acats
  where
    aflags :: Map CId Literal
aflags = CId -> Literal -> Map CId Literal
forall k a. k -> a -> Map k a
Map.singleton (FilePath -> CId
mkCId FilePath
"startcat") (FilePath -> Literal
LStr ((FilePath, [Int]) -> FilePath
forall a b. (a, b) -> a
fst (ParamCFG -> (FilePath, [Int])
forall c t. Grammar c t -> c
cfgStartCat ParamCFG
cfg)))

    acats :: Map CId ([a], [(Double, CId)], Double)
acats  = [(CId, ([a], [(Double, CId)], Double))]
-> Map CId ([a], [(Double, CId)], Double)
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList [(CId
cat, ([], [(Double
0,Rule (FilePath, [Int]) FilePath -> CId
forall c t. Rule c t -> CId
mkRuleName Rule (FilePath, [Int]) FilePath
rule) | Rule (FilePath, [Int]) FilePath
rule <- [Rule (FilePath, [Int]) FilePath]
rules], Double
0))
                            | (CId
cat,[Rule (FilePath, [Int]) FilePath]
rules) <- (Map CId [Rule (FilePath, [Int]) FilePath]
-> [(CId, [Rule (FilePath, [Int]) FilePath])]
forall k a. Map k a -> [(k, a)]
Map.toList (Map CId [Rule (FilePath, [Int]) FilePath]
 -> [(CId, [Rule (FilePath, [Int]) FilePath])])
-> ([(CId, [Rule (FilePath, [Int]) FilePath])]
    -> Map CId [Rule (FilePath, [Int]) FilePath])
-> [(CId, [Rule (FilePath, [Int]) FilePath])]
-> [(CId, [Rule (FilePath, [Int]) FilePath])]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([Rule (FilePath, [Int]) FilePath]
 -> [Rule (FilePath, [Int]) FilePath]
 -> [Rule (FilePath, [Int]) FilePath])
-> [(CId, [Rule (FilePath, [Int]) FilePath])]
-> Map CId [Rule (FilePath, [Int]) FilePath]
forall k a. Ord k => (a -> a -> a) -> [(k, a)] -> Map k a
Map.fromListWith [Rule (FilePath, [Int]) FilePath]
-> [Rule (FilePath, [Int]) FilePath]
-> [Rule (FilePath, [Int]) FilePath]
forall a. [a] -> [a] -> [a]
(++))
                                                [((FilePath, [Int]) -> CId
forall b. (FilePath, b) -> CId
cat2id (FilePath, [Int])
cat, ParamCFG -> (FilePath, [Int]) -> [Rule (FilePath, [Int]) FilePath]
forall c t. Ord c => Grammar c t -> c -> [Rule c t]
catRules ParamCFG
cfg (FilePath, [Int])
cat) |
                                                     (FilePath, [Int])
cat <- ParamCFG -> [(FilePath, [Int])]
forall c t. (Ord c, Ord t) => Grammar c t -> [c]
allCats' ParamCFG
cfg]]
    afuns :: Map CId (Type, Int, Maybe a, Double)
afuns  = [(CId, (Type, Int, Maybe a, Double))]
-> Map CId (Type, Int, Maybe a, Double)
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList [(Rule (FilePath, [Int]) FilePath -> CId
forall c t. Rule c t -> CId
mkRuleName Rule (FilePath, [Int]) FilePath
rule, ([CId] -> CId -> Type
cftype [(FilePath, [Int]) -> CId
forall b. (FilePath, b) -> CId
cat2id (FilePath, [Int])
c | NonTerminal (FilePath, [Int])
c <- Rule (FilePath, [Int]) FilePath
-> [Symbol (FilePath, [Int]) FilePath]
forall c t. Rule c t -> [Symbol c t]
ruleRhs Rule (FilePath, [Int]) FilePath
rule] ((FilePath, [Int]) -> CId
forall b. (FilePath, b) -> CId
cat2id (Rule (FilePath, [Int]) FilePath -> (FilePath, [Int])
forall c t. Rule c t -> c
ruleLhs Rule (FilePath, [Int]) FilePath
rule)), Int
0, Maybe a
forall a. Maybe a
Nothing, Double
0))
                            | Rule (FilePath, [Int]) FilePath
rule <- ParamCFG -> [Rule (FilePath, [Int]) FilePath]
forall c t. Grammar c t -> [Rule c t]
allRules ParamCFG
cfg]

    cat2id :: (FilePath, b) -> CId
cat2id = FilePath -> CId
mkCId (FilePath -> CId)
-> ((FilePath, b) -> FilePath) -> (FilePath, b) -> CId
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (FilePath, b) -> FilePath
forall a b. (a, b) -> a
fst

cf2concr :: ParamCFG -> Concr
cf2concr :: ParamCFG -> Concr
cf2concr ParamCFG
cfg = Map CId Literal
-> Map CId FilePath
-> Array Int CncFun
-> IntMap [Int]
-> IntMap [Int]
-> Array Int Sequence
-> IntMap (Set Production)
-> IntMap (Set Production)
-> Map CId (IntMap (Set Production))
-> Map CId CncCat
-> IntMap (IntMap (TrieMap FilePath IntSet))
-> Int
-> Concr
Concr Map CId Literal
forall k a. Map k a
Map.empty Map CId FilePath
forall k a. Map k a
Map.empty
                     Array Int CncFun
cncfuns IntMap [Int]
lindefsrefs IntMap [Int]
lindefsrefs
                     Array Int Sequence
sequences IntMap (Set Production)
productions
                     IntMap (Set Production)
forall a. IntMap a
IntMap.empty Map CId (IntMap (Set Production))
forall k a. Map k a
Map.empty
                     Map CId CncCat
cnccats
                     IntMap (IntMap (TrieMap FilePath IntSet))
forall a. IntMap a
IntMap.empty
                     Int
totalCats
  where
    cats :: [(FilePath, [Int])]
cats  = ParamCFG -> [(FilePath, [Int])]
forall c t. (Ord c, Ord t) => Grammar c t -> [c]
allCats' ParamCFG
cfg
    rules :: [Rule (FilePath, [Int]) FilePath]
rules = ParamCFG -> [Rule (FilePath, [Int]) FilePath]
forall c t. Grammar c t -> [Rule c t]
allRules ParamCFG
cfg

    sequences0 :: Set Sequence
sequences0 = [Sequence] -> Set Sequence
forall a. Ord a => [a] -> Set a
Set.fromList ((Int, Int) -> [Symbol] -> Sequence
forall (a :: * -> * -> *) e i.
(IArray a e, Ix i) =>
(i, i) -> [e] -> a i e
listArray (Int
0,Int
0) [Int -> Int -> Symbol
SymCat Int
0 Int
0] Sequence -> [Sequence] -> [Sequence]
forall a. a -> [a] -> [a]
:
                               (Rule (FilePath, [Int]) FilePath -> Sequence)
-> [Rule (FilePath, [Int]) FilePath] -> [Sequence]
forall a b. (a -> b) -> [a] -> [b]
map Rule (FilePath, [Int]) FilePath -> Sequence
forall (a :: * -> * -> *) b.
IArray a Symbol =>
Rule (FilePath, b) FilePath -> a Int Symbol
mkSequence [Rule (FilePath, [Int]) FilePath]
rules)
    sequences :: Array Int Sequence
sequences  = (Int, Int) -> [Sequence] -> Array Int Sequence
forall (a :: * -> * -> *) e i.
(IArray a e, Ix i) =>
(i, i) -> [e] -> a i e
listArray (Int
0,Set Sequence -> Int
forall a. Set a -> Int
Set.size Set Sequence
sequences0Int -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1) (Set Sequence -> [Sequence]
forall a. Set a -> [a]
Set.toList Set Sequence
sequences0)

    idFun :: CncFun
idFun = CId -> UArray Int Int -> CncFun
CncFun CId
wildCId ((Int, Int) -> [Int] -> UArray Int Int
forall (a :: * -> * -> *) e i.
(IArray a e, Ix i) =>
(i, i) -> [e] -> a i e
listArray (Int
0,Int
0) [Int
seqid])
      where
        seq :: Sequence
seq   = (Int, Int) -> [Symbol] -> Sequence
forall (a :: * -> * -> *) e i.
(IArray a e, Ix i) =>
(i, i) -> [e] -> a i e
listArray (Int
0,Int
0) [Int -> Int -> Symbol
SymCat Int
0 Int
0]
        seqid :: Int
seqid = Sequence -> Array Int Sequence -> (Int, Int) -> Int
forall a t (a :: * -> * -> *).
(Ord t, IArray a t, Ix a, Integral a) =>
t -> a a t -> (a, a) -> a
binSearch Sequence
seq Array Int Sequence
sequences (Array Int Sequence -> (Int, Int)
forall (a :: * -> * -> *) e i.
(IArray a e, Ix i) =>
a i e -> (i, i)
bounds Array Int Sequence
sequences)
    ((Int
fun_cnt,[CncFun]
cncfuns0),[[(Int, Production)]]
productions0) = ((Int, [CncFun])
 -> Rule (FilePath, [Int]) FilePath
 -> ((Int, [CncFun]), [(Int, Production)]))
-> (Int, [CncFun])
-> [Rule (FilePath, [Int]) FilePath]
-> ((Int, [CncFun]), [[(Int, Production)]])
forall (t :: * -> *) a b c.
Traversable t =>
(a -> b -> (a, c)) -> a -> t b -> (a, t c)
mapAccumL (Map (FilePath, [Int]) Int
-> (Int, [CncFun])
-> Rule (FilePath, [Int]) FilePath
-> ((Int, [CncFun]), [(Int, Production)])
forall p.
p
-> (Int, [CncFun])
-> Rule (FilePath, [Int]) FilePath
-> ((Int, [CncFun]), [(Int, Production)])
convertRule Map (FilePath, [Int]) Int
cs) (Int
1,[CncFun
idFun]) [Rule (FilePath, [Int]) FilePath]
rules
    productions :: IntMap (Set Production)
productions = (IntMap (Set Production)
 -> (Int, Production) -> IntMap (Set Production))
-> IntMap (Set Production)
-> [(Int, Production)]
-> IntMap (Set Production)
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl IntMap (Set Production)
-> (Int, Production) -> IntMap (Set Production)
forall a. Ord a => IntMap (Set a) -> (Int, a) -> IntMap (Set a)
addProd IntMap (Set Production)
forall a. IntMap a
IntMap.empty ([[(Int, Production)]] -> [(Int, Production)]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[(Int, Production)]]
productions0[[(Int, Production)]]
-> [[(Int, Production)]] -> [[(Int, Production)]]
forall a. [a] -> [a] -> [a]
++[[(Int, Production)]]
coercions))
    cncfuns :: Array Int CncFun
cncfuns = (Int, Int) -> [CncFun] -> Array Int CncFun
forall (a :: * -> * -> *) e i.
(IArray a e, Ix i) =>
(i, i) -> [e] -> a i e
listArray (Int
0,Int
fun_cntInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1) ([CncFun] -> [CncFun]
forall a. [a] -> [a]
reverse [CncFun]
cncfuns0)

    lbls :: Array Int FilePath
lbls = (Int, Int) -> [FilePath] -> Array Int FilePath
forall (a :: * -> * -> *) e i.
(IArray a e, Ix i) =>
(i, i) -> [e] -> a i e
listArray (Int
0,Int
0) [FilePath
"s"]
    (Int
fid,[(CId, CncCat)]
cnccats0) = ((Int -> (FilePath, Int) -> (Int, (CId, CncCat)))
-> Int -> [(FilePath, Int)] -> (Int, [(CId, CncCat)])
forall (t :: * -> *) a b c.
Traversable t =>
(a -> b -> (a, c)) -> a -> t b -> (a, t c)
mapAccumL Int -> (FilePath, Int) -> (Int, (CId, CncCat))
mkCncCat Int
0 ([(FilePath, Int)] -> (Int, [(CId, CncCat)]))
-> ([(FilePath, Int)] -> [(FilePath, Int)])
-> [(FilePath, Int)]
-> (Int, [(CId, CncCat)])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Map FilePath Int -> [(FilePath, Int)]
forall k a. Map k a -> [(k, a)]
Map.toList (Map FilePath Int -> [(FilePath, Int)])
-> ([(FilePath, Int)] -> Map FilePath Int)
-> [(FilePath, Int)]
-> [(FilePath, Int)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int -> Int -> Int) -> [(FilePath, Int)] -> Map FilePath Int
forall k a. Ord k => (a -> a -> a) -> [(k, a)] -> Map k a
Map.fromListWith Int -> Int -> Int
forall a. Ord a => a -> a -> a
max)
                              [(FilePath
c,Int
p) | (FilePath
c,[Int]
ps) <- [(FilePath, [Int])]
cats, Int
p <- [Int]
ps]
    ((Int
totalCats,Map (FilePath, [Int]) Int
cs), [[(Int, Production)]]
coercions) = ((Int, Map (FilePath, [Int]) Int)
 -> (FilePath, [Int])
 -> ((Int, Map (FilePath, [Int]) Int), [(Int, Production)]))
-> (Int, Map (FilePath, [Int]) Int)
-> [(FilePath, [Int])]
-> ((Int, Map (FilePath, [Int]) Int), [[(Int, Production)]])
forall (t :: * -> *) a b c.
Traversable t =>
(a -> b -> (a, c)) -> a -> t b -> (a, t c)
mapAccumL (Int, Map (FilePath, [Int]) Int)
-> (FilePath, [Int])
-> ((Int, Map (FilePath, [Int]) Int), [(Int, Production)])
forall a.
Num a =>
(a, Map (FilePath, [Int]) a)
-> (FilePath, [Int])
-> ((a, Map (FilePath, [Int]) a), [(a, Production)])
mkCoercions (Int
fid,Map (FilePath, [Int]) Int
forall k a. Map k a
Map.empty) [(FilePath, [Int])]
cats
    cnccats :: Map CId CncCat
cnccats = [(CId, CncCat)] -> Map CId CncCat
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList [(CId, CncCat)]
cnccats0

    lindefsrefs :: IntMap [Int]
lindefsrefs =
       [(Int, [Int])] -> IntMap [Int]
forall a. [(Int, a)] -> IntMap a
IntMap.fromList (((FilePath, [Int]) -> (Int, [Int]))
-> [(FilePath, [Int])] -> [(Int, [Int])]
forall a b. (a -> b) -> [a] -> [b]
map (FilePath, [Int]) -> (Int, [Int])
forall a b. Num a => (FilePath, b) -> (Int, [a])
mkLinDefRef [(FilePath, [Int])]
cats)

    convertRule :: p
-> (Int, [CncFun])
-> Rule (FilePath, [Int]) FilePath
-> ((Int, [CncFun]), [(Int, Production)])
convertRule p
cs (Int
funid,[CncFun]
funs) Rule (FilePath, [Int]) FilePath
rule =
      let args :: [PArg]
args   = [[(Int, Int)] -> Int -> PArg
PArg [] ((FilePath, [Int]) -> Int
cat2arg (FilePath, [Int])
c) | NonTerminal (FilePath, [Int])
c <- Rule (FilePath, [Int]) FilePath
-> [Symbol (FilePath, [Int]) FilePath]
forall c t. Rule c t -> [Symbol c t]
ruleRhs Rule (FilePath, [Int]) FilePath
rule]
          prod :: Production
prod   = Int -> [PArg] -> Production
PApply Int
funid [PArg]
args
          seqid :: Int
seqid  = Sequence -> Array Int Sequence -> (Int, Int) -> Int
forall a t (a :: * -> * -> *).
(Ord t, IArray a t, Ix a, Integral a) =>
t -> a a t -> (a, a) -> a
binSearch (Rule (FilePath, [Int]) FilePath -> Sequence
forall (a :: * -> * -> *) b.
IArray a Symbol =>
Rule (FilePath, b) FilePath -> a Int Symbol
mkSequence Rule (FilePath, [Int]) FilePath
rule) Array Int Sequence
sequences (Array Int Sequence -> (Int, Int)
forall (a :: * -> * -> *) e i.
(IArray a e, Ix i) =>
a i e -> (i, i)
bounds Array Int Sequence
sequences)
          fun :: CncFun
fun    = CId -> UArray Int Int -> CncFun
CncFun (Rule (FilePath, [Int]) FilePath -> CId
forall c t. Rule c t -> CId
mkRuleName Rule (FilePath, [Int]) FilePath
rule) ((Int, Int) -> [Int] -> UArray Int Int
forall (a :: * -> * -> *) e i.
(IArray a e, Ix i) =>
(i, i) -> [e] -> a i e
listArray (Int
0,Int
0) [Int
seqid])
          funid' :: Int
funid' = Int
funidInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1
      in Int
funid' Int
-> ((Int, [CncFun]), [(Int, Production)])
-> ((Int, [CncFun]), [(Int, Production)])
`seq` ((Int
funid',CncFun
funCncFun -> [CncFun] -> [CncFun]
forall a. a -> [a] -> [a]
:[CncFun]
funs),let (FilePath
c,[Int]
ps) = Rule (FilePath, [Int]) FilePath -> (FilePath, [Int])
forall c t. Rule c t -> c
ruleLhs Rule (FilePath, [Int]) FilePath
rule in [(FilePath -> Int -> Int
cat2fid FilePath
c Int
p, Production
prod) | Int
p <- [Int]
ps])

    mkSequence :: Rule (FilePath, b) FilePath -> a Int Symbol
mkSequence Rule (FilePath, b) FilePath
rule = (Int, Int) -> [Symbol] -> a Int Symbol
forall (a :: * -> * -> *) e i.
(IArray a e, Ix i) =>
(i, i) -> [e] -> a i e
listArray (Int
0,[Symbol] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Symbol]
symsInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1) [Symbol]
syms
      where
        syms :: [Symbol]
syms   = (Int, [Symbol]) -> [Symbol]
forall a b. (a, b) -> b
snd ((Int, [Symbol]) -> [Symbol]) -> (Int, [Symbol]) -> [Symbol]
forall a b. (a -> b) -> a -> b
$ (Int -> Symbol (FilePath, b) FilePath -> (Int, Symbol))
-> Int -> [Symbol (FilePath, b) FilePath] -> (Int, [Symbol])
forall (t :: * -> *) a b c.
Traversable t =>
(a -> b -> (a, c)) -> a -> t b -> (a, t c)
mapAccumL Int -> Symbol (FilePath, b) FilePath -> (Int, Symbol)
forall b. Int -> Symbol (FilePath, b) FilePath -> (Int, Symbol)
convertSymbol Int
0 (Rule (FilePath, b) FilePath -> [Symbol (FilePath, b) FilePath]
forall c t. Rule c t -> [Symbol c t]
ruleRhs Rule (FilePath, b) FilePath
rule)

        convertSymbol :: Int -> Symbol (FilePath, b) FilePath -> (Int, Symbol)
convertSymbol Int
d (NonTerminal (FilePath
c,b
_)) = (Int
dInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1,if FilePath
c FilePath -> [FilePath] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [FilePath
"Int",FilePath
"Float",FilePath
"String"] then Int -> Int -> Symbol
SymLit Int
d Int
0 else Int -> Int -> Symbol
SymCat Int
d Int
0)
        convertSymbol Int
d (Terminal FilePath
t)        = (Int
d,  FilePath -> Symbol
SymKS FilePath
t)

    mkCncCat :: Int -> (FilePath, Int) -> (Int, (CId, CncCat))
mkCncCat Int
fid (FilePath
cat,Int
n)
      | FilePath
cat FilePath -> FilePath -> Bool
forall a. Eq a => a -> a -> Bool
== FilePath
"Int"    = (Int
fid, (FilePath -> CId
mkCId FilePath
cat, Int -> Int -> Array Int FilePath -> CncCat
CncCat Int
fidInt    Int
fidInt    Array Int FilePath
lbls))
      | FilePath
cat FilePath -> FilePath -> Bool
forall a. Eq a => a -> a -> Bool
== FilePath
"Float"  = (Int
fid, (FilePath -> CId
mkCId FilePath
cat, Int -> Int -> Array Int FilePath -> CncCat
CncCat Int
fidFloat  Int
fidFloat  Array Int FilePath
lbls))
      | FilePath
cat FilePath -> FilePath -> Bool
forall a. Eq a => a -> a -> Bool
== FilePath
"String" = (Int
fid, (FilePath -> CId
mkCId FilePath
cat, Int -> Int -> Array Int FilePath -> CncCat
CncCat Int
fidString Int
fidString Array Int FilePath
lbls))
      | Bool
otherwise       = let fid' :: Int
fid' = Int
fidInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1
                          in Int
fid' Int -> (Int, (CId, CncCat)) -> (Int, (CId, CncCat))
`seq` (Int
fid', (FilePath -> CId
mkCId FilePath
cat,Int -> Int -> Array Int FilePath -> CncCat
CncCat Int
fid (Int
fidInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
n) Array Int FilePath
lbls))

    mkCoercions :: (a, Map (FilePath, [Int]) a)
-> (FilePath, [Int])
-> ((a, Map (FilePath, [Int]) a), [(a, Production)])
mkCoercions (a
fid,Map (FilePath, [Int]) a
cs) c :: (FilePath, [Int])
c@(FilePath
cat,[Int
p]) = ((a
fid,Map (FilePath, [Int]) a
cs),[])
    mkCoercions (a
fid,Map (FilePath, [Int]) a
cs) c :: (FilePath, [Int])
c@(FilePath
cat,[Int]
ps ) =
      let fid' :: a
fid' = a
fida -> a -> a
forall a. Num a => a -> a -> a
+a
1
      in a
fid' a
-> ((a, Map (FilePath, [Int]) a), [(a, Production)])
-> ((a, Map (FilePath, [Int]) a), [(a, Production)])
`seq` ((a
fid', (FilePath, [Int])
-> a -> Map (FilePath, [Int]) a -> Map (FilePath, [Int]) a
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert (FilePath, [Int])
c a
fid Map (FilePath, [Int]) a
cs), [(a
fid,Int -> Production
PCoerce (FilePath -> Int -> Int
cat2fid FilePath
cat Int
p)) | Int
p <- [Int]
ps])

    mkLinDefRef :: (FilePath, b) -> (Int, [a])
mkLinDefRef (FilePath
cat,b
_) =
      (FilePath -> Int -> Int
cat2fid FilePath
cat Int
0,[a
0])

    addProd :: IntMap (Set a) -> (Int, a) -> IntMap (Set a)
addProd IntMap (Set a)
prods (Int
fid,a
prod) =
      case Int -> IntMap (Set a) -> Maybe (Set a)
forall a. Int -> IntMap a -> Maybe a
IntMap.lookup Int
fid IntMap (Set a)
prods of
        Just Set a
set -> Int -> Set a -> IntMap (Set a) -> IntMap (Set a)
forall a. Int -> a -> IntMap a -> IntMap a
IntMap.insert Int
fid (a -> Set a -> Set a
forall a. Ord a => a -> Set a -> Set a
Set.insert a
prod Set a
set) IntMap (Set a)
prods
        Maybe (Set a)
Nothing  -> Int -> Set a -> IntMap (Set a) -> IntMap (Set a)
forall a. Int -> a -> IntMap a -> IntMap a
IntMap.insert Int
fid (a -> Set a
forall a. a -> Set a
Set.singleton a
prod)  IntMap (Set a)
prods

    binSearch :: t -> a a t -> (a, a) -> a
binSearch t
v a a t
arr (a
i,a
j)
      | a
i a -> a -> Bool
forall a. Ord a => a -> a -> Bool
<= a
j    = case t -> t -> Ordering
forall a. Ord a => a -> a -> Ordering
compare t
v (a a t
arr a a t -> a -> t
forall (a :: * -> * -> *) e i.
(IArray a e, Ix i) =>
a i e -> i -> e
! a
k) of
                      Ordering
LT -> t -> a a t -> (a, a) -> a
binSearch t
v a a t
arr (a
i,a
ka -> a -> a
forall a. Num a => a -> a -> a
-a
1)
                      Ordering
EQ -> a
k
                      Ordering
GT -> t -> a a t -> (a, a) -> a
binSearch t
v a a t
arr (a
ka -> a -> a
forall a. Num a => a -> a -> a
+a
1,a
j)
      | Bool
otherwise = FilePath -> a
forall a. HasCallStack => FilePath -> a
error FilePath
"binSearch"
      where
        k :: a
k = (a
ia -> a -> a
forall a. Num a => a -> a -> a
+a
j) a -> a -> a
forall a. Integral a => a -> a -> a
`div` a
2

    cat2fid :: FilePath -> Int -> Int
cat2fid FilePath
cat Int
p =
      case CId -> Map CId CncCat -> Maybe CncCat
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup (FilePath -> CId
mkCId FilePath
cat) Map CId CncCat
cnccats of
        Just (CncCat Int
fid Int
_ Array Int FilePath
_) -> Int
fidInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
p
        Maybe CncCat
_                     -> FilePath -> Int
forall a. HasCallStack => FilePath -> a
error FilePath
"cat2fid"

    cat2arg :: (FilePath, [Int]) -> Int
cat2arg c :: (FilePath, [Int])
c@(FilePath
cat,[Int
p]) = FilePath -> Int -> Int
cat2fid FilePath
cat Int
p
    cat2arg c :: (FilePath, [Int])
c@(FilePath
cat,[Int]
ps ) =
      case (FilePath, [Int]) -> Map (FilePath, [Int]) Int -> Maybe Int
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup (FilePath, [Int])
c Map (FilePath, [Int]) Int
cs of
        Just Int
fid -> Int
fid
        Maybe Int
Nothing  -> FilePath -> Int
forall a. HasCallStack => FilePath -> a
error FilePath
"cat2arg"

mkRuleName :: Rule c t -> CId
mkRuleName Rule c t
rule =
  case Rule c t -> CFTerm
forall c t. Rule c t -> CFTerm
ruleName Rule c t
rule of
    CFObj CId
n [CFTerm]
_ -> CId
n
    CFTerm
_         -> CId
wildCId