Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
Newer
Older
100644 97 lines (83 sloc) 2.273 kb
9dabfe0 @VincentToups microstack first
authored
1 (require 'lisp-parser)
2 (require 'functional)
3 (require 'with-stack)
4 (require 'stack-words)
5
6 (defunc =microstack-symbol ()
7 (=let* [_ (=or (letter)
8 (=space)
9 (=other-id-char))]
10 (if _
11 (intern (concat (list _))) nil)))
12
13
14 (defun microstack-parser () (zero-or-more (=or
15 (=microstack-symbol)
16 (=number)
17 (=lisp-string))))
18
19 (defun parse-microstack (code)
20 (filter
21 (f-not (cr #'eq (intern " ")))
22 (car (parse-string-det (microstack-parser) code))))
23
24 (defstackword delete-forward0
25 (backward-delete-char -1))
26 (defstackword delete-backward0
27 (backward-delete-char 1))
28 (defstackword delete-backward
29 (backward-delete-char (pop *stack*)))
30 (defstackword delete-forward
31 (backward-delete-char (- (pop *stack*))))
32 (defstackword insert (insert (pop *stack*)))
33 (defstackword microstack->quotation
34 (let ((str (pop *stack*)))
35 (push (translate-microstack (parse-microstack str)))))
36 (defstackword do-n-times
37 (let ((n (pop *stack*))
38 (q (pop *stack*)))
39 (loop for i from 0 below n do
40 (|||- {q} call))))
41
42 (defstackword call-string
43 (|||- 1>intern 1>list call))
44
45 (defstackword string->quotation
46 (|||- 1>intern 1>list))
47
48 (defstackword kill-current-region
49 (||| lisp-val: (point) lisp-val: (mark) 2>kill-region))
50
51 (setq micro-stack-map
52 (alist>>
53 'b '0>backward-char
54 'B '1>backward-char
55 'f '0>forward-char
56 'F '1>forward-char
57 'd 'delete-forward0
58 'D 'delete-forward
59 'k 'delete-backward0
60 'K 'delete-backward
61 'q 'microstack->quotation
62 'Q 'string->quotation
63 '! 'call
64 '? 'if
65 '+ '+
66 '- '-
67 't 't
68 '_ 'nil
69 'm '0>push-mark
70 'g '1>goto-char
71 'x 'kill-current-region
72 '* '*
73 '/ '/
74 's '1>search-forward
75 'S '1>search-forward-regexp
76 'c 'concat
77 'i 'insert))
78
79 (defun translate-microstack (code)
80 (loop for el in code append
81 (cond
82 ((symbolp el)
83 (let ((trans (alist micro-stack-map el)))
84 (if trans (list trans) (error "Unknown microstack word."))))
85 (t (list el)))))
86
87 (defun do-microstack-parsed-translated (code)
88 (eval `(||| ,@code)))
89
90 (defun do-microstack (str)
91 (interactive "s")
92 (let* ((code (parse-microstack str))
93 (code (translate-microstack code)))
94 (print code)
95 (do-microstack-parsed-translated code)))
96
Something went wrong with that request. Please try again.