aparler/RosettaCodeData
1
0
Fork 0
Code Issues 12 Pull requests 3 Projects Releases Packages Wiki Activity Actions

March 2014 update

Browse source
This commit is contained in:
Ingy döt Net 2014-04-02 16:56:35 +00:00
parent 09687c4926
commit a25938f123
1846 changed files with 21876 additions and 5203 deletions
Download patch file Download diff file Expand all files Collapse all files

8
Task/Parsing-RPN-to-infix-conversion/D/parsing-rpn-to-infix-conversion-2.d
View file

@ -1,10 +1,10 @@
import std.stdio, std.typecons, std.string, std.array, std.algorithm;
import std.stdio, std.string, std.array, std.algorithm;
void rpmToInfix(in string str) {
alias Exp = Tuple!(int,"p", string,"e");
static struct Exp { int p; string e; }
immutable P = (in Exp pair, in int prec) pure =>
pair.p < prec ? format("( %s )", pair.e) : pair.e;
immutable F = (string[] s...) pure nothrow => s.join(" ");
immutable F = (in string[] s...) pure nothrow => s.join(" ");
writefln("=================\n%s", str);
Exp[] stack;
@ -24,7 +24,7 @@ void rpmToInfix(in string str) {
default: throw new Error("Wrong part: " ~ w);
}
}
stack.map!q{ a[1] }.writeln;
stack.map!q{ a.e }.writeln;
}
writeln("-----------------\n", stack.back.e);
}

64
Task/Parsing-RPN-to-infix-conversion/TXR/parsing-rpn-to-infix-conversion.txr Normal file
View file

@ -0,0 +1,64 @@
@(do
;; alias for circumflex, which is reserved syntax
(defvar exp (intern "^"))
(defvar *prec* ^((,exp . 4) (* . 3) (/ . 3) (+ . 2) (- . 2)))
(defvar *asso* ^((,exp . :right) (* . nil)
(/ . :left) (+ . nil) (- . :left)))
(defun debug-print (label val)
(format t "~a: ~a\n" label val)
val)
(defun rpn-to-lisp (rpn)
(let (stack)
(each ((term rpn))
(if (symbolp (debug-print "rpn term" term))
(let ((right (pop stack))
(left (pop stack)))
(push ^(,term ,left ,right) stack))
(push term stack))
(debug-print "stack" stack))
(if (rest stack)
(return-from error "*excess stack elements*"))
(debug-print "lisp" (pop stack))))
(defun prec (term)
(or (cdr (assoc term *prec*)) 99))
(defun asso (term dfl)
(or (cdr (assoc term *asso*)) dfl))
(defun inf-term (op term left-or-right)
(if (atom term)
`@term`
(let ((pt (prec (car term)))
(po (prec op))
(at (asso (car term) left-or-right))
(ao (asso op left-or-right)))
(cond
((< pt po) `(@(lisp-to-infix term))`)
((> pt po) `@(lisp-to-infix term)`)
((and (eq at ao) (eq left-or-right ao)) `@(lisp-to-infix term)`)
(t `(@(lisp-to-infix term))`)))))
(defun lisp-to-infix (lisp)
(tree-case lisp
((op left right) (let ((left-inf (inf-term op left :left))
(right-inf (inf-term op right :right)))
`@{left-inf} @op @{right-inf}`))
(() (return-from error "*stack underflow*"))
(else `@lisp`)))
(defun string-to-rpn (str)
(debug-print "rpn"
(mapcar (do if (int-str @1) (int-str @1) (intern @1))
(tok-str str #/[^ \t]+/))))
(debug-print "infix"
(block error
(tree-case *args*
((a b . c) "*excess args*")
((a) (lisp-to-infix (rpn-to-lisp (string-to-rpn a))))
(else "*arg needed*")))))