source: project/release/4/miniML/trunk/miniML.grm @ 22116

Last change on this file since 22116 was 20899, checked in by Ivan Raikov, 10 years ago

miniML: removing NineML-related syntactic pollution

File size: 6.4 KB
Line 
1;; -*- Hen -*-
2;;
3;;  A grammar for a simple ML-like language.
4;;
5;;  Based on the code and paper by Xavier Leroy (2000): A modular
6;;  module system. Journal of Functional Programming, 10, pp 269-303
7;;  doi:10.1017/S0956796800003683
8;;
9;;
10;; Copyright 2010 Ivan Raikov and the Okinawa Institute of
11;; Science and Technology.
12;;
13;; This program is free software: you can redistribute it and/or
14;; modify it under the terms of the GNU General Public License as
15;; published by the Free Software Foundation, either version 3 of the
16;; License, or (at your option) any later version.
17;;
18;; This program is distributed in the hope that it will be useful, but
19;; WITHOUT ANY WARRANTY; without even the implied warranty of
20;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
21;; General Public License for more details.
22;;
23;; A full copy of the GPL license can be found at
24;; <http://www.gnu.org/licenses/>.
25;;
26
27(require-extension lalr static-modules miniML)
28
29(define expr-parser
30  (lalr-parser
31
32   (output:  parser "miniML.grm.scm")
33
34   (out-table: "miniML.grm.out")
35
36   ;; --- token definitions
37
38   (IDENT LABEL NAT REAL ELSE
39          END EOF FUNCTOR
40          IF IN  LET  MODULE
41          RPAREN SEMISEMI RETURN
42          SIG STRUCT THEN TYPE VALUE
43          (left: COMMA DOT FUNCTION)
44          (left: LG LESS LEQ GREATER GEQ EQ EQUAL)
45          (left: PLUS MINUS STAR SLASH)
46          (right: ARROW)
47          (right: LPAREN SEMICOLON COLON QUOTE))
48
49   ;; Toplevel entry point
50
51   (phrase
52    (moddef)          :           (list $1)
53    (phrase SEMISEMI moddef) :    (cons $3 $1)
54    )
55   
56   ;; Paths
57
58   (path
59    (IDENT)            : (Pident  (token-value $1))
60    (path DOT IDENT)   : (Pdot $1 (ident-name (token-value $3))) )
61
62   ;; Value expressions for the core language
63
64   (valexpr
65    (valexpr1)                          : $1
66    (valexpr COMMA valexpr)             : (binop "pair" $1 $3 )
67    (valexpr PLUS valexpr)              : (binop "add" $1 $3 )
68    (valexpr MINUS valexpr)             : (binop "sub" $1 $3 )
69    (valexpr STAR valexpr)              : (binop "mul" $1 $3 )
70    (valexpr SLASH valexpr)             : (binop "div" $1 $3 )
71    (valexpr EQ valexpr)                : (binop "==" $1 $3 )
72    (valexpr LG valexpr)                : (binop "<>" $1 $3 )
73    (valexpr LESS valexpr)              : (binop "<" $1 $3 )
74    (valexpr LEQ valexpr)               : (binop "<=" $1 $3 )
75    (valexpr GREATER valexpr)           : (binop ">" $1 $3 )
76    (valexpr GEQ valexpr)               : (binop ">=" $1 $3 )
77    (FUNCTION IDENT ARROW valexpr)      : (Function (token-value $2) $4)
78    (LET IDENT valbind IN valexpr)      : (Let0 (token-value $2) $3 $5)
79    (IF valexpr THEN valexpr ELSE valexpr) : (ternop "cond" $2 $4 $6)
80    )
81
82   (valexpr1
83    (valexpr0) : $1
84    (valexpr1 valexpr0) : (Apply $1 $2))
85
86   (valexpr0
87    (path)                              : (Longid $1)
88    (LABEL)                             : (Const `(label ,(token-value $1)))
89    (REAL)                              : (Const `(real ,(token-value $1)))
90    (NAT)                               : (Const `(nat ,(token-value $1)))
91    (LPAREN valexpr RPAREN)             : $2 )
92
93   (valbind
94    (EQUAL valexpr)     : $2
95    (IDENT valbind)     : (Function (token-value $1) $2)
96    )
97
98   ;; Type expressions for the core language
99
100   (simpletype
101    (QUOTE IDENT)                 : (Tvar (find-type-variable (token-value $2)) )
102    (simpletype ARROW simpletype) : (Tcon path-arrow (list $1 $3))
103    (simpletype STAR simpletype)  : (Tcon path-star (list $1 $3))
104    (path)                        : (Tcon $1 '())
105    (simpletype path)             : (Tcon $2 (list $1))
106    (LPAREN simpletypelist RPAREN path) :  (Tcon $4 (reverse $2))
107    )
108
109
110   (simpletypelist
111    (simpletype) :  (list $1)
112    (simpletypelist COMMA simpletype) : (cons $3 $1)
113    )
114
115
116   (valuedecl
117    (colon-begin-scheme simpletype) : (begin (reset-type-variables)
118                                             (end-def)
119                                             (generalize $2)))
120
121   (colon-begin-scheme ;; Hack to perform side effects before reading the type
122    (COLON):   (begin
123                 (begin-def)
124                 (reset-type-variables)))
125
126
127   ;; Type definitions and declarations
128
129   (typedecl
130    (typeparams IDENT) :        (list (token-value $2) (make-kind (length $1))))
131
132   (typedef
133    (typeparams IDENT EQUAL simpletype):   (begin
134                                             (reset-type-variables)
135                                             (list (token-value $2) (make-kind (length $1)) (make-deftype $1 $4)))
136    )
137
138   (typeparams
139    () : '()
140    (typeparam) :  (list $1)
141    (LPAREN typeparamlist RPAREN) : (reverse $2))
142
143   (typeparamlist
144    (typeparam) : (list $1)
145    (typeparamlist COMMA typeparam) :   (cons $3 $1 ))
146
147   
148   (typeparam
149    (QUOTE IDENT) : (find-type-variable (token-value $2)))
150
151   (typeinfo
152    (typedef) :   (begin
153                    (let ((id (car $1)) (kind (cadr $1)) (def (caddr $1)))
154                      (list id (make-typedecl kind def))))
155    (typedecl) :  (begin
156                    (let ((id (car $1)) (kind (cadr $1)))
157                      (list id (make-typedecl kind #f)))))
158
159
160;; Value expressions for the module language
161
162   (modterm
163    (path) :                              (Modid $1)
164    (STRUCT modstruct END) :              (Structure (reverse $2))
165    (FUNCTOR LPAREN IDENT COLON modtype RPAREN modterm) :
166    (Functor (token-value $3) $5 $7)
167    (modterm LPAREN modterm RPAREN) : (Mapply $1 $3)
168    (LPAREN modterm RPAREN) :           $2
169    (modterm COLON modtype) :        (Constraint $1 $3))
170
171   (modstruct
172    () : '()
173    (modstruct moddef opt_semi) : (cons $2  $1))
174
175
176   (moddef
177    (VALUE IDENT valbind) :            (Value_def (token-value $2) $3)
178    (TYPE typedef) :                   (begin
179                                         (let ((id (car $2)) (kind (cadr $2)) (def (caddr $2)))
180                                           (Type_def id kind def)))
181    (MODULE IDENT COLON modtype EQUAL modterm) : (Module_def (token-value $2) (Constraint $6 $4))
182    (MODULE IDENT EQUAL modterm) :   (Module_def (token-value $2) $4))
183
184   (opt_semi
185    () : '()
186    (SEMICOLON) : '())
187
188
189   ;; Type expressions for the module language
190
191   (modtype
192    (SIG modsig END) :               (Signature (reverse $2))
193    (FUNCTOR LPAREN IDENT COLON modtype RPAREN modtype) : (Functorty (token-value $3) $5 $7)
194    (LPAREN modtype RPAREN) :        $2 )
195
196   (modsig
197    () : '()
198    (modsig modspec opt_semi) : (cons $2  $1 ))
199
200   (modspec
201    (VALUE IDENT valuedecl) :         (Value_sig (token-value $2) $3)
202    (TYPE typeinfo) :                 (begin
203                                        (let ((id (car $2))
204                                              (def (cadr $2)))
205                                          (Type_sig id def) ))
206    (MODULE IDENT COLON modtype) : (Module_sig (token-value $2) $4) )
207
208
209))
Note: See TracBrowser for help on using the repository browser.