GitHub/gf-core
1
0
Fork 1
mirror of https://github.com/GrammaticalFramework/gf-core.git synced 2026-05-01 15:22:50 -06:00
Code Issues Packages Projects Releases Wiki Activity

manually copy the "c-runtime" branch from the old repository.

Browse Source
This commit is contained in:
Krasimir Angelov
2018-11-02 14:38:44 +01:00
parent bf5abe2948
commit 5a2b200948
80 changed files with 2618 additions and 1527 deletions
Download Patch File Download Diff File Expand all files Collapse all files

26
src/compiler/GF/Compile/PGFtoHaskell.hs
View File

@@ -16,13 +16,14 @@
module GF.Compile.PGFtoHaskell (grammar2haskell) where
import PGF(showCId)
import PGF
import PGF.Internal
import GF.Data.Operations
import GF.Infra.Option
import Data.List --(isPrefixOf, find, intersperse)
import Data.List
import Data.Maybe(mapMaybe)
import qualified Data.Map as Map
type Prefix = String -> String
@@ -39,7 +40,7 @@ grammar2haskell opts name gr = foldr (++++) [] $
lexical cat = haskellOption opts HaskellLexical && isLexicalCat opts cat
gId | haskellOption opts HaskellNoPrefix = id
| otherwise = ("G"++)
pragmas | gadt = ["{-# OPTIONS_GHC -fglasgow-exts #-}","{-# LANGUAGE GADTs #-}"]
pragmas | gadt = ["{-# OPTIONS_GHC -fglasgow-exts #-}"]
| otherwise = []
types | gadt = datatypesGADT gId lexical gr'
| otherwise = datatypes gId lexical gr'
@@ -262,18 +263,21 @@ fInstance gId lexical m (cat,rules) =
--type HSkeleton = [(OIdent, [(OIdent, [OIdent])])]
hSkeleton :: PGF -> (String,HSkeleton)
hSkeleton gr =
(showCId (absname gr),
(showCId (abstractName gr),
let fs =
[(showCId c, [(showCId f, map showCId cs) | (f, (cs,_)) <- fs]) |
fs@((_, (_,c)):_) <- fns]
[(showCId c, [(showCId f, map showCId cs) | (f, cs,_) <- fs]) |
fs@((_, _,c):_) <- fns]
in fs ++ [(sc, []) | c <- cts, let sc = showCId c, notElem sc (["Int", "Float", "String"] ++ map fst fs)]
)
where
cts = Map.keys (cats (abstract gr))
fns = groupBy valtypg (sortBy valtyps (map jty (Map.assocs (funs (abstract gr)))))
valtyps (_, (_,x)) (_, (_,y)) = compare x y
valtypg (_, (_,x)) (_, (_,y)) = x == y
jty (f,(ty,_,_,_)) = (f,catSkeleton ty)
cts = categories gr
fns = groupBy valtypg (sortBy valtyps (mapMaybe jty (functions gr)))
valtyps (_,_,x) (_,_,y) = compare x y
valtypg (_,_,x) (_,_,y) = x == y
jty f = case functionType gr f of
Just ty -> let (hypos,valcat,_) = unType ty
in Just (f,[argcat | (_,_,ty) <- hypos, let (_,argcat,_) = unType ty],valcat)
Nothing -> Nothing
{-
updateSkeleton :: OIdent -> HSkeleton -> (OIdent, [OIdent]) -> HSkeleton
updateSkeleton cat skel rule =