artemist/mes
1
0
Fork 0
Code Issues Pull requests Packages Projects Releases Wiki Activity

cleanup and doc update.

Browse source
This commit is contained in:
Jan Nieuwenhuizen 2016-10-10 23:24:44 +02:00
parent bf02fa7f07
commit 7ff86c393f
13 changed files with 253 additions and 1050 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

7
.gitignore vendored
View file

@ -6,11 +6,8 @@
/mes
/mes.h
/environment.i
/peg.test
/syntax.test
/paren.test
/syntax-case.test
/mescc.test
/symbols.i
/*.cat
?
?.mes
/hello

45
ANNOUNCE Normal file
View file

@ -0,0 +1,45 @@
Subject: on bootstrapping: introducing Mes
Date: Sun, 19 Jun 2016 13:08:02 +0200
Hi,
I have a minimal LISP-1.5-resembling interpreter in C that now can
also interpret itself
https://gitlab.com/janneke/mes
It was inspired by the seemingly often ignored bootstrapping question
made so painfully visible by GuixSD and by OriansJ with their self
hosting hex assembler project.
As a next step after a hex assembler I was thinking of getting Scheme up
and running and use that to create a tiny C compiler, probably using
PEG. For that I think we need define-syntax, which I had a peek at and
still scares the all-sorts-of-things out of me :-)
I searched for minimal Lisp/Scheme to get that going and found an
article called the Maxwell Equations of Software 1) with a pointer to
the 1962 LISP 1.5 paper by John McCarthy 2).
First I `implemented' Mes/LISP-1.5: the bottom half of page 13 and the
necessary helper procedures defined on pages 8-12 using Guile, removing
all but the primitives needed to run LISP-1.5/Mes (I think): car, cdr,
cond, cons, define, eq?, '()/nil, null?, pair? and quote. I cheated
with read, and with display and newline for debugging.
Then I translated the program into C and got rid of read by using
getchar/ungetchar.
It's been great fun and now I'm kind of stuck a bit at the point of
implementing macros. I have a simplistic version in C but want to
remove that again --I like the idea of having the absolute minimal LISP
interpreter in C-- and only introduce macros after having bootstrapped
into the LISP/Mes domain.
Greetings,
Jan
1) http://www.michaelnielsen.org/ddi/lisp-as-the-maxwells-equations-of-software/
2)
http://www.softwarepreservation.org/projects/LISP/book/LISP%201.5%20Programmers%20Manual.pdf

87
ANNOUNCE-2 Normal file
View file

@ -0,0 +1,87 @@
Subject: on bootstrapping: 2nd status report on Mes
Date: Sun, 25 Sep 2016 13:52:11 +0200
Hi!
In June I announced[0] Mes as a project that seeks to reduce the size of/
dependency on bootstrap binaries, esp. for a system like GuixSD
The strategy was to create a minimal trusted binary (prototyped in C but
eventually to be hand-crafted in assembly/hex) that interpets a minimal
LISP. Then using this minimal but already convenient LISP, extend it
into Scheme and write a tiny C compiler/linker.
Last time I had a minimal LISP-1.5-resembling interpreter in 900 lines
of C that could interpret itself and an extension layer written in LISP
providing a minimal Scheme environment. I was stuck on adding macros in
LISP and had a broken macro implentation in C that I wanted to remove.
Also I hoped to greatly reduce the size of the C part.
New status[1]
* Provide Scheme primitives directly in 1400 lines of C
* Remove LISP-1.5 staging
* closures clue-bat, fixing bugs in begin, lambda, lexical
scoping etc. ... learned a lot!
* quasiquote, unquote, unquote-splicing (in C, too slow in Scheme)
* define-macro (in C)
* define-syntax, syntax-rules (in Scheme, using define-macro)
* all primitives needed to run LALR (strings, vectors, records,
some srfi bits; mostly in Scheme)
* test suite with 97 tests that run with Mes and also with Guile
* minimal and partial ANSI C parser for hello world
* minimal and simplistic 32 bit elf c-ast->elf generator
Mes can now create a running 32-bit elf binary from this hello
world C source with a simplistic for loop
int main ()
{
int i;
puts ("Hi Mes!\n");
for (i = 0; i < 4; ++i)
puts (" Hello, world!\n");
return 1;
}
It takes Mes 1'20" to compile this program, Guile takes 0.5 seconds.
* cannot get psyntax.pp hooked-up or running
* do not understand syntax stuff [well enough] to implement in C
-> no let-syntax, no MATCH
-> no syntax-case, no PEG parser
In theory the bootstrapping problem I set out to solve seems to be
cracked. The remaining problem is reduced to `just work':
implementing a minimal C compiler in Scheme. Questions here: I'm not
convinced yet that this is a meaningful project...aaand I really not
want to tackle this without having MATCH, which Mes does not have yet.
Of the possible directions that I see
0 write the C compiler in Scheme without match
1 rewrite match without let-syntax
2 grok+write let-syntax/syntax-case using define-macro, some bits in C
3 run and hook-up psyntax.pp...BUT that would probably require:
4 address performance problem, possibly by
5 rewrite Mes into a VM-based solution
none I find really attractive. Option 5, a VM is proven to work but
that's quite a change of direction. Looking at other VM-based projects
(e.g. GNU Epsilon[2]) I fear that this must result in a much larger code
base in C, throwing out the minimal trusted binary idea. The other
puzzles and work 0, 2 or 3 still need to be done.
However, diving into syntax-macro or eval work (2 or 3) most probably
needs the performance issue addressed. And if it turns out that a big
VM solution is needed, that may still invalidate this project after
having done even more work.
Help! :-) Ideas?
Greetings,
Jan
[0] https://lists.gnu.org/archive/html/guile-user/2016-06/msg00061.html
[1] https://gitlab.com/janneke/mes
[2] http://git.savannah.gnu.org/cgit/epsilon.git

45
GNUmakefile
View file

@ -45,6 +45,7 @@ mes-check: all
cat base0.mes base0-if.mes base.mes quasiquote.mes lib/test.mes test/quasiquote.test | ./mes
cat base0.mes base0-if.mes base.mes quasiquote.mes let.mes lib/test.mes test/let.test | ./mes
cat base0.mes base0-if.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-if.mes base.mes quasiquote.mes let.mes lib/srfi/srfi-0.scm scm.mes syntax.mes lib/record.mes lib/record.scm lib/srfi/srfi-9.scm lib/test.mes test/record.test |./mes
ifneq ($(SYNTAX),)
cat base0.mes base0-if.mes base.mes quasiquote.mes let.mes scm.mes syntax.mes let-syntax.mes lib/srfi/srfi-0.scm lib/test.mes test/let-syntax.test | ./mes
cat base0.mes base0-if.mes base.mes quasiquote.mes let.mes scm.mes syntax.mes let-syntax.mes lib/srfi/srfi-0.scm lib/match.scm lib/test.mes test/match.test | ./mes
@ -65,6 +66,7 @@ guile-check:
guile -s <(cat lib/test.mes test/let.test)
guile -s <(cat quasiquote.mes lib/test.mes test/base.test)
guile -s <(cat quasiquote.mes lib/test.mes test/quasiquote.test)
guile -s <(cat lib/test.mes test/record.test)
guile -s <(cat lib/test.mes test/let-syntax.test)
guile -s <(cat lib/test.mes test/match.test)
@ -74,62 +76,46 @@ run: all
psyntax: all
cat base0.mes base0-if.mes base.mes quasiquote.mes let.mes psyntax.mes psyntax.pp psyntax2.mes | ./mes
syntax: all
cat base0.mes base0-if.mes base.mes quasiquote.mes let.mes scm.mes syntax.mes syntax-test.mes | ./mes
syntax.test: syntax.mes syntax-test.mes
cat $^ > $@
guile-syntax: syntax.test
guile -s $^
syntax-case: all
cat scm.mes syntax.mes syntax-case-lib.mes syntax-case.mes syntax-case-after.mes syntax-case-test.mes | ./mes
syntax-case.test: syntax.mes syntax-case-lib.mes syntax-case.mes syntax-case-after.mes syntax-case-test.mes
syntax-case.cat: syntax.mes syntax-case-lib.mes syntax-case.mes syntax-case-after.mes syntax-case-test.mes
cat $^ > $@
guile-syntax-case: syntax-case.test
guile-syntax-case: syntax-case.cat
guile -s $^
macro: all
cat base0.mes base0-if.mes base.mes quasiquote.mes let.mes scm.mes macro.mes | ./mes
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
peg.test: peg/pmatch.scm peg.mes peg/codegen.scm peg/string-peg.scm peg/simplify-tree.scm peg/using-parsers.scm peg/cache.scm peg-test.mes
peg.cat: peg/pmatch.scm peg.mes peg/codegen.scm peg/string-peg.scm peg/simplify-tree.scm peg/using-parsers.scm peg/cache.scm peg-test.mes
cat $^ | sed 's,\(;; Packages the results of a parser\),(when (guile?) (set! compile-peg-pattern (@@ (ice-9 peg codegen) compile-peg-pattern)))\n\1,' > $@
guile-peg: peg.test
guile-peg: peg.cat
# guile -s peg-test.mes
# @echo "======================================="
guile -s $^
clean:
rm -f mes environment.i mes.h peg.test syntax.test
record: all
cat scm.mes syntax.mes lib/record.mes lib/record.scm lib/srfi/srfi-9.scm record.mes |./mes
rm -f mes environment.i symbol.i mes.h *.cat hello.o main.o a.out
paren: all
echo -e 'EOF\n___P((()))' | cat base0.mes base0-if.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.cat: lib/lalr.scm paren.scm
cat $^ > $@
guile-paren: paren.test
guile-paren: paren.cat
echo '___P((()))' | guile -s $^
mescc: all
echo ' EOF ' | cat base0.mes base0-if.mes base.mes quasiquote.mes let.mes scm.mes syntax.mes let-syntax.mes lib/srfi/srfi-0.scm lib/record.mes lib/record.scm lib/srfi/srfi-9.scm lib/lalr.mes lib/lalr.scm lib/rnrs/bytevectors.scm lib/srfi/srfi-1.scm lib/match.scm lib/elf.mes c-lexer.scm mescc.scm - main.c | ./mes > a.out
chmod +x a.out
mescc.test: lib/lalr.scm lib/rnrs/bytevectors.scm lib/srfi/srfi-1.scm lib/match.scm lib/elf.mes c-lexer.scm mescc.scm
mescc.cat: lib/lalr.scm lib/rnrs/bytevectors.scm lib/srfi/srfi-1.scm lib/match.scm lib/elf.mes c-lexer.scm mescc.scm
cat $^ > $@
guile-mescc: mescc.test
guile-mescc: mescc.cat
cat main.c | guile -s $^ > a.out
chmod +x a.out
@ -143,12 +129,3 @@ hello: hello.o
a.out: lib/elf.mes elf.mes GNUmakefile
cat base0.mes base0-if.mes base.mes quasiquote.mes let.mes scm.mes lib/rnrs/bytevectors.scm lib/elf.mes elf.mes | ./mes > a.out
chmod +x a.out
match: all
echo ' EOF ' | cat base0.mes base0-if.mes base.mes quasiquote.mes let.mes scm.mes syntax.mes let-syntax.mes lib/srfi/srfi-0.scm lib/record.mes lib/record.scm lib/srfi/srfi-9.scm lib/lalr.mes lib/lalr.scm lib/rnrs/bytevectors.scm lib/srfi/srfi-1.scm lib/match.scm match.mes | ./mes
match.test: lib/lalr.scm lib/rnrs/bytevectors.scm lib/srfi/srfi-1.scm lib/match.scm match.mes
cat $^ > $@
guile-match: match.test
guile -s $^

1
HACKING
View file

@ -1,4 +1,5 @@
-*-mode:org-*-
* Booting from LISP-1.5 into Mes
Mes started out experimenting with booting from a hex-coded minimal

6
README
View file

@ -22,9 +22,11 @@ Current targets.
from there, work on mescc.scm, main.c.
* Transition to syntax-if.scm (still using syntax-cond.scm)
* syntax-case: simple portable version by Andre van Tonder
* syntax-case using portable psyntax.pp
TODO
* syntax-case: using portable psyntax.pp
make psyntax

140
TODO
View file

@ -1,36 +1,36 @@
-*-mode:org-*-
* minimal bootstrap binary, via Scheme, into C compiler/linker
** match
*** let-syntax
** define-syntax and syntax-rules
*** syntax.mes
**** now syntax-cond.mes --> syntax-if.mes
Using define-macro-based version.
** psyntax.pp
Find out how to hook-up sc-expand in eval/apply.
** make core smaller
*** replase mes.c:quasiquote by qq.mes
*** cleanup environment/closures
** make core faster
** core: mes.c
*** make mes.c smaller
**** replace mes.c:quasiquote by quasiquote.mes
***** SPEEDUP
**** cleanup environment/closures
*** make mes.c faster
*** use GC
*** move from C to hex/assembly
** bugs
See bugs/
** run PEG
*** find/fix hygiene problem: see lib/match.scm ;; X vs x
Is it in let, define-syntax, match or intrinsically in define-macro?
** parse C using PEG
http://piumarta.com/software/peg/
*** Simple Guile test:
make guile-peg
*** PEG on Mes does not work yet:
make peg
**** v define-syntax-rule
**** v assq-ref
**** v assq-set!
**** datum->syntax
**** syntax->datum
**** syntax-case
***** portable syntax-case Andre van Tonder
***** psyntax.pp
***** hook-up sc-expand, see guile-1.0?: scheme:eval-transformer
Find out how to hook-up sc-expand in eval/apply.
** parse C using LALR
*** v get LALR running paren.scm
*** Translate cgram.y into lalr, generate AST
** parse C using PEG
http://piumarta.com/software/peg/
** C grammar in lex/yacc
*** C grammar in lex/yacc
https://github.com/rabishah/Mini-C-Compiler-using-Flex-And-Yacc
https://www.lysator.liu.se/c/ANSI-C-grammar-y.html
http://www2.cs.uidaho.edu/~jeffery/courses/nmsu/370/cgram.y
@ -43,57 +43,47 @@ https://en.wikipedia.org/wiki/Tiny_C_Compiler
http://www.t3x.org/subc/index.html
**
https://groups.google.com/forum/#!topic/comp.lang.lisp/VPuX0VsjTTE
** implement core primitives: DONE
begin
define
if
lambda
letrec
quote
set!
** implement minimal needed for psyntax.pp:
v "string"
v #(v e c t o r)
#\CHAR
v assq
v call-with-values
v char?
v for-each
v length
v list
v list->vector
v make-vector
v memq
v memv
v string
v string-append
v string?
v symbol?
v values
v vector
v vector->list
v vector-length
v vector-ref
v vector-set!
v vector?
v procedure?
*** any, each?
*** hook-up sc-expand, see guile-1.0?: scheme:eval-transformer
*** implement extras:
v (gensym)
** implement minimal needed for define-macro-based define-syntax
v char?
v assq
v define-macro
v equal?
v member
v let loop
v nested define-macro
v nested define
v boolean?
v list?
v <=, >=
v string->symbol
v and
v or
v ,@ unquote-splicing
* assorted info
** ASM
http://www.tldp.org/HOWTO/Assembly-HOWTO/linux.html
Basically, you issue an int 0x80, with the __NR_syscallname number
(from asm/unistd.h) in eax, and parameters (up to six) in ebx, ecx,
edx, esi, edi, ebp respectively.
** ELF
7f 45 4c 46
http://www.muppetlabs.com/~breadbox/software/tiny/
http://www.cirosantilli.com/elf-hello-world/
** SCM
http://groups.csail.mit.edu/mac/ftpdir/scm/OLD/scm2e.tar.Z
wget http://groups.csail.mit.edu/mac/ftpdir/scm/OLD/scm3c13.tar.Z
http://groups.csail.mit.edu/mac/ftpdir/scm/OLD/scm4a5.tar.Z
http://groups.csail.mit.edu/mac/ftpdir/scm/OLD/scm5a1.tar.gz --> syntax-rules
http://groups.csail.mit.edu/mac/ftpdir/scm/OLD/scm5c0.tar.gz
define-
http://www.cs.indiana.edu/chezscheme/syntax-case/old-psyntax.html
http://www.cs.indiana.edu/chezscheme/syntax-case/
1.4..2.9:
http://groups.csail.mit.edu/mac/ftpdir/siod/
http://groups.csail.mit.edu/mac/ftpdir/s48/archive/scheme48-0-21.tar.gz
Macros:
http://www.bcl.hamilton.ie/~barak/teach/F97/CS257/macros.html
syntax-case/syntax-rules in clojure
https://github.com/qbg/syntax-rules/blob/master/src/qbg/syntax_rules.clj

32
bugs/c2.mes
View file

@ -1,32 +0,0 @@
;; guile
#!
;;; compiling /home/janneke/src/mes/c2.mes
joepie-complie
;;; compiled /home/janneke/.cache/guile/ccache/2.2-LE-8-3.7/home/janneke/src/mes/c2.mes.go
joepie
jippie
!#
;;mes
(define-macro (bla naam de-lambda)
`(define-macro (,naam . rest)
(,de-lambda)))
(bla joepie
(let ()
(lambda ()
(list 'begin
(list 'display "joepie")
(list 'newline)
(and
(display "joepie-complie")
(newline)
"jippie")))))
(display "compiled")
(newline)
(display (joepie 'x))
(newline)

11
bugs/c4.mes
View file

@ -1,11 +0,0 @@
;; guile: g0
;; mes: crash
(define gensym
(let ((counter 0))
(lambda (. rest)
(let ((value (number->string counter)))
(set! counter (+ counter 1))
(string->symbol (string-append "g" value))))))
(display (gensym))
(newline)

825
cgram-ll1
View file

@ -1,825 +0,0 @@
; 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))))

51
macro.mes
View file

@ -1,51 +0,0 @@
(define-macro (d-s n t)
;; (display "D-S: ")
;; (display `(define-macro (,n . a)
;; (,t (cons ',n a))))
;; (newline)
`(define-macro (,n . args)
;; (display "CALLING: t: ")
;; (display ,t)
;; (display " args: ")
;; (display (cons ',n a))
;; (newline)
;; (display "HALLO: ==>")
;; (display (,t (cons ',n a)))
;; ;; (display "HALLO: ==>")
;; ;; (display (,t (cons ',n a)))
;; (newline)
(,t (cons ',n args))
)
)
(d-s s-r
(let ()
(define name? symbol?)
(lambda (. n-a)
;;(define name? symbol?)
(display "YEAH:")
(display n-a)
(display (name? n-a))
(newline)
'(lambda (. i) ;;(i r c)
(display "transformers")
(newline)
''tee-hee-hee
)
;; (define (foo) (display "Footje") (newline) 'f-f-f)
;; foo
;;"blaat"
))
)
(display "calling s-r")
(newline)
(d-s when
(s-r 0 1 2)
)
(display "calling when")
(newline)
(display (when 3 4 5))
(newline)
'dun

15
record.mes
View file

@ -1,15 +0,0 @@
(define-record-type lexical-token
(make-lexical-token category source value)
lexical-token?
(category lexical-token-category)
(source lexical-token-source)
(value lexical-token-value))
(define tok (make-lexical-token 'x 'y 'z))
(display "tok?: ")
(display (lexical-token? tok))
(newline)
(display tok)
(newline)

38
test/record.test Normal file
View file

@ -0,0 +1,38 @@
;;; -*-scheme-*-
;;; Mes --- Maxwell Equations of Software
;;; Copyright © 2016 Jan Nieuwenhuizen <janneke@gnu.org>
;;;
;;; record.test: 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/>.
(when guile?
(use-modules (srfi srfi-9))
)
(pass-if "first dummy" #t)
(pass-if-not "second dummy" #f)
(define-record-type lexical-token
(make-lexical-token category source value)
lexical-token?
(category lexical-token-category)
(source lexical-token-source)
(value lexical-token-value))
(pass-if "record"
(lexical-token? (make-lexical-token 'x 'y 'z)))
(result 'report)