]> gitweb.factorcode.org Git - factor-unmaintained.git/commitdiff
Merge pull request #1 from AlexIljin/master
authorJohn Benediktsson <mrjbq7@gmail.com>
Mon, 22 Jan 2018 16:00:03 +0000 (08:00 -0800)
committerGitHub <noreply@github.com>
Mon, 22 Jan 2018 16:00:03 +0000 (08:00 -0800)
Remove resurrected vocabs

boolean-expr/authors.txt [deleted file]
boolean-expr/boolean-expr.factor [deleted file]
boolean-expr/summary.txt [deleted file]
dragdrop-listener/dragdrop-listener.factor [deleted file]
dragdrop-listener/platforms.txt [deleted file]

diff --git a/boolean-expr/authors.txt b/boolean-expr/authors.txt
deleted file mode 100644 (file)
index 1901f27..0000000
+++ /dev/null
@@ -1 +0,0 @@
-Slava Pestov
diff --git a/boolean-expr/boolean-expr.factor b/boolean-expr/boolean-expr.factor
deleted file mode 100644 (file)
index 33e5e92..0000000
+++ /dev/null
@@ -1,95 +0,0 @@
-! Copyright (C) 2008 Slava Pestov.
-! See http://factorcode.org/license.txt for BSD license.
-USING: accessors arrays classes kernel sequences sets
-io prettyprint multi-methods ;
-IN: boolean-expr
-
-! Demonstrates the use of Unicode symbols in source files, and
-! multi-method dispatch.
-
-TUPLE: ⋀ x y ;
-TUPLE: ⋁ x y ;
-TUPLE: ¬ x ;
-
-SINGLETONS: ⊤ ⊥ ;
-
-SINGLETONS: P Q R S T U V W X Y Z ;
-
-UNION: □ ⋀ ⋁ ¬ ⊤ ⊥ P Q R S T U V W X Y Z ;
-
-GENERIC: ⋀ ( x y -- expr )
-
-METHOD: ⋀ { ⊤ □ } nip ;
-METHOD: ⋀ { □ ⊤ } drop ;
-METHOD: ⋀ { ⊥ □ } drop ;
-METHOD: ⋀ { □ ⊥ } nip ;
-
-METHOD: ⋀ { ⋁ □ } [ [ x>> ] dip ⋀ ] [ [ y>> ] dip ⋀ ] 2bi ⋁ ;
-METHOD: ⋀ { □ ⋁ } [ x>> ⋀ ] [ y>> ⋀ ] 2bi ⋁ ;
-
-METHOD: ⋀ { □ □ } \ ⋀ boa ;
-
-GENERIC: ⋁ ( x y -- expr )
-
-METHOD: ⋁ { ⊤ □ } drop ;
-METHOD: ⋁ { □ ⊤ } nip ;
-METHOD: ⋁ { ⊥ □ } nip ;
-METHOD: ⋁ { □ ⊥ } drop ;
-
-METHOD: ⋁ { □ □ } \ ⋁ boa ;
-
-GENERIC: ¬ ( x -- expr )
-
-METHOD: ¬ { ⊤ } drop ⊥ ;
-METHOD: ¬ { ⊥ } drop ⊤ ;
-
-METHOD: ¬ { ⋀ } [ x>> ¬ ] [ y>> ¬ ] bi ⋁ ;
-METHOD: ¬ { ⋁ } [ x>> ¬ ] [ y>> ¬ ] bi ⋀ ;
-
-METHOD: ¬ { □ } \ ¬ boa ;
-
-: → ( x y -- expr ) ¬ ⋀ ;
-: ⊕ ( x y -- expr ) [ ⋁ ] [ ⋀ ¬ ] 2bi ⋀ ;
-: ≣ ( x y -- expr ) [ ⋀ ] [ [ ¬ ] bi@ ⋀ ] 2bi ⋁ ;
-
-GENERIC: (cnf) ( expr -- cnf )
-
-METHOD: (cnf) { ⋀ } [ x>> (cnf) ] [ y>> (cnf) ] bi append ;
-METHOD: (cnf) { □ } 1array ;
-
-GENERIC: cnf ( expr -- cnf )
-
-METHOD: cnf { ⋁ } [ x>> cnf ] [ y>> cnf ] bi append ;
-METHOD: cnf { □ } (cnf) 1array ;
-
-GENERIC: satisfiable? ( expr -- ? )
-
-METHOD: satisfiable? { ⊤ } drop t ;
-METHOD: satisfiable? { ⊥ } drop f ;
-
-: partition ( seq quot -- left right )
-    [ [ not ] compose filter ] [ filter ] 2bi ; inline
-
-: (satisfiable?) ( seq -- ? )
-    [ \ ¬ instance? ] partition [ x>> ] map intersect empty? ;
-
-METHOD: satisfiable? { □ }
-    cnf [ (satisfiable?) ] any? ;
-
-GENERIC: (expr.) ( expr -- )
-
-METHOD: (expr.) { □ } pprint ;
-
-: op. ( expr -- )
-    "(" write
-    [ x>> (expr.) ]
-    [ bl class pprint bl ]
-    [ y>> (expr.) ]
-    tri
-    ")" write ;
-
-METHOD: (expr.) { ⋀ } op. ;
-METHOD: (expr.) { ⋁ } op. ;
-METHOD: (expr.) { ¬ } [ class pprint ] [ x>> (expr.) ] bi ;
-
-: expr. ( expr -- ) (expr.) nl ;
diff --git a/boolean-expr/summary.txt b/boolean-expr/summary.txt
deleted file mode 100644 (file)
index 9b51186..0000000
+++ /dev/null
@@ -1 +0,0 @@
-Simple boolean expression evaluator and simplifier
diff --git a/dragdrop-listener/dragdrop-listener.factor b/dragdrop-listener/dragdrop-listener.factor
deleted file mode 100644 (file)
index 5f3f12b..0000000
+++ /dev/null
@@ -1,74 +0,0 @@
-USING: alien.strings io.encodings.utf16n windows.com
-windows.com.wrapper combinators windows.kernel32 windows.ole32
-windows.shell32 kernel accessors windows.types
-prettyprint namespaces ui.tools.listener ui.tools.workspace
-alien.data alien sequences math classes.struct ;
-SPECIALIZED-ARRAY: WCHAR
-IN: windows.dragdrop-listener
-
-: filenames-from-hdrop ( hdrop -- filenames )
-    dup 0xFFFFFFFF f 0 DragQueryFile ! get count of files
-    [
-        2dup f 0 DragQueryFile 1 + ! get size of filename buffer
-        dup WCHAR <c-array>
-        [ swap DragQueryFile drop ] keep
-        utf16n alien>string
-    ] with map ;
-
-: filenames-from-data-object ( data-object -- filenames )
-    FORMATETC <struct>
-        CF_HDROP         >>cfFormat
-        f                >>ptd
-        DVASPECT_CONTENT >>dwAspect
-        -1               >>lindex
-        TYMED_HGLOBAL    >>tymed
-    STGMEDIUM <struct>
-    [ IDataObject::GetData ] keep swap succeeded? [
-        dup data>>
-        [ filenames-from-hdrop ] with-global-lock
-        swap ReleaseStgMedium
-    ] [ drop f ] if ;
-
-TUPLE: listener-dragdrop hWnd last-drop-effect ;
-
-: <listener-dragdrop> ( hWnd -- object )
-    DROPEFFECT_NONE listener-dragdrop construct-boa ;
-
-SYMBOL: +listener-dragdrop-wrapper+
-{
-    { "IDropTarget" {
-        [ ! DragEnter
-            [
-                2drop
-                filenames-from-data-object
-                length 1 = [ DROPEFFECT_COPY ] [ DROPEFFECT_NONE ] if
-                dup 0
-            ] dip set-ulong-nth
-            >>last-drop-effect drop
-            S_OK
-        ] [ ! DragOver
-            [ 2drop last-drop-effect>> 0 ] dip set-ulong-nth
-            S_OK
-        ] [ ! DragLeave
-            drop S_OK
-        ] [ ! Drop
-            [
-                2drop nip
-                filenames-from-data-object
-                dup length 1 = [
-                    first unparse [ "USE: parser " % % " run-file" % ] "" make
-                    eval-listener
-                    DROPEFFECT_COPY
-                ] [ 2drop DROPEFFECT_NONE ] if
-                0
-            ] dip set-ulong-nth
-            S_OK
-        ]
-    } }
-} <com-wrapper> +listener-dragdrop-wrapper+ set-global
-
-: dragdrop-listener-window ( -- )
-    get-workspace parent>> handle>> hWnd>>
-    dup <listener-dragdrop>
-    +listener-dragdrop-wrapper+ get-global com-wrap
-    [ RegisterDragDrop ole32-error ] with-com-interface ;
diff --git a/dragdrop-listener/platforms.txt b/dragdrop-listener/platforms.txt
deleted file mode 100644 (file)
index 8e1a559..0000000
+++ /dev/null
@@ -1 +0,0 @@
-windows