mirror of
https://github.com/GrammaticalFramework/gf-core.git
synced 2026-04-16 16:29:32 -06:00
80 lines
2.3 KiB
Haskell
80 lines
2.3 KiB
Haskell
-- | Auxiliary types and functions for use with grammars translated to Haskell
|
|
-- with @gf -output-format=haskell -haskell=concrete@
|
|
{-# LANGUAGE MultiParamTypeClasses, FunctionalDependencies, FlexibleInstances #-}
|
|
module PGF.Haskell where
|
|
import Control.Applicative((<$>),(<*>))
|
|
import Control.Monad(join)
|
|
import Data.Char(toUpper)
|
|
import Data.List(isPrefixOf)
|
|
import qualified Data.Map as M
|
|
|
|
-- ** Concrete syntax
|
|
|
|
-- | For enumerating parameter values used in tables
|
|
class EnumAll a where enumAll :: [a]
|
|
|
|
-- | Tables
|
|
table vs = let m = M.fromList (zip enumAll vs) in (M.!) m
|
|
|
|
|
|
-- | Token sequences, output form linearization functions
|
|
type Str = [Tok] -- token sequence
|
|
|
|
-- | Tokens
|
|
data Tok = TK String | TP [([Prefix],Str)] Str | BIND | SOFT_BIND | SOFT_SPACE | CAPIT | ALL_CAPIT
|
|
deriving (Eq,Ord,Show)
|
|
|
|
type Prefix = String -- ^ To be matched with the prefix of a following token
|
|
|
|
-- | Render a token sequence as a 'String'
|
|
fromStr :: Str -> String
|
|
fromStr = from False id
|
|
where
|
|
from space cap ts =
|
|
case ts of
|
|
[] -> []
|
|
TK "":ts -> from space cap ts
|
|
TK s:ts -> put s++from True cap ts
|
|
BIND:ts -> from False cap ts
|
|
SOFT_BIND:ts -> from False cap ts
|
|
SOFT_SPACE:ts -> from True cap ts
|
|
CAPIT:ts -> from space toUpper1 ts
|
|
ALL_CAPIT:ts -> from space toUpperAll ts
|
|
TP alts def:ts -> from space cap (pick alts def r++[TK r]) -- hmm
|
|
where r = fromStr ts
|
|
where
|
|
put s = [' '|space]++cap s
|
|
|
|
toUpper1 (c:s) = toUpper c:s
|
|
toUpper1 s = s
|
|
|
|
toUpperAll = map toUpper
|
|
|
|
pick alts def r = head ([str|(ps,str)<-alts,any (`isPrefixOf` r) ps]++[def])
|
|
|
|
-- *** Common record types
|
|
|
|
-- | Overloaded function to project the @s@ field from any record type
|
|
class Has_s r a | r -> a where proj_s :: r -> a
|
|
|
|
-- | Haskell representation of the GF record type @{s:t}@
|
|
data R_s t = R_s t deriving (Eq,Ord,Show)
|
|
instance (EnumAll t) => EnumAll (R_s t) where enumAll = R_s <$> enumAll
|
|
instance Has_s (R_s t) t where proj_s (R_s t) = t
|
|
|
|
-- | Coerce from any record type @{...,s:t,...}@ to the supertype @{s:t}@
|
|
to_R_s r = R_s (proj_s r)
|
|
|
|
|
|
-- *** Variants
|
|
|
|
infixr 5 +++
|
|
|
|
-- | Concatenation with variants
|
|
xs +++ ys = (++) <$> xs <*> ys
|
|
|
|
-- | Selection from tables with variants
|
|
t ! p = join (t p)
|
|
t !$ p = join (t <$> p)
|
|
t !* p = join (t <*> p)
|