0votos

Analizador Lexico en Haskell

por josejuan hace 4 años

Este problema creo que se ha hecho ya varias veces (el típico en cursos de programación).

Resolucion de Expresiones algebraicas

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
118
{- 
    Este problema creo que se ha hecho ya varias veces (el típico 
    en cursos de programación). 
     
    La grámatica podría ser la siguiente: 
 
        EXPR0 = EXPR1 [ `+` EXPR0 | `-` EXPR0 ] 
        EXPR1 = EXPR2 [ `*` EXPR1 | `/` EXPR1 ] 
        EXPR2 = EXPR3 [ `^` EXPR2 ] 
        EXPR3 = `(` EXPR0 `)` | `-` EXPR0 | VAR | CONST 
 
    Y hacer un parser a mano es inmediato. 
-} 
import Data.Either 
import Data.Char 
import Control.Applicative hiding (Const) 
import Control.Arrow 
import Control.Monad 
 
-- Generaremos un árbol sintáctico. Sirve para cualquier tipo de dato: 
data Expr a = Const a 
            | Var String 
            | Add (Expr a) (Expr a) 
            | Sub (Expr a) (Expr a) 
            | Mul (Expr a) (Expr a) 
            | Div (Expr a) (Expr a) 
            | Pow (Expr a) (Expr a) 
            | Neg (Expr a) deriving Show 
 
-- Un helper para encadenar operaciones binarias a un nivel de prioridad: 
bin next symExps xs = next xs >>= \r@(ys, a) -> 
    case ys of 
      (z:zs) -> case filter ((z==).fst) symExps of 
                  ((_, exp):_) -> bin next symExps zs >>= return . second (exp a) 
                  _            -> return r 
      _ -> return r 
 
-- El parser es prácticamente una traslación directa de la gramática: 
expr0 = bin expr1 [('+', Add), ('-', Sub)] 
expr1 = bin expr2 [('*', Mul), ('/', Div)] 
expr2 = bin expr3 [('^', Pow)] 
expr3 (x:xs) 
    | x == '(' = expr0 xs >>= \(ys, a) -> case ys of 
                                            (')':zs) -> return (zs, a) 
                                            _        -> Left $ "`)` expected at `" ++ take 10 ys ++ "...`" 
    | x == '-' = expr0 xs >>= \(ys, a) -> return (ys, Neg a) 
    -- Obviamente para generalizar aquí debería parametrizarse el "parseador" de constantes 
    | isDigit x = return (dropWhile isDigit xs, Const $ read $ x: takeWhile isDigit xs) 
    | isAlpha x = return (dropWhile isAlpha xs, Var $ x: takeWhile isAlpha xs) 
expr3 xs = Left $ "Error at `" ++ take 10 xs ++ "...`" 
 
-- Ya tenemos el parser. 
 
-- Dado un árbol sintáctico, lo evalúa (enteros) usando un pool de variables 
eval :: [(String, Integer)] -> Expr Integer -> Either String Integer 
eval vars = e 
    where e (Const k) = return k 
          e (Var   v) = case filter ((v==).fst) vars of 
                            ((_, k):_) -> return k 
                            _          -> Left $ "Variable `" ++ v ++ "` not found" 
          e (Add a b) = e a >>= \k -> e b >>= return . (k+) 
          e (Sub a b) = e a >>= \k -> e b >>= return . (k-) 
          e (Mul a b) = e a >>= \k -> e b >>= return . (k*) 
          e (Div a b) = e a >>= \k -> e b >>= return . div k 
          e (Pow a b) = e a >>= \k -> e b >>= return . (k^) 
          e (Neg   a) = e a >>= return . ((-1)*) 
 
-- Ta tenemos todo el tinglado. 
 
-- Ahora, podemos hacer un pequeño interactivo: 
main = do 
    putStrLn "Introduzca expresión:" 
    r <- getLine >>= return . expr0 
    case r of 
        Left err -> putStrLn $ "ERROR de compilación: " ++ err 
        Right (rs, exp) -> do 
            if not (null rs) 
                then putStrLn $ "ATENCIÓN: no se parseó `" ++ take 10 rs ++ "...`" 
                else return () 
            case eval (zip (words "a b c d") [1..]) exp of 
                Left err -> putStrLn $ "ERROR de ejecución: " ++ err 
                Right  v -> putStrLn $ "Devolvió: " ++ show v 
    putStrLn "" 
    main 
 
{-- 
 
**** Por ejemplo, como se han creado las variables `a`, `b`, `c` y `d` **** 
 
D:\Projects\haskell>runghc calc.hs 
Introduzca expresión: 
3*b+b^3 
Devolvió: 14 
 
Introduzca expresión: 
2*(4+10) 
Devolvió: 28 
 
Introduzca expresión: 
a+r 
ERROR de ejecución: Variable `r` not found 
 
Introduzca expresión: 
5+ 
ERROR de compilación: Error at `...` 
 
Introduzca expresión: 
5+-4 
Devolvió: 1 
 
Introduzca expresión: 
5+*6 
ERROR de compilación: Error at `*6...` 
 
Introduzca expresión: 
 
 
--} 

Comenta la solución

Tienes que identificarte para poder publicar tu comentario.