diff --git a/.gitignore b/.gitignore index 11e545fe..8751850f 100644 --- a/.gitignore +++ b/.gitignore @@ -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 diff --git a/ANNOUNCE b/ANNOUNCE new file mode 100644 index 00000000..e73075b4 --- /dev/null +++ b/ANNOUNCE @@ -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 + diff --git a/ANNOUNCE-2 b/ANNOUNCE-2 new file mode 100644 index 00000000..6a2e5234 --- /dev/null +++ b/ANNOUNCE-2 @@ -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 diff --git a/GNUmakefile b/GNUmakefile index d06c80c2..7498e132 100644 --- a/GNUmakefile +++ b/GNUmakefile @@ -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 $^ diff --git a/HACKING b/HACKING index fd0ff1ee..a3cb933c 100644 --- a/HACKING +++ b/HACKING @@ -1,4 +1,5 @@ -*-mode:org-*- + * Booting from LISP-1.5 into Mes Mes started out experimenting with booting from a hex-coded minimal diff --git a/README b/README index 0ad3736b..2d776db4 100644 --- a/README +++ b/README @@ -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 diff --git a/TODO b/TODO index 9c8d4db1..c61a9304 100644 --- a/TODO +++ b/TODO @@ -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 diff --git a/bugs/c2.mes b/bugs/c2.mes deleted file mode 100644 index ee9f374b..00000000 --- a/bugs/c2.mes +++ /dev/null @@ -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) - diff --git a/bugs/c4.mes b/bugs/c4.mes deleted file mode 100644 index c77dd210..00000000 --- a/bugs/c4.mes +++ /dev/null @@ -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) diff --git a/cgram-ll1 b/cgram-ll1 deleted file mode 100644 index 2c23d511..00000000 --- a/cgram-ll1 +++ /dev/null @@ -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)))) diff --git a/macro.mes b/macro.mes deleted file mode 100644 index a7a2d498..00000000 --- a/macro.mes +++ /dev/null @@ -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 diff --git a/record.mes b/record.mes deleted file mode 100644 index fb15dabe..00000000 --- a/record.mes +++ /dev/null @@ -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) diff --git a/test/record.test b/test/record.test new file mode 100644 index 00000000..e27b5430 --- /dev/null +++ b/test/record.test @@ -0,0 +1,38 @@ +;;; -*-scheme-*- + +;;; Mes --- Maxwell Equations of Software +;;; Copyright © 2016 Jan Nieuwenhuizen +;;; +;;; 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 . + +(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)