view src/ploki/examples/calc.pk @ 8916:0234daffd946

<oerjan> addquote <int-e> I couldn\'t help thinking that maybe if one considers the ramifications in full detail it will turn out that overthinking is often not helpful and therefore, not something to be proud of.
author HackBot
date Sun, 14 Aug 2016 02:31:47 +0000
parents ac0403686959
children
line wrap: on
line source

#!../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