File: monad001.y

package info (click to toggle)
happy 1.18.9-1
  • links: PTS, VCS
  • area: main
  • in suites: wheezy
  • size: 1,024 kB
  • sloc: haskell: 6,327; xml: 3,388; yacc: 809; makefile: 263
file content (92 lines) | stat: -rw-r--r-- 2,006 bytes parent folder | download | duplicates (5)
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
-- Testing %monad without %lexer, using the IO monad.

{
module Main where

import System.IO
import Data.Char
}

%name calc
%tokentype { Token }

%token 	num		{ TokenNum $$ }
	'+'		{ TokenPlus }
	'-'		{ TokenMinus }
	'*'		{ TokenTimes }
	'/'		{ TokenDiv }
	'^'		{ TokenExp }
	'\n'		{ TokenEOL }
	'('		{ TokenOB }
	')'		{ TokenCB }

%left '-' '+'
%left '*'
%nonassoc '/'
%left NEG     -- negation--unary minus
%right '^'    -- exponentiation

%monad { IO } { (>>=) } { return }

%%
input	: {- empty string -}   { () }
        | input line	      { $1 }

line	: '\n'		     { () }
        | exp '\n'  	     {% hPutStr stdout (show $1) }

exp	: num                { $1         }
        | exp '+' exp        { $1 + $3    }
        | exp '-' exp        { $1 - $3    }
        | exp '*' exp        { $1 * $3    }
        | exp '/' exp        { $1 / $3    }
        | '-' exp  %prec NEG { -$2        }
--        | exp '^' exp        { $1 ^ $3    }
        | '(' exp ')'        { $2         }

{
main = do
   calc (lexer "1 + 2 * 3 / 4\n")

    {-
   -- check that non-associative operators can't be used together
   r <- try (calc (lexer "1 / 2 / 3"))
   case r of 
       Left e  -> return ()
       Right _ -> ioError (userError "fail!")
-}

data Token
	= TokenExp
	| TokenEOL
	| TokenNum Double
	| TokenPlus
	| TokenMinus
	| TokenTimes
	| TokenDiv
	| TokenOB
	| TokenCB

-- and a simple lexer that returns this datastructure.

lexer :: String -> [Token]
lexer [] = []
lexer ('\n':cs) = TokenEOL : lexer cs
lexer (c:cs)
	| isSpace c = lexer cs
	| isDigit c = lexNum (c:cs)
lexer ('+':cs) = TokenPlus : lexer cs
lexer ('-':cs) = TokenMinus : lexer cs
lexer ('*':cs) = TokenTimes : lexer cs
lexer ('/':cs) = TokenDiv : lexer cs
lexer ('^':cs) = TokenExp : lexer cs
lexer ('(':cs) = TokenOB : lexer cs
lexer (')':cs) = TokenCB : lexer cs

lexNum cs = TokenNum (read num) : lexer rest
	where (num,rest) = span isNum cs
	      isNum c = isDigit c || c == '.'


happyError tokens = ioError (userError "parse error")
}