Merge branch 'master' into lpgf

# Conflicts:
#	gf.cabal
This commit is contained in:
John J. Camilleri
2021-07-08 12:25:46 +02:00
8 changed files with 59 additions and 49 deletions

View File

@@ -27,6 +27,10 @@ instance Predef Int where
instance Predef Bool where
toValue = boolV
fromValue v = case v of
VCApp (cPredef,cPTrue) [] -> return True
VCApp (cPredef,cPFalse) [] -> return False
_ -> verror "Bool" v
instance Predef String where
toValue = string

View File

@@ -437,7 +437,7 @@ wc_type = cmd_name
x2 = takeWhile (\c -> isIdent c || isSpace c || c == '-' || c == '=' || c == '"') x1
cmd = case [x | (x,cs) <- RP.readP_to_S pCommand x2, all isSpace cs] of
[x] -> Just x
[x] -> Just x
_ -> Nothing
isIdent c = c == '_' || c == '\'' || isAlphaNum c

View File

@@ -23,10 +23,10 @@ data Fun = Fun { fname:: FunId, ftype:: Type }
data Concrete = Concrete { langcode:: Id,
opens:: [ModId],
params:: [Param],
lincats:: [Lincat],
opers:: [Oper],
lins:: [Lin] }
params:: [Param],
lincats:: [Lincat],
opers:: [Oper],
lins:: [Lin] }
deriving Show
data Param = Param {pname:: Id, prhs:: String} deriving Show

View File

@@ -28,7 +28,7 @@ instance Binary PGF where
let v = (major,minor)
if major==pgfMajorVersion && minor<=pgfMinorVersion
then getPGF'
else if v==Old.version
else if v==Old.version
then Old.getPGF'
else fail $ "Unsupported PGF version "++show (major,minor)
@@ -185,6 +185,7 @@ instance Binary Instr where
put (PUSH_ACCUM (LFlt d)) = putWord8 78 >> put d
put (POP_ACCUM ) = putWord8 80
put (ADD ) = putWord8 84
get = fail "Missing implementation for get in the instance declaration for Binary Instr"
instance Binary Type where
put (DTyp hypos cat exps) = put (hypos,cat,exps)

View File

@@ -14,17 +14,19 @@ tested-with: GHC==7.10.3, GHC==8.0.2, GHC==8.10.4
library
default-language: Haskell2010
build-depends:
base >= 4.9.1 && < 4.15,
array >= 0.5.1 && < 0.6,
containers >= 0.5.7 && < 0.7,
base >= 4.9.1 && < 4.15,
bytestring >= 0.10.8 && < 0.11,
utf8-string >= 1.0.1.1 && < 1.1,
random >= 1.1 && < 1.3,
pretty >= 1.1.3 && < 1.2,
mtl >= 2.2.1 && < 2.3,
containers >= 0.5.7 && < 0.7,
ghc-prim >= 0.5.0 && < 0.7,
-- For compatability with GHC < 8
fail >= 4.9.0 && < 4.10
mtl >= 2.2.1 && < 2.3,
pretty >= 1.1.3 && < 1.2,
random >= 1.1 && < 1.3,
utf8-string >= 1.0.1.1 && < 1.1
if impl(ghc<8.0)
build-depends:
fail >= 4.9.0 && < 4.10
other-modules:
-- not really part of GF but I have changed the original binary library

View File

@@ -6,9 +6,9 @@ import Data.Char (chr,digitToInt,isHexDigit)
-- | Decode hexadecimal escapes
urlDecodeUnicode :: String -> String
urlDecodeUnicode [] = ""
urlDecodeUnicode ('%':'u':x1:x2:x3:x4:s)
urlDecodeUnicode ('%':'u':x1:x2:x3:x4:s)
| all isHexDigit [x1,x2,x3,x4] =
chr ( digitToInt x1 `shiftL` 12
chr ( digitToInt x1 `shiftL` 12
.|. digitToInt x2 `shiftL` 8
.|. digitToInt x3 `shiftL` 4
.|. digitToInt x4) : urlDecodeUnicode s
@@ -45,8 +45,8 @@ fromhex2 d1 d2 = 16*digitToInt d1+digitToInt d2
-- Repeatedly extract (and transform) values until a predicate hold. Return the list of values.
unfoldr :: (a -> (b, a)) -> (a -> Bool) -> a -> [b]
unfoldr f p x | p x = []
| otherwise = y:unfoldr f p x'
where (y, x') = f x
| otherwise = y:unfoldr f p x'
where (y, x') = f x
chopList :: ([a] -> (b, [a])) -> [a] -> [b]
chopList f l = unfoldr f null l
@@ -54,8 +54,8 @@ chopList f l = unfoldr f null l
breakAt :: (Eq a) => a -> [a] -> ([a], [a])
breakAt _ [] = ([], [])
breakAt x (x':xs) =
if x == x' then
([], xs)
else
let (ys, zs) = breakAt x xs
in (x':ys, zs)
if x == x' then
([], xs)
else
let (ys, zs) = breakAt x xs
in (x':ys, zs)

View File

@@ -13,14 +13,14 @@ fold t =
case unApp t of
Just (i,[x]) ->
case M.lookup i foldable of
Just j -> appFold j x
_ -> mkApp i [fold x]
Just j -> appFold j x
_ -> mkApp i [fold x]
Just (i,xs) -> mkApp i $ map fold xs
_ -> t
appFold :: CId -> Tree -> Tree
appFold j t =
appFold j t =
case unApp t of
Just (i,[t,ts]) | isPre i "Cons" -> mkApp j [fold t, appFold j ts]
Just (i,[t,s]) | isPre i "Base" -> mkApp j [fold t, fold s]
where isPre i s = take 4 (show i) == s
where isPre i s = take 4 (show i) == s