diff options
| author | kr.angelov <kr.angelov@gmail.com> | 2011-11-22 20:31:58 +0000 |
|---|---|---|
| committer | kr.angelov <kr.angelov@gmail.com> | 2011-11-22 20:31:58 +0000 |
| commit | 26d61354dd74e2f6b9fe4d6c4ac945942d73e999 (patch) | |
| tree | 590983dab4a387c12a996e591f0d5f0182a0de8a /src | |
| parent | 1f731df2859ad9ce2164c097b5b3f956eb87c82d (diff) | |
make addSequencesB(V) strict. Otherwise we get stack overflow when compiling LangFre
Diffstat (limited to 'src')
| -rw-r--r-- | src/compiler/GF/Compile/GeneratePMCFG.hs | 24 |
1 files changed, 15 insertions, 9 deletions
diff --git a/src/compiler/GF/Compile/GeneratePMCFG.hs b/src/compiler/GF/Compile/GeneratePMCFG.hs index f4f1a3fca..1c1187956 100644 --- a/src/compiler/GF/Compile/GeneratePMCFG.hs +++ b/src/compiler/GF/Compile/GeneratePMCFG.hs @@ -393,25 +393,31 @@ goV (CPar t) rpath ss = restrictHead (reversePath rpath) t >> return ss type SeqSet = Map.Map Sequence SeqId addSequencesB :: SeqSet -> Branch (Value [Symbol]) -> (SeqSet, Branch (Value SeqId)) -addSequencesB seqs (Case nr path bs) = let (seqs1,bs1) = List.mapAccumL (\seqs (trm,b) -> let (seqs',b') = addSequencesB seqs b - in (seqs',(trm,b'))) seqs bs +addSequencesB seqs (Case nr path bs) = let !(seqs1,bs1) = mapAccumL' (\seqs (trm,b) -> let !(seqs',b') = addSequencesB seqs b + in (seqs',(trm,b'))) seqs bs in (seqs1,Case nr path bs1) -addSequencesB seqs (Variant bs) = let (seqs1,bs1) = List.mapAccumL addSequencesB seqs bs +addSequencesB seqs (Variant bs) = let !(seqs1,bs1) = mapAccumL' addSequencesB seqs bs in (seqs1,Variant bs1) -addSequencesB seqs (Return v) = let (seqs1,v1) = addSequencesV seqs v +addSequencesB seqs (Return v) = let !(seqs1,v1) = addSequencesV seqs v in (seqs1,Return v1) addSequencesV :: SeqSet -> Value [Symbol] -> (SeqSet, Value SeqId) -addSequencesV seqs (CRec vs) = let (seqs1,vs1) = List.mapAccumL (\seqs (lbl,b) -> let (seqs',b') = addSequencesB seqs b - in (seqs',(lbl,b'))) seqs vs +addSequencesV seqs (CRec vs) = let !(seqs1,vs1) = mapAccumL' (\seqs (lbl,b) -> let !(seqs',b') = addSequencesB seqs b + in (seqs',(lbl,b'))) seqs vs in (seqs1,CRec vs1) -addSequencesV seqs (CTbl pt vs)=let (seqs1,vs1) = List.mapAccumL (\seqs (trm,b) -> let (seqs',b') = addSequencesB seqs b - in (seqs',(trm,b'))) seqs vs +addSequencesV seqs (CTbl pt vs)=let !(seqs1,vs1) = mapAccumL' (\seqs (trm,b) -> let !(seqs',b') = addSequencesB seqs b + in (seqs',(trm,b'))) seqs vs in (seqs1,CTbl pt vs1) -addSequencesV seqs (CStr lin) = let (seqs1,seqid) = addSequence seqs (optimizeLin lin) +addSequencesV seqs (CStr lin) = let !(seqs1,seqid) = addSequence seqs (optimizeLin lin) in (seqs1,CStr seqid) addSequencesV seqs (CPar i) = (seqs,CPar i) +-- a strict version of Data.List.mapAccumL +mapAccumL' f s [] = (s,[]) +mapAccumL' f s (x:xs) = (s'',y:ys) + where !(s', y ) = f s x + !(s'',ys) = mapAccumL' f s' xs + optimizeLin [] = [] optimizeLin lin@(SymKS _ : _) = let (ts,lin') = getRest lin |