forked from XmacsLabs/goldfish
-
Notifications
You must be signed in to change notification settings - Fork 0
/
Copy pathstack.scm
74 lines (62 loc) · 1.71 KB
/
stack.scm
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
;
; Copyright (C) 2024 The Goldfish Scheme Authors
;
; Licensed under the Apache License, Version 2.0 (the "License");
; you may not use this file except in compliance with the License.
; You may obtain a copy of the License at
;
; http://www.apache.org/licenses/LICENSE-2.0
;
; Unless required by applicable law or agreed to in writing, software
; distributed under the License is distributed on an "AS IS" BASIS, WITHOUT
; WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. See the
; License for the specific language governing permissions and limitations
; under the License.
;
(define-library (liii stack)
(import (srfi srfi-9)
(liii base)
(liii error))
(export
stack
stack? stack-empty?
stack-size stack-top
stack-push! stack-pop!
stack->list
)
(begin
(define-record-type :stack
(make-stack data)
stack?
(data get-data set-data!))
(define (%stack-check-parameter st)
(when (not (stack? st))
(error 'type-error "Parameter st is not a stack")))
(define (stack . l)
(if (null? l)
(make-stack '())
(make-stack l)))
(define (stack-empty? st)
(%stack-check-parameter st)
(null? (get-data st)))
(define (stack-size st)
(%stack-check-parameter st)
(length (get-data st)))
(define (stack-top st)
(%stack-check-parameter st)
(car (get-data st)))
(define (stack-push! st elem)
(%stack-check-parameter st)
(set-data! st (cons elem (get-data st))))
(define (stack-pop! st)
(%stack-check-parameter st)
(when (stack-empty? st)
(error 'value-error "Failed to stack-pop! on empty stack"))
(let1 data (get-data st)
(set-data! st (cdr data))
(car data)))
(define (stack->list st)
(%stack-check-parameter st)
(get-data st))
) ; end of begin
) ; end of library