diff options
| -rw-r--r-- | src/compiler/GF/Compile/ConcreteToHaskell.hs | 31 | ||||
| -rw-r--r-- | src/runtime/haskell/PGF/Haskell.hs | 44 |
2 files changed, 52 insertions, 23 deletions
diff --git a/src/compiler/GF/Compile/ConcreteToHaskell.hs b/src/compiler/GF/Compile/ConcreteToHaskell.hs index 9d870e68c..93becd16e 100644 --- a/src/compiler/GF/Compile/ConcreteToHaskell.hs +++ b/src/compiler/GF/Compile/ConcreteToHaskell.hs @@ -83,22 +83,14 @@ haskPreamble absname cncname = "import Control.Applicative((<$>),(<*>))" $$ "import qualified Data.Map as M" $$ "import Data.Map((!))" $$ + "import PGF.Haskell" $$ "import qualified" <+> absname <+> "as A" $$ "" $$ "--- Standard definitions ---" $$ - "class EnumAll a where enumAll :: [a]" $$ - "type Str = [Tok] -- token sequence" $$ - "type Prefix = String -- to match with prefix of following token" $$ - "type Simple = [String] -- Simple token sequence" $$ - hang "data Tok = TK String | TP [([Prefix],Simple)] Simple" 4 - "deriving (Eq,Ord,Show)" $$ "linString (A.GString s) = R_s [TK s]" $$ "linInt (A.GInt i) = R_s [TK (show i)]" $$ "linFloat (A.GFloat x) = R_s [TK (show x)]" $$ "" $$ ---"table is vs = let m = M.fromList (zip is vs) in (m!)" $$ - "table vs = let m = M.fromList (zip enumAll vs) in (m!)" $$ - "" $$ "----------------------------------------------------" $$ "-- Automatic translation from GF to Haskell follows" $$ "----------------------------------------------------" @@ -237,7 +229,7 @@ convert' atomic gId gr = if atomic then ppA else ppT Sort k -> pp k EInt n -> pp n Q (m,n) -> if m==cPredef - then ppPredef token n + then ppPredef n else pp (qual m n) QC (m,n) -> gId (qual m n) K s -> token s @@ -246,11 +238,11 @@ convert' atomic gId gr = if atomic then ppA else ppT Alts t' vs -> alts t' vs _ -> parens (ppT' True t) - ppPredef tok n = + ppPredef n = case predef n of - Ok BIND -> tok "&+" - Ok SOFT_BIND -> tok "SOFT_BIND" -- hmm - Ok CAPIT -> tok "CAPIT" -- hmm + Ok BIND -> brackets "BIND" + Ok SOFT_BIND -> brackets "SOFT_BIND" + Ok CAPIT -> brackets "CAPIT" _ -> pp n ppP p = @@ -273,16 +265,9 @@ convert' atomic gId gr = if atomic then ppA else ppT token s = brackets ("TK"<+>doubleQuotes s) - alts t' vs = brackets ("TP" <+> list' (map alt vs) <+> simple t') + alts t' vs = brackets ("TP" <+> list' (map alt vs) <+> ppT t') where - alt (t,p) = parens (show (pre p)<>","<>simple t) - - simple (K s) = brackets (doubleQuotes s) - simple (C t1 t2) = parens (simple t1 <+>"++"<+>simple t2) - simple (Q (m,n)) = if m==cPredef - then ppPredef simp n - else pp (qual m n) -- hmm !! - simp op = brackets (doubleQuotes op) + alt (t,p) = parens (show (pre p)<>","<>ppT t) pre (K s) = [s] pre (Strs ts) = concatMap pre ts diff --git a/src/runtime/haskell/PGF/Haskell.hs b/src/runtime/haskell/PGF/Haskell.hs new file mode 100644 index 000000000..8f5021bfe --- /dev/null +++ b/src/runtime/haskell/PGF/Haskell.hs @@ -0,0 +1,44 @@ +-- | Auxiliary types and functions for use with grammars translated to Haskell +-- with gf -output-format=haskell -haskell=concrete +module PGF.Haskell where +import Data.Char(toUpper) +import Data.List(isPrefixOf) +import qualified Data.Map as M + +-- | 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 | 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 False + where + from space cap ts = + case ts of + [] -> [] + TK s:ts -> put s++from True cap ts + BIND:ts -> from False cap ts + SOFT_BIND:ts -> from False cap ts + CAPIT:ts -> from space True ts + TP alts def:ts -> from space cap (pick alts def r++[TK r]) -- hmm + where r = fromStr ts + where + put s = [' '|space]++up s + up = if cap then toUpper1 else id + + toUpper1 (c:s) = toUpper c:s + toUpper1 s = s + + pick alts def r = head ([str|(ps,str)<-alts,any (`isPrefixOf` r) ps]++[def]) |