GitHub/gf-core
1
0
Fork 1
mirror of https://github.com/GrammaticalFramework/gf-core.git synced 2026-05-26 11:18:55 -06:00
Code Issues Packages Projects Releases Wiki Activity

fix the compilation of case insensitive grammars

Browse Source
This commit is contained in:
krangelov
2020-02-17 12:40:14 +01:00
parent 98a18843da
commit 9604a6309c
1 changed files with 37 additions and 32 deletions
Download Patch File Download Diff File Expand all files Collapse all files

67
src/compiler/GF/Compile/GrammarToPGF.hs
View File

@@ -359,14 +359,18 @@ sortNubBy cmp = mergeAll . sequences
-- This is used to allow case-insensitive parsing, while -- This is used to allow case-insensitive parsing, while
-- the linearizer still has access to the original cases. -- the linearizer still has access to the original cases.
compareCaseInsensitve s1 s2 = compareCaseInsensitve s1 s2 =
compareSeq (elems s1) (elems s2) case compareSeq (elems s1) (elems s2) of
(EQ,c) -> c
(c, _) -> c
where where
compareSeq [] [] = EQ compareSeq [] [] = dup EQ
compareSeq [] _ = LT compareSeq [] _ = dup LT
compareSeq _ [] = GT compareSeq _ [] = dup GT
compareSeq (x:xs) (y:ys) = compareSeq (x:xs) (y:ys) =
case compareSym x y of case compareSym x y of
EQ -> compareSeq xs ys (EQ,EQ) -> compareSeq xs ys
(EQ,c2) -> case compareSeq xs ys of
(c1,_) -> (c1,c2)
x -> x x -> x
compareSym s1 s2 = compareSym s1 s2 =
@@ -375,56 +379,57 @@ compareCaseInsensitve s1 s2 =
-> case s2 of -> case s2 of
D.SymCat d2 r2 D.SymCat d2 r2
-> case compare d1 d2 of -> case compare d1 d2 of
EQ -> r1 `compare` r2 EQ -> dup (r1 `compare` r2)
x -> x x -> dup x
_ -> LT _ -> dup LT
D.SymLit d1 r1 D.SymLit d1 r1
-> case s2 of -> case s2 of
D.SymCat {} -> GT D.SymCat {} -> dup GT
D.SymLit d2 r2 D.SymLit d2 r2
-> case compare d1 d2 of -> case compare d1 d2 of
EQ -> r1 `compare` r2 EQ -> dup (r1 `compare` r2)
x -> x x -> dup x
_ -> LT _ -> dup LT
D.SymVar d1 r1 D.SymVar d1 r1
-> if tagToEnum# (getTag s2 ># 2#) -> if tagToEnum# (getTag s2 ># 2#)
then LT then dup LT
else case s2 of else case s2 of
D.SymVar d2 r2 D.SymVar d2 r2
-> case compare d1 d2 of -> case compare d1 d2 of
EQ -> r1 `compare` r2 EQ -> dup (r1 `compare` r2)
x -> x x -> dup x
_ -> GT _ -> dup GT
D.SymKS t1 D.SymKS t1
-> if tagToEnum# (getTag s2 ># 3#) -> if tagToEnum# (getTag s2 ># 3#)
then LT then dup LT
else case s2 of else case s2 of
D.SymKS t2 -> t1 `compareToken` t2 D.SymKS t2 -> t1 `compareToken` t2
_ -> GT _ -> dup GT
D.SymKP a1 b1 D.SymKP a1 b1
-> if tagToEnum# (getTag s2 ># 4#) -> if tagToEnum# (getTag s2 ># 4#)
then LT then dup LT
else case s2 of else case s2 of
D.SymKP a2 b2 D.SymKP a2 b2
-> case compare a1 a2 of -> case compare a1 a2 of
EQ -> b1 `compare` b2 EQ -> dup (b1 `compare` b2)
x -> x x -> dup x
_ -> GT _ -> dup GT
_ -> let t1 = getTag s1 _ -> let t1 = getTag s1
t2 = getTag s2 t2 = getTag s2
in if tagToEnum# (t1 <# t2) in if tagToEnum# (t1 <# t2)
then LT then dup LT
else if tagToEnum# (t1 ==# t2) else if tagToEnum# (t1 ==# t2)
then EQ then dup EQ
else GT else dup GT
compareToken [] [] = EQ compareToken [] [] = dup EQ
compareToken [] _ = LT compareToken [] _ = dup LT
compareToken _ [] = GT compareToken _ [] = dup GT
compareToken (x:xs) (y:ys) compareToken (x:xs) (y:ys)
| x == y = compareToken xs ys | x == y = compareToken xs ys
| otherwise = case compare (toLower x) (toLower y) of | otherwise = case compare (toLower x) (toLower y) of
EQ -> case compareToken xs ys of EQ -> case compareToken xs ys of
EQ -> compare x y (c,_) -> (c,compare x y)
x -> x c -> dup c
x -> x
dup x = (x,x)