FAECompiler/stack.rkt at master · gusridd/FAECompiler · 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
77
78
79
80
81
82
83
84
85
86
87
#lang play

(print-only-errors #t)

;; ADT STACK

(deftype Stack
  (Stacked value next)
  (EmptyStack))

;; stack-init :: -> Stack
(defun (stack-init)
  (EmptyStack))

(test (stack-init) (EmptyStack))

;; stack-pop :: Stack -> Stack
(defun (stack-pop s)
  (match s
    [(Stacked v n) n]
    [(EmptyStack) (error "stack-pop to an EmptyStack")]))

(test (stack-pop (Stacked 3 (EmptyStack)))
      (EmptyStack))
(test (stack-pop (Stacked 3 (Stacked 4 (EmptyStack))))
      (Stacked 4 (EmptyStack)))
(test/exn (stack-pop (stack-init)) "stack-pop to an EmptyStack")

;; stack-top :: Stack -> V
(defun (stack-top s)
  (match s
    [(Stacked v n) v]
    [(EmptyStack) (error "stack-top to an EmptyStack")]))

(test (stack-top (Stacked 3 (EmptyStack))) 3)
(test (stack-top (Stacked 8 (Stacked 4 (EmptyStack)))) 8)
(test/exn (stack-top (EmptyStack)) "stack-top to an EmptyStack")

;; stack-push :: Stack, V -> Stack
(defun (stack-push s v)
  (Stacked v s))

;; stack-empty :: Stack -> Boolean
(defun (stack-empty? s)
  (match s
    [(EmptyStack) #t]
    [(Stacked v n) #f]))

(test (stack-empty? (EmptyStack)) #t)
(test (stack-empty? (Stacked 3(EmptyStack))) #f)

;; stack-size :: Stack -> Int
(defun (stack-size s)
  (letrec ([sstr (λ(s c)
                   (match s
                     [(EmptyStack) c]
                     [(Stacked v n) (sstr n (+ 1 c))]))])
    (sstr s 0)))

(test (stack-size (EmptyStack)) 0)
(test (stack-size (Stacked 8 (Stacked 4 (EmptyStack)))) 2)

;; stack-to-list :: Stack -> List[V]
(defun (stack-to-list stack)
  (match stack
    [(EmptyStack) '()]
    [(Stacked v next) (cons v (stack-to-list next))]))

(test (stack-to-list (EmptyStack)) '())
(test (stack-to-list (Stacked 3 (Stacked 8 (Stacked 1 (EmptyStack))))) (list 3 8 1))

;; list-to-stack :: List[V] -> Stack
(defun (list-to-stack list)
  (match list
    ['() (EmptyStack)]
    [(cons h t) (Stacked h (list-to-stack t))]))

(test (list-to-stack '()) (EmptyStack))
(test (list-to-stack (list 3 8 1)) (Stacked 3 (Stacked 8 (Stacked 1 (EmptyStack)))))

;; stack-debug :: Stack -> void
(defun (stack-debug stack)
  (letrec ([collectString (λ(s)
                            (match s
                              [(EmptyStack) ""]
                              [(Stacked v next) (string-append (~v v) " ] " (collectString next))]))])
    (display (collectString stack))))