]> Git — Sourcephile - haskell/symantic.git/blob - symantic/Language/Symantic/Interpreting/Text.hs
Backtrack (try) the grammar only when necessary to get better error messages.
[haskell/symantic.git] / symantic / Language / Symantic / Interpreting / Text.hs
1 {-# LANGUAGE UndecidableInstances #-}
2 -- | Interpreter to serialize an expression into a 'Text'.
3 module Language.Symantic.Interpreting.Text where
4
5 import Data.Text (Text)
6 import qualified Data.Text as Text
7 import Prelude hiding (Integral(..))
8
9 import Language.Symantic.Grammar
10
11 -- * Type 'TextI'
12
13 -- | Interpreter's data.
14 newtype TextI h
15 = TextI
16 { unTextI -- Inherited attributes:
17 :: (Infix, LR)
18 -> TextI_Lambda_Depth
19 -- Synthetised attributes:
20 -> Text
21 }
22 type TextI_Lambda_Depth = Int
23 instance Show (TextI h) where
24 show = Text.unpack . text_from_term
25
26 -- | Interpreter.
27 text_from_term :: TextI h -> Text
28 text_from_term r = unTextI r (infixN0, L) 0
29
30 -- * Helpers
31
32 -- ** Helpers for lambda applications
33 textI0 :: Text -> TextI h
34 textI0 name = TextI $ \_op _v -> name
35 textI1 :: Text -> TextI a1 -> TextI h
36 textI1 name (TextI a1) = TextI $ \po v ->
37 infix_paren po op $
38 Text.intercalate " "
39 [ name
40 , a1 (op, L) v
41 ]
42 where op = infixN 10
43 textI2 :: Text -> TextI a1 -> TextI a2 -> TextI h
44 textI2 name (TextI a1) (TextI a2) =
45 TextI $ \po v ->
46 infix_paren po op $
47 Text.intercalate " "
48 [ name
49 , a1 (op, L) v
50 , a2 (op, L) v
51 ]
52 where op = infixN 10
53 textI3 :: Text -> TextI a1 -> TextI a2 -> TextI a3 -> TextI h
54 textI3 name (TextI a1) (TextI a2) (TextI a3) =
55 TextI $ \po v ->
56 infix_paren po op $
57 Text.intercalate " "
58 [ name
59 , a1 (op, L) v
60 , a2 (op, L) v
61 , a3 (op, L) v
62 ]
63 where op = infixN 10
64
65 textI_infix :: Text -> Infix -> TextI a1 -> TextI a2 -> TextI h
66 textI_infix name op (TextI a1) (TextI a2) =
67 TextI $ \po v ->
68 infix_paren po op $
69 Text.intercalate " "
70 [ a1 (op, L) v
71 , name
72 , a2 (op, R) v
73 ]