langs a-z

Task/Arithmetic-evaluation/OCaml/arithmetic-evaluation-1.ocaml

@@ -0,0 +1,39 @@
+type expression =
+  | Const of float
+  | Sum  of expression * expression   (* e1 + e2 *)
+  | Diff of expression * expression   (* e1 - e2 *)
+  | Prod of expression * expression   (* e1 * e2 *)
+  | Quot of expression * expression   (* e1 / e2 *)
+
+let rec eval = function
+  | Const c -> c
+  | Sum (f, g) -> eval f +. eval g
+  | Diff(f, g) -> eval f -. eval g
+  | Prod(f, g) -> eval f *. eval g
+  | Quot(f, g) -> eval f /. eval g
+
+open Genlex
+
+let lexer = make_lexer ["("; ")"; "+"; "-"; "*"; "/"]
+
+let rec parse_expr = parser
+     [< e1 = parse_mult; e = parse_more_adds e1 >] -> e
+ and parse_more_adds e1 = parser
+     [< 'Kwd "+"; e2 = parse_mult; e = parse_more_adds (Sum(e1, e2)) >] -> e
+   | [< 'Kwd "-"; e2 = parse_mult; e = parse_more_adds (Diff(e1, e2)) >] -> e
+   | [< >] -> e1
+ and parse_mult = parser
+     [< e1 = parse_simple; e = parse_more_mults e1 >] -> e
+ and parse_more_mults e1 = parser
+     [< 'Kwd "*"; e2 = parse_simple; e = parse_more_mults (Prod(e1, e2)) >] -> e
+   | [< 'Kwd "/"; e2 = parse_simple; e = parse_more_mults (Quot(e1, e2)) >] -> e
+   | [< >] -> e1
+ and parse_simple = parser
+   | [< 'Int i >] -> Const(float i)
+   | [< 'Float f >] -> Const f
+   | [< 'Kwd "("; e = parse_expr; 'Kwd ")" >] -> e
+
+
+let parse_expression = parser [< e = parse_expr; _ = Stream.empty >] -> e
+
+let read_expression s = parse_expression(lexer(Stream.of_string s))

Task/Arithmetic-evaluation/OCaml/arithmetic-evaluation-2.ocaml

@@ -0,0 +1,9 @@
+let () =
+  while true do
+    print_string "Expression: ";
+    let str = read_line() in
+    if str = "q" then exit 0;
+    let expr = read_expression str in
+    let res = eval expr in
+    Printf.printf " = %g\n%!" res;
+  done

Task/Arithmetic-evaluation/Oz/arithmetic-evaluation.oz

@@ -0,0 +1,88 @@
+declare
+
+  fun {Expr X0 ?X}
+     choice
+        [L _ R] = {Do [Term &+ Expr] X0 ?X} in add(L R)
+     [] [L _ R] = {Do [Term &- Expr] X0 ?X} in sub(L R)
+     [] {Term X0 X}
+     end
+  end
+
+  fun {Term X0 ?X}
+     choice
+        [L _ R] = {Do [Factor &* Term] X0 ?X} in mul(L R)
+     [] [L _ R] = {Do [Factor &/ Term] X0 ?X} in 'div'(L R)
+     [] {Factor X0 X}
+     end
+  end
+
+  fun {Factor X0 ?X}
+     choice {Parens Expr X0 X}
+     [] {Number X0 X}
+     end
+  end
+
+  fun {Number X0 X}
+     Ds = {Many1 Digit X0 X}
+  in
+     num(Ds)
+  end
+
+  fun {Digit X0 ?X}
+     D|!X = X0
+  in
+     D = choice &0 [] &1 [] &2 [] &3 [] &4 [] &5 [] &6 [] &7 [] &8 [] &9 end
+  end
+
+  fun {Many1 Rule X0 ?X}
+     choice [{Rule X0 X}]
+     [] X1 in {Rule X0 X1}|{Many1 Rule X1 X}
+     end
+  end
+
+  fun {Parens Rule X0 ?X}
+     [_ R _] = {Do [&( Rule &)] X0 X}
+  in
+     R
+  end
+
+  fun {Do Rules X0 ?X}
+     Res#Xn = {FoldL Rules
+               fun {$ Res#Xi Rule}
+                  if {Char.is Rule} then
+                     !Rule|X2 = Xi
+                  in
+                     (Rule|Res) # X2
+                  elseif {Procedure.is Rule} then
+                     X2 in
+                     ({Rule Xi X2}|Res) # X2
+                  end
+               end
+               nil#X0}
+  in
+     X = Xn
+     {Reverse Res}
+  end
+
+  %% Returns a singleton list if an AST was found or nil otherwise.
+  fun {Parse S}
+     {SearchOne fun {$} {Expr S nil} end}
+  end
+
+  fun {Eval X}
+     case X of
+        num(Ds)    then {String.toInt Ds}
+     [] add(L R)   then {Eval L} + {Eval R}
+     [] sub(L R)   then {Eval L} - {Eval R}
+     [] mul(L R)   then {Eval L} * {Eval R}
+     [] 'div'(L R) then {Eval L} div {Eval R}
+     end
+  end
+
+  [AST] = {Parse "((11+15)*15)*2-(3)*4*1"}
+
+in
+
+  {Inspector.configure widgetShowStrings true}
+  {Inspect AST}
+  {Inspect {Eval AST}}

Task/Arithmetic-evaluation/Perl-6/arithmetic-evaluation-1.pl6

@@ -0,0 +1,37 @@
+sub ev (Str $s --> Num) {
+
+    grammar expr {
+        token TOP { ^ <sum> $ }
+        token sum { <product> (('+' || '-') <product>)* }
+        token product { <factor> (('*' || '/') <factor>)* }
+        token factor { <unary_minus>? [ <parens> || <literal> ] }
+        token unary_minus { '-' }
+        token parens { '(' <sum> ')' }
+        token literal { \d+ ['.' \d+]? || '.' \d+ }
+    }
+
+    my sub minus ($b) { $b ?? -1 !! +1 }
+
+    my sub sum ($x) {
+        [+] product($x<product>), map
+            { minus($^y[0] eq '-') * product $^y<product> },
+            |($x[0] or [])
+    }
+
+    my sub product ($x) {
+        [*] factor($x<factor>), map
+            { factor($^y<factor>) ** minus($^y[0] eq '/') },
+            |($x[0] or [])
+    }
+
+    my sub factor ($x) {
+        minus($x<unary_minus>) * ($x<parens>
+          ?? sum $x<parens><sum>
+          !! $x<literal>)
+    }
+
+    expr.parse([~] split /\s+/, $s);
+    $/ or fail 'No parse.';
+    sum $/<sum>;
+
+}

Task/Arithmetic-evaluation/Perl-6/arithmetic-evaluation-2.pl6

@@ -0,0 +1,4 @@
+say ev '5';                                    #   5
+say ev '1 + 2 - 3 * 4 / 5';                    #   0.6
+say ev '1 + 5*3.4 - .5  -4 / -2 * (3+4) -6';   #  25.5
+say ev '((11+15)*15)* 2 + (3) * -4 *1';        # 768

Task/Arithmetic-evaluation/Pop11/arithmetic-evaluation.pop11

@@ -0,0 +1,149 @@
+/* Scanner routines */
+/* Uncomment the following to parse data from standard input
+
+vars itemrep;
+incharitem(charin) -> itemrep;
+
+*/
+
+;;; Current symbol
+vars sym;
+
+define get_sym();
+    itemrep() -> sym;
+enddefine;
+
+define expect(x);
+    lvars x;
+    if x /= sym then
+        printf(x, 'Error, expected %p\n');
+        mishap(sym, 1, 'Example parser error');
+    endif;
+    get_sym();
+enddefine;
+
+lconstant res_list = [( ) + * ];
+
+lconstant reserved = newproperty(
+  maplist(res_list, procedure(x); [^x ^(true)]; endprocedure),
+    20, false, "perm");
+
+/*
+  Parser for arithmetic expressions
+*/
+/*
+expr: term
+   | expr "+" term
+   | expr "-" term
+   ;
+*/
+
+define do_expr() -> result;
+    lvars result = do_term(), op;
+    while sym = "+" or sym = "-" do
+        sym -> op;
+        get_sym();
+        [^op ^result ^(do_term())] -> result;
+    endwhile;
+enddefine;
+
+/*
+term: factor
+   | term "*" factor
+   | term "/" factor
+   ;
+*/
+
+define do_term() -> result;
+    lvars result = do_factor(), op;
+    while sym = "*" or sym = "/" do
+        sym -> op;
+        get_sym();
+        [^op ^result ^(do_factor())] -> result;
+    endwhile;
+enddefine;
+
+/*
+factor: word
+   | constant
+   | "(" expr ")"
+   ;
+*/
+
+define do_factor() -> result;
+    if sym = "(" then
+        get_sym();
+        do_expr() -> result;
+        expect(")");
+    elseif isinteger(sym) or isbiginteger(sym) then
+        sym -> result;
+        get_sym();
+    else
+        if reserved(sym) then
+            printf(sym, 'unexpected symbol %p\n');
+            mishap(sym, 1, 'Example parser syntax error');
+        endif;
+        sym -> result;
+        get_sym();
+    endif;
+enddefine;
+
+/* Expression evaluator, returns false on error (currently only
+   division by 0 */
+
+define arith_eval(expr);
+    lvars op, arg1, arg2;
+    if not(expr) then
+        return(expr);
+    endif;
+    if isinteger(expr) or isbiginteger(expr) then
+        return(expr);
+    endif;
+    expr(1) -> op;
+    arith_eval(expr(2)) -> arg1;
+    arith_eval(expr(3)) -> arg2;
+    if not(arg1) or not(arg2) then
+        return(false);
+    endif;
+    if op = "+" then
+        return(arg1 + arg2);
+    elseif op = "-" then
+        return(arg1 - arg2);
+    elseif op = "*" then
+        return(arg1 * arg2);
+    elseif op = "/" then
+        if arg2 = 0 then
+            return(false);
+        else
+            return(arg1 div arg2);
+        endif;
+    else
+        printf('Internal error\n');
+        return(false);
+    endif;
+enddefine;
+
+/* Given list, create item repeater.  Input list is stored in a
+   closure are traversed when new item is requested. */
+
+define listitemrep(lst);
+    procedure();
+        lvars item;
+        if lst = [] then
+            termin;
+        else
+            front(lst) -> item;
+            back(lst) -> lst;
+            item;
+         endif;
+     endprocedure;
+enddefine;
+
+/* Initialise scanner */
+
+listitemrep([(3 + 50) * 7 - 100 / 10]) -> itemrep;
+
+get_sym();
+
+;;; Test it
+arith_eval(do_expr()) =>

Task/Arithmetic-evaluation/TXR/arithmetic-evaluation.txr

@@ -0,0 +1,53 @@
+@(next :args)
+@(define space)@/ */@(end)
+@(define mulop (nod))@\
+   @(local op)@\
+   @(space)@\
+   @(cases)@\
+     @{op /[*]/}@(bind nod @(intern op *user-package*))@\
+   @(or)@\
+     @{op /\//}@(bind (nod) @(list 'trunc))@\
+   @(end)@\
+   @(space)@\
+@(end)
+@(define addop (nod))@\
+   @(local op)@(space)@{op /[+\-]/}@(space)@\
+   @(bind nod @(intern op *user-package*))@\
+@(end)
+@(define number (nod))@\
+  @(local n)@(space)@{n /[0-9]+/}@(space)@\
+  @(bind nod @(int-str n 10))@\
+@(end)
+@(define factor (nod))@(cases)(@(expr nod))@(or)@(number nod)@(end)@(end)
+@(define term (nod))@\
+  @(local op nod1 nod2)@\
+  @(cases)@\
+    @(factor nod1)@\
+    @(cases)@(mulop op)@(term nod2)@(bind nod (op nod1 nod2))@\
+    @(or)@(bind nod nod1)@\
+    @(end)@\
+  @(or)@\
+    @(addop op)@(factor nod1)@\
+    @(bind nod (op nod1))@\
+  @(end)@\
+@(end)
+@(define expr (nod))@\
+  @(local op nod1 nod2)@\
+  @(term nod1)@\
+  @(cases)@(addop op)@(expr nod2)@(bind nod (op nod1 nod2))@\
+  @(or)@(bind nod nod1)@\
+  @(end)@\
+@(end)
+@(cases)
+@  {source (expr e)}
+@  (output)
+source: @source
+AST:    @(format nil "~s" e)
+value:  @(eval e nil)
+@  (end)
+@(or)
+@  (maybe)@(expr e)@(end)@bad
+@  (output)
+erroneous suffix "@bad"
+@  (end)
+@(end)

Task/Arithmetic-evaluation/Ursala/arithmetic-evaluation-1.ursala

@@ -0,0 +1,18 @@
+#import std
+#import nat
+#import flo
+
+lex = ~=' '*~F+ rlc both -=digits    # separate into tokens
+
+parse = # build a tree
+
+--<';'>; @iNX ~&l->rh ^/~&lt cases~&lhh\~&lhPNVrC {
+   '*/': ^|C/~&hNV associate '*/',
+   '+-': ^|C/~&hNV associate '*/+-',
+   ');': @r ~&htitBPC+ associate '*/+-'}
+
+associate "ops" = ~&tihdh2B-="ops"-> ~&thd2tth2hNCCVttt2C
+
+traverse = *^ ~&v?\%ep ^H\~&vhthPX '+-*/'-$<plus,minus,times,div>@dh
+
+evaluate = traverse+ parse+ lex

Task/Arithmetic-evaluation/Ursala/arithmetic-evaluation-2.ursala

@@ -0,0 +1,17 @@
+#cast %eL
+
+test = evaluate*t
+
+-[
+1+1
+4/5
+2-1
+3*7
+3+4+5
+9-2-4
+7/3/2
+4+2*3
+5*2-1
+5-3*2
+(1+1)*(2+3)
+(2-4)/(3+5*(8-1))]-