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