OCanada/split-string.lisp at main · ZeroPlayerRodent/OCanada · GitHub

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
; Function that tokenizes a string of OCanada code.
(defun split-string (foo)
  (let ((i 0) (s "") (l (list 1)))
    (loop
      (loop
        (when (>= i (length foo))(return))
        (when (or (equal #\+ (char foo i))
              (equal #\- (char foo i))
              (equal #\* (char foo i))
              (equal #\^ (char foo i))
              (equal #\% (char foo i))
              (equal #\/ (char foo i)))
          (when (> (length s) 0)(nconc l (list s)))
          (setf s (string (char foo i)))
          (nconc l (list s))
          (setf s "")
          (setf i (+ i 1))
          (when (>= i (length foo))(return))
        )
        (when (or (equal #\[ (char foo i))
              (equal #\] (char foo i))
              (equal #\{ (char foo i))
              (equal #\} (char foo i))
              (equal #\( (char foo i))
              (equal #\) (char foo i)))
          (when (> (length s) 0)(nconc l (list s)))
          (setf s (string (char foo i)))
          (nconc l (list s))
          (setf s "")
          (when (>= i (length foo))(return))
        )
        (when (equal #\" (char foo i))
          (setf s (concatenate 'string s "#"))
          (loop
            (setf i (+ i 1))
            (when (equal #\" (char foo i))(return))
            (setf s (concatenate 'string s (string (char foo i))))
          )
          (return)
        )
        (when (equal #\' (char foo i))
          (setf s (concatenate 'string s "#"))
          (loop
            (setf i (+ i 1))
            (when (equal #\' (char foo i))(return))
            (setf s (concatenate 'string s (string (char foo i))))
          )
          (return)
        )
        (when (equal #\| (char foo i))
          (loop
            (setf i (+ i 1))
            (when (equal #\| (char foo i))(return))
          )
          (return)
        )
        (when (equal #\Space (char foo i))(return))
        (when (equal #\Newline (char foo i))(return))
        (when (equal #\Return (char foo i))(return))
        (when (equal #\Tab (char foo i))(return))
        (unless (or (equal #\[ (char foo i))(equal #\] (char foo i))
                    (equal #\( (char foo i))(equal #\) (char foo i))
                    (equal #\{ (char foo i))(equal #\} (char foo i)))
          (setf s (concatenate 'string s (string (char-upcase (char foo i)))))
        )
        (setf i (+ i 1))
      )
      (when (> (length s) 0)(push s (cdr (last l))))
      (setf s "")
      (setf i (+ i 1))
      (when (>= i (length foo))(return))
    )
    (pop l)
    l
  )
)