2016 Update
This commit is contained in:
Tina Müller
parent
948b86eafa
commit
dcf5d15da3
7965 changed files with 139854 additions and 31002 deletions
|
|
@ -6,15 +6,17 @@ Create a program which parses and evaluates arithmetic expressions.
|
|||
* The expression will be a string or list of symbols like "(1+3)*7".
|
||||
* The four symbols + - * / must be supported as binary operators with conventional precedence rules.
|
||||
* Precedence-control parentheses must also be supported.
|
||||
<br>
|
||||
|
||||
;Note:
|
||||
For those who don't remember, mathematical precedence is as follows:
|
||||
* Parentheses
|
||||
* Multiplication/Division (left to right)
|
||||
* Addition/Subtraction (left to right)
|
||||
|
||||
<br>
|
||||
|
||||
;C.f:
|
||||
* [[24 game Player]].
|
||||
* [[Parsing/RPN calculator algorithm]].
|
||||
* [[Parsing/RPN to infix conversion]].
|
||||
<br><br>
|
||||
|
|
|
|||
|
|
@ -1,6 +1,7 @@
|
|||
#define system.
|
||||
#define system'routines.
|
||||
#define extensions.
|
||||
#import system.
|
||||
#import system'routines.
|
||||
#import extensions.
|
||||
#import extensions'text.
|
||||
|
||||
#class Token
|
||||
{
|
||||
|
|
@ -9,7 +10,7 @@
|
|||
|
||||
#constructor new &level:aLevel
|
||||
[
|
||||
theValue := String new.
|
||||
theValue := StringWriter new.
|
||||
theLevel := aLevel + 9.
|
||||
]
|
||||
|
||||
|
|
@ -17,10 +18,10 @@
|
|||
|
||||
#method append : aChar
|
||||
[
|
||||
theValue += aChar.
|
||||
theValue << aChar.
|
||||
]
|
||||
|
||||
#method number = theValue value toReal.
|
||||
#method number = theValue get toReal.
|
||||
}
|
||||
|
||||
#class Node
|
||||
|
|
@ -100,8 +101,6 @@
|
|||
#method number => theTop.
|
||||
}
|
||||
|
||||
// --- States ---
|
||||
|
||||
#symbol operatorState = (:ch)
|
||||
[
|
||||
ch =>
|
||||
|
|
@ -219,7 +218,7 @@
|
|||
|
||||
#method append:ch
|
||||
[
|
||||
((ch >= 48) and:(ch < 58))
|
||||
((ch >= #48) and:(ch < #58))
|
||||
? [ theToken append:ch. ]
|
||||
! [ #throw InvalidArgumentException new &message:"Invalid expression". ].
|
||||
]
|
||||
|
|
@ -320,11 +319,13 @@
|
|||
#var aText := String new.
|
||||
#var aParser := Parser new.
|
||||
|
||||
[ (aText << console readLine) length > 0] doWhile:
|
||||
[ console readLine save &to:aText length > 0] doWhile:
|
||||
[
|
||||
console writeLine:"=" :(aParser run:aText)
|
||||
| if &Error:e [
|
||||
console writeLine:"Invalid Expression".
|
||||
].
|
||||
|
||||
aText clear.
|
||||
].
|
||||
].
|
||||
|
|
|
|||
|
|
@ -0,0 +1,93 @@
|
|||
#!/usr/bin/env emacs --script
|
||||
;; -*- mode: emacs-lisp; lexical-binding: t -*-
|
||||
;;> ./arithmetic-evaluation '(1 + 2) * 3'
|
||||
|
||||
(defun advance ()
|
||||
(let ((rtn (buffer-substring-no-properties (point) (match-end 0))))
|
||||
(goto-char (match-end 0))
|
||||
rtn))
|
||||
|
||||
(defvar current-symbol nil)
|
||||
|
||||
(defun next-symbol ()
|
||||
(when (looking-at "[ \t\n]+")
|
||||
(goto-char (match-end 0)))
|
||||
|
||||
(cond
|
||||
((eobp)
|
||||
(setq current-symbol 'eof))
|
||||
((looking-at "[0-9]+")
|
||||
(setq current-symbol (string-to-number (advance))))
|
||||
((looking-at "[-+*/()]")
|
||||
(setq current-symbol (advance)))
|
||||
((looking-at ".")
|
||||
(error "Unknown character '%s'" (advance)))))
|
||||
|
||||
(defun accept (sym)
|
||||
(when (equal sym current-symbol)
|
||||
(next-symbol)
|
||||
t))
|
||||
|
||||
(defun expect (sym)
|
||||
(unless (accept sym)
|
||||
(error "Expected symbol %s, but found %s" sym current-symbol))
|
||||
t)
|
||||
|
||||
(defun p-expression ()
|
||||
" expression = term { ('+' | '-') term } . "
|
||||
(let ((rtn (p-term)))
|
||||
(while (or (equal current-symbol "+") (equal current-symbol "-"))
|
||||
(let ((op current-symbol)
|
||||
(left rtn))
|
||||
(next-symbol)
|
||||
(setq rtn (list op left (p-term)))))
|
||||
rtn))
|
||||
|
||||
(defun p-term ()
|
||||
" term = factor { ('*' | '/') factor } . "
|
||||
(let ((rtn (p-factor)))
|
||||
(while (or (equal current-symbol "*") (equal current-symbol "/"))
|
||||
(let ((op current-symbol)
|
||||
(left rtn))
|
||||
(next-symbol)
|
||||
(setq rtn (list op left (p-factor)))))
|
||||
rtn))
|
||||
|
||||
(defun p-factor ()
|
||||
" factor = constant | variable | '(' expression ')' . "
|
||||
(let (rtn)
|
||||
(cond
|
||||
((numberp current-symbol)
|
||||
(setq rtn current-symbol)
|
||||
(next-symbol))
|
||||
((accept "(")
|
||||
(setq rtn (p-expression))
|
||||
(expect ")"))
|
||||
(t (error "Syntax error")))
|
||||
rtn))
|
||||
|
||||
(defun ast-build (expression)
|
||||
(let (rtn)
|
||||
(with-temp-buffer
|
||||
(insert expression)
|
||||
(goto-char (point-min))
|
||||
(next-symbol)
|
||||
(setq rtn (p-expression))
|
||||
(expect 'eof))
|
||||
rtn))
|
||||
|
||||
(defun ast-eval (v)
|
||||
(pcase v
|
||||
((pred numberp) v)
|
||||
(`("+" ,a ,b) (+ (ast-eval a) (ast-eval b)))
|
||||
(`("-" ,a ,b) (- (ast-eval a) (ast-eval b)))
|
||||
(`("*" ,a ,b) (* (ast-eval a) (ast-eval b)))
|
||||
(`("/" ,a ,b) (/ (ast-eval a) (float (ast-eval b))))
|
||||
(_ (error "Unknown value %s" v))))
|
||||
|
||||
(dolist (arg command-line-args-left)
|
||||
(let ((ast (ast-build arg)))
|
||||
(princ (format " ast = %s\n" ast))
|
||||
(princ (format " value = %s\n" (ast-eval ast)))
|
||||
(terpri)))
|
||||
(setq command-line-args-left nil)
|
||||
|
|
@ -2,6 +2,7 @@ import Text.Parsec
|
|||
import Text.Parsec.Expr
|
||||
import Text.Parsec.Combinator
|
||||
import Data.Functor
|
||||
import Data.Function (on)
|
||||
|
||||
data Exp = Num Int
|
||||
| Add Exp Exp
|
||||
|
|
@ -15,15 +16,13 @@ expr = buildExpressionParser table factor
|
|||
op s f assoc = Infix (f <$ string s) assoc
|
||||
factor = (between `on` char) '(' ')' expr
|
||||
<|> (Num . read <$> many1 digit)
|
||||
on f g = \x y -> f (g x) (g y)
|
||||
|
||||
eval :: Num a => Exp -> a
|
||||
eval e = case e of
|
||||
Num x -> fromIntegral x
|
||||
Add a b -> eval a + eval b
|
||||
Sub a b -> eval a - eval b
|
||||
Mul a b -> eval a * eval b
|
||||
Div a b -> eval a `div` eval b
|
||||
eval (Num x) = fromIntegral x
|
||||
eval (Add a b) = eval a + eval b
|
||||
eval (Sub a b) = eval a - eval b
|
||||
eval (Mul a b) = eval a * eval b
|
||||
eval (Div a b) = eval a `div` eval b
|
||||
|
||||
solution :: Num a => String -> a
|
||||
solution = either (const (error "Did not parse")) eval . parse expr ""
|
||||
|
|
|
|||
|
|
@ -13,13 +13,13 @@ sub ev (Str $s --> Num) {
|
|||
my sub minus ($b) { $b ?? -1 !! +1 }
|
||||
|
||||
my sub sum ($x) {
|
||||
[+] product($x<product>), map
|
||||
[+] flat product($x<product>), map
|
||||
{ minus($^y[0] eq '-') * product $^y<product> },
|
||||
|($x[0] or [])
|
||||
}
|
||||
|
||||
my sub product ($x) {
|
||||
[*] factor($x<factor>), map
|
||||
[*] flat factor($x<factor>), map
|
||||
{ factor($^y<factor>) ** minus($^y[0] eq '/') },
|
||||
|($x[0] or [])
|
||||
}
|
||||
|
|
|
|||
|
|
@ -1,117 +1,116 @@
|
|||
/*REXX pgm evaluates an infix-type arithmetic expression & shows result.*/
|
||||
nchars = '0123456789.eEdDqQ' /*possible parts of a #, sans ± */
|
||||
e='***error!***'; $=' '; doubleOps='&|*/'; z=
|
||||
parse arg x 1 ox1; if x='' then call serr 'no input was specified.'
|
||||
x=space(x); L=length(x); x=translate(x,'()()',"[]{}")
|
||||
|
||||
j=0; do forever; j=j+1; if j>L then leave; _=substr(x,j,1); _2=getX()
|
||||
newT=pos(_,' ()[]{}^÷')\==0; if newT then do; z=z _ $; iterate; end
|
||||
possDouble=pos(_,doubleOps)\==0 /*is _ a possible double operator*/
|
||||
if possDouble then do /*is this a possible double oper?*/
|
||||
if _2==_ then do /*yup, it's one of 'em.*/
|
||||
_=_||_ /*use a double operator*/
|
||||
x=overlay($,x,Nj) /*blank out the*/
|
||||
end /* 2nd symbol.*/
|
||||
z=z _ $; iterate
|
||||
end
|
||||
if _=='+' | _=="-" then do; p_=word(z,words(z)) /*last Z token*/
|
||||
if p_=='(' then z=z 0 /*handle unary ±*/
|
||||
z=z _ $; iterate
|
||||
/*REXX program evaluates an infix─type arithmetic expression and displays the result.*/
|
||||
nchars = '0123456789.eEdDqQ' /*possible parts of a number, sans ± */
|
||||
e='***error***'; $=" "; doubleOps= '&|*/'; z= /*handy─dandy variables.*/
|
||||
parse arg x 1 ox1; if x='' then call serr "no input was specified."
|
||||
x=space(x); L=length(x); x=translate(x, '()()', "[]{}")
|
||||
j=0
|
||||
do forever; j=j+1; if j>L then leave; _=substr(x, j, 1); _2=getX()
|
||||
newT=pos(_,' ()[]{}^÷')\==0; if newT then do; z=z _ $; iterate; end
|
||||
possDouble=pos(_,doubleOps)\==0 /*is _ a possible double operator?*/
|
||||
if possDouble then do /* " this " " " " */
|
||||
if _2==_ then do /*yupper, it's one of a double operator*/
|
||||
_=_ || _ /*create and use a double char operator*/
|
||||
x=overlay($, x, Nj) /*blank out 2nd symbol.*/
|
||||
end
|
||||
z=z _ $; iterate
|
||||
end
|
||||
if _=='+' | _=="-" then do; p_=word(z, max(1,words(z))) /*last Z token. */
|
||||
if p_=='(' then z=z 0 /*handle a unary ± */
|
||||
z=z _ $; iterate
|
||||
end
|
||||
lets=0; sigs=0; #=_
|
||||
|
||||
do j=j+1 to L; _=substr(x,j,1) /*build a valid number.*/
|
||||
if lets==1 & sigs==0 then if _=='+' | _=='-' then do; sigs=1
|
||||
#=# || _
|
||||
iterate
|
||||
do j=j+1 to L; _=substr(x,j,1) /*build a valid number.*/
|
||||
if lets==1 & sigs==0 then if _=='+' | _=="-" then do; sigs=1
|
||||
#=# || _
|
||||
iterate
|
||||
end
|
||||
if pos(_,nchars)==0 then leave
|
||||
lets=lets+datatype(_,'M') /*keep track of # of exponents. */
|
||||
#=# || translate(_,'EEEEE','eDdQq') /*keep buildingthe num.*/
|
||||
lets=lets+datatype(_,'M') /*keep track of the number of exponents*/
|
||||
#=# || translate(_,'EEEEE', "eDdQq") /*keep building the number. */
|
||||
end /*j*/
|
||||
j=j-1
|
||||
if \datatype(#,'N') then call serr 'invalid number: ' #
|
||||
if \datatype(#,'N') then call serr "invalid number: " #
|
||||
z=z # $
|
||||
end /*forever*/
|
||||
|
||||
_=word(z,1); if _=='+' | _=='-' then z=0 z /*handle unary cases.*/
|
||||
x='(' space(z) ') '; tokens=words(x) /*force stacking for expression. */
|
||||
do i=1 for tokens; @.i=word(x,i); end /*i*/ /*assign input tokens*/
|
||||
L=max(20,length(x)) /*use 20 for the min show width. */
|
||||
op=')(-+/*^'; rOp=substr(op,3); p.=; s.=; n=length(op); epr=; stack=
|
||||
_=word(z,1); if _=='+' | _=="-" then z=0 z /*handle the unary cases. */
|
||||
x='(' space(z) ")"; tokens=words(x) /*force stacking for the expression. */
|
||||
do i=1 for tokens; @.i=word(x,i); end /*i*/ /*assign input tokens. */
|
||||
L=max(20,length(x)) /*use 20 for the minimum display width.*/
|
||||
op= ')(-+/*^'; Rop=substr(op,3); p.=; s.=; n=length(op); epr=; stack=
|
||||
|
||||
do i=1 for n; _=substr(op,i,1); s._=(i+1)%2; p._=s._+(i==n); end /*i*/
|
||||
/*[↑] assign operator priorities.*/
|
||||
do #=1 for tokens; ?=@.# /*process each token from @. list*/
|
||||
if ?=='**' then ?="^" /*convert REXX-type exponentation*/
|
||||
select /*@.# is: (, operator, ), operand*/
|
||||
when ?=='(' then stack='(' stack
|
||||
when isOp(?) then do /*is token an operator?*/
|
||||
do i=1 for n; _=substr(op,i,1); s._=(i+1)%2; p._=s._ + (i==n); end /*i*/
|
||||
/* [↑] assign the operator priorities.*/
|
||||
do #=1 for tokens; ?=@.# /*process each token from the @. list.*/
|
||||
if ?=='**' then ?="^" /*convert to REXX-type exponentiation. */
|
||||
select /*@.# is: ( operator ) operand*/
|
||||
when ?=='(' then stack="(" stack
|
||||
when isOp(?) then do /*is the token an operator ? */
|
||||
!=word(stack,1) /*get token from stack.*/
|
||||
do while !\==')' & s.!>=p.?; epr=epr ! /*add*/
|
||||
stack=subword(stack,2); /*del token from stack.*/
|
||||
!=word(stack,1) /*get token from stack.*/
|
||||
end /*while ···)*/
|
||||
stack=? stack /*add token to stack.*/
|
||||
do while !\==')' & s.!>=p.?; epr=epr ! /*addition.*/
|
||||
stack=subword(stack, 2) /*del token from stack*/
|
||||
!= word(stack, 1) /*get token from stack*/
|
||||
end /*while*/
|
||||
stack=? stack /*add token to stack*/
|
||||
end
|
||||
when ?==')' then do; !=word(stack,1) /*get token from stack.*/
|
||||
do while !\=='('; epr=epr ! /*add to epr.*/
|
||||
stack=subword(stack,2) /*del token from stack.*/
|
||||
!=word(stack,1) /*get token from stack.*/
|
||||
end /*while ···( */
|
||||
stack=subword(stack,2) /*del token from stack.*/
|
||||
when ?==')' then do; !=word(stack, 1) /*get token from stack*/
|
||||
do while !\=='('; epr=epr ! /*append to expression*/
|
||||
stack=subword(stack, 2) /*del token from stack*/
|
||||
!= word(stack, 1) /*get token from stack*/
|
||||
end /*while*/
|
||||
stack=subword(stack, 2) /*del token from stack*/
|
||||
end
|
||||
otherwise epr=epr ? /*add operand to epr. */
|
||||
otherwise epr=epr ? /*add operand to epr.*/
|
||||
end /*select*/
|
||||
end /*#*/
|
||||
|
||||
epr=space(epr stack); tokens=words(epr); x=epr; z=; stack=
|
||||
do i=1 for tokens; @.i=word(epr,i); end /*i*/ /*assign input tokens*/
|
||||
dop='/ // % ÷'; bop='& | &&' /*division ops; binary operands*/
|
||||
aop='- + * ^ **' dop bop; lop=aop '||' /*arithmetic ops; legal operands*/
|
||||
do i=1 for tokens; @.i=word(epr,i); end /*i*/ /*assign input tokens.*/
|
||||
Dop='/ // % ÷'; Bop="& | &&" /*division operands; binary operands.*/
|
||||
Aop='- + * ^ **' Dop Bop; Lop=Aop "||" /*arithmetic operands; legal operands.*/
|
||||
|
||||
do #=1 for tokens; ?=@.#; ??=? /*process each token from @. list*/
|
||||
w=words(stack); b=word(stack,max(1,w)) /*stack count; last entry.*/
|
||||
a=word(stack,max(1,w-1)) /*stack's "first" operand.*/
|
||||
division =wordpos(?,dop)\==0 /*flag: doing a division.*/
|
||||
arith =wordpos(?,aop)\==0 /*flag: doing arithmetic.*/
|
||||
bitOp =wordpos(?,bop)\==0 /*flag: doing binary math*/
|
||||
if datatype(?,'N') then do; stack=stack ?; iterate; end
|
||||
if wordpos(?,lop)==0 then do; z=e 'illegal operator:' ?; leave; end
|
||||
if w<2 then do; z=e 'illegal epr expression.'; leave; end
|
||||
if ?=='^' then ??="**" /*REXXify ^ ──► ** (make legal)*/
|
||||
if ?=='÷' then ??="/" /*REXXify ÷ ──► / (make legal)*/
|
||||
if division & b=0 then do; z=e 'division by zero: ' b; leave; end
|
||||
if bitOp & \isBit(a) then do; z=e "token isn't logical: " a; leave; end
|
||||
if bitOp & \isBit(b) then do; z=e "token isn't logical: " b; leave; end
|
||||
select /*perform arith. operation*/
|
||||
when ??=='+' then y = a + b
|
||||
when ??=='-' then y = a - b
|
||||
when ??=='*' then y = a * b
|
||||
when ??=='/' | ??=="÷" then y = a / b
|
||||
when ??=='//' then y = a // b
|
||||
when ??=='%' then y = a % b
|
||||
when ??=='^' | ??=="**" then y = a ** b
|
||||
when ??=='||' then y = a || b
|
||||
otherwise z=e 'invalid operator:' ?; leave
|
||||
end /*select*/
|
||||
if datatype(y,'W') then y=y/1 /*normalize number with ÷ by 1.*/
|
||||
_=subword(stack,1,w-2); stack=_ y /*rebuild the stack with answer. */
|
||||
do #=1 for tokens; ?=@.#; ??=? /*process each token from @. list. */
|
||||
w=words(stack); b=word(stack, max(1, w ) ) /*stack count; the last entry. */
|
||||
a=word(stack, max(1, w-1) ) /*stack's "first" operand. */
|
||||
division =wordpos(?, Dop)\==0 /*flag: doing a division operation. */
|
||||
arith =wordpos(?, Aop)\==0 /*flag: doing arithmetic operation. */
|
||||
bitOp =wordpos(?, Bop)\==0 /*flag: doing binary mathematics. */
|
||||
if datatype(?, 'N') then do; stack=stack ?; iterate; end
|
||||
if wordpos(?,Lop)==0 then do; z=e "illegal operator:" ?; leave; end
|
||||
if w<2 then do; z=e "illegal epr expression."; leave; end
|
||||
if ?=='^' then ??="**" /*REXXify ^ ──► ** (make it legal).*/
|
||||
if ?=='÷' then ??="/" /*REXXify ÷ ──► / (make it legal).*/
|
||||
if division & b=0 then do; z=e "division by zero" b; leave; end
|
||||
if bitOp & \isBit(a) then do; z=e "token isn't logical: " a; leave; end
|
||||
if bitOp & \isBit(b) then do; z=e "token isn't logical: " b; leave; end
|
||||
select /*perform an arithmetic operation. */
|
||||
when ??=='+' then y = a + b
|
||||
when ??=='-' then y = a - b
|
||||
when ??=='*' then y = a * b
|
||||
when ??=='/' | ??=="÷" then y = a / b
|
||||
when ??=='//' then y = a // b
|
||||
when ??=='%' then y = a % b
|
||||
when ??=='^' | ??=="**" then y = a ** b
|
||||
when ??=='||' then y = a || b
|
||||
otherwise z=e 'invalid operator:' ?; leave
|
||||
end /*select*/
|
||||
if datatype(y, 'W') then y=y/1 /*normalize the number with ÷ by 1. */
|
||||
_=subword(stack, 1, w-2); stack=_ y /*rebuild the stack with the answer. */
|
||||
end /*#*/
|
||||
|
||||
if word(z,1)==e then stack= /*handle special case of errors. */
|
||||
z=space(z stack) /*append any residual entries. */
|
||||
say 'answer──►' z /*display the answer (result). */
|
||||
parse source upper . how . /*invoked via C.L. or REXX pgm?*/
|
||||
if how=='COMMAND' | ,
|
||||
\datatype(z,'W') then exit /*stick a fork in it, we're done.*/
|
||||
return z /*return Z ──► invoker (RESULT).*/
|
||||
/*──────────────────────────────────subroutines─────────────────────────*/
|
||||
isBit: return arg(1)==0 | arg(1)==1 /*returns 1 if arg1 is bin bit.*/
|
||||
isOp: return pos(arg(1),rOp)\==0 /*is argument1 a "real" operator?*/
|
||||
serr: say; say e arg(1); say; exit 13 /*issue an error message with txt*/
|
||||
/*──────────────────────────────────GETX subroutine─────────────────────*/
|
||||
getX: do Nj=j+1 to length(x); _n=substr(x,Nj,1); if _n==$ then iterate
|
||||
return substr(x,Nj,1) /* [↑] ignore any blanks in exp.*/
|
||||
end /*Nj*/
|
||||
return $ /*reached end-of-tokens, return $*/
|
||||
if word(z, 1)==e then stack= /*handle the special case of errors. */
|
||||
z=space(z stack) /*append any residual entries. */
|
||||
say 'answer──►' z /*display the answer (result). */
|
||||
parse source upper . how . /*invoked via C.L. or REXX program ? */
|
||||
if how=='COMMAND' | \datatype(z, 'W') then exit /*stick a fork in it, we're all done. */
|
||||
return z /*return Z ──► invoker (the RESULT). */
|
||||
/*──────────────────────────────────────────────────────────────────────────────────────*/
|
||||
isBit: return arg(1)==0 | arg(1) == 1 /*returns 1 if 1st argument is binary*/
|
||||
isOp: return pos(arg(1), rOp) \== 0 /*is argument 1 a "real" operator? */
|
||||
serr: say; say e arg(1); say; exit 13 /*issue an error message with some text*/
|
||||
/*──────────────────────────────────────────────────────────────────────────────────────*/
|
||||
getX: do Nj=j+1 to length(x); _n=substr(x, Nj, 1); if _n==$ then iterate
|
||||
return substr(x, Nj, 1) /* [↑] ignore any blanks in expression*/
|
||||
end /*Nj*/
|
||||
return $ /*reached end-of-tokens, return $. */
|
||||
|
|
|
|||
|
|
@ -0,0 +1,69 @@
|
|||
(* AST *)
|
||||
datatype expression =
|
||||
Con of int (* constant *)
|
||||
| Add of expression * expression (* addition *)
|
||||
| Mul of expression * expression (* multiplication *)
|
||||
| Sub of expression * expression (* subtraction *)
|
||||
| Div of expression * expression (* division *)
|
||||
|
||||
(* Evaluator *)
|
||||
fun eval (Con x) = x
|
||||
| eval (Add (x, y)) = (eval x) + (eval y)
|
||||
| eval (Mul (x, y)) = (eval x) * (eval y)
|
||||
| eval (Sub (x, y)) = (eval x) - (eval y)
|
||||
| eval (Div (x, y)) = (eval x) div (eval y)
|
||||
|
||||
(* Lexer *)
|
||||
datatype token =
|
||||
CON of int
|
||||
| ADD
|
||||
| MUL
|
||||
| SUB
|
||||
| DIV
|
||||
| LPAR
|
||||
| RPAR
|
||||
|
||||
fun lex nil = nil
|
||||
| lex (#"+" :: cs) = ADD :: lex cs
|
||||
| lex (#"*" :: cs) = MUL :: lex cs
|
||||
| lex (#"-" :: cs) = SUB :: lex cs
|
||||
| lex (#"/" :: cs) = DIV :: lex cs
|
||||
| lex (#"(" :: cs) = LPAR :: lex cs
|
||||
| lex (#")" :: cs) = RPAR :: lex cs
|
||||
| lex (#"~" :: cs) = if null cs orelse not (Char.isDigit (hd cs)) then raise Domain
|
||||
else lexDigit (0, cs, ~1)
|
||||
| lex (c :: cs) = if Char.isDigit c then lexDigit (0, c :: cs, 1)
|
||||
else raise Domain
|
||||
|
||||
and lexDigit (a, cs, s) = if null cs orelse not (Char.isDigit (hd cs)) then CON (a*s) :: lex cs
|
||||
else lexDigit (a * 10 + (ord (hd cs))- (ord #"0") , tl cs, s)
|
||||
|
||||
(* Parser *)
|
||||
exception Error of string
|
||||
|
||||
fun match (a,ts) t = if null ts orelse hd ts <> t
|
||||
then raise Error "match"
|
||||
else (a, tl ts)
|
||||
|
||||
fun extend (a,ts) p f = let val (a',tr) = p ts in (f(a,a'), tr) end
|
||||
|
||||
fun parseE ts = parseE' (parseM ts)
|
||||
and parseE' (e, ADD :: ts) = parseE' (extend (e, ts) parseM Add)
|
||||
| parseE' (e, SUB :: ts) = parseE' (extend (e, ts) parseM Sub)
|
||||
| parseE' s = s
|
||||
|
||||
and parseM ts = parseM' (parseP ts)
|
||||
and parseM' (e, MUL :: ts) = parseM' (extend (e, ts) parseP Mul)
|
||||
| parseM' (e, DIV :: ts) = parseM' (extend (e, ts) parseP Div)
|
||||
| parseM' s = s
|
||||
|
||||
and parseP (CON c :: ts) = (Con c, ts)
|
||||
| parseP (LPAR :: ts) = match (parseE ts) RPAR
|
||||
| parseP _ = raise Error "parseP"
|
||||
|
||||
|
||||
(* Test *)
|
||||
fun lex_parse_eval (str:string) =
|
||||
case parseE (lex (explode str)) of
|
||||
(exp, nil) => eval exp
|
||||
| _ => raise Error "not parseable stuff at the end"
|
||||
|
|
@ -0,0 +1,31 @@
|
|||
10 PRINT "Use integer numbers and signs"'"+ - * / ( )"''
|
||||
20 LET s$="": REM last symbol
|
||||
30 LET pc=0: REM parenthesis counter
|
||||
40 LET i$="1+2*(3+(4*5+6*7*8)-9)/10"
|
||||
50 PRINT "Input = ";i$
|
||||
60 FOR n=1 TO LEN i$
|
||||
70 LET c$=i$(n)
|
||||
80 IF c$>="0" AND c$<="9" THEN GO SUB 170: GO TO 130
|
||||
90 IF c$="+" OR c$="-" THEN GO SUB 200: GO TO 130
|
||||
100 IF c$="*" OR c$="/" THEN GO SUB 200: GO TO 130
|
||||
110 IF c$="(" OR c$=")" THEN GO SUB 230: GO TO 130
|
||||
120 GO TO 300
|
||||
130 NEXT n
|
||||
140 IF pc>0 THEN PRINT FLASH 1;"Parentheses not paired.": BEEP 1,-25: STOP
|
||||
150 PRINT "Result = ";VAL i$
|
||||
160 STOP
|
||||
170 IF s$=")" THEN GO TO 300
|
||||
180 LET s$=c$
|
||||
190 RETURN
|
||||
200 IF (NOT (s$>="0" AND s$<="9")) AND s$<>")" THEN GO TO 300
|
||||
210 LET s$=c$
|
||||
220 RETURN
|
||||
230 IF c$="(" AND ((s$>="0" AND s$<="9") OR s$=")") THEN GO TO 300
|
||||
240 IF c$=")" AND ((NOT (s$>="0" AND s$<="9")) OR s$="(") THEN GO TO 300
|
||||
250 LET s$=c$
|
||||
260 IF c$="(" THEN LET pc=pc+1: RETURN
|
||||
270 LET pc=pc-1
|
||||
280 IF pc<0 THEN GO TO 300
|
||||
290 RETURN
|
||||
300 PRINT FLASH 1;"Invalid symbol ";c$;" detected in pos ";n: BEEP 1,-25
|
||||
310 STOP
|
||||
Loading…
Add table
Add a link
Reference in a new issue