Use IF iso COND as primitive; keep COND primitive as option.
This commit is contained in:
Jan Nieuwenhuizen
parent
af1b6dc88d
commit
287c0284fe
34
GNUmakefile
34
GNUmakefile
|
|
@ -1,6 +1,15 @@
|
||||||
.PHONY: all check default
|
.PHONY: all check default
|
||||||
CFLAGS=-std=c99 -O3 -finline-functions
|
CFLAGS:=-std=c99 -O3 -finline-functions
|
||||||
#CFLAGS=-std=c99 -g
|
#CFLAGS:=-std=c99 -g
|
||||||
|
|
||||||
|
COND:=0
|
||||||
|
ifeq ($(COND),1)
|
||||||
|
CONDIF:=cond
|
||||||
|
else
|
||||||
|
CONDIF:=if
|
||||||
|
endif
|
||||||
|
|
||||||
|
CFLAGS+=-DCOND=$(COND)
|
||||||
|
|
||||||
default: all
|
default: all
|
||||||
|
|
||||||
|
|
@ -33,17 +42,18 @@ mes.h: mes.c GNUmakefile
|
||||||
check: all guile-check
|
check: all guile-check
|
||||||
# ./mes.test
|
# ./mes.test
|
||||||
# ./mes.test ./mes
|
# ./mes.test ./mes
|
||||||
cat base0.mes base.mes lib/test.mes test/base.test | ./mes
|
cat base0.mes base0-$(CONDIF).mes base.mes lib/test.mes test/base.test | ./mes
|
||||||
cat base0.mes base.mes lib/test.mes test/closure.test | ./mes
|
cat base0.mes base0-$(CONDIF).mes base.mes lib/test.mes test/closure.test | ./mes
|
||||||
cat base0.mes base.mes quasiquote.mes lib/test.mes test/quasiquote.test | ./mes
|
cat base0.mes base0-$(CONDIF).mes base.mes quasiquote.mes lib/test.mes test/quasiquote.test | ./mes
|
||||||
cat base0.mes base.mes quasiquote.mes let.mes lib/test.mes test/let.test | ./mes
|
cat base0.mes base0-$(CONDIF).mes base.mes quasiquote.mes let.mes lib/test.mes test/let.test | ./mes
|
||||||
cat base0.mes base.mes quasiquote.mes let.mes lib/srfi/srfi-0.scm scm.mes lib/test.mes test/scm.test | ./mes
|
cat base0.mes base0-$(CONDIF).mes base.mes quasiquote.mes let.mes lib/srfi/srfi-0.scm scm.mes lib/test.mes test/scm.test | ./mes
|
||||||
|
|
||||||
guile-check:
|
guile-check:
|
||||||
guile -s <(cat base.mes lib/test.mes test/base.test)
|
guile -s <(cat base.mes lib/test.mes test/base.test)
|
||||||
guile -s <(cat base.mes lib/test.mes test/closure.test)
|
guile -s <(cat base.mes lib/test.mes test/closure.test)
|
||||||
guile -s <(cat base.mes lib/test.mes test/quasiquote.test)
|
guile -s <(cat base.mes lib/test.mes test/quasiquote.test)
|
||||||
guile -s <(cat quasiquote.mes lib/test.mes test/quasiquote.test)
|
guile -s <(cat quasiquote.mes lib/test.mes test/quasiquote.test)
|
||||||
|
# guile -s <(cat base.mes quasiquote.mes let.mes lib/test.mes test/let.test)
|
||||||
# guile -s <(cat base.mes let.mes test/foo.test)
|
# guile -s <(cat base.mes let.mes test/foo.test)
|
||||||
# exit 1
|
# exit 1
|
||||||
guile -s <(cat lib/test.mes test/base.test)
|
guile -s <(cat lib/test.mes test/base.test)
|
||||||
|
|
@ -57,10 +67,10 @@ run: all
|
||||||
cat scm.mes test.mes | ./mes
|
cat scm.mes test.mes | ./mes
|
||||||
|
|
||||||
psyntax: all
|
psyntax: all
|
||||||
cat base0.mes base.mes quasiquote.mes let.mes psyntax.mes psyntax.pp psyntax2.mes | ./mes
|
cat base0.mes base0-$(CONDIF).mes base.mes quasiquote.mes let.mes psyntax.mes psyntax.pp psyntax2.mes | ./mes
|
||||||
|
|
||||||
syntax: all
|
syntax: all
|
||||||
cat base0.mes base.mes quasiquote.mes let.mes scm.mes syntax.mes syntax-test.mes | ./mes
|
cat base0.mes base0-$(CONDIF).mes base.mes quasiquote.mes let.mes scm.mes syntax.mes syntax-test.mes | ./mes
|
||||||
|
|
||||||
syntax.test: syntax.mes syntax-test.mes
|
syntax.test: syntax.mes syntax-test.mes
|
||||||
cat $^ > $@
|
cat $^ > $@
|
||||||
|
|
@ -78,7 +88,7 @@ guile-syntax-case: syntax-case.test
|
||||||
guile -s $^
|
guile -s $^
|
||||||
|
|
||||||
macro: all
|
macro: all
|
||||||
cat base0.mes base.mes quasiquote.mes let.mes scm.mes macro.mes | ./mes
|
cat base0.mes base0-$(CONDIF).mes base.mes quasiquote.mes let.mes scm.mes macro.mes | ./mes
|
||||||
|
|
||||||
peg: all
|
peg: all
|
||||||
cat scm.mes syntax.mes syntax-case-lib.mes syntax-case.mes syntax-case-after.mes peg.mes peg/codegen.scm peg/string-peg.scm peg/simplify-tree.scm peg/using-parsers.scm peg/cache.scm peg-test.mes | ./mes
|
cat scm.mes syntax.mes syntax-case-lib.mes syntax-case.mes syntax-case-after.mes peg.mes peg/codegen.scm peg/string-peg.scm peg/simplify-tree.scm peg/using-parsers.scm peg/cache.scm peg-test.mes | ./mes
|
||||||
|
|
@ -99,7 +109,7 @@ record: all
|
||||||
|
|
||||||
|
|
||||||
paren: all
|
paren: all
|
||||||
echo -e 'EOF\n___P((()))' | cat base0.mes base.mes quasiquote.mes let.mes scm.mes syntax.mes lib/srfi/srfi-0.scm lib/record.mes lib/record.scm lib/srfi/srfi-9.scm lib/lalr.mes lib/lalr.scm paren.scm - | ./mes
|
echo -e 'EOF\n___P((()))' | cat base0.mes base0-$(CONDIF).mes base.mes quasiquote.mes let.mes scm.mes syntax.mes lib/srfi/srfi-0.scm lib/record.mes lib/record.scm lib/srfi/srfi-9.scm lib/lalr.mes lib/lalr.scm paren.scm - | ./mes
|
||||||
|
|
||||||
paren.test: lib/lalr.scm paren.scm
|
paren.test: lib/lalr.scm paren.scm
|
||||||
cat $^ > $@
|
cat $^ > $@
|
||||||
|
|
@ -108,7 +118,7 @@ guile-paren: paren.test
|
||||||
echo '___P((()))' | guile -s $^
|
echo '___P((()))' | guile -s $^
|
||||||
|
|
||||||
mescc: all
|
mescc: all
|
||||||
echo ' EOF ' | cat base0.mes base.mes quasiquote.mes let.mes scm.mes syntax.mes lib/srfi/srfi-0.scm lib/record.mes lib/record.scm lib/srfi/srfi-9.scm lib/lalr.mes lib/lalr.scm c-lexer.scm mescc.scm - main.c | ./mes
|
echo ' EOF ' | cat base0.mes base0-$(CONDIF).mes base.mes quasiquote.mes let.mes scm.mes syntax.mes lib/srfi/srfi-0.scm lib/record.mes lib/record.scm lib/srfi/srfi-9.scm lib/lalr.mes lib/lalr.scm c-lexer.scm mescc.scm - main.c | ./mes
|
||||||
|
|
||||||
mescc.test: lib/lalr.scm c-lexer.scm mescc.scm
|
mescc.test: lib/lalr.scm c-lexer.scm mescc.scm
|
||||||
cat $^ > $@
|
cat $^ > $@
|
||||||
|
|
|
||||||
83
base.mes
83
base.mes
|
|
@ -21,39 +21,26 @@
|
||||||
(define (identity x) x)
|
(define (identity x) x)
|
||||||
(define else #t)
|
(define else #t)
|
||||||
|
|
||||||
(define (not x)
|
;;; COND based
|
||||||
(cond (x #f)
|
|
||||||
(#t #t)))
|
|
||||||
|
|
||||||
(define guile? (not (pair? (current-module))))
|
|
||||||
|
|
||||||
(define-macro (or2 x y)
|
|
||||||
`(cond (,x ,x) (#t ,y)))
|
|
||||||
|
|
||||||
(define-macro (and2 x y)
|
|
||||||
`(cond (,x ,y) (#t #f)))
|
|
||||||
|
|
||||||
(define-macro (and . x)
|
|
||||||
(cond ((null? x) #t)
|
|
||||||
((null? (cdr x)) (car x))
|
|
||||||
(#t (list 'cond (list (car x) (cons 'and (cdr x)))
|
|
||||||
'(#t #f)))))
|
|
||||||
|
|
||||||
(define-macro (or . x)
|
(define-macro (or . x)
|
||||||
(cond
|
(cond ;; COND
|
||||||
((null? x) #f)
|
((null? x) #f)
|
||||||
((null? (cdr x)) (car x))
|
((null? (cdr x)) (car x))
|
||||||
(#t (list 'cond (list (car x))
|
(#t (list 'cond (list (car x)) ;; COND
|
||||||
(list #t (cons 'or (cdr x)))))))
|
(list #t (cons 'or (cdr x)))))))
|
||||||
|
|
||||||
(define (cons* x . rest)
|
(define-macro (and . x)
|
||||||
(define (loop rest)
|
(cond ((null? x) #t) ;; COND
|
||||||
(cond ((null? (cdr rest)) (car rest))
|
((null? (cdr x)) (car x))
|
||||||
(#t (cons (car rest) (loop (cdr rest))))))
|
(#t (list 'cond (list (car x) (cons 'and (cdr x))) ;; COND
|
||||||
(loop (cons x rest)))
|
'(#t #f)))))
|
||||||
|
|
||||||
|
(define (not x)
|
||||||
|
(cond (x #f) ;; COND
|
||||||
|
(#t #t)))
|
||||||
|
|
||||||
(define (equal? a b) ;; FIXME: only 2 arg
|
(define (equal? a b) ;; FIXME: only 2 arg
|
||||||
(cond ((and (null? a) (null? b)) #t)
|
(cond ((and (null? a) (null? b)) #t) ;; COND
|
||||||
((and (pair? a) (pair? b))
|
((and (pair? a) (pair? b))
|
||||||
(and (equal? (car a) (car b))
|
(and (equal? (car a) (car b))
|
||||||
(equal? (cdr a) (cdr b))))
|
(equal? (cdr a) (cdr b))))
|
||||||
|
|
@ -64,16 +51,56 @@
|
||||||
(#t (eq? a b))))
|
(#t (eq? a b))))
|
||||||
|
|
||||||
(define (memq x lst)
|
(define (memq x lst)
|
||||||
(cond ((null? lst) #f)
|
(cond ((null? lst) #f) ;; COND
|
||||||
((eq? x (car lst)) lst)
|
((eq? x (car lst)) lst)
|
||||||
(#t (memq x (cdr lst)))))
|
(#t (memq x (cdr lst)))))
|
||||||
|
|
||||||
(define (map f l . r)
|
(define (map f l . r)
|
||||||
(cond ((null? l) '())
|
(cond ((null? l) '()) ;; COND
|
||||||
((null? r) (cons (f (car l)) (map f (cdr l))))
|
((null? r) (cons (f (car l)) (map f (cdr l))))
|
||||||
((null? (cdr r))
|
((null? (cdr r))
|
||||||
(cons (f (car l) (caar r)) (map f (cdr l) (cdar r))))))
|
(cons (f (car l) (caar r)) (map f (cdr l) (cdar r))))))
|
||||||
|
|
||||||
|
;; IF based
|
||||||
|
(define-macro (or . x)
|
||||||
|
(if (null? x) #f ;; IF
|
||||||
|
(if (null? (cdr x)) (car x) ;; IF
|
||||||
|
(list 'if (car x) (car x)
|
||||||
|
(cons* 'or (cdr x))))))
|
||||||
|
|
||||||
|
(define-macro (and . x)
|
||||||
|
(if (null? x) #t ;; IF
|
||||||
|
(if (null? (cdr x)) (car x) ;; IF
|
||||||
|
(list 'if (car x) (cons 'and (cdr x)) ;; IF
|
||||||
|
#f))))
|
||||||
|
|
||||||
|
(define (not x)
|
||||||
|
(if x #f #t))
|
||||||
|
|
||||||
|
(define (equal? a b) ;; FIXME: only 2 arg
|
||||||
|
(if (and (null? a) (null? b)) #t ;; IF
|
||||||
|
(if (and (pair? a) (pair? b))
|
||||||
|
(and (equal? (car a) (car b))
|
||||||
|
(equal? (cdr a) (cdr b)))
|
||||||
|
(if (and (string? a) (string? b)) ;; IF
|
||||||
|
(eq? (string->symbol a) (string->symbol b))
|
||||||
|
(if (and (vector? a) (vector? b)) ;; IF
|
||||||
|
(equal? (vector->list a) (vector->list b))
|
||||||
|
(eq? a b))))))
|
||||||
|
|
||||||
|
(define (memq x lst)
|
||||||
|
(if (null? lst) #f ;; IF
|
||||||
|
(if (eq? x (car lst)) lst ;; IF
|
||||||
|
(memq x (cdr lst)))))
|
||||||
|
|
||||||
|
(define guile? (not (pair? (current-module))))
|
||||||
|
|
||||||
|
(define (map f l . r)
|
||||||
|
(if (null? l) '() ;; IF
|
||||||
|
(if (null? r) (cons (f (car l)) (map f (cdr l))) ;; IF
|
||||||
|
(if (null? (cdr r)) ;; IF
|
||||||
|
(cons (f (car l) (caar r)) (map f (cdr l) (cdar r)))))))
|
||||||
|
|
||||||
(define-macro (simple-let bindings . rest)
|
(define-macro (simple-let bindings . rest)
|
||||||
(cons (cons 'lambda (cons (map car bindings) rest))
|
(cons (cons 'lambda (cons (map car bindings) rest))
|
||||||
(map cadr bindings)))
|
(map cadr bindings)))
|
||||||
|
|
|
||||||
31
base0-cond.mes
Normal file
31
base0-cond.mes
Normal file
|
|
@ -0,0 +1,31 @@
|
||||||
|
;;; -*-scheme-*-
|
||||||
|
|
||||||
|
;;; Mes --- Maxwell Equations of Software
|
||||||
|
;;; Copyright © 2016 Jan Nieuwenhuizen <janneke@gnu.org>
|
||||||
|
;;;
|
||||||
|
;;; base.mes: This file is part of Mes.
|
||||||
|
;;;
|
||||||
|
;;; Mes is free software; you can redistribute it and/or modify it
|
||||||
|
;;; under the terms of the GNU General Public License as published by
|
||||||
|
;;; the Free Software Foundation; either version 3 of the License, or (at
|
||||||
|
;;; your option) any later version.
|
||||||
|
;;;
|
||||||
|
;;; Mes is distributed in the hope that it will be useful, but
|
||||||
|
;;; WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||||
|
;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
||||||
|
;;; GNU General Public License for more details.
|
||||||
|
;;;
|
||||||
|
;;; You should have received a copy of the GNU General Public License
|
||||||
|
;;; along with Mes. If not, see <http://www.gnu.org/licenses/>.
|
||||||
|
|
||||||
|
(define-macro (if expr then . else)
|
||||||
|
(list 'cond ;; COND
|
||||||
|
(list expr then)
|
||||||
|
(list #t (list 'cond (list (pair? else) ;; COND
|
||||||
|
(cons (cons 'lambda (cons '() (cons (cons 'begin (cons *unspecified* else)) '()))) '()))))))
|
||||||
|
|
||||||
|
(define (cons* x . rest)
|
||||||
|
(define (loop rest)
|
||||||
|
(cond ((null? (cdr rest)) (car rest)) ;; COND
|
||||||
|
(#t (cons (car rest) (loop (cdr rest))))))
|
||||||
|
(loop (cons x rest)))
|
||||||
40
base0-if.mes
Normal file
40
base0-if.mes
Normal file
|
|
@ -0,0 +1,40 @@
|
||||||
|
;;; -*-scheme-*-
|
||||||
|
|
||||||
|
;;; Mes --- Maxwell Equations of Software
|
||||||
|
;;; Copyright © 2016 Jan Nieuwenhuizen <janneke@gnu.org>
|
||||||
|
;;;
|
||||||
|
;;; base.mes: This file is part of Mes.
|
||||||
|
;;;
|
||||||
|
;;; Mes is free software; you can redistribute it and/or modify it
|
||||||
|
;;; under the terms of the GNU General Public License as published by
|
||||||
|
;;; the Free Software Foundation; either version 3 of the License, or (at
|
||||||
|
;;; your option) any later version.
|
||||||
|
;;;
|
||||||
|
;;; Mes is distributed in the hope that it will be useful, but
|
||||||
|
;;; WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||||
|
;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
||||||
|
;;; GNU General Public License for more details.
|
||||||
|
;;;
|
||||||
|
;;; You should have received a copy of the GNU General Public License
|
||||||
|
;;; along with Mes. If not, see <http://www.gnu.org/licenses/>.
|
||||||
|
|
||||||
|
(define (cons* x . rest)
|
||||||
|
(define (loop rest)
|
||||||
|
(if (null? (cdr rest)) (car rest) ;; IF
|
||||||
|
(cons (car rest) (loop (cdr rest)))))
|
||||||
|
(loop (cons x rest)))
|
||||||
|
|
||||||
|
(define-macro cond
|
||||||
|
(lambda clauses
|
||||||
|
(if (null? clauses) *unspecified* ;; IF
|
||||||
|
(if (null? (cdr clauses)) ;; IF
|
||||||
|
(list 'if (car (car clauses)) ;; IF
|
||||||
|
(cons* 'begin (car (car clauses)) (cdr (car clauses)))
|
||||||
|
*unspecified*)
|
||||||
|
(if (eq? (car (cadr clauses)) 'else) ;; IF
|
||||||
|
(list 'if (car (car clauses)) ;; IF
|
||||||
|
(cons* 'begin (car (car clauses)) (cdr (car clauses)))
|
||||||
|
(cons* 'begin *unspecified* (cdr (cadr clauses))))
|
||||||
|
(list 'if (car (car clauses)) ;; IF
|
||||||
|
(cons* 'begin (car (car clauses)) (cdr (car clauses)))
|
||||||
|
(cons* 'cond (cdr clauses)))))))) ;; IF
|
||||||
825
cgram-ll1
Normal file
825
cgram-ll1
Normal file
|
|
@ -0,0 +1,825 @@
|
||||||
|
; Author: Mohd Hanafiah Abdullah (napi@cs.indiana.edu or napi@ms.mimos.my)
|
||||||
|
; Please report any bugs that you find. Thanks.
|
||||||
|
;
|
||||||
|
; ANSI C LL(k) GRAMMAR (1 <= k <= 2)
|
||||||
|
;
|
||||||
|
; THE TERMINALS
|
||||||
|
;
|
||||||
|
; "identifier" "octal_constant" "hex_constant" "decimal_constant"
|
||||||
|
; "float_constant" "char_constant" "string_literal" "sizeof"
|
||||||
|
; "->" "++" "--" "<<" ">>" "<=" ">=" "==" "!="
|
||||||
|
; "&&" "||" "*=" "/=" "%=" "+="
|
||||||
|
; "-=" "<<=" ">>=" "&="
|
||||||
|
; "^=" "|="
|
||||||
|
|
||||||
|
; "typedef" "extern" "static" "auto" "register"
|
||||||
|
; "char" "short" "int" "long" "signed" "unsigned" "float" "double"
|
||||||
|
; "const" "volatile" "void"
|
||||||
|
; "struct" "union" "enum" "..."
|
||||||
|
|
||||||
|
; "case" "default" "if" "else" "switch" "while" "do" "for" "goto"
|
||||||
|
; "continue" "break" "return"
|
||||||
|
;---------------------------------------------------------------------------
|
||||||
|
|
||||||
|
(define g
|
||||||
|
'((primary_expr
|
||||||
|
("identifier")
|
||||||
|
("octal_constant")
|
||||||
|
("hex_constant")
|
||||||
|
("decimal_constant")
|
||||||
|
("float_constant")
|
||||||
|
("char_constant")
|
||||||
|
("string_literal")
|
||||||
|
("(" expr ")"))
|
||||||
|
|
||||||
|
(postfix_expr
|
||||||
|
(primary_expr postfix_exprP))
|
||||||
|
|
||||||
|
(postfix_exprP
|
||||||
|
("[" expr "]" postfix_exprP)
|
||||||
|
("(" fact_postfix_exprP)
|
||||||
|
("." "identifier" postfix_exprP)
|
||||||
|
("->" "identifier" postfix_exprP)
|
||||||
|
("++" postfix_exprP)
|
||||||
|
("--" postfix_exprP)
|
||||||
|
())
|
||||||
|
|
||||||
|
(fact_postfix_exprP
|
||||||
|
(argument_expr_list ")" postfix_exprP)
|
||||||
|
(")" postfix_exprP))
|
||||||
|
|
||||||
|
(argument_expr_list
|
||||||
|
(assignment_expr argument_expr_listP))
|
||||||
|
|
||||||
|
(argument_expr_listP
|
||||||
|
("," assignment_expr argument_expr_listP)
|
||||||
|
())
|
||||||
|
|
||||||
|
(unary_expr
|
||||||
|
(postfix_expr)
|
||||||
|
("++" unary_expr)
|
||||||
|
("--" unary_expr)
|
||||||
|
(unary_operator cast_expr)
|
||||||
|
("sizeof" fact_unary_expr))
|
||||||
|
|
||||||
|
(fact_unary_expr
|
||||||
|
("identifier" postfix_exprP)
|
||||||
|
("octal_constant" postfix_exprP)
|
||||||
|
("hex_constant" postfix_exprP)
|
||||||
|
("decimal_constant" postfix_exprP)
|
||||||
|
("float_constant" postfix_exprP)
|
||||||
|
("char_constant" postfix_exprP)
|
||||||
|
("string_literal" postfix_exprP)
|
||||||
|
("++" unary_expr)
|
||||||
|
("--" unary_expr)
|
||||||
|
(unary_operator cast_expr)
|
||||||
|
("sizeof" fact_unary_expr)
|
||||||
|
("(" fact_fact_unary_expr))
|
||||||
|
|
||||||
|
(fact_fact_unary_expr
|
||||||
|
(expr ")" postfix_exprP)
|
||||||
|
(type_name ")"))
|
||||||
|
|
||||||
|
(unary_operator
|
||||||
|
("&")
|
||||||
|
("*")
|
||||||
|
("+")
|
||||||
|
("-")
|
||||||
|
("~")
|
||||||
|
("!"))
|
||||||
|
|
||||||
|
(cast_expr
|
||||||
|
("identifier" postfix_exprP)
|
||||||
|
("octal_constant" postfix_exprP)
|
||||||
|
("hex_constant" postfix_exprP)
|
||||||
|
("decimal_constant" postfix_exprP)
|
||||||
|
("float_constant" postfix_exprP)
|
||||||
|
("char_constant" postfix_exprP)
|
||||||
|
("string_literal" postfix_exprP)
|
||||||
|
("++" unary_expr)
|
||||||
|
("--" unary_expr)
|
||||||
|
(unary_operator cast_expr)
|
||||||
|
("sizeof" fact_unary_expr)
|
||||||
|
("(" fact_cast_expr))
|
||||||
|
|
||||||
|
(fact_cast_expr
|
||||||
|
(expr ")" postfix_exprP)
|
||||||
|
(type_name ")" cast_expr))
|
||||||
|
|
||||||
|
(multiplicative_expr
|
||||||
|
(cast_expr multiplicative_exprP))
|
||||||
|
|
||||||
|
(multiplicative_exprP
|
||||||
|
("*" cast_expr multiplicative_exprP)
|
||||||
|
("/" cast_expr multiplicative_exprP)
|
||||||
|
("%" cast_expr multiplicative_exprP)
|
||||||
|
())
|
||||||
|
|
||||||
|
(additive_expr
|
||||||
|
(multiplicative_expr additive_exprP))
|
||||||
|
|
||||||
|
(additive_exprP
|
||||||
|
("+" multiplicative_expr additive_exprP)
|
||||||
|
("-" multiplicative_expr additive_exprP)
|
||||||
|
())
|
||||||
|
|
||||||
|
(shift_expr
|
||||||
|
(additive_expr shift_exprP))
|
||||||
|
|
||||||
|
(shift_exprP
|
||||||
|
("<<" additive_expr shift_exprP)
|
||||||
|
(">>" additive_expr shift_exprP)
|
||||||
|
())
|
||||||
|
|
||||||
|
(relational_expr
|
||||||
|
(shift_expr relational_exprP))
|
||||||
|
|
||||||
|
(relational_exprP
|
||||||
|
("<" shift_expr relational_exprP)
|
||||||
|
(">" shift_expr relational_exprP)
|
||||||
|
("<=" shift_expr relational_exprP)
|
||||||
|
(">=" shift_expr relational_exprP)
|
||||||
|
())
|
||||||
|
|
||||||
|
(equality_expr
|
||||||
|
(relational_expr equality_exprP))
|
||||||
|
|
||||||
|
(equality_exprP
|
||||||
|
("==" relational_expr equality_exprP)
|
||||||
|
("!=" relational_expr equality_exprP)
|
||||||
|
())
|
||||||
|
|
||||||
|
(and_expr
|
||||||
|
(equality_expr and_exprP))
|
||||||
|
|
||||||
|
(and_exprP
|
||||||
|
("&" equality_expr and_exprP)
|
||||||
|
())
|
||||||
|
|
||||||
|
(exclusive_or_expr
|
||||||
|
(and_expr exclusive_or_exprP))
|
||||||
|
|
||||||
|
(exclusive_or_exprP
|
||||||
|
("^" and_expr exclusive_or_exprP)
|
||||||
|
())
|
||||||
|
|
||||||
|
(inclusive_or_expr
|
||||||
|
(exclusive_or_expr inclusive_or_exprP))
|
||||||
|
|
||||||
|
(inclusive_or_exprP
|
||||||
|
("|" exclusive_or_expr inclusive_or_exprP)
|
||||||
|
())
|
||||||
|
|
||||||
|
(logical_and_expr
|
||||||
|
(inclusive_or_expr logical_and_exprP))
|
||||||
|
|
||||||
|
(logical_and_exprP
|
||||||
|
("&&" inclusive_or_expr logical_and_exprP)
|
||||||
|
())
|
||||||
|
|
||||||
|
(logical_or_expr
|
||||||
|
(logical_and_expr logical_or_exprP))
|
||||||
|
|
||||||
|
(logical_or_exprP
|
||||||
|
("||" logical_and_expr logical_or_exprP)
|
||||||
|
())
|
||||||
|
|
||||||
|
(conditional_expr
|
||||||
|
(logical_or_expr fact_conditional_expr))
|
||||||
|
|
||||||
|
(fact_conditional_expr
|
||||||
|
("?" expr ":" conditional_expr)
|
||||||
|
())
|
||||||
|
|
||||||
|
(assignment_expr
|
||||||
|
(conditional_expr fact_assignment_expr))
|
||||||
|
|
||||||
|
(fact_assignment_expr
|
||||||
|
(assignment_operator assignment_expr)
|
||||||
|
())
|
||||||
|
|
||||||
|
(assignment_operator
|
||||||
|
("=")
|
||||||
|
("*=")
|
||||||
|
("/=")
|
||||||
|
("%=")
|
||||||
|
("+=")
|
||||||
|
("-=")
|
||||||
|
("<<=")
|
||||||
|
(">>=")
|
||||||
|
("&=")
|
||||||
|
("^=")
|
||||||
|
("|="))
|
||||||
|
|
||||||
|
(OPT_EXPR
|
||||||
|
(expr)
|
||||||
|
())
|
||||||
|
|
||||||
|
(expr
|
||||||
|
(assignment_expr exprP))
|
||||||
|
|
||||||
|
(exprP
|
||||||
|
("," assignment_expr exprP)
|
||||||
|
())
|
||||||
|
|
||||||
|
(constant_expr
|
||||||
|
(conditional_expr))
|
||||||
|
|
||||||
|
(declaration
|
||||||
|
(declaration_specifiers fact_declaration))
|
||||||
|
|
||||||
|
(fact_declaration
|
||||||
|
(init_declarator_list ";")
|
||||||
|
(";"))
|
||||||
|
|
||||||
|
(declaration_specifiers
|
||||||
|
(storage_class_specifier fact_declaration_specifiers1)
|
||||||
|
(type_specifier fact_declaration_specifiers2)
|
||||||
|
(type_qualifier fact_declaration_specifiers3))
|
||||||
|
|
||||||
|
(fact_declaration_specifiers1
|
||||||
|
(declaration_specifiers)
|
||||||
|
())
|
||||||
|
|
||||||
|
(fact_declaration_specifiers2
|
||||||
|
(declaration_specifiers)
|
||||||
|
())
|
||||||
|
|
||||||
|
(fact_declaration_specifiers3
|
||||||
|
(declaration_specifiers)
|
||||||
|
())
|
||||||
|
|
||||||
|
(init_declarator_list
|
||||||
|
(init_declarator init_declarator_listP))
|
||||||
|
|
||||||
|
(init_declarator_listP
|
||||||
|
("," init_declarator init_declarator_listP)
|
||||||
|
())
|
||||||
|
|
||||||
|
(init_declarator
|
||||||
|
(declarator fact_init_declarator))
|
||||||
|
|
||||||
|
(fact_init_declarator
|
||||||
|
("=" initializer)
|
||||||
|
())
|
||||||
|
|
||||||
|
(storage_class_specifier
|
||||||
|
("typedef")
|
||||||
|
("extern")
|
||||||
|
("static")
|
||||||
|
("auto")
|
||||||
|
("register"))
|
||||||
|
|
||||||
|
(type_specifier
|
||||||
|
("void")
|
||||||
|
("char")
|
||||||
|
("short")
|
||||||
|
("int")
|
||||||
|
("long")
|
||||||
|
("float")
|
||||||
|
("double")
|
||||||
|
("signed")
|
||||||
|
("unsigned")
|
||||||
|
(struct_or_union_specifier)
|
||||||
|
(enum_specifier)
|
||||||
|
(typedef_name))
|
||||||
|
|
||||||
|
(struct_or_union_specifier
|
||||||
|
(struct_or_union fact_struct_or_union_specifier))
|
||||||
|
|
||||||
|
(fact_struct_or_union_specifier
|
||||||
|
("{" struct_declaration_list "}")
|
||||||
|
("identifier" fact_fact_struct_or_union_specifier))
|
||||||
|
|
||||||
|
(fact_fact_struct_or_union_specifier
|
||||||
|
("{" struct_declaration_list "}")
|
||||||
|
())
|
||||||
|
|
||||||
|
(struct_or_union
|
||||||
|
("struct")
|
||||||
|
("union"))
|
||||||
|
|
||||||
|
(struct_declaration_list
|
||||||
|
(struct_declaration struct_declaration_listP))
|
||||||
|
|
||||||
|
(struct_declaration_listP
|
||||||
|
(struct_declaration struct_declaration_listP)
|
||||||
|
())
|
||||||
|
|
||||||
|
(struct_declaration
|
||||||
|
(specifier_qualifier_list struct_declarator_list ";"))
|
||||||
|
|
||||||
|
(specifier_qualifier_list
|
||||||
|
(type_specifier fact_specifier_qualifier_list1)
|
||||||
|
(type_qualifier fact_specifier_qualifier_list2))
|
||||||
|
|
||||||
|
(fact_specifier_qualifier_list1
|
||||||
|
(specifier_qualifier_list)
|
||||||
|
())
|
||||||
|
|
||||||
|
(fact_specifier_qualifier_list2
|
||||||
|
(specifier_qualifier_list)
|
||||||
|
())
|
||||||
|
|
||||||
|
(struct_declarator_list
|
||||||
|
(struct_declarator struct_declarator_listP))
|
||||||
|
|
||||||
|
(struct_declarator_listP
|
||||||
|
("," struct_declarator struct_declarator_listP)
|
||||||
|
())
|
||||||
|
|
||||||
|
(struct_declarator
|
||||||
|
(declarator fact_struct_declarator)
|
||||||
|
(":" constant_expr))
|
||||||
|
|
||||||
|
(fact_struct_declarator
|
||||||
|
(":" constant_expr)
|
||||||
|
())
|
||||||
|
|
||||||
|
(enum_specifier
|
||||||
|
("enum" fact_enum_specifier))
|
||||||
|
|
||||||
|
(fact_enum_specifier
|
||||||
|
("{" enumerator_list "}")
|
||||||
|
("identifier" fact_fact_enum_specifier))
|
||||||
|
|
||||||
|
(fact_fact_enum_specifier
|
||||||
|
("{" enumerator_list "}")
|
||||||
|
())
|
||||||
|
|
||||||
|
(enumerator_list
|
||||||
|
(enumerator enumerator_listP))
|
||||||
|
|
||||||
|
(enumerator_listP
|
||||||
|
("," enumerator enumerator_listP)
|
||||||
|
())
|
||||||
|
|
||||||
|
(enumerator
|
||||||
|
("identifier" fact_enumerator))
|
||||||
|
|
||||||
|
(fact_enumerator
|
||||||
|
("=" constant_expr)
|
||||||
|
())
|
||||||
|
|
||||||
|
(type_qualifier
|
||||||
|
("const")
|
||||||
|
("volatile"))
|
||||||
|
|
||||||
|
(declarator
|
||||||
|
(pointer direct_declarator)
|
||||||
|
(direct_declarator))
|
||||||
|
|
||||||
|
(direct_declarator
|
||||||
|
("identifier" direct_declaratorP)
|
||||||
|
("(" declarator ")" direct_declaratorP))
|
||||||
|
|
||||||
|
(direct_declaratorP
|
||||||
|
("[" fact_direct_declaratorP1)
|
||||||
|
("(" fact_direct_declaratorP2)
|
||||||
|
())
|
||||||
|
|
||||||
|
(fact_direct_declaratorP1
|
||||||
|
(constant_expr "]" direct_declaratorP)
|
||||||
|
("]" direct_declaratorP))
|
||||||
|
|
||||||
|
(fact_direct_declaratorP2
|
||||||
|
(parameter_type_list ")" direct_declaratorP)
|
||||||
|
(identifier_list ")" direct_declaratorP)
|
||||||
|
(")" direct_declaratorP))
|
||||||
|
|
||||||
|
(pointer
|
||||||
|
("*" fact_pointer))
|
||||||
|
|
||||||
|
(fact_pointer
|
||||||
|
(type_qualifier_list fact_fact_pointer)
|
||||||
|
(pointer)
|
||||||
|
())
|
||||||
|
|
||||||
|
(fact_fact_pointer
|
||||||
|
(pointer)
|
||||||
|
())
|
||||||
|
|
||||||
|
(type_qualifier_list
|
||||||
|
(type_qualifier type_qualifier_listP))
|
||||||
|
|
||||||
|
(type_qualifier_listP
|
||||||
|
(type_qualifier type_qualifier_listP)
|
||||||
|
())
|
||||||
|
|
||||||
|
(identifier_list
|
||||||
|
("identifier" identifier_listP))
|
||||||
|
|
||||||
|
(identifier_listP
|
||||||
|
("," "identifier" identifier_listP)
|
||||||
|
())
|
||||||
|
|
||||||
|
(parameter_type_list
|
||||||
|
(parameter_list fact_parameter_type_list))
|
||||||
|
|
||||||
|
(fact_parameter_type_list
|
||||||
|
("," "...")
|
||||||
|
())
|
||||||
|
|
||||||
|
(parameter_list
|
||||||
|
(parameter_declaration parameter_listP))
|
||||||
|
|
||||||
|
(parameter_listP
|
||||||
|
("," parameter_declaration parameter_listP)
|
||||||
|
())
|
||||||
|
|
||||||
|
(parameter_declaration
|
||||||
|
(declaration_specifiers fact_parameter_declaration))
|
||||||
|
|
||||||
|
(fact_parameter_declaration
|
||||||
|
(modified_declarator)
|
||||||
|
())
|
||||||
|
|
||||||
|
(modified_declarator
|
||||||
|
(pointer fact_modified_declarator)
|
||||||
|
(direct_modified_declarator))
|
||||||
|
|
||||||
|
(fact_modified_declarator
|
||||||
|
(direct_modified_declarator)
|
||||||
|
())
|
||||||
|
|
||||||
|
(direct_modified_declarator
|
||||||
|
("identifier" direct_modified_declaratorP)
|
||||||
|
("[" fact_direct_modified_declarator1)
|
||||||
|
("(" fact_direct_modified_declarator2))
|
||||||
|
|
||||||
|
(fact_direct_modified_declarator1
|
||||||
|
(constant_expr "]" direct_modified_declaratorP)
|
||||||
|
("]" direct_modified_declaratorP))
|
||||||
|
|
||||||
|
(fact_direct_modified_declarator2
|
||||||
|
(modified_declarator ")" direct_modified_declaratorP)
|
||||||
|
(parameter_type_list ")" direct_modified_declaratorP)
|
||||||
|
(")" direct_modified_declaratorP))
|
||||||
|
|
||||||
|
(direct_modified_declaratorP
|
||||||
|
("[" fact_direct_modified_declaratorP1)
|
||||||
|
("(" fact_direct_modified_declaratorP2)
|
||||||
|
())
|
||||||
|
|
||||||
|
(fact_direct_modified_declaratorP1
|
||||||
|
(constant_expr "]" direct_modified_declaratorP)
|
||||||
|
("]" direct_modified_declaratorP))
|
||||||
|
|
||||||
|
(fact_direct_modified_declaratorP2
|
||||||
|
(parameter_type_list ")" direct_modified_declaratorP)
|
||||||
|
(")" direct_modified_declaratorP))
|
||||||
|
|
||||||
|
(type_name
|
||||||
|
(specifier_qualifier_list fact_type_name))
|
||||||
|
|
||||||
|
(fact_type_name
|
||||||
|
(abstract_declarator)
|
||||||
|
())
|
||||||
|
|
||||||
|
(abstract_declarator
|
||||||
|
(pointer fact_abstract_declarator)
|
||||||
|
(direct_abstract_declarator))
|
||||||
|
|
||||||
|
(fact_abstract_declarator
|
||||||
|
(direct_abstract_declarator)
|
||||||
|
())
|
||||||
|
|
||||||
|
(direct_abstract_declarator
|
||||||
|
("[" fact_direct_abstract_declarator1)
|
||||||
|
("(" fact_direct_abstract_declarator2))
|
||||||
|
|
||||||
|
(fact_direct_abstract_declarator1
|
||||||
|
(constant_expr "]" direct_abstract_declaratorP)
|
||||||
|
("]" direct_abstract_declaratorP))
|
||||||
|
|
||||||
|
(fact_direct_abstract_declarator2
|
||||||
|
(abstract_declarator ")" direct_abstract_declaratorP)
|
||||||
|
(parameter_type_list ")" direct_abstract_declaratorP)
|
||||||
|
(")" direct_abstract_declaratorP))
|
||||||
|
|
||||||
|
(direct_abstract_declaratorP
|
||||||
|
("[" fact_direct_abstract_declaratorP1)
|
||||||
|
("(" fact_direct_abstract_declaratorP2)
|
||||||
|
())
|
||||||
|
|
||||||
|
(fact_direct_abstract_declaratorP1
|
||||||
|
(constant_expr "]" direct_abstract_declaratorP)
|
||||||
|
("]" direct_abstract_declaratorP))
|
||||||
|
|
||||||
|
(fact_direct_abstract_declaratorP2
|
||||||
|
(parameter_type_list ")" direct_abstract_declaratorP)
|
||||||
|
(")" direct_abstract_declaratorP))
|
||||||
|
|
||||||
|
(typedef_name
|
||||||
|
("identifier"))
|
||||||
|
|
||||||
|
(initializer
|
||||||
|
(assignment_expr)
|
||||||
|
("{" initializer_list fact_initializer))
|
||||||
|
|
||||||
|
(fact_initializer
|
||||||
|
("}")
|
||||||
|
("," "}"))
|
||||||
|
|
||||||
|
(initializer_list
|
||||||
|
(initializer initializer_listP))
|
||||||
|
|
||||||
|
(initializer_listP
|
||||||
|
("," initializer initializer_listP)
|
||||||
|
())
|
||||||
|
|
||||||
|
(statement
|
||||||
|
(labeled_statement)
|
||||||
|
(compound_statement)
|
||||||
|
(expression_statement)
|
||||||
|
(selection_statement)
|
||||||
|
(iteration_statement)
|
||||||
|
(jump_statement))
|
||||||
|
|
||||||
|
(labeled_statement
|
||||||
|
("identifier" ":" statement)
|
||||||
|
("case" constant_expr ":" statement)
|
||||||
|
("default" ":" statement))
|
||||||
|
|
||||||
|
(compound_statement
|
||||||
|
("{" fact_compound_statement))
|
||||||
|
|
||||||
|
(fact_compound_statement
|
||||||
|
(declaration_list fact_fact_compound_statement)
|
||||||
|
(statement_list "}")
|
||||||
|
("}"))
|
||||||
|
|
||||||
|
(fact_fact_compound_statement
|
||||||
|
(statement_list "}")
|
||||||
|
("}"))
|
||||||
|
|
||||||
|
(declaration_list
|
||||||
|
(declaration declaration_listP))
|
||||||
|
|
||||||
|
(declaration_listP
|
||||||
|
(declaration declaration_listP)
|
||||||
|
())
|
||||||
|
|
||||||
|
(statement_list
|
||||||
|
(statement statement_listP))
|
||||||
|
|
||||||
|
(statement_listP
|
||||||
|
(statement statement_listP)
|
||||||
|
())
|
||||||
|
|
||||||
|
(expression_statement
|
||||||
|
(expr ";")
|
||||||
|
(";"))
|
||||||
|
|
||||||
|
(selection_statement
|
||||||
|
("if" "(" expr ")" statement fact_selection_statement)
|
||||||
|
("switch" "(" expr ")" statement))
|
||||||
|
|
||||||
|
(fact_selection_statement
|
||||||
|
("else" statement)
|
||||||
|
())
|
||||||
|
|
||||||
|
(iteration_statement
|
||||||
|
("while" "(" expr ")" statement)
|
||||||
|
("do" statement "while" "(" expr ")" ";")
|
||||||
|
("for" "(" OPT_EXPR ";" OPT_EXPR ";" OPT_EXPR ")" statement))
|
||||||
|
|
||||||
|
(jump_statement
|
||||||
|
("goto" "identifier" ";")
|
||||||
|
("continue" ";")
|
||||||
|
("break" ";")
|
||||||
|
("return" fact_jump_statement))
|
||||||
|
|
||||||
|
(fact_jump_statement
|
||||||
|
(";")
|
||||||
|
(expr ";"))
|
||||||
|
|
||||||
|
(translation_unit
|
||||||
|
(external_declaration translation_unitP))
|
||||||
|
|
||||||
|
(translation_unitP
|
||||||
|
(external_declaration translation_unitP)
|
||||||
|
())
|
||||||
|
|
||||||
|
(external_declaration
|
||||||
|
(arbitrary_declaration))
|
||||||
|
|
||||||
|
(OPT_DECLARATION_LIST
|
||||||
|
(declaration_list)
|
||||||
|
())
|
||||||
|
|
||||||
|
(arbitrary_declaration
|
||||||
|
(declaration_specifiers fact_arbitrary_declaration)
|
||||||
|
(declarator OPT_DECLARATION_LIST compound_statement))
|
||||||
|
|
||||||
|
(fact_arbitrary_declaration
|
||||||
|
(choice1)
|
||||||
|
(";"))
|
||||||
|
|
||||||
|
(choice1
|
||||||
|
(init_declarator fact_choice1))
|
||||||
|
|
||||||
|
(fact_choice1
|
||||||
|
("," choice1)
|
||||||
|
(";")
|
||||||
|
(OPT_DECLARATION_LIST compound_statement))
|
||||||
|
))
|
||||||
|
|
||||||
|
------------------------------Cut Here---------------------------------------
|
||||||
|
; f-f-d.s
|
||||||
|
;
|
||||||
|
; Computation of the LL(1) condition, LL(1) director sets,
|
||||||
|
; and FIRST and FOLLOW sets.
|
||||||
|
;
|
||||||
|
; Grammars are represented as a list of entries, where each
|
||||||
|
; entry is a list giving the productions for a nonterminal.
|
||||||
|
; The first entry in the grammar must be for the start symbol.
|
||||||
|
; The car of an entry is the nonterminal; the cdr is a list
|
||||||
|
; of productions. Each production is a list of grammar symbols
|
||||||
|
; giving the right hand side for the production; the empty string
|
||||||
|
; is represented by the empty list.
|
||||||
|
; A nonterminal is represented as a Scheme symbol.
|
||||||
|
; A terminal is represented as a Scheme string.
|
||||||
|
;
|
||||||
|
; Example:
|
||||||
|
;
|
||||||
|
; (define g
|
||||||
|
; '((S ("id" ":=" E "\;")
|
||||||
|
; ("while" E S)
|
||||||
|
; ("do" S A "od"))
|
||||||
|
; (A ()
|
||||||
|
; (S A))
|
||||||
|
; (E (T E'))
|
||||||
|
; (E' () ("+" T E') ("-" T E'))
|
||||||
|
; (T (F T'))
|
||||||
|
; (T' () ("*" F T') ("/" F T'))
|
||||||
|
; (F ("id") ("(" E ")"))))
|
||||||
|
|
||||||
|
; Given a grammar, returns #t if it is LL(1), else returns #f.
|
||||||
|
|
||||||
|
(define (LL1? g)
|
||||||
|
(define (loop dsets)
|
||||||
|
(cond ((null? dsets) #t)
|
||||||
|
((disjoint? (cdr (car dsets))) (loop (cdr dsets)))
|
||||||
|
(else (display "Failure of LL(1) condition ")
|
||||||
|
(write (car dsets))
|
||||||
|
(newline)
|
||||||
|
(loop (cdr dsets)))))
|
||||||
|
(define (disjoint? sets)
|
||||||
|
(cond ((null? sets) #t)
|
||||||
|
((null? (car sets)) (disjoint? (cdr sets)))
|
||||||
|
((member-remaining-sets? (caar sets) (cdr sets))
|
||||||
|
#f)
|
||||||
|
(else (disjoint? (cons (cdr (car sets)) (cdr sets))))))
|
||||||
|
(define (member-remaining-sets? x sets)
|
||||||
|
(cond ((null? sets) #f)
|
||||||
|
((member x (car sets)) #t)
|
||||||
|
(else (member-remaining-sets? x (cdr sets)))))
|
||||||
|
(loop (director-sets g)))
|
||||||
|
|
||||||
|
; Given a grammar, returns the director sets for each production.
|
||||||
|
; In a director set, the end of file token is represented as the
|
||||||
|
; Scheme symbol $.
|
||||||
|
|
||||||
|
(define (director-sets g)
|
||||||
|
(let ((follows (follow-sets g)))
|
||||||
|
(map (lambda (p)
|
||||||
|
(let ((lhs (car p))
|
||||||
|
(alternatives (cdr p)))
|
||||||
|
(cons lhs
|
||||||
|
(map (lambda (rhs)
|
||||||
|
(let ((f (first rhs g '())))
|
||||||
|
(if (member "" f)
|
||||||
|
(union (lookup lhs follows)
|
||||||
|
(remove "" f))
|
||||||
|
f)))
|
||||||
|
alternatives))))
|
||||||
|
g)))
|
||||||
|
|
||||||
|
; Given a string of grammar symbols, a grammar, and a list of nonterminals
|
||||||
|
; that have appeared in the leftmost position during the recursive
|
||||||
|
; computation of FIRST(s), returns FIRST(s).
|
||||||
|
; In the output, the empty string is represented as the Scheme string "".
|
||||||
|
; Prints a warning message if left recursion is detected.
|
||||||
|
|
||||||
|
(define (first s g recursion)
|
||||||
|
(cond ((null? s) '(""))
|
||||||
|
((memq (car s) recursion)
|
||||||
|
(display "Left recursion for ")
|
||||||
|
(write (car s))
|
||||||
|
(newline)
|
||||||
|
'())
|
||||||
|
((and (null? (cdr s)) (string? (car s))) s)
|
||||||
|
((and (null? (cdr s)) (symbol? (car s)))
|
||||||
|
(let ((p (assoc (car s) g))
|
||||||
|
(newrecursion (cons (car s) recursion)))
|
||||||
|
(cond ((not p)
|
||||||
|
(error "No production for " (car s)))
|
||||||
|
(else (apply union
|
||||||
|
(map (lambda (s) (first s g newrecursion))
|
||||||
|
(cdr p)))))))
|
||||||
|
(else (let ((x (first (list (car s)) g recursion)))
|
||||||
|
(if (member "" x)
|
||||||
|
(append (remove "" x)
|
||||||
|
(first (cdr s) g recursion))
|
||||||
|
x)))))
|
||||||
|
|
||||||
|
; Given a grammar g, returns FOLLOW(g).
|
||||||
|
; In the output, the end of file token is represented as the Scheme
|
||||||
|
; symbol $.
|
||||||
|
; Warning messages will be printed if left recursion is detected.
|
||||||
|
|
||||||
|
(define (follow-sets g)
|
||||||
|
|
||||||
|
; Uses a relaxation algorithm.
|
||||||
|
|
||||||
|
(define (loop g table)
|
||||||
|
(let* ((new (map (lambda (x) (cons x (fol x g table)))
|
||||||
|
(map car g)))
|
||||||
|
(new (cons (cons (caar new) (union '($) (cdar new)))
|
||||||
|
(cdr new))))
|
||||||
|
(if (equal-table? table new)
|
||||||
|
table
|
||||||
|
(loop g new))))
|
||||||
|
|
||||||
|
; Given a nonterminal, a grammar, and a table giving
|
||||||
|
; preliminary follow sets for all nonterminals, returns
|
||||||
|
; the next approximation to the follow set for the given
|
||||||
|
; nonterminal.
|
||||||
|
|
||||||
|
(define (fol x g t)
|
||||||
|
(define (fol-production p)
|
||||||
|
(let ((lhs (car p))
|
||||||
|
(alternatives (cdr p)))
|
||||||
|
(do ((l alternatives (cdr l))
|
||||||
|
(f '() (union (fol-alternative x (car l)) f)))
|
||||||
|
((null? l)
|
||||||
|
(if (member "" f)
|
||||||
|
(union (lookup lhs t)
|
||||||
|
(remove "" f))
|
||||||
|
f)))))
|
||||||
|
(define (fol-alternative x rhs)
|
||||||
|
(cond ((null? rhs) '())
|
||||||
|
((eq? x (car rhs))
|
||||||
|
(union (first (cdr rhs) g '())
|
||||||
|
(fol-alternative x (cdr rhs))))
|
||||||
|
(else (fol-alternative x (cdr rhs)))))
|
||||||
|
(apply union (map fol-production g)))
|
||||||
|
|
||||||
|
(loop g
|
||||||
|
(cons (list (caar g) '$)
|
||||||
|
(map (lambda (p) (cons (car p) '()))
|
||||||
|
(cdr g)))))
|
||||||
|
|
||||||
|
; Tables represented as association lists using eq? for equality.
|
||||||
|
|
||||||
|
(define (lookup x t)
|
||||||
|
(cdr (assq x t)))
|
||||||
|
|
||||||
|
(define (equal-table? x y)
|
||||||
|
(cond ((and (null? x) (null? y)) #t)
|
||||||
|
((or (null? x) (null? y)) #f)
|
||||||
|
(else (let ((entry (assoc (caar x) y)))
|
||||||
|
(if entry
|
||||||
|
(and (equal-as-sets? (cdr (car x)) (cdr entry))
|
||||||
|
(equal-table? (cdr x) (remove entry y)))
|
||||||
|
#f)))))
|
||||||
|
|
||||||
|
; Sets represented as lists.
|
||||||
|
|
||||||
|
(define (equal-as-sets? x y)
|
||||||
|
(and (every? (lambda (a) (member a y)) x)
|
||||||
|
(every? (lambda (a) (member a x)) y)))
|
||||||
|
|
||||||
|
(define (union . args)
|
||||||
|
(define (union2 x y)
|
||||||
|
(cond ((null? x) y)
|
||||||
|
((member (car x) y)
|
||||||
|
(union (cdr x) y))
|
||||||
|
(else (cons (car x)
|
||||||
|
(union (cdr x) y)))))
|
||||||
|
(cond ((null? args) '())
|
||||||
|
((null? (cdr args)) (car args))
|
||||||
|
((null? (cddr args)) (union2 (car args) (cadr args)))
|
||||||
|
(else (union2 (union2 (car args) (cadr args))
|
||||||
|
(apply union (cddr args))))))
|
||||||
|
|
||||||
|
(define (every? p? l)
|
||||||
|
(cond ((null? l) #t)
|
||||||
|
((p? (car l)) (every? p? (cdr l)))
|
||||||
|
(else #f)))
|
||||||
|
|
||||||
|
(define remove
|
||||||
|
(lambda (item ls)
|
||||||
|
(cond
|
||||||
|
((null? ls) '())
|
||||||
|
((equal? (car ls) item) (remove item (cdr ls)))
|
||||||
|
(else (cons (car ls) (remove item (cdr ls)))))))
|
||||||
|
|
||||||
|
(define pp-director-sets
|
||||||
|
(lambda (g)
|
||||||
|
(pp (director-sets g))))
|
||||||
|
|
||||||
|
(define pp-follow-sets
|
||||||
|
(lambda (g)
|
||||||
|
(pp (follow-sets g))))
|
||||||
9
let.mes
9
let.mes
|
|
@ -42,11 +42,18 @@
|
||||||
(set! ,label (lambda ,(map car bindings) ,@rest))
|
(set! ,label (lambda ,(map car bindings) ,@rest))
|
||||||
(,label ,@(map cadr bindings))))
|
(,label ,@(map cadr bindings))))
|
||||||
|
|
||||||
|
;; COND
|
||||||
(define-macro (let bindings-or-label . rest)
|
(define-macro (let bindings-or-label . rest)
|
||||||
`(cond (,(symbol? bindings-or-label)
|
`(cond (,(symbol? bindings-or-label) ;; COND
|
||||||
(xnamed-let ,bindings-or-label ,(car rest) ,(cdr rest)))
|
(xnamed-let ,bindings-or-label ,(car rest) ,(cdr rest)))
|
||||||
(#t (xsimple-let ,bindings-or-label ,rest))))
|
(#t (xsimple-let ,bindings-or-label ,rest))))
|
||||||
|
|
||||||
|
;; IF
|
||||||
|
(define-macro (let bindings-or-label . rest)
|
||||||
|
`(if ,(symbol? bindings-or-label) ;; IF
|
||||||
|
(xnamed-let ,bindings-or-label ,(car rest) ,(cdr rest))
|
||||||
|
(xsimple-let ,bindings-or-label ,rest)))
|
||||||
|
|
||||||
(define (expand-let* bindings body)
|
(define (expand-let* bindings body)
|
||||||
(cond ((null? bindings)
|
(cond ((null? bindings)
|
||||||
`((lambda () ,@body)))
|
`((lambda () ,@body)))
|
||||||
|
|
|
||||||
|
|
@ -4,7 +4,7 @@
|
||||||
`(assq ,x (cddr (current-module))))
|
`(assq ,x (cddr (current-module))))
|
||||||
|
|
||||||
(define (cond-expand-expander clauses)
|
(define (cond-expand-expander clauses)
|
||||||
(named-let loop ((clauses clauses))
|
(let loop ((clauses clauses))
|
||||||
(if (defined? (caar clauses))
|
(if (defined? (caar clauses))
|
||||||
(eval (cons 'begin (cdar clauses)) (current-module))
|
(eval (cons 'begin (cdar clauses)) (current-module))
|
||||||
(loop (cdr clauses)))))
|
(loop (cdr clauses)))))
|
||||||
|
|
|
||||||
36
mes.c
36
mes.c
|
|
@ -88,6 +88,7 @@ scm symbol_lambda = {SYMBOL, "lambda"};
|
||||||
scm symbol_begin = {SYMBOL, "begin"};
|
scm symbol_begin = {SYMBOL, "begin"};
|
||||||
scm symbol_list = {SYMBOL, "list"};
|
scm symbol_list = {SYMBOL, "list"};
|
||||||
scm symbol_cond = {SYMBOL, "cond"};
|
scm symbol_cond = {SYMBOL, "cond"};
|
||||||
|
scm symbol_if = {SYMBOL, "if"};
|
||||||
scm symbol_quote = {SYMBOL, "quote"};
|
scm symbol_quote = {SYMBOL, "quote"};
|
||||||
scm symbol_quasiquote = {SYMBOL, "quasiquote"};
|
scm symbol_quasiquote = {SYMBOL, "quasiquote"};
|
||||||
scm symbol_unquote = {SYMBOL, "unquote"};
|
scm symbol_unquote = {SYMBOL, "unquote"};
|
||||||
|
|
@ -386,19 +387,24 @@ eval (scm *e, scm *a)
|
||||||
return make_closure (cadr (e), cddr (e), assq (&symbol_closure, a));
|
return make_closure (cadr (e), cddr (e), assq (&symbol_closure, a));
|
||||||
if (car (e) == &symbol_closure)
|
if (car (e) == &symbol_closure)
|
||||||
return e;
|
return e;
|
||||||
|
if ((macro = assq (&symbol_sc_expand, a)) != &scm_f)
|
||||||
|
if (cdr (macro) != &scm_f)
|
||||||
|
return eval (apply_env (cdr (macro), e, a), a);
|
||||||
|
if ((macro = lookup_macro (car (e), a)) != &scm_f)
|
||||||
|
return eval (apply_env (macro, cdr (e), a), a);
|
||||||
|
#if COND
|
||||||
if (car (e) == &symbol_cond)
|
if (car (e) == &symbol_cond)
|
||||||
return evcon (cdr (e), a);
|
return evcon (cdr (e), a);
|
||||||
|
#else
|
||||||
|
if (car (e) == &symbol_if)
|
||||||
|
return if_env (cdr (e), a);
|
||||||
|
#endif
|
||||||
if (eq_p (car (e), &symbol_define) == &scm_t)
|
if (eq_p (car (e), &symbol_define) == &scm_t)
|
||||||
return define (e, a);
|
return define (e, a);
|
||||||
if (eq_p (car (e), &symbol_define_macro) == &scm_t)
|
if (eq_p (car (e), &symbol_define_macro) == &scm_t)
|
||||||
return define (e, a);
|
return define (e, a);
|
||||||
if (car (e) == &symbol_set_x)
|
if (car (e) == &symbol_set_x)
|
||||||
return set_env_x (cadr (e), eval (caddr (e), a), a);
|
return set_env_x (cadr (e), eval (caddr (e), a), a);
|
||||||
if ((macro = assq (&symbol_sc_expand, a)) != &scm_f)
|
|
||||||
if (cdr (macro) != &scm_f)
|
|
||||||
return eval (apply_env (cdr (macro), e, a), a);
|
|
||||||
if ((macro = lookup_macro (car (e), a)) != &scm_f)
|
|
||||||
return eval (apply_env (macro, cdr (e), a), a);
|
|
||||||
if (car (e) == &symbol_unquote)
|
if (car (e) == &symbol_unquote)
|
||||||
return eval (cadr (e), a);
|
return eval (cadr (e), a);
|
||||||
if (car (e) == &symbol_quasiquote)
|
if (car (e) == &symbol_quasiquote)
|
||||||
|
|
@ -424,6 +430,16 @@ evcon (scm *c, scm *a)
|
||||||
return evcon (cdr (c), a);
|
return evcon (cdr (c), a);
|
||||||
}
|
}
|
||||||
|
|
||||||
|
scm *
|
||||||
|
if_env (scm *e, scm *a)
|
||||||
|
{
|
||||||
|
if (eval (car (e), a) != &scm_f)
|
||||||
|
return eval (cadr (e), a);
|
||||||
|
if (cddr (e) != &scm_nil)
|
||||||
|
return eval (caddr (e), a);
|
||||||
|
return &scm_unspecified;
|
||||||
|
}
|
||||||
|
|
||||||
scm *
|
scm *
|
||||||
evlis (scm *m, scm *a)
|
evlis (scm *m, scm *a)
|
||||||
{
|
{
|
||||||
|
|
@ -755,11 +771,13 @@ lookup (char *x, scm *a)
|
||||||
if (!strcmp (x, scm_nil.name)) return &scm_nil;
|
if (!strcmp (x, scm_nil.name)) return &scm_nil;
|
||||||
if (!strcmp (x, scm_t.name)) return &scm_t;
|
if (!strcmp (x, scm_t.name)) return &scm_t;
|
||||||
if (!strcmp (x, scm_unspecified.name)) return &scm_unspecified;
|
if (!strcmp (x, scm_unspecified.name)) return &scm_unspecified;
|
||||||
|
|
||||||
if (!strcmp (x, symbol_begin.name)) return &symbol_begin;
|
if (!strcmp (x, symbol_begin.name)) return &symbol_begin;
|
||||||
if (!strcmp (x, symbol_closure.name)) return &symbol_closure;
|
if (!strcmp (x, symbol_closure.name)) return &symbol_closure;
|
||||||
|
#if COND
|
||||||
if (!strcmp (x, symbol_cond.name)) return &symbol_cond;
|
if (!strcmp (x, symbol_cond.name)) return &symbol_cond;
|
||||||
if (!strcmp (x, symbol_current_module.name)) return &symbol_current_module;
|
#else
|
||||||
|
if (!strcmp (x, symbol_if.name)) return &symbol_if;
|
||||||
|
#endif
|
||||||
if (!strcmp (x, symbol_lambda.name)) return &symbol_lambda;
|
if (!strcmp (x, symbol_lambda.name)) return &symbol_lambda;
|
||||||
|
|
||||||
if (!strcmp (x, symbol_quasiquote.name)) return &symbol_quasiquote;
|
if (!strcmp (x, symbol_quasiquote.name)) return &symbol_quasiquote;
|
||||||
|
|
@ -792,6 +810,10 @@ lookup (char *x, scm *a)
|
||||||
fprintf (stderr, "mes: got EOF\n");
|
fprintf (stderr, "mes: got EOF\n");
|
||||||
return &scm_nil; // `EOF': eval program, which may read stdin
|
return &scm_nil; // `EOF': eval program, which may read stdin
|
||||||
}
|
}
|
||||||
|
|
||||||
|
// Hmm?
|
||||||
|
if (!strcmp (x, symbol_current_module.name)) return &symbol_current_module;
|
||||||
|
|
||||||
return make_symbol (x);
|
return make_symbol (x);
|
||||||
}
|
}
|
||||||
|
|
||||||
|
|
|
||||||
57
scm.mes
57
scm.mes
|
|
@ -20,11 +20,6 @@
|
||||||
|
|
||||||
(define (list . rest) rest)
|
(define (list . rest) rest)
|
||||||
|
|
||||||
(define-macro (if expr then . else)
|
|
||||||
`(cond
|
|
||||||
(,expr ,then)
|
|
||||||
(#t (cond (,(pair? else) ((lambda () ,@else)))))))
|
|
||||||
|
|
||||||
(define-macro (case val . args)
|
(define-macro (case val . args)
|
||||||
(if (null? args)
|
(if (null? args)
|
||||||
#f
|
#f
|
||||||
|
|
@ -57,17 +52,6 @@
|
||||||
|
|
||||||
(define integer? number?)
|
(define integer? number?)
|
||||||
|
|
||||||
(define (equal? a b) ;; FIXME: only 2 arg
|
|
||||||
(cond ((and (null? a) (null? b)) #t)
|
|
||||||
((and (pair? a) (pair? b))
|
|
||||||
(and (equal? (car a) (car b))
|
|
||||||
(equal? (cdr a) (cdr b))))
|
|
||||||
((and (string? a) (string? b))
|
|
||||||
(eq? (string->symbol a) (string->symbol b)))
|
|
||||||
((and (vector? a) (vector? b))
|
|
||||||
(equal? (vector->list a) (vector->list b)))
|
|
||||||
(#t (eq? a b))))
|
|
||||||
|
|
||||||
(define (vector . rest) (list->vector rest))
|
(define (vector . rest) (list->vector rest))
|
||||||
(define (make-vector n . x)
|
(define (make-vector n . x)
|
||||||
(let ((fill (if (pair? x) (car x) *unspecified*)))
|
(let ((fill (if (pair? x) (car x) *unspecified*)))
|
||||||
|
|
@ -90,42 +74,52 @@
|
||||||
(define assv-ref assq-ref)
|
(define assv-ref assq-ref)
|
||||||
|
|
||||||
(define (assoc key alist)
|
(define (assoc key alist)
|
||||||
(cond ((null? alist) #f)
|
(cond ((null? alist) #f) ;; COND
|
||||||
((equal? key (caar alist)) (car alist))
|
((equal? key (caar alist)) (car alist))
|
||||||
(#t (assoc key (cdr alist)))))
|
(#t (assoc key (cdr alist)))))
|
||||||
|
|
||||||
|
(define (assoc key alist)
|
||||||
|
(if (null? alist) #f ;; IF
|
||||||
|
(if (equal? key (caar alist)) (car alist)
|
||||||
|
(assoc key (cdr alist)))))
|
||||||
|
|
||||||
(define (assoc-ref alist key)
|
(define (assoc-ref alist key)
|
||||||
(let ((entry (assoc key alist)))
|
(let ((entry (assoc key alist)))
|
||||||
(if entry (cdr entry)
|
(if entry (cdr entry)
|
||||||
#f)))
|
#f)))
|
||||||
|
|
||||||
(define (memq x lst)
|
(define (memq x lst)
|
||||||
(cond ((null? lst) #f)
|
(cond ((null? lst) #f) ;; COND
|
||||||
((eq? x (car lst)) lst)
|
((eq? x (car lst)) lst)
|
||||||
(#t (memq x (cdr lst)))))
|
(#t (memq x (cdr lst)))))
|
||||||
|
|
||||||
|
(define (memq x lst)
|
||||||
|
(if (null? lst) #f ;; IF
|
||||||
|
(if (eq? x (car lst)) lst
|
||||||
|
(memq x (cdr lst)))))
|
||||||
(define memv memq)
|
(define memv memq)
|
||||||
|
|
||||||
(define (member x lst)
|
(define (member x lst)
|
||||||
(cond ((null? lst) #f)
|
(cond ((null? lst) #f) ;; COND
|
||||||
((equal? x (car lst)) lst)
|
((equal? x (car lst)) lst)
|
||||||
(#t (member x (cdr lst)))))
|
(#t (member x (cdr lst)))))
|
||||||
|
|
||||||
(define (map f l . r)
|
(define (member x lst)
|
||||||
(cond ((null? l) '())
|
(if (null? lst) #f ;; IF
|
||||||
((null? r) (cons (f (car l)) (map f (cdr l))))
|
(if (equal? x (car lst)) lst
|
||||||
((null? (cdr r))
|
(member x (cdr lst)))))
|
||||||
(cons (f (car l) (caar r)) (map f (cdr l) (cdar r))))))
|
|
||||||
|
|
||||||
(define (identity x) x)
|
|
||||||
(define (for-each f l . r)
|
(define (for-each f l . r)
|
||||||
(cond ((null? l) '())
|
(cond ((null? l) '()) ;; COND
|
||||||
((null? r) (f (car l)) (for-each f (cdr l)))
|
((null? r) (f (car l)) (for-each f (cdr l)))
|
||||||
((null? (cdr r))
|
((null? (cdr r))
|
||||||
(for-each f (cdr l) (cdar r)))))
|
(for-each f (cdr l) (cdar r)))))
|
||||||
|
|
||||||
(define (not x)
|
(define (for-each f l . r)
|
||||||
(cond (x #f)
|
(if (null? l) '() ;; IF
|
||||||
(#t #t)))
|
(if (null? r) (begin (f (car l)) (for-each f (cdr l)))
|
||||||
|
(if (null? (cdr r))
|
||||||
|
(for-each f (cdr l) (cdar r))))))
|
||||||
|
|
||||||
(define (<= . rest)
|
(define (<= . rest)
|
||||||
(or (apply < rest)
|
(or (apply < rest)
|
||||||
|
|
@ -135,6 +129,11 @@
|
||||||
(or (apply > rest)
|
(or (apply > rest)
|
||||||
(apply = rest)))
|
(apply = rest)))
|
||||||
|
|
||||||
|
;; (define (>= . rest)
|
||||||
|
;; (if (apply > rest) #t
|
||||||
|
;; (if (apply = rest) #t
|
||||||
|
;; #f)))
|
||||||
|
|
||||||
(define quotient /)
|
(define quotient /)
|
||||||
|
|
||||||
(define (remainder x y)
|
(define (remainder x y)
|
||||||
|
|
|
||||||
|
|
@ -27,11 +27,29 @@
|
||||||
(begin (define *top-begin-a* '*top-begin-a*))
|
(begin (define *top-begin-a* '*top-begin-a*))
|
||||||
(pass-if "top begin " (seq? *top-begin-a* '*top-begin-a*))
|
(pass-if "top begin " (seq? *top-begin-a* '*top-begin-a*))
|
||||||
|
|
||||||
|
(pass-if "if" (seq? (if #t 'true) 'true))
|
||||||
|
(pass-if "if 2" (seq? (if #f #f) *unspecified*))
|
||||||
|
(pass-if "if 3" (seq? (if (seq? 0 '0) 'true 'false) 'true))
|
||||||
|
(pass-if "if 4" (seq? (if (= 1 2) 'true 'false) 'false))
|
||||||
|
|
||||||
|
;;(pass-if ">=" (seq? (>= 3 2 1) #t))
|
||||||
|
|
||||||
|
(if (defined? 'cond)
|
||||||
|
(begin
|
||||||
|
(pass-if "cond" (seq? (cond (#f #f) (#t #t)) #t))
|
||||||
|
(pass-if "cond" (seq? (cond (#t)) #t))
|
||||||
|
(pass-if "cond 2" (seq? (cond (#f)) *unspecified*))
|
||||||
|
(pass-if "cond 3" (seq? (cond (#t 0)) 0))
|
||||||
|
(pass-if "cond 3" (seq? (cond (#f 1) (#t 0)) 0)))
|
||||||
|
)
|
||||||
|
|
||||||
(pass-if "and" (seq? (and 1) 1))
|
(pass-if "and" (seq? (and 1) 1))
|
||||||
(pass-if "and 2" (seq? (and 1 (= 0 1) #f) #f))
|
(pass-if "and 2" (seq? (and 1 (= 0 1) #f) #f))
|
||||||
(pass-if "or" (seq? (or) #f))
|
(pass-if "or" (seq? (or) #f))
|
||||||
(pass-if "or 2" (seq? (or 1) 1))
|
(pass-if "or 2" (seq? (or 1) 1))
|
||||||
(pass-if "or 3" (seq? (or #f (= 0 1) 3) 3))
|
(pass-if "or 3" (seq? (or #f (= 0 1) 3) 3))
|
||||||
|
(pass-if "or 4" (seq? (or (= 0 0) (= 0 1)) #t))
|
||||||
|
(pass-if "or 5" (seq? (or (= 0 1) (= 0 0)) #t))
|
||||||
(pass-if "let" (seq? (let () 0) 0))
|
(pass-if "let" (seq? (let () 0) 0))
|
||||||
(pass-if "let 2" (seq? (let ((x 0)) x) 0))
|
(pass-if "let 2" (seq? (let ((x 0)) x) 0))
|
||||||
(pass-if "let 3" (seq? (let ((p 5) (q 6)) (+ p q)) 11))
|
(pass-if "let 3" (seq? (let ((p 5) (q 6)) (+ p q)) 11))
|
||||||
|
|
|
||||||
|
|
@ -26,10 +26,6 @@
|
||||||
(pass-if "first dummy" #t)
|
(pass-if "first dummy" #t)
|
||||||
(pass-if-not "second dummy" #f)
|
(pass-if-not "second dummy" #f)
|
||||||
|
|
||||||
(pass-if "if" (seq? (if #t 'true) 'true))
|
|
||||||
(pass-if "if 2" (seq? (if (seq? 0 '0) 'true 'false) 'true))
|
|
||||||
(pass-if "if 3" (seq? (if (= 1 2) 'true 'false) 'false))
|
|
||||||
|
|
||||||
(pass-if "when" (seq? (when #t 'true) 'true))
|
(pass-if "when" (seq? (when #t 'true) 'true))
|
||||||
(pass-if "when 2" (seq? (when #f 'true) *unspecified*))
|
(pass-if "when 2" (seq? (when #f 'true) *unspecified*))
|
||||||
|
|
||||||
|
|
|
||||||
Loading…
Reference in a new issue