Arithmetic evaluation: Difference between revisions

added Scheme example
m (fix concatenation)
(added Scheme example)
Line 4,770:
 
This example was made rather more complex by the requirement of generating an AST tree. With a Scala distribution there are many examples of arithmetic parsers, as small as half a dozen lines.
 
=={{header|Scheme}}==
 
This works in three stages: string->tokens turns the input string into a list of tokens, parse converts this into an AST, which is eventually evaluated into a number result. Only positive integers are read, though output can be a rational, positive or negative.
 
The parse function uses a recursive-descent parser to follow the precedence rules.
 
<lang scheme>
(import (scheme base)
(scheme char)
(scheme cxr)
(scheme write)
(srfi 1 lists))
 
;; convert a string into a list of tokens
(define (string->tokens str)
(define (next-token chars)
(cond ((member (car chars) (list #\+ #\- #\* #\/) char=?)
(values (cdr chars)
(cdr (assq (car chars) ; convert char for op into op procedure, using a look up list
(list (cons #\+ +) (cons #\- -) (cons #\* *) (cons #\/ /))))))
((member (car chars) (list #\( #\)) char=?)
(values (cdr chars)
(if (char=? (car chars) #\()
'open
'close)))
(else ; read a multi-digit positive integer
(let loop ((rem chars)
(res 0))
(if (and (not (null? rem))
(char-numeric? (car rem)))
(loop (cdr rem)
(+ (* res 10)
(- (char->integer (car rem))
(char->integer #\0))))
(values rem
res))))))
;
(let loop ((chars (remove char-whitespace? (string->list str)))
(tokens '()))
(if (null? chars)
(reverse tokens)
(let-values (((remaining-chars token) (next-token chars)))
(loop remaining-chars
(cons token tokens))))))
 
;; turn list of tokens into an AST
;; -- using recursive descent parsing to obey laws of precedence
(define (parse tokens)
(define (parse-factor tokens)
(if (number? (car tokens))
(values (car tokens) (cdr tokens))
(let-values (((expr rem) (parse-expr (cdr tokens))))
(values expr (cdr rem)))))
(define (parse-term tokens)
(let-values (((left-expr rem) (parse-factor tokens)))
(if (and (not (null? rem))
(member (car rem) (list * /)))
(let-values (((right-expr remr) (parse-term (cdr rem))))
(values (list (car rem) left-expr right-expr)
remr))
(values left-expr rem))))
(define (parse-part tokens)
(let-values (((left-expr rem) (parse-term tokens)))
(if (and (not (null? rem))
(member (car rem) (list + -)))
(let-values (((right-expr remr) (parse-part (cdr rem))))
(values (list (car rem) left-expr right-expr)
remr))
(values left-expr rem))))
(define (parse-expr tokens)
(let-values (((expr rem) (parse-part tokens)))
(values expr rem)))
;
(let-values (((expr rem) (parse-expr tokens)))
(if (null? rem)
expr
(error "Misformed expression"))))
 
;; evaluate the AST, returning a number
(define (eval-expression ast)
(cond ((number? ast)
ast)
((member (car ast) (list + - * /))
((car ast)
(eval-expression (cadr ast))
(eval-expression (caddr ast))))
(else
(error "Misformed expression"))))
 
;; parse and evaluate the given string
(define (interpret str)
(eval-expression (parse (string->tokens str))))
 
;; running some examples
(for-each
(lambda (str)
(display
(string-append str
" => "
(number->string (interpret str))))
(newline))
'("1 + 2" "20+4*5" "1/2+5*(6-3)" "(1+3)/4-1" "(1 - 5) * 2 / (20 + 1)"))
</lang>
 
{{out}}
 
<pre>
1 + 2 => 3
20+4*5 => 40
1/2+5*(6-3) => 31/2
(1+3)/4-1 => 0
(1 - 5) * 2 / (20 + 1) => -8/21
</pre>
 
=={{header|Sidef}}==
342

edits