Mercurial > repo
diff src/ploki/examples/calc.pk @ 4223:ac0403686959
<oerjan> rm -rf src/ploki; mv ploki src
author | HackBot |
---|---|
date | Fri, 20 Dec 2013 22:18:50 +0000 |
parents | |
children |
line wrap: on
line diff
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/src/ploki/examples/calc.pk Fri Dec 20 22:18:50 2013 +0000 @@ -0,0 +1,192 @@ +#!../ploki +FOR main "> " + LET line @LEGS \EING + IF line ; "" + LET px @parse line + LET s @shiftws (px . 1) + IF s [ -1 : "\n" + LET s ]= -1 + FI + IF @TYPE OF (px . 0) : "list" + IF s : "" + @eval (px . 0) _" + ELSE + "error: trailing garbage at --> \Vs + FI + ELSE + IF s : "" + LET s " at end of input" + ELSE + LET s " at --> \Vs" + FI + "error: \V(px . 0)\Vs + FI + NEXT main + FI + "EOF +KTHX + +FOR shiftws LEET s \@ + IF s ~ "^{s!+}" + KTHX s [ @+0 + FI +KTHX s + +FOR parse LEET s \@ + LEET first @mult s + IF @TYPE OF (first . 0) ; "list" + KTHX first + FI + LET s first . 1 + LEET op + LEET second + 10 IF s ~ "^s!*{'+-'}" + LET op "b\V\0" + LET s [= @+0 + LET second @mult s + IF @TYPE OF (second . 0) ; "list" + KTHX second + FI + LET s second . 1 + LET first #<#<op (first . 0) (second . 0)#> s#> + GOFOR 10 + FI +KTHX first + +FOR mult LEET s \@ + LEET first @pow s + IF @TYPE OF (first . 0) ; "list" + KTHX first + FI + LET s first . 1 + LEET op + LEET second + 10 IF s ~ "^s!*{'/%'|*![*!^]}" + LET op "b\V\0" + LET s [= @+0 + LET second @pow s + IF @TYPE OF (second . 0) ; "list" + KTHX second + FI + LET s second . 1 + LET first #<#<op (first . 0) (second . 0)#> s#> + GOFOR 10 + FI +KTHX first + +FOR pow LEET s \@ + LEET first @term s + IF @TYPE OF (first . 0) ; "list" + KTHX first + FI + LET s first . 1 + IF s ~ "^s!*{^!|*!*!}" + LET s [= @+0 + LEET second @pow s + IF @TYPE OF (second . 0) ; "list" + KTHX second + FI + LET s second . 1 + KTHX #<#<"b^" (first . 0) (second . 0)#> s#> + FI +KTHX first + +FOR term LEET s \@ + IF s ~ "^s!*(!{}" + LET s [= @+0 + LEET tmp @parse s + IF @TYPE OF (tmp . 0) ; "list" + KTHX tmp + FI + LET s tmp . 1 + IF s ~ "^s!*)!{}" + LET s [= @+0 + KTHX #<(tmp . 0) s#> + FI + KTHX #<"`)' expected" s#> + FI + IF s ~ "^s!*{d!+(.!d!*)?|.!d!+}" + LET s [= @+0 + KTHX #<#<"n" @NUM \0#> s#> + FI + IF s ~ "^s!*{'+-'|log|exp|a?(sin|cos|tan)}" + LEET op \0 + LET s [= @+0 + LEET tmp @pow s + IF @TYPE OF (tmp . 0) ; "list" + KTHX tmp + FI + KTHX #<#<"u\Vop" (tmp . 0)#> (tmp . 1)#> + FI + IF s ~ "^s!*pi{}" + LET s [= @+0 + KTHX #<#<"n" \PI#> s#> + FI + IF s ~ "^s!*e{}" + LET s [= @+0 + KTHX #<#<"n" \E#> s#> + FI +KTHX #<"invalid value" s#> + +FOR eval LEET e \@ + IF e . 0 : "n" + KTHX e . 1 + FI + IF e . 0 . 0 : "u" + LEET right @eval (e . 1) + LEET op e . 0 [ 1 + IF op : "+" + KTHX right + FI + IF op : "-" + KTHX @NEG right + FI + IF op : "log" + KTHX @LN right + FI + IF op : "exp" + KTHX \E ^ right + FI + IF op : "sin" + KTHX @SIN right + FI + IF op : "cos" + KTHX @COS right + FI + IF op : "tan" + KTHX @TAN right + FI + IF op : "asin" + KTHX @ASIN right + FI + IF op : "acos" + KTHX @ACOS right + FI + IF op : "atan" + KTHX @ATAN right + FI + FI + IF e . 0 . 0 : "b" + LEET left @eval (e . 1) + LEET right @eval (e . 2) + LEET op e . 0 . 1 + IF op : "+" + KTHX left + right + FI + IF op : "-" + KTHX left - right + FI + IF op : "*" + KTHX left * right + FI + IF op : "/" + KTHX left / right + FI + IF op : "%" + KTHX left % right + FI + IF op : "^" + KTHX left ^ right + FI + FI +KTHX