From 242638fc5c20a70cd96a3dd770ed097fb3327824 Mon Sep 17 00:00:00 2001
From: Slava Pestov <slava@slava-pestovs-macbook-pro.local>
Date: Fri, 6 Feb 2009 04:38:31 -0600
Subject: [PATCH] alien.complex vocabulary implementing support for C99 complex
 numbers

---
 basis/alien/complex/authors.txt               |  1 +
 basis/alien/complex/complex-tests.factor      | 18 ++++++++++
 basis/alien/complex/complex.factor            |  6 ++++
 basis/alien/complex/functor/authors.txt       |  1 +
 .../complex/functor/functor-tests.factor      |  4 +++
 basis/alien/complex/functor/functor.factor    | 35 +++++++++++++++++++
 basis/alien/complex/summary.txt               |  1 +
 7 files changed, 66 insertions(+)
 create mode 100644 basis/alien/complex/authors.txt
 create mode 100644 basis/alien/complex/complex-tests.factor
 create mode 100644 basis/alien/complex/complex.factor
 create mode 100644 basis/alien/complex/functor/authors.txt
 create mode 100644 basis/alien/complex/functor/functor-tests.factor
 create mode 100644 basis/alien/complex/functor/functor.factor
 create mode 100644 basis/alien/complex/summary.txt

diff --git a/basis/alien/complex/authors.txt b/basis/alien/complex/authors.txt
new file mode 100644
index 0000000000..d4f5d6b3ae
--- /dev/null
+++ b/basis/alien/complex/authors.txt
@@ -0,0 +1 @@
+Slava Pestov
\ No newline at end of file
diff --git a/basis/alien/complex/complex-tests.factor b/basis/alien/complex/complex-tests.factor
new file mode 100644
index 0000000000..bfb2c1137c
--- /dev/null
+++ b/basis/alien/complex/complex-tests.factor
@@ -0,0 +1,18 @@
+! Copyright (C) 2009 Slava Pestov.
+! See http://factorcode.org/license.txt for BSD license.
+USING: tools.test alien.complex kernel alien.c-types alien.syntax
+namespaces ;
+IN: alien.complex.tests
+
+C-STRUCT: complex-holder
+    { "complex-float" "z" } ;
+
+: <complex-holder> ( z -- alien )
+    "complex-holder" <c-object>
+    [ set-complex-holder-z ] keep ;
+
+[ ] [
+    C{ 1.0 2.0 } <complex-holder> "h" set
+] unit-test
+
+[ C{ 1.0 2.0 } ] [ "h" get complex-holder-z ] unit-test
\ No newline at end of file
diff --git a/basis/alien/complex/complex.factor b/basis/alien/complex/complex.factor
new file mode 100644
index 0000000000..60a84b9394
--- /dev/null
+++ b/basis/alien/complex/complex.factor
@@ -0,0 +1,6 @@
+! Copyright (C) 2009 Slava Pestov.
+! See http://factorcode.org/license.txt for BSD license.
+USING: alien.complex.functor sequences kernel ;
+IN: alien.complex
+
+<< { "float" "double" } [ dup "complex-" prepend define-complex-type ] each >>
\ No newline at end of file
diff --git a/basis/alien/complex/functor/authors.txt b/basis/alien/complex/functor/authors.txt
new file mode 100644
index 0000000000..d4f5d6b3ae
--- /dev/null
+++ b/basis/alien/complex/functor/authors.txt
@@ -0,0 +1 @@
+Slava Pestov
\ No newline at end of file
diff --git a/basis/alien/complex/functor/functor-tests.factor b/basis/alien/complex/functor/functor-tests.factor
new file mode 100644
index 0000000000..c2df22be1d
--- /dev/null
+++ b/basis/alien/complex/functor/functor-tests.factor
@@ -0,0 +1,4 @@
+! Copyright (C) 2009 Slava Pestov.
+! See http://factorcode.org/license.txt for BSD license.
+USING: tools.test alien.complex.functor ;
+IN: alien.complex.functor.tests
diff --git a/basis/alien/complex/functor/functor.factor b/basis/alien/complex/functor/functor.factor
new file mode 100644
index 0000000000..1d12bb0ff4
--- /dev/null
+++ b/basis/alien/complex/functor/functor.factor
@@ -0,0 +1,35 @@
+! Copyright (C) 2009 Slava Pestov.
+! See http://factorcode.org/license.txt for BSD license.
+USING: alien.structs alien.c-types math math.functions sequences
+arrays kernel functors vocabs.parser namespaces accessors
+quotations ;
+IN: alien.complex.functor
+
+FUNCTOR: define-complex-type ( N T -- )
+
+T-real DEFINES ${T}-real
+T-imaginary DEFINES ${T}-imaginary
+set-T-real DEFINES set-${T}-real
+set-T-imaginary DEFINES set-${T}-imaginary
+
+>T DEFINES >${T}
+T> DEFINES ${T}>
+
+WHERE
+
+: >T ( z -- alien )
+    >rect T <c-object> [ set-T-imaginary ] [ set-T-real ] [ ] tri ; inline
+
+: T> ( alien -- z )
+    [ T-real ] [ T-imaginary ] bi rect> ; inline
+
+T in get
+{ { N "real" } { N "imaginary" } }
+define-struct
+
+T c-type
+T> 1quotation >>boxer-quot
+>T 1quotation >>unboxer-quot
+drop
+
+;FUNCTOR
\ No newline at end of file
diff --git a/basis/alien/complex/summary.txt b/basis/alien/complex/summary.txt
new file mode 100644
index 0000000000..76c00c1d65
--- /dev/null
+++ b/basis/alien/complex/summary.txt
@@ -0,0 +1 @@
+Implementation details for C99 complex float and complex double types