blob: 184fdb00da760656c23ab64738358b819b213e96 (
about) (
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
|
;;; This is the parser for interface files.
(define (parse-tokens/interface tokens)
(init-token-stream tokens)
(let ((interface (token-case
(|interface| (parse-interface))
(|module| (interface-required-error))
(else (crud-in-interface-error)))))
(cons interface (parse-interface-list))))
(define (interface-required-error)
(parser-error 'interface-required "Expecting `interface' keyword"))
(define (crud-in-interface-error)
(parser-error 'unexpected-interface-crud "Junk after interface"))
(define (parse-interface-list)
(token-case
(|interface|
(let ((interface (parse-interface)))
(cons interface (parse-interface-list))))
(|module| (interface-required-error))
(eof '())
(else (crud-in-interface-error))))
(define (parse-interface)
(token-case
(modid
(let ((module-name (token->symbol)))
(require-token |where|
(signal-missing-token "`where'" "interface definition"))
(let ((mod-ast (make module (name module-name)
(type 'interface)
(exports '()))))
(start-layout (lambda (in-layout?)
(parse-interface-decls mod-ast in-layout? 'import))))))))
(define (parse-interface-decls mod-ast in-layout? state)
(token-case
(|import| (let ((import (parse-import)))
(when (not (eq? (import-decl-mode import) 'by-name))
(phase-error 'illegal-import
"Imports in interfaces must specify specific entities"))
(if (eq? state 'import)
(push-decl-list import (module-imports mod-ast))
(signal-misplaced-import)))
(terminate-interface-topdecl mod-ast in-layout? state))
(|infix| (terminate-interface-topdecl mod-ast in-layout?
(parse-fixity 'n mod-ast state)))
(|infixl| (terminate-interface-topdecl mod-ast in-layout?
(parse-fixity 'l mod-ast state)))
(|infixr| (terminate-interface-topdecl mod-ast in-layout?
(parse-fixity 'r mod-ast state)))
(|data| (let ((data-decl (parse-type-decl '#t)))
(push-decl-list data-decl (module-algdatas mod-ast)))
(terminate-interface-topdecl mod-ast in-layout? 'topdecl))
(|type| (let ((synonym-decl (parse-synonym-decl)))
(push-decl-list synonym-decl (module-synonyms mod-ast)))
(terminate-interface-topdecl mod-ast in-layout? 'topdecl))
(|class| (let ((class-decl (parse-class-decl)))
(check-class-default-decls class-decl)
(push-decl-list class-decl (module-classes mod-ast)))
(terminate-interface-topdecl mod-ast in-layout? 'topdecl))
(|instance| (let ((instance-decl (parse-instance-decl '#t)))
(push-decl-list instance-decl (module-instances mod-ast)))
(terminate-interface-topdecl mod-ast in-layout? 'topdecl))
(var (let ((decl (parse-signdecl)))
(setf (module-decls mod-ast)
(decl-push decl (module-decls mod-ast))))
(terminate-interface-topdecl mod-ast in-layout? 'topdecl))
((begin-annotation no-advance)
(let ((annotations (parse-annotations)))
(setf (module-annotations mod-ast)
(append (module-annotations mod-ast) annotations)))
(terminate-interface-topdecl mod-ast in-layout? state))
(else
(maybe-end-interface mod-ast in-layout?))))
(define (maybe-end-interface mod-ast in-layout?)
(cond ((or (eq-token? '|interface|) (eq-token? 'eof) (eq-token? '\})
(eq-token? '$\}))
(close-layout in-layout?)
(wrapup-module mod-ast)
mod-ast)
(else
(signal-invalid-syntax "a topdecl"))))
(define (terminate-interface-topdecl mod-ast in-layout? state)
(token-case
(\; (parse-interface-decls mod-ast in-layout? state))
(else (maybe-end-interface mod-ast in-layout?))))
(define (check-class-default-decls class-decl)
(dolist (d (class-decl-decls class-decl))
(when (valdef? d)
(remember-context d
(recoverable-error 'no-defaults-in-interface
"Class defaults should not be put in interface files")))))
|
