source: project/release/4/miniML/trunk/miniMLparse.scm @ 22116

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

miniML: added list type

File size: 2.5 KB
Line 
1;;
2;;  A parser for a simple ML-like language.
3;;
4;;  Based on the code and paper by Xavier Leroy (2000): A modular
5;;  module system. Journal of Functional Programming, 10, pp 269-303
6;;  doi:10.1017/S0956796800003683
7;;
8;;
9;; Copyright 2010 Ivan Raikov and the Okinawa Institute of
10;; Science and Technology.
11;;
12;; This program is free software: you can redistribute it and/or
13;; modify it under the terms of the GNU General Public License as
14;; published by the Free Software Foundation, either version 3 of the
15;; License, or (at your option) any later version.
16;;
17;; This program is distributed in the hope that it will be useful, but
18;; WITHOUT ANY WARRANTY; without even the implied warranty of
19;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
20;; General Public License for more details.
21;;
22;; A full copy of the GPL license can be found at
23;; <http://www.gnu.org/licenses/>.
24;;
25
26
27(module miniMLparse
28
29        (parse)
30
31        (import scheme chicken 
32                (only srfi-1 fold combine every unzip2 filter-map)
33                (only data-structures conc)
34                (only extras fprintf))
35        (require-extension extras static-modules miniML miniMLsyntax)
36
37
38(define-values (type-variables reset-type-variables
39                find-type-variable 
40                begin-def end-def newvar generalize
41                make-deftype make-valtype make-kind
42                binop ternop path-star path-list path-arrow
43                star-type list-type arrow-type label-type bot-type)
44  (core-utils))
45
46(define-record token symbol value line)
47
48(define-record-printer (token x out)
49  (fprintf out "#(token  ~S ~S)"
50           (token-symbol x)
51           (token-value x) ))
52
53(define (token p line)
54  (cons (car p)
55        (cond  [(pair? (cdr p))  (make-token (car p) (cadr p) line)]
56               [else (make-token (car p) #f line)])))
57
58(define-syntax tok
59  (syntax-rules ()
60    ((tok t)   (token (quasiquote t) 0))
61    ((tok t l) (token (quasiquote t) l))))
62
63(define (make-parse-error loc)
64  (lambda (msg #!optional arg)
65    (let ((loc-str (or (and loc (if (list? loc) (conc " " loc " ") (conc " (" loc ") "))) "")))
66      (cond  [(not arg) (error loc-str msg)]
67             [(token? arg)
68              (error (conc "line " (token-line arg) ": " msg) loc-str
69                     (conc (token-symbol arg) 
70                           (if (token-value arg) (conc " " (token-value arg)) "")))]
71             [else (error loc-str (conc msg arg))]
72             ))))
73
74(define lexer-error error)
75
76(include "miniML.l.scm")
77(include "miniML.grm.scm")
78
79
80(define (parse loc s)
81  (cond ((port? s)   (lexer-init 'port s))
82        ((string? s) (lexer-init 'string s))
83        (else (error 'parse "bad argument type; not a string or port" s)) )
84  (reverse (parser lexer (make-parse-error loc))) )
85
86)
Note: See TracBrowser for help on using the repository browser.