blob: a43f7982ce6d5ff8782499b6aab2362dd80692e3 (
plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
|
(in-package :cl-forth)
;; (defun main ()
;; (let ((args (rest sb-ext:*posix-argv*)))
;; (let ((flag (first args)))
;; (cond ((string= flag "-c")
;; ;; (iter (for (k v) in-hashtable *operations*)
;; ;; (for i from 0)
;; ;; (format t "~s: ~s~%" i k))
;; ;; (let ((tokens (lex-file (second args))))
;; ;; (format t "~s~%" tokens)
;; ;; (let ((program (prog-from-tokens tokens)))
;; ;; (format t "~s~%" program)
;; ;; (generate-program program :compile t)))
;; (generate-program (make-program (second args)) :compile t))
;; ((string= flag "-p")
;; (format t "~a" (make-program (second args))))
;; ((string= flag "-t")
;; (run-tests))
;; ((string= flag "-s")
;; (simulate-program (make-program (second args))))
;; ((string= flag "-i")
;; (simulate-program (with-open-file (str (second args))
;; (read str))))
;; ((string= flag "-e")
;; (print 5))
;; (t (format t "~a is not a valid flag~%" flag))))))
;; (defun make-exe ()
;; (sb-ext:save-lisp-and-die #P"cl-forth"
;; :toplevel #'main
;; :executable t))
(defparameter *example-path* (from-root "test/prog.lorth"))
(defun example-lex ()
(lex-file *example-path* t))
(defun example-prog ()
(make-program *example-path*))
(defun example-compile ()
(generate-program (make-program *example-path*) :path "test/output.asm"
:compile t))
;; (defun example-interpret ()
;; (interpret-program (make-program *example-path*)))
(defun example-run ()
(example-compile)
(run '("test/output") :output t))
(defun start-forth-repl ()
(iter (for line = (progn (format t "~&> ") (read-line)))
(when (string= line "bye")
(finish))
(simulate-program (parse-tokens (lex-line line 0)))))
(defun subcommands ()
(list (clingon:make-command
:name "derle"
:description "Dosyadaki programı derle"
:usage "<dosya-ismi>"
:handler (lambda (cmd) (generate-program
(make-program
(car (clingon:command-arguments cmd)))
:compile t)))
(clingon:make-command
:name "test"
:description "Testleri çalıştır."
:handler (lambda (cmd) (declare (ignore cmd)) (run-tests)))
(clingon:make-command
:name "sim"
:description "Dosyadaki programı simüle et."
:usage "<dosya-ismi>"
:handler (lambda (cmd) (simulate-program
(make-program
(car (clingon:command-arguments cmd))))))))
(defun top-level-options ()
(list (clingon:make-option
:flag
:description "Programın seçeneklerini göster."
:short-name #\h
:key :help)))
(defun top-level-handler (cmd)
(clingon:print-usage-and-exit cmd t))
(defun top-level-command ()
(clingon:make-command
:name "cl-forth"
:description "cl-forth derleyicisi"
:version "0.1.0"
:authors '("Emre Akan <[email protected]>")
:options (top-level-options)
:handler #'top-level-handler
:sub-commands (subcommands)))
(defun main ()
(let ((app (top-level-command)))
(clingon:run app)))
;; (defun handler (cmd)
;; (let ((help (clingon:getopt cmd :help))
;; (comp (clingon:getopt cmd :compile))
;; (sim (clingon:getopt cmd :simulate))
;; (test (clingon:getopt cmd :test)))
;; (cond ((or (not (null help)) (= 0 (length cmd (clingon:command-arguments cmd))))
;; (clingon:print-usage (cli-command) t))
;; ((not (null compile))
;; (generate-program (make-program (second args)) :compile t))
;; ((not null sim)
;; (simulate-program (make-program (second args))))
;; ((not null test)
;; (run-tests)))))
;; (defun sim-options ()
;; (list (clingon:make-option
;; :filepath
;; :description "Dosyadaki programı simüle et."
;; :short-name #\s
;; :key :simulate)))
;; (defun comp-options ()
;; (list (clingon:make-option
;; :filepath
;; :description "Dosyadaki programı derle."
;; :short-name #\c
;; :key :compile)))
;; (defun test-options ()
;; (list (clingon:make-option
;; :flag
;; :description "Testleri çalıştır."
;; :short-name #\t
;; :key :test)))
|