Différents langages à parser

• les maths à pile (notation polonaise inversée) : "1 2 +" signifie 1 + 2, "1 2 3 * +" signifie 1 + (2 * 3), "1 2 * 3 +" signifie (1 * 2) + 3, etc.
• les maths en arbre (notation polonaise), la même chose à l'envers : "+ 1 2", "+ 1 * 2 3", "+ * 1 2 3", etc.
• les maths en LISP (et pas en slip) : comme la notation à pile, mais avec des parenthèses, et on peut mettre plus de nombres par opérations : "(* (+ 1 2 3) (- 4 5))" signifie (1 + 2 + 3) * (4 - 5), "(- 1 2 3)" signifie (1 - 2 - 3), etc.
• les maths comme d'habitude : "1 + 2 * 3", "(1 + 2) + (3 * 4 - 5) / 6", etc. Attention à la priorité des opérateurs !
• Les maths comme d'habitude, mais avec l'opérateur "puissance", ^, en plus. Attention, "2^3^4" => 2^(3^4) !

Règles

Citation : Conseils

On veut le code, on veut tripoter

Publiez toujours la source de votre programme (normalement vous n'avez besoin de donner rien d'autre); il faudrait, dans la mesure du possible, que chacun puisse l'essayer chez soi (donc évitez les langages propriétaires, les machins pas portables du tout, etc.).

Essayez de présenter votre source de la manière la plus lisible et la plus claire possible (pas de "oh j'ai pas eu le temps de mettre des vrais noms de variables"); sinon, vous vous exposez aux commentaires du public, et ça peut vous poursuivre pendant longtemps (hein delroth ?).

Les autres participants peuvent reprendre la source, la modifier, l'améliorer, etc. On n'impose pas de licence ou quoi (et si vous précisez une licence libre elle sera respectée, enfin j'espère), mais si vous n'êtes pas prêts à vous faire tripoter, ne postez rien.

Éviter les répétitions

Si vous avez fait un programme dans votre langage préféré, mais qu'il existe déjà une proposition pour ce langage (ou un langage quasiment identique) et que le votre n'apporte visiblement rien, vous pouvez vous retenir de poster. Cherchez plutôt un aspect intéressant à explorer (une optimisation, etc.).

Le but c'est surtout d'avoir un certain nombre de versions intéressantes à comparer, et de pouvoir voir par exemple les forces ou les faiblesses de certains langages ou styles de programmation. Pas de montrer à tout le monde qu'on est le meilleur programmeur de la planète (même si c'est cool aussi).

let op_position a chaine = 
  let rec aux a chaine n lvl = 
    let taille = String.length chaine in
      if chaine = "" then -1
      else match chaine.[0] with
	| '(' -> aux a (String.sub chaine 1 (taille - 1)) (n+1) (lvl+1)
	| ')' -> aux a (String.sub chaine 1 (taille - 1)) (n+1) (lvl-1)
	| _ -> 
	    if chaine.[0] = a & lvl = 0 then n
	    else aux a (String.sub chaine 1 (taille - 1)) (n+1) lvl in
    aux a chaine 0 0
let rec calculer chaine =
  try int_of_string chaine with 
    | _ -> 
	let taille = String.length chaine in
	let rec aux chars ops chaine =
	    if chars = [] then calculer (String.sub chaine 1 (taille-2))
	    else 
	      let taille = String.length chaine in
	      let pos = op_position (List.hd chars) chaine in
		if (pos <> -1) then 
		  ((List.hd ops) (calculer (String.sub chaine 0 pos))
		     (calculer (String.sub chaine (pos+1) (taille-pos-1))))
		else aux (List.tl chars) (List.tl ops) chaine
	  in aux ['+';'-';'*'] [( + );( - );( * )] chaine

let rec parse stack = parser
| [< '( ' ' | '\t' | '\n'); rest >] -> parse stack rest
| [< n = parse_chiffre; num = parse_int n; rest >] -> parse (num :: stack) rest
| [< op = parse_op; rest >] ->
    let (a::b::stack) = stack in parse (op a b :: stack) rest
| [< >] -> stack
and parse_int n = parser
| [< k = parse_chiffre; rest >] -> parse_int (n * 10 + k) rest
| [< >] -> n
and parse_chiffre = parser
| [< ' ('0' .. '9') as chiffre >] -> int_of_char chiffre - int_of_char '0'
and parse_op = parser
| [< ''+' >] -> (+)
| [< ''-' >] -> (-)
| [< ''*' >] -> ( * )
| [< ''/' >] -> (/)

let () =
  let entree = Stream.of_channel stdin in
  let [resultat] = parse [] entree in
  Stream.empty entree;
  print_int resultat; print_newline ()

open Genlex
let lexer input = make_lexer ["+";"-";"*";"/"] input

let rec parse stack = parser
| [< '(Int n); rest >] -> parse (n :: stack) rest
| [< '(Kwd op); rest >] ->
    let a::b::stack = stack in parse (op_fn op a b :: stack) rest
| [< >] -> stack
and op_fn = function
| "+" -> (+) | "-" -> (-) | "*" -> ( * ) | "/" -> (/)

let () =
  let entree = lexer (Stream.of_channel stdin) in
  let [resultat] = parse [] entree in
  Stream.empty entree;
  print_int resultat; print_newline ()

let op_position a chaine = 
  let rec aux a chaine n lvl = 
    let taille = String.length chaine in
      if chaine = "" then -1
      else match chaine.[0] with
	| '(' -> aux a (String.sub chaine 1 (taille - 1)) (n+1) (lvl+1)
	| ')' -> aux a (String.sub chaine 1 (taille - 1)) (n+1) (lvl-1)
	| _ -> 
	    if chaine.[0] = a & lvl = 0 then n
	    else aux a (String.sub chaine 1 (taille - 1)) (n+1) lvl in
    aux a chaine 0 0
let rec calculer chaine =
  try int_of_string chaine with 
    | _ -> 
	let taille = String.length chaine in
	let rec aux chars ops chaine =
	    if chars = [] then calculer (String.sub chaine 1 (taille-2))
	    else 
	      let taille = String.length chaine in
	      let pos = op_position (List.hd chars) chaine in
		if (pos <> -1) then 
		  ((List.hd ops) (calculer (String.sub chaine 0 pos))
		     (calculer (String.sub chaine (pos+1) (taille-pos-1))))
		else aux (List.tl chars) (List.tl ops) chaine
	  in aux ['+';'-';'*'] [( + );( - );( * )] chaine
let eval chaine = 
  let s = Str.global_replace (Str.regexp "-\\([0-9]\\)") "+(0-\\1)" "1-2-3" in
    calculer s

type arbre = Num of int
             | Op of arbre * op * arbre
and op = int -> int -> int

let rec parse = parser
| [< '( ' ' | '\t' | '\n'); rest >] -> parse rest
| [< n = parse_chiffre; num = parse_int n >] -> Num num
| [< op = parse_op; a = parse; b = parse >] -> Op (a, op, b)
and parse_int n = parser
| [< k = parse_chiffre; rest >] -> parse_int (n * 10 + k) rest
| [< >] -> n
and parse_chiffre = parser
| [< ' ('0' .. '9') as chiffre >] -> int_of_char chiffre - int_of_char '0'
and parse_op = parser
| [< ''+' >] -> (+)
| [< ''-' >] -> (-)
| [< ''*' >] -> ( * )
| [< ''/' >] -> (/)

let rec eval = function
| Num n -> n
| Op (a, op, b) -> op (eval a) (eval b)

let () =
  let entree = Stream.of_channel stdin in
  let resultat = parse entree in
  print_int (eval resultat); print_newline ()

let rec parse = parser
| [< '( ' ' | '\t' | '\n'); rest >] -> parse rest
| [< n = parse_chiffre; num = parse_int n >] -> num
| [< op = parse_op; a = parse; b = parse >] -> op a b
and parse_int n = parser
| [< k = parse_chiffre; rest >] -> parse_int (n * 10 + k) rest
| [< >] -> n
and parse_chiffre = parser
| [< ' ('0' .. '9') as chiffre >] -> int_of_char chiffre - int_of_char '0'
and parse_op = parser
| [< ''+' >] -> (+)
| [< ''-' >] -> (-)
| [< ''*' >] -> ( * )
| [< ''/' >] -> (/)

let () =
  let entree = Stream.of_channel stdin in
  let resultat = parse entree in
  print_int resultat; print_newline ()

#!/usr/bin/env python3

from collections import namedtuple
from operator import add, sub, mul, floordiv

precs = {
    '+': 10,
    '-': 10,
    '*': 9,
    '/': 9
}
funcs = {
    '+': add,
    '-': sub,
    '*': mul,
    '/': floordiv
}

Token = namedtuple('Token', 'type value')

def tokenize(expr):
    expr = expr.replace(' ', '')
    i = 0
    while i < len(expr):
        if expr[i].isdigit():
            n = 0
            while i < len(expr) and expr[i].isdigit():
                n = n * 10 + int(expr[i])
                i += 1
            yield Token(type='int', value=n)
            i -= 1
        elif expr[i] in precs:
            yield Token(type='op', value=expr[i])
        elif expr[i] == '(':
            yield Token(type='lparen', value=None)
        elif expr[i] == ')':
            yield Token(type='rparen', value=None)
        else:
            raise ValueError('unexpected character {0}'.format(expr[i]))
        i += 1

def eval_rpn(rpn):
    st = []
    for tok in rpn:
        if tok.type == 'int':
            st.append(tok.value)
        elif tok.type == 'op':
            if len(st) < 2:
                raise ValueError('missing operand')
            v2 = st.pop()
            v1 = st.pop()
            st.append(funcs[tok.value](v1, v2))
        else:
            raise RuntimeError('wtf?')
    if len(st) == 1:
        return st[0]
    else:
        raise ValueError('missing operator')

def eval_infix(expr):
    rpn = []
    ops_stack = []
    for tok in tokenize(expr):
        if tok.type == 'int':
            rpn.append(tok)
        elif tok.type == 'op':
            while ops_stack and ops_stack[-1].type == 'op' and \
                    precs[tok.value] <= precs[ops_stack[-1].value]:
                rpn.append(ops_stack.pop())
            ops_stack.append(tok)
        elif tok.type == 'lparen':
            ops_stack.append(tok)
        else:
            while ops_stack[-1].type != 'lparen':
                rpn.append(ops_stack.pop())
                if not ops_stack:
                    raise ValueError('missing left parenthesis')
            ops_stack.pop()
    while ops_stack:
        if ops_stack[-1].type == 'lparen':
            raise ValueError('missing right parenthesis')
        rpn.append(ops_stack.pop())
    return eval_rpn(rpn)

import ast
eval_infix = ast.literal_eval

#!/usr/bin/env python3

from collections import namedtuple
from operator import add, sub, mul, floordiv, pow

leftassoc = {
    '+': True,
    '-': True,
    '*': True,
    '/': True,
    '^': False
}
precs = {
    '+': 10,
    '-': 10,
    '*': 9,
    '/': 9,
    '^': 20
}
funcs = {
    '+': add,
    '-': sub,
    '*': mul,
    '/': floordiv,
    '^': pow
}

Token = namedtuple('Token', 'type value')

def tokenize(expr):
    expr = expr.replace(' ', '')
    i = 0
    while i < len(expr):
        if expr[i].isdigit():
            n = 0
            while i < len(expr) and expr[i].isdigit():
                n = n * 10 + int(expr[i])
                i += 1
            yield Token(type='int', value=n)
            i -= 1
        elif expr[i] in precs:
            yield Token(type='op', value=expr[i])
        elif expr[i] == '(':
            yield Token(type='lparen', value=None)
        elif expr[i] == ')':
            yield Token(type='rparen', value=None)
        else:
            raise ValueError('unexpected character {0}'.format(expr[i]))
        i += 1

def eval_rpn(rpn):
    st = []
    for tok in rpn:
        if tok.type == 'int':
            st.append(tok.value)
        elif tok.type == 'op':
            if len(st) < 2:
                raise ValueError('missing operand')
            v2 = st.pop()
            v1 = st.pop()
            st.append(funcs[tok.value](v1, v2))
        else:
            raise RuntimeError('wtf?')
    if len(st) == 1:
        return st[0]
    else:
        raise ValueError('missing operator')

def should_move_op(o1, o2):
    if not leftassoc[o1]:
        return precs[o1] < precs[o2]
    else:
        return precs[o1] <= precs[o2]

def eval_infix(expr):
    rpn = []
    ops_stack = []
    for tok in tokenize(expr):
        if tok.type == 'int':
            rpn.append(tok)
        elif tok.type == 'op':
            while ops_stack and ops_stack[-1].type == 'op' and \
                    should_move_op(tok.value, ops_stack[-1].value):
                rpn.append(ops_stack.pop())
            ops_stack.append(tok)
        elif tok.type == 'lparen':
            ops_stack.append(tok)
        else:
            while ops_stack[-1].type != 'lparen':
                rpn.append(ops_stack.pop())
                if not ops_stack:
                    raise ValueError('missing left parenthesis')
            ops_stack.pop()
    while ops_stack:
        if ops_stack[-1].type == 'lparen':
            raise ValueError('missing right parenthesis')
        rpn.append(ops_stack.pop())
    return eval_rpn(rpn)

perl -lne 'my@s;sub f{$a=pop@s;$b=pop@s;eval sprintf(q{push@s,%s%s%s},$a,shift,$b)};split/\s+/;for$x(@_){if($x=~/\d/){unshift@s,$x}elsif(grep{$x eq$_}qw[+ - * /]){f$x}};print@s'

#!/usr/bin/perl -l

use strict;
use warnings;

my @stack;
sub eval_op {
    my ($x, $y) = (pop @stack, pop @stack);
    my $code = sprintf( q[push @stack ,%s %s %s], $x, shift, $y );
    eval $code;
}

while (my $line = <STDIN>) {
    my @line = split /\s+/, $line;
    for my $tok (@line) {
        if ($tok =~ /\d/) { unshift @stack, $tok }
        elsif (grep { $tok eq $_ } qw[+ - * /]) { eval_op $tok }
        else { die "Bad token" }
    }
    print @stack;
    undef @stack;
}

#-*- coding:Latin-1 -*-

from Tkinter import *

def evaluer():
    operation =entree.get()
    entree.delete(0, END)
    entree.insert(END, str(eval(operation)))

fen = Tk()
fen.title('Calc')

entree = Entry(fen)
entree.grid(row = 0, columnspan = 3)

Button (fen, text = '=', width =3, command =evaluer).grid(row =2, column =2)

fen.mainloop()

>>> eval("2^3")
1

#include <iostream>
#include <stack>
#include <string>

using namespace std;

bool isOp(char c){
    string op = "+-/*";
    if(op.find(c) != string::npos)
        return true;

    return false;
}

void interprete(string epf){
    stack<int> stack;
    int val1 = 0, val2 = 0, res = 0;

    for(unsigned int i = 0; i < epf.length(); i++){
        if(!isOp(epf.at(i)))
            stack.push(epf.at(i) - '0');
        else{
            val1 = stack.top();
            stack.pop();

            val2 = stack.top();
            stack.pop();

            switch(epf.at(i)){
                case '+':
                    res = val2 + val1;
                break;

                case '-':
                    res = val2 - val1;
                break;

                case '*':
                    res = val2 * val1;
                break;

                case '/':
                    res = val2 / val1;
                break;
            }

            stack.push(res);
        }
    }

    cout << "Resultat : " << stack.top() << endl;
}

int main(){
    string epf;

    cout << "Entrez votre expression : ";
    cin >> epf;

    interprete(epf);

    return 0;
}

open Genlex
let lexer = make_lexer [ "+"; "-"; "*"; "/"; "^"; "("; ")" ]

(* generic parsers *)
let rec op_right opfunc operators next_level = parser
  | [< e = next_level; s >] -> match s with parser
      | [< 'Kwd op when List.mem op operators;
           e' = op_right opfunc operators next_level >] -> opfunc op e e'
      | [< >] -> e
and op_left opfunc operators next_level =
  let rec loop e = parser
    | [< 'Kwd op when List.mem op operators;
         e' = next_level; s >] -> loop (opfunc op e e') s
    | [< >] -> e in
  parser [< acc = next_level; e = loop acc >] -> e

(* mathematical grammar *)
let rec parse stream = sum_expr stream
and sum_expr s = op_left binop ["+"; "-"] mul_expr s
and mul_expr s = op_left binop ["*"; "/"] pow_expr s
and pow_expr s = op_right binop ["^"] simple_expr s
and simple_expr = parser
| [< 'Int n >] -> n
| [< '(Kwd "("); e = parse; '(Kwd ")") >] -> e
and binop = function
| "+" -> (+) | "-" -> (-) | "/" -> (/)
| "*" -> ( * )
| "^" ->
    let rec pow a = function
    | 0 -> 1
    | n -> pow (a * a) (n / 2) * (if n mod 2 = 0 then 1 else a) in
    pow

let () =
  let result = parse (lexer (Stream.of_channel stdin)) in
  print_int result; print_newline ()

if expr[i].isdigit():
            n = 0
            while i < len(expr) and expr[i].isdigit():
                n = n * 10 + int(expr[i])
                i += 1

#include <stdio.h>
#include <stdlib.h>
#include <string.h>

#define MAX 256

/* ################################## */

int pile[MAX];
int taille_pile;

void push(int i)
{
     pile[taille_pile++] = i;
}

/* un appel a getList() vide la pile */
int getList(int **p)
{
     int tmp = taille_pile;
     taille_pile = 0;
     *p = pile;
     return tmp;
}

/* ################################## */

typedef enum { NOMBRE, OPERATEUR } Type;
typedef struct {
     Type type;
     union
     {
	  int n;
	  char op;
     } v;
} Elemt;

/* facon strtok() */
int nextElemt(char* expression,Elemt *e)
{
     static char* p = NULL;
     char* suite = NULL;
     int ret = 1;
     long n;
     char op;

     if(expression)
	  p = expression;

     n = strtol(p,&suite,10);
     /* une conversion reussi ? */
     if(suite != p)
     {
	  e->type = NOMBRE;
	  e->v.n = n;
	  p = suite;
     }
     /* un operateur ? */
     else if(sscanf(p," %c",&op)==1 && strchr("+-/*",op))
     {
	  e->type = OPERATEUR;
	  e->v.op = op;
	  p = strchr(p,op) + 1;
     }

     else if(!*p) /* fin de chaine, RAS */
	  ret = 0;
     else  /* caractere inconnu */
	  ret = -1;
	  
     return ret;
}

/* ################################## */

int calc(int a, int b, char op)
{
     int ret = 0;
     switch(op)
     {
     case '+':
	  ret = a+b;
	  break;

     case '-':
	  ret = a-b;
	  break;

     case '*':
	  ret = a*b;
	  break;

     case '/':
	  ret = a/b;
	  break;

     default:
	  break;
     }

     return ret;
}

void process(char *expr)
{
     Elemt e;
     int ok;
     int resultat;
     int taille;

     ok = nextElemt(expr,&e);
     while(ok && ok!=-1)
     {
	  if(e.type == NOMBRE)
	       push(e.v.n);
	  else
	  {
	       int *liste;
	       int i;
	       
	       /* init au neutre */
	       resultat = (e.v.op=='*' || e.v.op=='/') ? 1 : 0;
	  
	       taille = getList(&liste);
	       if(taille==1)
	       {
		    fprintf(stderr,"Erreur : operande manquant\n");
		    return;
	       }
	       for(i= 0;i<taille; i++)
		    resultat = calc(resultat,liste[i],e.v.op);
	       push(resultat);
	  }
	  ok = nextElemt(NULL,&e);
     }

     if(ok == -1)
	  fprintf(stderr,"Erreur : caractere inconnu\n");
     else if(taille_pile != 1)
	  fprintf(stderr,"Erreur : operateur manquant\n");
     else
	  printf("%d\n",resultat);
}

/* ################################## */

int main(void)
{
     char ligne[MAX];
     char *p;

     while(fgets(ligne,MAX,stdin))
     {
	  if( (p=strchr(ligne,'\n')) )
	  {
	       *p = '\0';

	       memset(pile,0,MAX);
	       taille_pile = 0;
	    
	       process(ligne);
	  }
	  else
	  {
	       fprintf(stderr,"Erreur : %d caracteres maxi\n",MAX-2);
	       break;
	  }
     }

     return 0;
}

Citation : Un codeur du côté obscur

Bon, moi aussi j'ai décidé de participer ! J'ai opté pour le langage numéro 2, c-à-d celui avec la notation préfixée.
J'ai fait ça en erlang (pour changer), je pense que c'est assez lisible.
Je gère les entiers et les flottants, les 4 opérations "basiques" (à savoir +,-,*,/) et hum... c'est à peu près tout.
Si jamais il manque des trucs, signalez.
Voici le code :

-module(calc).
-export([eval/1]).

-import(lists, [member/2, reverse/1]).

eval(Str) -> num(parse([], Str)).

num(X) when is_list(X) ->
    case member($., X) of
        true -> list_to_float(reverse(X));
        _ -> list_to_integer(reverse(X))
    end;
num(X) -> X.

op(S, Xs) ->
    X = num(parse([], Xs)),
    Y = num(parse([], Xs)),
    case S of
        $+ -> X + Y;
        $- -> X - Y;
        $* -> X * Y;
        $/ -> X / Y
    end.

parse(Acc, []) -> Acc;
parse(Acc, [X|Xs]) ->
    case X of
        $  when Acc =/= [] -> Acc;
        $  -> parse(Acc, Xs);
        $+ -> op($+, Xs);
        $- -> op($-, Xs);
        $* -> op($*, Xs);
        $/ -> op($/, Xs);
        Y when Y >= $0, Y =< $9 -> parse([Y|Acc], Xs);
        Y when Y == $. -> parse([Y|Acc], Xs);
        _ -> error
    end.

Si y'a des passages qui vous semblent louches, n'hésitez pas à demander.

Citation : bluestorm

Pensez bien à préciser quel langage vous traitez, aussi. Visiblement c'est le 1 pour zulon.

#!/usr/bin/perl -wl
use strict;

while (<STDIN>) {
    my @text = split /\s+/;
    my @num = reverse( grep /\d/, @text );
    my @op = grep m{^[+*\/-]$}, @text;
    for my $op (@op) {
        my ($x, $y) = (pop @num, pop @num);
        eval( sprintf( q[push @num, %s %s %s], $x, $op, $y ) );
    }
    print @num;
    undef @num;
}

38> calc:eval("+ 1+ 2 2 4 ").
8

41> calc:eval("+ 1 * 2 3 ").
2

my ($x, $y) = (pop @num, pop @num);

#!/usr/bin/perl -wl
use strict;

while (<STDIN>) {
    my @text = split /\s+/;
    my @num = reverse( grep /\d/, @text );
    my @op = grep m{^[+*\/-]$}, @text;
    for my $op (@op) {
        my $x = pop @num; my $y = pop @num;
        eval( sprintf( q[push @num, %s %s %s], $x, $op, $y ) );
    }
    print @num;
    undef @num;
}

{ open Parser }

let num = '-'? ['0'-'9']+ ('.' ['0'-'9']+)? (['e' 'E'] '-'? ['0'-'9']+)?

rule token = parse
  | '+'         { ADD }
  | '-'         { REM }
  | '*'         { MUL }
  | '/'         { DIV }
  | '^'         { POW }
  | '('         { LPA }
  | ')'         { RPA }
  | num         { NUM (float_of_string (Lexing.lexeme lexbuf)) }
  | _           { token lexbuf }
  | eof         { EOF }

%token LPA RPA EOF
%token ADD REM MUL DIV POW
%token <float> NUM

%start eval
%type <float option> eval

%%

eval:
  | /* Empty */         { None }
  | expr EOF            { Some $1 }
  | error               { failwith "Syntax error" }

expr:
  | NUM                 { $1 }
  | LPA expr RPA        { $2 }
  | expr ADD expr       { $1 +. $3 }
  | expr REM expr       { $1 -. $3 }
  | expr MUL expr       { $1 *. $3 }
  | expr DIV expr       { $1 /. $3 }
  | expr POW expr       { $1 ** $3 }

let _ =
  let rec loop () =
    let expr = read_line (print_string "Expression à évaluer : ") in
    match Parser.eval Lexer.token (Lexing.from_string expr) with
    | None -> print_endline "Terminé"
    | Some res -> print_float res; print_newline (); loop ()
  in loop ()

Citation : bluestorm

ce n'est pas lui qui fait la partie difficile, mais un outil spécialisé

Citation : bluestorm

on remarque ironiquement que mon code pour le langage 5, qui est complet, est en réalité plus court, bien que clairement moins compréhensible

Citation : bluestorm

je ne vous encourage pas à vous reposer sur des générateurs de parseurs par la suite

module NPI where

parse :: String -> [String] -> Double
parse [] stack =  (read (head (filter (not.null) stack)))::Double
parse (x:xs) stack 
    | x `elem` "+-*/"     = parse xs (parse_op x stack)
    | x `elem` ['0'..'9'] = parse xs (parse_num x stack)
    | x `elem` " \n\t"    = parse xs (parse_other stack)
   where parse_other (hd:stack)
            | hd == "" = (hd:stack)
            | otherwise = ("":hd:stack)
         parse_num x (hd:stack) = (hd ++ (x:[])):stack 
         parse_op x stack = 
            let op = case x of
			  '+' -> (+)
                          '-' -> (-)
                          '*' -> (*) 
                          '/' -> (/)
	        num_stack = map (\s -> (read s::Double)) (filter (not.null) stack)
            in (show ((num_stack!!0) `op` (num_stack!!1))):[]

main = do
    input <- getLine
    let out = parse input [""]
    putStrLn (show out)

parse :: String -> [Integer] -> Integer
parse [] [result] = result
parse (x:xs) stack 
    | x `elem` "+-*/"     = parse_op xs x stack
    | x `elem` ['0'..'9'] = parse_num xs (to_int x) stack
    | x `elem` " \n\t"    = parse xs stack
    where
        parse_num input@(x:xs) n stack
                  | x `elem` ['0'..'9'] = parse_num xs (n * 10 + to_int x) stack
                  | otherwise = parse input (n:stack)
        to_int x = Char.ord x - Char.ord "0"
        parse_op input op_char (a:b:stack) = parse input (op a b : stack)
                 where op = case op_char of
			    '+' -> (+)
                            '-' -> (-)
                            '*' -> (*)
                            '/' -> div

import qualified Char
import Control.Monad.State

eval str = evalState parse str
parse = do
      c:input <- get
      put input
      choose c
choose c
       | c `elem` " \t\n" = parse
       | c `elem` ['0'..'9'] = get >>= parse_num (to_int c)
       | c `elem` "+-*/" = do
         a <- parse
         b <- parse
         return $ parse_op c a b
parse_num n [] = return n
parse_num n (c:input)
          | c `elem` ['0' .. '9'] = put input >> get >>= parse_num (n * 10 + to_int c)
          | otherwise = return n
to_int c = Char.ord c - Char.ord '0'
parse_op '+' = (+)
parse_op '-' = (-)
parse_op '*' = (*)
parse_op '/' = div

module NPI where

isNumber :: Char -> Bool
isNumber x = x `elem` "0123456789."

parse :: String -> [Double] -> Double
parse [] stack =  head stack
parse (x:xs) stack
    | isNumber x      = parse (snd (break (`elem` terminator) xs)) $ (parse_num xs (x:[])):stack
    | x `elem` "+-*/" = parse xs $ parse_op x stack
    |otherwise        = parse xs stack
   where parse_num (x:xs) acc
            | isNumber x = parse_num xs $ x:acc
            | otherwise  = ((read . reverse) acc)::Double
         parse_op x stack = 
            let op = case x of
                        '+' -> (+)
                        '-' -> (-)
                        '*' -> (*) 
                        '/' -> (/)
            in ((stack !! 1) `op` (stack !! 0)) : []
         terminator = " \n\t"

main = do
    input <- getLine
    let out = parse input []
    putStrLn (show out)

Citation : bluestorm

Je n'aime pas trop (stack !! 1) et (stack !! 0) non plus, tu devrais utiliser un pattern matching pour ça. D'ailleurs il y a un bug dans ton code ici, : [] vide la stack à chaque fois (par exemple "1 2 3 + +" ne marche pas, parce que le 1 est "oublié").

Citation : bluestorm

Edit : La gestion des espacements (snd . break) est bof, j'aimais mieux avant : maintenant "1 2+" va faire des bêtises.