beginnings of a c preprocessor -- needs #if, #elif, #else

diff --git a/extra/c/preprocessor/authors.txt b/extra/c/preprocessor/authors.txt
new file mode 100644 (file)
index 0000000..b4bd0e7
--- /dev/null
+++ b/extra/c/preprocessor/authors.txt
@@ -0,0 +1 @@
+Doug Coleman
\ No newline at end of file

diff --git a/extra/c/preprocessor/preprocessor-tests.factor b/extra/c/preprocessor/preprocessor-tests.factor
new file mode 100644 (file)
index 0000000..d86b85a
--- /dev/null
+++ b/extra/c/preprocessor/preprocessor-tests.factor
@@ -0,0 +1,16 @@
+! Copyright (C) 2009 Doug Coleman.
+! See http://factorcode.org/license.txt for BSD license.
+USING: tools.test c.preprocessor kernel accessors ;
+IN: c.preprocessor.tests
+
+[ "vocab:c/tests/test1/test1.c" start-preprocess-file ]
+[ include-nested-too-deeply? ] must-fail-with
+
+[ "yo\n\n\n\nyo4\n" ]
+[ "vocab:c/tests/test2/test2.c" start-preprocess-file nip ] unit-test
+
+[ "vocab:c/tests/test3/test3.c" start-preprocess-file ]
+[ "\"BOO\"" = ] must-fail-with
+
+[ V{ "\"omg\"" "\"lol\"" } ]
+[ "vocab:c/tests/test4/test4.c" start-preprocess-file drop warnings>> ] unit-test

diff --git a/extra/c/preprocessor/preprocessor.factor b/extra/c/preprocessor/preprocessor.factor
new file mode 100644 (file)
index 0000000..89292eb
--- /dev/null
+++ b/extra/c/preprocessor/preprocessor.factor
@@ -0,0 +1,155 @@
+! Copyright (C) 2009 Doug Coleman.
+! See http://factorcode.org/license.txt for BSD license.
+USING: html.parser.state io io.encodings.utf8 io.files
+io.streams.string kernel combinators accessors io.pathnames
+fry sequences arrays locals namespaces io.directories
+assocs math splitting make ;
+IN: c.preprocessor
+
+: initial-library-paths ( -- seq )
+    V{ "/usr/include" } clone ;
+
+TUPLE: preprocessor-state library-paths symbol-table
+include-nesting include-nesting-max processing-disabled?
+ifdef-nesting warnings ;
+
+: <preprocessor-state> ( -- preprocessor-state )
+    preprocessor-state new
+        initial-library-paths >>library-paths
+        H{ } clone >>symbol-table
+        0 >>include-nesting
+        200 >>include-nesting-max
+        0 >>ifdef-nesting
+        V{ } clone >>warnings ;
+
+DEFER: preprocess-file
+
+ERROR: unknown-c-preprocessor state-parser name ;
+
+ERROR: bad-include-line line ;
+
+ERROR: header-file-missing path ;
+
+:: read-standard-include ( preprocessor-state path -- )
+    preprocessor-state dup library-paths>>
+    [ path append-path exists? ] find nip
+    [
+        dup [
+            path append-path
+            preprocess-file
+        ] with-directory
+    ] [
+        ! path header-file-missing
+        drop
+    ] if* ;
+
+:: read-local-include ( preprocessor-state path -- )
+    current-directory get path append-path dup :> full-path
+    dup exists? [
+        [ preprocessor-state ] dip preprocess-file
+    ] [
+        ! full-path header-file-missing
+        drop
+    ] if ;
+
+: handle-include ( preprocessor-state state-parser -- )
+    skip-whitespace advance dup previous {
+        { CHAR: < [ CHAR: > take-until-object read-standard-include ] }
+        { CHAR: " [ CHAR: " take-until-object read-local-include ] }
+        [ bad-include-line ]
+    } case ;
+
+: (readlns) ( -- )
+    readln "\\" ?tail [ , ] dip [ (readlns) ] when ;
+
+: readlns ( -- string ) [ (readlns) ] { } make concat ;
+
+: handle-define ( preprocessor-state state-parser -- )
+    [ take-token ] [ take-rest ] bi 
+    "\\" ?tail [ readlns append ] when
+    spin symbol-table>> set-at ;
+
+: handle-undef ( preprocessor-state state-parser -- )
+    take-token swap symbol-table>> delete-at ;
+
+: handle-ifdef ( preprocessor-state state-parser -- )
+    [ [ 1 + ] change-ifdef-nesting ] dip
+    take-token over symbol-table>> key?
+    [ drop ] [ t >>processing-disabled? drop ] if ;
+
+: handle-ifndef ( preprocessor-state state-parser -- )
+    [ [ 1 + ] change-ifdef-nesting ] dip
+    take-token over symbol-table>> key?
+    [ t >>processing-disabled? drop ]
+    [ drop ] if ; 
+
+: handle-endif ( preprocessor-state state-parser -- )
+    drop [ 1 - ] change-ifdef-nesting drop ;
+
+: handle-error ( preprocessor-state state-parser -- )
+    skip-whitespace
+    nip take-rest throw ;
+
+: handle-warning ( preprocessor-state state-parser -- )
+    skip-whitespace
+    take-rest swap warnings>> push ;
+
+: parse-directive ( preprocessor-state state-parser string -- )
+    {
+        { "warning" [ handle-warning ] }
+        { "error" [ handle-error ] }
+        { "include" [ handle-include ] }
+        { "define" [ handle-define ] }
+        { "undef" [ handle-undef ] }
+        { "ifdef" [ handle-ifdef ] }
+        { "ifndef" [ handle-ifndef ] }
+        { "endif" [ handle-endif ] }
+        { "if" [ 2drop ] }
+        { "elif" [ 2drop ] }
+        { "else" [ 2drop ] }
+        { "pragma" [ 2drop ] }
+        { "include_next" [ 2drop ] }
+        [ unknown-c-preprocessor ]
+    } case ;
+
+: parse-directive-line ( preprocessor-state state-parser -- )
+    advance dup take-token
+    pick processing-disabled?>> [
+        "endif" = [
+            drop f >>processing-disabled?
+            [ 1 - ] change-ifdef-nesting
+            drop
+         ] [ 2drop ] if
+    ] [
+        parse-directive
+    ] if ;
+
+: preprocess-line ( preprocessor-state state-parser -- )
+    skip-whitespace dup current CHAR: # =
+    [ parse-directive-line ]
+    [ swap processing-disabled?>> [ drop ] [ write-full nl ] if ] if ;
+
+: preprocess-lines ( preprocessor-state -- )
+    readln 
+    [ <state-parser> [ preprocess-line ] [ drop preprocess-lines ] 2bi ]
+    [ drop ] if* ;
+
+ERROR: include-nested-too-deeply ;
+
+: check-nesting ( preprocessor-state -- preprocessor-state )
+    [ 1 + ] change-include-nesting
+    dup [ include-nesting>> ] [ include-nesting-max>> ] bi > [
+        include-nested-too-deeply
+    ] when ;
+
+: preprocess-file ( preprocessor-state path -- )
+    [ check-nesting ] dip
+    [ utf8 [ preprocess-lines ] with-file-reader ]
+    [ drop [ 1 - ] change-include-nesting drop ] 2bi ;
+
+: start-preprocess-file ( path -- preprocessor-state string )
+    dup parent-directory [
+        [
+            [ <preprocessor-state> dup ] dip preprocess-file
+        ] with-string-writer
+    ] with-directory ;

diff --git a/extra/c/tests/test1/README b/extra/c/tests/test1/README
new file mode 100644 (file)
index 0000000..9987313
--- /dev/null
+++ b/extra/c/tests/test1/README
@@ -0,0 +1 @@
+Tests if the preprocessor bails on an infinite loop caused by mutually recursive #include lines.

diff --git a/extra/c/tests/test1/hi.h b/extra/c/tests/test1/hi.h
new file mode 100644 (file)
index 0000000..c9f337c
--- /dev/null
+++ b/extra/c/tests/test1/hi.h
@@ -0,0 +1 @@
+#include "lo.h"

diff --git a/extra/c/tests/test1/lo.h b/extra/c/tests/test1/lo.h
new file mode 100644 (file)
index 0000000..d59fdd2
--- /dev/null
+++ b/extra/c/tests/test1/lo.h
@@ -0,0 +1 @@
+#include "hi.h"

diff --git a/extra/c/tests/test1/test1.c b/extra/c/tests/test1/test1.c
new file mode 100644 (file)
index 0000000..d59fdd2
--- /dev/null
+++ b/extra/c/tests/test1/test1.c
@@ -0,0 +1 @@
+#include "hi.h"

diff --git a/extra/c/tests/test2/README b/extra/c/tests/test2/README
new file mode 100644 (file)
index 0000000..4244828
--- /dev/null
+++ b/extra/c/tests/test2/README
@@ -0,0 +1 @@
+Tests whether #define and #ifdef/#endif work in the positive case.

diff --git a/extra/c/tests/test2/test2.c b/extra/c/tests/test2/test2.c
new file mode 100644 (file)
index 0000000..4cc4191
--- /dev/null
+++ b/extra/c/tests/test2/test2.c
@@ -0,0 +1,17 @@
+#define YO
+#ifdef YO
+yo
+#endif
+
+#define YO2
+#ifndef YO2
+yo2
+#endif
+
+#ifdef YO3
+yo3
+#endif
+
+#ifndef YO4
+yo4
+#endif

diff --git a/extra/c/tests/test3/README b/extra/c/tests/test3/README
new file mode 100644 (file)
index 0000000..4244828
--- /dev/null
+++ b/extra/c/tests/test3/README
@@ -0,0 +1 @@
+Tests whether #define and #ifdef/#endif work in the positive case.

diff --git a/extra/c/tests/test3/test3.c b/extra/c/tests/test3/test3.c
new file mode 100644 (file)
index 0000000..8d08e83
--- /dev/null
+++ b/extra/c/tests/test3/test3.c
@@ -0,0 +1 @@
+#error "BOO"

diff --git a/extra/c/tests/test4/test4.c b/extra/c/tests/test4/test4.c
new file mode 100644 (file)
index 0000000..5acd20d
--- /dev/null
+++ b/extra/c/tests/test4/test4.c
@@ -0,0 +1,2 @@
+#warning "omg"
+#warning "lol"