forked from strake/frown
-
Notifications
You must be signed in to change notification settings - Fork 0
/
Copy pathQuote.lhs
117 lines (100 loc) · 5.87 KB
/
Quote.lhs
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
% %
% Frown --- An LALR(k) parser generator for Haskell 98 %
% Copyright (C) 2001-2005 Ralf Hinze %
% %
% This program is free software; you can redistribute it and/or modify %
% it under the terms of the GNU General Public License (version 2) as %
% published by the Free Software Foundation. %
% %
% This program is distributed in the hope that it will be useful, %
% but WITHOUT ANY WARRANTY; without even the implied warranty of %
% MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the %
% GNU General Public License for more details. %
% %
% You should have received a copy of the GNU General Public License %
% along with this program; see the file COPYING. If not, write to %
% the Free Software Foundation, Inc., 59 Temple Place - Suite 330, %
% Boston, MA 02111-1307, USA. %
% %
% Contact information %
% Email: Ralf Hinze <[email protected]> %
% Homepage: http://www.informatik.uni-bonn.de/~ralf/ %
% Paper mail: Dr. Ralf Hinze %
% Institut für Informatik III %
% Universität Bonn %
% Römerstraße 164 %
% 53117 Bonn, Germany %
% %
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
> module Quote ( unquotify )
> where
> import Lexer
> import System.IO
> import Options
Simple facility for a Haskell quote/unquote mechanism:
{ ...
... %{
...... { ... }
... }%
}
> rquote, runquote :: Token
> rquote = RQuote
> runquote = Special '}'
>
> isLUnquoteOrRQuote :: Token -> Bool
> isLUnquoteOrRQuote (Special '{')
> = True
> isLUnquoteOrRQuote RQuote = True
> isLUnquoteOrRQuote _ = False
> unquotify :: [Flag] -> [Token] -> IO [Token]
> unquotify opts ts = do verb "* Quote/unquote ..."
> verb (" " ++ show (length ts') ++ " tokens")
> return ts'
> where
> (cs, us) = unquote 0 ts
> ts' = cs ++ [ Error ("quote/unquote error: incomplete parse"
> ++ "\n<...> " ++ next 3 (concatMap toString ts))
> | not (null us) ]
> verb = verbose opts
TODO: what happens if |ts| contains a lexical error?
> unquote :: Int -> [Token] -> ([Token], [Token])
> unquote n ts = let (us, vs, n') = lquote n ts
> in if null vs || head vs == runquote then
> (us, vs)
> else
> let (qs, ws) = quote (tail vs)
> xs = literal rquote ws
> (uqs, ys) = unquote n' xs
> in (us ++ [Quote qs ] ++ uqs, ys)
> quote :: [Token] -> ([Token], [Token])
> quote ts = let (us, vs) = break isLUnquoteOrRQuote ts
> in if null vs || head vs == rquote then
> (us, vs)
> else
> let (qs, ws) = unquote 0 (tail vs)
> xs = literal runquote ws
> (uqs, ys) = quote xs
> in (us ++ [Unquote qs] ++ uqs, ys)
> literal :: Token -> [Token] -> [Token]
> literal x [] = expected x [EOF]
> literal x (t : ts)
> | t == x = ts
> | otherwise = expected x ts
> expected :: Token -> [Token] -> [Token]
> expected x ts = [Error ("quote/unquote error: expected `" ++ toString x ++ "'"
> ++ "\n<...> " ++ next 3 (concatMap toString ts))]
Breaks at the point where it finds the first left quote or the
first unmatched right unquote.
> lquote :: Int -> [Token] -> ([Token], [Token], Int)
> lquote n (LQuote : ts) = ([], LQuote : ts, n)
> lquote 0 (Special '}' : ts) = ([], Special '}' : ts, 0)
> lquote (n + 1) (Special '}' : ts)
> = Special '}' <| lquote n ts
> lquote n (Special '{' : ts) = Special '{' <| lquote (n + 1) ts
> lquote n [] = ([], [], n)
> lquote n (t : ts) = t <| lquote n ts
> (<|) :: a -> ([a], x, y) -> ([a], x, y)
> a <| (as, x, y) = (a : as, x, y)
readFile "Expr.g" >>= \ s -> print ((unquotify @@ tokenize) s)
print ((unquotify @@ tokenize) "hello %{ world }%")